'COLLECT1 - collections - checks if goods paid for when appropriate

external   vloadif() sch scw messbox() fentrybox() dpath cpath shopmask nr5
external   fgp userid scr dsa strtoary() arytostr() vkeybox() $enternow
external   remove() makeidx() bgp fgi bgi progress() PrintReport() colpopup()
external   lpath bge popuplist() city wraptext() #maxleft #minleft messboxwait()
external   entryline() messline() strcount() posnpopup() jobs[6] shopname
external   vunloadif() ipath base navrecs() bpopdb() chkdate() Background()
external   addidxrec() delidxrec() getidxrecs() delstr() gdsoutpath FindJob()
external   to_busdate() colmessbox() $menu increment()

public     #start #end #days ptstr ptval psa ptary[1] plist[1,1] custcode
public     ftgdate custname $collector $deldate $thisday jobnr cr_status
public     $cust docref $ref $name custref prodcode

global     x startdate enddate y #recs i y1 y2 y3 col z ss SetupScreen() WC()
global     $date $dow $dfa $a1 $a2 $a3 $a4 $a5 $a6 $a7 w $comment r1 #precnr
global     $slotsrem #slotsrem #apptslots $jobstr sd c UpdateStock()
global     $popstr ftrname #appt $appth deladdr1 title1 PrintDespatch()
global     spc $pl g fgc bgc EnterCollector() $itemtype AllThisReqn() NavMess()
global     z1 z2 z3 z4 z5 z6 z7 z8 $ftrcode n #prec #rec #count NewGoodsOut()
global     drows pl t rec recs lc sc sym mr blen l c2 r2 dc pc k pg tr $refnr
global     namelist[1,1] $idx $stat $dely $esc #dellength #delcost reqnnr
global     prodMRC #del_cost #rem_len #refnr $ordstat #bline $mess ShowSelection()
global     refcode #rem_cost $daynr $ftgnr $col1 $gdsout1 $gdsout2 DeliverMenu()
global     $status $b1 $b2 $b3 $b4 $b5 $b6 $b7 ca ChooseAction() StoreReport()
global     EnterJobNr() ReturnToMenu() #oslength #oscost $rollnr SelectStock()
global     p1 p2 p3 p4 p5 p6 RecsScroll() NavMess_A() arc #out Trans_STCK()
'  UpdateDocRef() #out
global     colSf colSb colIf colIb ProcessCollection() CheckRdy4Inv()
global     EnterCustomer() ec SelectCustomer() CuttingList() Trans_BESP()
global     stkfile datenumber #newbal EnterDocRef() Trans_ANCL()
global     CuttingTicket()


MAIN
local pc
single-step off
  Background()
'   screen clear box 1 1 sch scw 0 0 no-border
  file unload all

  p2 = ""               ' p2 = title at top of choice popup ("LABEL")
  p3 = 1                ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
  p4 = 2                ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
  p5 = 1                ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE
  p6 = 1                ' p6 = nr of copies
  $gdsout1 = "gds_col1.vw"
  $gdsout2 = "gds_col2.vw"
  $deldate = today
'   $thisday = $deldate
  $name = custname
  ftgdate = today

  colSf = 14
  colSb = 12
  colIf = 0
  colIb = 15

  while true
    sc = SelectCustomer()              ' message "sc is:"&str(sc)
    if sc = -1
      exit while
    elseif sc = 1
      continue while
    end if

    pc = ProcessCollection()
    if pc = -1
      exit while
    elseif pc = 1
      continue while
    end if
  end while

  ReturnToMenu()
  transfer cpath|"pm_menu.psl" in-memory

END MAIN


FUNCTION SelectCustomer()
  ec = EnterCustomer()               '2=Other customer ;0=Trade customer
  if ec = 2
    x = EnterJobNr()
    if x = -1
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      return (1)

    elseif x = 1                   ' CASH a/c - not yet paid
      return (1)

    elseif x = 0                   ' OK for collection
      if [Completed] = "N"    'Mark order as completed if not already invoiced
        messbox(" This Order will be marked as COMPLETE & invoiced? (y/n) ",1,1,1)
        if ptstr == "n"
          return (-1)
        end if
        lock-record
          [Completed] = "Y"
        write-record
      end if
      return (0)
    end if

' message "cr_status is:"&str(cr_status)
    if cr_status = "C" or cr_status = "T"
'entering items to GOODSOUT & printing Collection Note is done AFTER payt
' message "check whether order has been invoiced & paid"
' message "[Balance_Due] is:"&str([Balance_Due])
      if [Balance_Due] > .1
        messboxwait(" Arrange for Cash to be paid & invoice printed ",0,0,1)
        return (0)
      else
        return (0)
      end if

    elseif cr_status = "A" or cr_status = "N" or cr_status = "D"
      return (0)
    end if

  elseif ec = 0                        ' Trade account
    return (0)

  elseif ec = 1                        ' Trade account
    return (1)

  elseif ec = -1
    return (-1)
  end if
END FUNCTION ' SelectCustomer()


FUNCTION EnterJobNr()                   ' finds Job & updates Cust_Ord
local l1 c3 c2 c1 ques $reqstr fj
  Background()
  smartpoke $_ins 0
  while true
    x = fentrybox(" Enter Order Nr for Delivery; {Esc} to exit ",6,shopmask,"")
    if x = -1
      return (-1)
    elseif x = 0
      jobnr = ptstr
    end if

    vloadif(dpath|"salord04.vw")
    order change key "[Job_Nr]"
    data find "[Job_Nr]" equal jobnr options "g"   '  find correct JOB
    if cerror
      messboxwait(" Job Nr -"&jobnr&"- NOT found ",0,0,1)
      return (-1)
    end if
    repaint off
    exit while
  end while

  custref   = [Customer_Ref]
  cr_status = [Credit_Status]
  custname = [CustOrd_Name]

'########## re-instate these lines when payment for collection is resolved
  if cr_status = "C" or cr_status = "T"    ' check for payment
    if round([Balance_Due],2) <> 0
      messboxwait(" "&jobnr&"- cannot collect - balance to pay ",0,0,1)
      return (1)
    end if
  end if
'##########

' check invoiced
'   if len([Inv_Nr])>0
'     if [Balance_Due] > 0
'       messboxwait(" Balance must be paid first ",0,0,1)
'       return (1)
'     else
'       return (2)
'     end if
'   end if

  if cr_status = "N"
    messboxwait(" Trade Account - use correct routine for Collections ",0,0,1)
    return (-1)
  end if
  return (0)
END FUNCTION ' EnterJobNr()


FUNCTION EnterCustomer()                   ' finds Job & updates Cust_Ord
local y1
  while true
    x = popuplist(10,33,13,"Trade˙Account Other˙customer","",1,0)
    if x = -1
      return (-1)
    end if

    if ptstr = "Other˙customer"
      return (2)

    elseif ptstr = "Trade˙Account"
      vloadif(dpath|"customer.vws")
      order change index ipath|"collectn.idx"
      repaint off
      y1 = format(" Choose Customer and press {Enter} ","M38")
      screen print 5 21 15 1 y1
      x = bpopdb("customer",6,"","[Customer_Name]","l35","[Customer_Code]","L6","[Customer_Code]",6,21,20,58,"",0)
      if x = 0
        if [Uninvoiced] = "N"
          Background()
          messboxwait(" NO collections permitted - contact Accounts ",0,0,1)
          return (1)
        end if
        screen clear box 1 1 sch scw 0 0 no-border
        custcode  = ptstr
        custname  = [Customer_Name]
'         cr_limit  = [Credit_Limit]
        cr_status = [Credit_Status]
        return (0)

      elseif x = -1
        screen clear box 1 1 sch scw 0 0 no-border
        return (-1)
      end if
    end if
  end while
END FUNCTION ' EnterCustomer()


FUNCTION ReturnToMenu()
  Background()
  error off
  while true
    window close
    if cerror
      exit while
    end if
  end while
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION


FUNCTION EnterCollector()
  while true
    x = fentrybox(" Name of person collecting ",10,"","")
    if x = -1
      continue while
    end if
    if ptstr = ""
      continue while
    end if
    $collector = ptstr
    exit while
  end while
END FUNCTION ' EnterCollector()


FUNCTION NewGoodsOut()
' message "custcode is:"&str(custcode)
' message "$itemtype) is:"&str($itemtype)
' message "#dellength) is:"&str(#dellength)
' message "#delcost) is:"&str(#delcost)
' message "$refnr) is:"&str($refnr)
' message "jobnr) is:"&str(jobnr)
' message "Check Roll Nr"
  vloadif(dpath|"goodsout.vws")
  data enter lock
    [FtrCode]   = custcode
    [Itemtype]  = $itemtype
    [Date_Out]  = date2(today)
    [QuantOut]  = #dellength
    [Cost]      = #delcost
    [Requsn_Nr] = $refnr
    [RollNr]    = $rollnr
    [Job_Nr]    = jobnr
    [Created_By]= userid
  write-record
  #precnr = precord
END FUNCTION ' NewGoodsOut()


FUNCTION StoreReport(p1,ext)
local despdoc collectidx
  despdoc = gdsoutpath|docref|"."|ext  'message "dlyrep is:"&str(dlyrep)
  print report execute p1 disk despdoc detail start 1 end 0 copies 1
  collectidx = gdsoutpath|docref|".idx"  'message "collectidx is:"&str(collectidx)
  remove(collectidx)
  makeidx("goodsout",collectidx,"0",1)
'save index
  for i = 1 to records
    x = addidxrec(collectidx,precord,7)  'message "x is:"&str(x)
    data goto record next
  end for
END FUNCTION ' StoreReport()


FUNCTION DeliverMenu()
local ca
  repaint off
  ss = SetupScreen()
  if ss = 1
    repaint off
    WC()
    vunloadif($gdsout1)
    vunloadif($gdsout2)
    return (-1)
  end if

  remove("showcoll.idx")
  makeidx("goodsout","showcoll.idx","0",1)

  ca = ChooseAction()                  'message "ca is:"&str(ca)
  repaint off
  WC()
  vunloadif($gdsout1)
  vunloadif($gdsout2)
  if ca = -1
    return (-1)
  elseif ca = 0
    return (0)
  end if
END FUNCTION ' DeliverMenu()


FUNCTION AllThisReqn()
  repaint off
  #dellength = [Quant_OS]              'message "#dellength is:"&str(#dellength)
  if #dellength = 0
    messboxwait(" Already marked for delivery ",0,0,1)
    return (1)
  end if
  #delcost  = [Cost]                   'message "#delcost is:"&str(#delcost)
  $refnr    = [Reference_Nr]
  $rollnr   = [RollNr]
  $itemtype = [Item_Type]              'message "$itemtype is:"&str($itemtype)
  jobnr     = [Job_Nr]

  if [RollNr] = "BESPOK"
    messboxwait(" Cannot deliver - not yet received ",0,0,1)
    return (1)
  elseif [RollNr] = "00000/00"
    messboxwait(" Cannot deliver - not yet allocated ",0,0,1)
    return (1)
  end if

'create record in GOODSOUT for req'n
  data goto window 2
  window zoom
  vloadif(dpath|"goodsout.vws")
  NewGoodsOut()
  vloadif(dpath|$gdsout2)
  window zoom

'update BAL_OS in REQUSN
  data goto window 1
  window zoom
  lock-record
   [Cost_OS]  = 0
   [Quant_OS] = 0
  write-record
  window zoom
  return (0)
END FUNCTION  ' AllThisReqn()


FUNCTION  DeliverPart()
'check for existing deliveries and delete
  repaint off
  $itemtype = [Item_Type]              'message "$itemtype is:"&str($itemtype)
  if $itemtype = "C"
    messboxwait(" Stock carpet req'ns cannot be split ",0,0,1)
    return (1)
  end if
  if [RollNr] = "BESPOK"
    messboxwait(" Cannot deliver - not yet received ",0,0,1)
    return (1)
  elseif [RollNr] = "00000/00"
    messboxwait(" Cannot deliver - not yet allocated ",0,0,1)
    return (1)
  end if

  #oslength = [Quant_OS]
  #oscost   = [Cost_OS]                'message "#oscost is:"&str(#oscost)
  if #oslength = 0
    messboxwait(" Already marked for delivery ",0,0,1)
    return (1)
  end if
  $refnr = [Reference_Nr]
  $rollnr = [RollNr]

  while true
    smartpoke $_ins 0
    x = fentrybox(" Amount to deliver on"&date2($deldate)|" ",8,"",#oslength)
    if x = -1
      smartpoke $_ins 1
      return (1)
    end if
    #dellength = val(ptstr)
    if #dellength > #oslength
      messboxwait(" Amount to deliver is more than outstanding amount ",0,0,1)
      continue while
    end if

    #delcost = #oscost*(#dellength/#oslength)  'message "#delcost is:"&str(#delcost)
    exit while
  end while

'create record in GOODSOUT for req'n
  data goto window 2
  window zoom
  NewGoodsOut()
  vloadif(dpath|$gdsout2)
  window zoom

'update BAL_OS in REQUSN
  data goto window 1
  window zoom
  lock-record
   [Quant_OS] = #oslength - #dellength
   [Cost_OS]  = #oscost - #delcost
  write-record
  window zoom
  smartpoke $_ins 1
  repaint on
  repaint
END FUNCTION  ' DeliverPart()


FUNCTION WC()
  error off
  while true
    window close
    if cerror
      exit while
    end if
  end while
END FUNCTION  ' WC()


FUNCTION ChooseAction()
local s1 at
  repaint on
  repaint
  ptval=0
  while true
    y1 = format(" Collections for"&custname,"M74")
    screen print 4 4 15 1 y1
    if cr_status = "N"                   'show all o/s non-ancillary items for custcode
      ptval = RecsScroll()
    else
      ptval = RecsScroll()
    end if

    if ptval = {C} or ptval = {c}        ' Cancel delivery for this day
      messboxwait(" Cancellations not yet permitted ",0,0,1)
      continue while

    elseif ptval = {A} or ptval = {a}  'Deliver ALL this req'n
      CheckRdy4Inv()
      at = AllThisReqn()               'message "at) is:"&str(at)
      if at = 0
        x = addidxrec("showcoll.idx",#precnr,7) '
      end if
      data goto record next
      repaint on
      repaint

    elseif ptval = {U} or ptval = {u}    ' Deliver ALL undelivered
      messboxwait(" Not yet in use - select individually ",0,0,1)
'       AllUndeliveredReqns()
'       repaint on
'       repaint

    elseif ptval = {S} or ptval = {s}    ' ShowSelected for Delivery
      messboxwait(" Not yet in use ",0,0,1)
'       ShowSelection()
'       repaint on
'       repaint

    elseif ptval = {P} or ptval = {p}
      CheckRdy4Inv()
      DeliverPart()
      repaint on
      repaint

    elseif ptval = {O} or ptval = {o}
      NavMess()
'       DeliverPart()
      repaint on
      repaint

    elseif ptval = {F10}
      repaint off
'       Background()
      vloadif(dpath|"collectA.vw")
      order change index "showcoll.idx"
      if records = 0
        messbox(" No items booked for collection - exit anyway? (y/n) ",1,1,1)
        if ptstr == "Y"
          Background()
          return (-1)
        else
          vloadif(dpath|$gdsout1)
          repaint on
          repaint
          continue while
        end if
      else
        messbox(" Continue & print paperwork? (y/n)",1,1,1)
        if ptstr ! "n"
          vloadif(dpath|$gdsout1)
          repaint on
          repaint
          continue while
        else
          return (0)
        end if
      end if

    elseif ptval = {Esc}
      messbox(" Abandon collections for"&custname|"? (y/n) ",1,1,1)
      if ptstr == "Y"
        Background()
        return (-1)
      else
        continue while
      end if
    end if
  end while
END FUNCTION  ' ChooseAction()


FUNCTION SetupScreen()
  vloadif(dpath|$gdsout1)
  order change index "os_colln.idx"
  window split vertical 58
  data goto window 2
  vloadif(dpath|$gdsout2)
  data goto window 1
  window link "[Reference_Nr]" $gdsout2 "[Reference_Nr]"
END FUNCTION ' SetupScreen()


FUNCTION RecsScroll()
local x bot psmode
  screen save scrheight 1 scrheight scrwidth bot
  smartpeek $_spndmes psmode
  if psmode = 1
    smartpoke $_spndmes 0
  end if
  while TRUE
    NavMess_A()
    x = inchar
    if x = {Down}
      data goto record next
      NavMess_A()

    elseif x = {Up}
      data goto record previous
      NavMess_A()

    elseif x = {PgDn}
      data goto page next
      NavMess_A()

    elseif x = {PgUp}
      data goto page previous
      NavMess_A()

    elseif x = {^End}
      data goto record last
      NavMess_A()

    elseif x = {^Home}
      data goto record first
      NavMess_A()

    elseif x = {Home}
      suspendone
      keys Home,F8
      screen shortrestore bot
      NavMess_A()

    elseif x = {End}
      suspendone
      keys End,F8
      screen shortrestore bot
      NavMess_A()

    else
      exit while
    end if
  end while
  if psmode = 1
    smartpoke $_spndmes 1
  end if
  return (x)
END FUNCTION ' RecsScroll()


'     increment(dpath|"doc_ref.dat",1)   'get document ref
'     datenumber = left(date2(today),2)|mid(date2(today),4,2)
'     docref = str(datenumber)|right(date2(today),1)|right("000"|str(ptval),3)
'
'     EnterVarnOrder()
'     file unload all
'
'     vloadif(dpath|"cus_ent4.vw")
'     FindJob(jobnr)
'
'     UpdateStkAncl()                    'update stock levels and enter in GOODSOUT
'     vunloadif("stk_ancl.vws")
'     vunloadif("cus_ent4.vw")
'
'     vloadif(dpath|"tradecnf.vw")
'     order change index "current.idx"
'     order sort execute dictionary "lst_stck" index "lst_stck"
'
'     PrintReport("collectc.dfr","",p3,p4,p5,p6) 'for customer
'     PrintReport("collectw.dfr","",p3,p4,p5,p6) 'for whse file
'     PrintReport("collecti.dfr","",p3,p4,p5,p6) 'priced to go with invoice
'
'     UpdateDocRef()                    'update GOODSOUT with docref
'
'     exit while
'
'   end while

' FUNCTION UpdateStock()
' local origview #oldbal
'   origview=apinfo(ap_filex)
'     vloadif(dpath|origview)
'   for i = 1 to records
'     prodcode = [Product_Code]
'     #dellength = [Length_Quantity]
'     #delcost = [Cost]
'     $refnr = [Reference_Nr]
' ' reduce amount shown in stock file
'     vloadif(dpath|"stk_ancl.vws")
'     data goto record first
'     data find "[Product_Code]" equal prodcode options ""
'     if cerror                               '   if none - then return
' message "Code"&prodcode&"not found"
'       x = messboxwait(" Ancillary code"&prodcode&"not found in Stock file - report to Office ",0,0,1)
'     end if
'     #oldbal = [PhysicalBalance]
'     lock-record
'       [PhysicalBalance] = #oldbal-#dellength
'     write-record
'     NewGoodsOut()
'     vloadif(dpath|origview)
'     data goto record next
'   end for
' END FUNCTION ' UpdateStock()


FUNCTION SelectStock()
  Background()
  if cr_status = "N"                   'TRADE ACC - show all o/s non-ancillary items for custcode
    progress(15,10," Searching for"&custname|"'s req'ns ",0)
    vloadif(dpath|"collect7.vw")
    order change key "[CustCode]"
    data query execute "collect3.dfq" index "c2.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ
'   [Job_Nr]=custcode
'   and
'   NOT (DELETED)
' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ
    if cerror
      messboxwait(" NO items awaiting collection ",0,0,1)
      Background()
      return (-1)
    end if
    data query execute "collect2.dfq" index "os_colln.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ
'   [Item_Type]<>"A"
'   and
'   [Quant_OS]>0.01
' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ
    if cerror
      messboxwait(" NO items awaiting collection ",0,0,1)
      return (-1)
    end if

  else
    progress(15,10," Searching for"&custname|"'s req'ns ",0)
    vloadif(dpath|"collect7.vw")
    order change key "[Job_Nr]"
    data query execute "job_reqn.dfq" index "os_colln.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ
'   [Job_Nr] = jobnr
'   and
'   not(deleted)
' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ
    if cerror
      messbox(" No requisitions entered for"&jobnr&" ",0,0,1)
      vunloadif("requsn.vws")
      return (-1)
    end if
    vunloadif("requsn.vws")
  end if
END FUNCTION ' SelectStock()


FUNCTION NavMess()
local col1 pd pq pr psc psn psr psp y2a pq1 origview $text1
  if [RollNr]="BESPOK"
    if [Item_Type] = "B" or [Item_Type]="W" or [Item_Type]="J" or [Item_Type]="T" or [Item_Type]="O"
      repaint off
      origview=apinfo(ap_filex)
      $refnr = [Reference_Nr]            'message "$refnr is:"&str($refnr)
      error off
      vloadif(dpath|"purchord.vws")
      vloadif(dpath|"supplier.vws")
      while true
        pd = filelookup([purchord.Order_Nr],[purchord.Date_Ordered],$refnr)
        if cerror
          col1 = 12
          y2 = format("Order not held in Purchase Order file ","M71")
          y2a = format(" ","M71")   'message "len(y2)) is:"&str(len(y2))
          exit while
        else
          pq  = filelookup([purchord.Order_Nr],[purchord.Delivery_Quoted],$refnr)
          pq1 = @if(pq=null,"N/Q",pq)    'message "pq1 is:"&str(pq1)
          psc = filelookup([purchord.Order_Nr],[purchord.Supplier_Code],$refnr)
          psn = filelookup([supplier.Supplier_Code],[supplier.Name],psc)
'         psp = filelookup([supplier.Supplier_Code],[supplier.Telephone],psc)
'         psr = filelookup([purchord.Order_Nr],[purchord.Order_Reference],$refnr)
          col1 = 1
          $text1="Ordered"&date2(pd)&"("|pq1|") from"&psn|" "
        end if
        exit while
      end while
      vunloadif("supplier.vws")
      vunloadif("purchord.vws")
    else
      return (0)
    end if
    messboxwait($text1,0,1,1)
  else
    return (0)
  end if

  screen clear box 22 4 23 74 0 0 no-border
  vloadif(dpath|origview)
END FUNCTION   'NavMess()


FUNCTION  Titles()
  y1 = format(" Collections for"&custname&"("|jobnr|")","M72")
  y3 = format("  ˙˙Description                    Colour              Length  RollNr ","L72")
  repaint on
  repaint
  screen print 5 5 15 12   y1
  screen print 6 5 fgp bgp y3
  y2 = format(" ¯ = add/remove for {C}ollection - {F10} finishes - {Esc} restarts","M72")
  screen print 21 5 fgp bgp y2
END FUNCTION   'Titles()


FUNCTION NavMess_A()
local ftgdate ordstat mess1 col1 mess2
  col1 = 12
  x = [Comment]
  if str(x) = "0"
    mess2 = format("No reference","M34")
  else
    mess2 = format([Comment],"M34")
  end if
  screen print 21 25 11 11 mess2
END FUNCTION   'NavMess_A()


FUNCTION ProcessCollection()
local ss dm

    while true
      ss = SelectStock()                 'message "ss) is:"&str(ss)
      if ss = -1
        WC()
'         file unload all
        return (1)
'       exit while
      end if

      dm = DeliverMenu()                 'message "dm) is:"&str(dm)
      if dm = -1
        WC()
'         file unload all
        return (1)
      end if

      x = EnterCollector()

      increment(dpath|"doc_ref.dat",1)   'get document ref
      datenumber = left(date2(today),2)|mid(date2(today),4,2)
      docref = str(datenumber)|right(date2(today),1)|right("000"|str(ptval),3)

      UpdateStock()

' message "Cutting list"
      CuttingList()

      PrintDespatch()

' message "Print list of items in stock/allocated but NOT yet collected "
      exit while

    end while
END FUNCTION ' ProcessCollection()


FUNCTION PrintDespatch()
  vloadif(dpath|"showcoll.vw")
  order change index "showcoll.idx"
  PrintReport("collectc.dfr","",p3,p4,p5,p6) 'for customer
  StoreReport("collectc.dfr","out")
  PrintReport("collectw.dfr","",p3,p4,p5,p6) 'for whse file
' message "cr_status is:"&str(cr_status)
'   if left(jobnr,1)<>"T"
  if cr_status<>"N"
    p6 = 2
    PrintReport("collecti.dfr","",p3,p4,p5,p6) 'priced to go with invoice
    p6 = 1
    StoreReport("collecti.dfr","inv")
  end if
END FUNCTION ' PrintDespatch()


FUNCTION ShowSelection()               ' show list of items to collect & ask for confirmation
  Background()
  vloadif(dpath|"showcoll.vw")
  order change index "showcoll.idx"
  #bline = records + 7
  repaint on
  repaint
  ptval=0
  y1 = format(" Goods to deliver now ","M78")
  y2 = format(" {F10} to continue - {Esc} to abandon ","M78")
  screen print 4 2 fgp bgp y1
  screen print #bline 2 fgp bgp y2
  while true
    ptval = navrecs()
    if ptval = {F10}
      messline(" Continue & print paperwork? (y/n)",1,1,1,#bline,2,78)
      if ptstr ! "n"
        return (-1)
      else
        return (0)
      end if
    elseif ptval = {Esc}
      return (-1)
    end if
  end while
END FUNCTION ' ShowSelection()


FUNCTION CuttingList()
' for each StockCarpet item in "showcoll.idx"
' message "Use Cutting List to transact delivery"
' new ctg list printout req'd - individual on dot matrix

  vloadif(dpath|"lststk_G.vw")
  order change index "showcoll.idx"

'----------------------------total list for stock carpet, tiles etc
  order sort now dictionary "listcarp.idx" fields "[ViewDesc]" ascending
  p1 = "listcoll.dfr"
message "Carpet List"
  PrintReport(p1,"Collection List",p3,p4,p5,p6)

message "print Cutting Ticket & update stock for each item on list"

  for i = 1 to records
    CuttingTicket()
    Trans_STCK()
    vloadif(dpath|"lststk_G.vw")
    data goto record next
  end for

'     StoreReport(p1,"005")
'     if mark = 0
'       EnterCPLref()
'       exit while
'     end if
'     if mark = 1
'       return (0)
'     end if
'   end while

END FUNCTION ' CuttingList()


FUNCTION UpdateStock()
  progress(15,10," Updating stock records ",0)
  vloadif(dpath|"goodsout.vws")
  order change index "showcoll.idx"
  for i = 1 to records
    if [Itemtype] <> "F"
      #out = [QuantOut]
      case [Itemtype]

        when "A"                       'STK_ANCL
          vloadif(dpath|"goodsout.vws")

        when "B"                       'STK_BESP
          Trans_BESP()
          vloadif(dpath|"goodsout.vws")

        when "C"                       'STK_CARP
message "Use Cutting List to transact delivery?"

        when "J"                       'STK_BESP
          Trans_BESP()
          vloadif(dpath|"goodsout.vws")

        when "S"                       'STK_CARP
message "Use Cutting List to transact delivery??"

        when "T"                       'STK_BESP
          Trans_BESP()
          vloadif(dpath|"goodsout.vws")

        when "V"                       'STK_CARP
message "Use Cutting List to transact delivery??"

        when "W"                       'STK_BESP
          Trans_BESP()
          vloadif(dpath|"goodsout.vws")

      end case
    end if
    data goto record next
  end for

  EnterDocRef(docref,"collect1")

  vunloadif("goodsout.vws")
  vunloadif("stk_besp.vws")
  vunloadif("stk_carp.vws")
  vunloadif("stk_ancl.vws")
END FUNCTION ' UpdateStock()


FUNCTION Trans_BESP()
  lock-record
    [Document]=docref
  write-record
  $rollnr = [RollNr]
  vloadif(dpath|"stk_besp.vws")
  order change key "[RollNr]"
' message "$rollnr is:"&str($rollnr)
  data find "[RollNr]" equal $rollnr options ""
  if cerror                               '   if none - then return
    x = messboxwait(" Roll Nr"&$rollnr&"not found - inform office ",1,0,1)
  else
    #newbal = [PhysicalBalance]-#out  'message "#newbal is:"&str(#newbal)
    lock-record
      [PhysicalBalance] = #newbal
    write-record
  end if
END FUNCTION ' Trans_BESP()


FUNCTION Trans_ANCL()
  lock-record
    [Document]=docref
  write-record
  prodcode = [Product_Code]
  vloadif(dpath|"stk_ancl.vws")
  order change key "[Product_Code]"
' message "prodcode is:"&str(prodcode)
  data find "[Product_Code]" equal prodcode options ""
  if cerror                               '   if none - then return
    x = messboxwait(" Product Code Nr not found - inform office ",1,0,1)
  else
    #newbal = [PhysicalBalance]-#out
message "#newbal is:"&str(#newbal)
    lock-record
      [PhysicalBalance] = #newbal
    write-record
  end if
END FUNCTION ' Trans_ANCL()


FUNCTION Trans_STCK()
  lock-record
    [Document]=docref
  write-record
  $rollnr = [RollNr]
  vloadif(dpath|"stk_carp.vws")
  order change key "[RollNr]"
' message "$rollnr is:"&str($rollnr)
  data find "[RollNr]" equal $rollnr options ""
  if cerror                               '   if none - then return
    x = messboxwait(" Roll Nr"&$rollnr&"not found - inform office ",1,0,1)
  else
    #newbal = [PhysicalBalance]-#out  'message "#newbal is:"&str(#newbal)
    lock-record
      [PhysicalBalance] = #newbal
    write-record
  end if
END FUNCTION ' Trans_STCK()


FUNCTION CheckRdy4Inv()
' message "jobnr is:"&str(jobnr)
  x=[Job_Nr]
' message "x is:"&str(x)
  if jobnr=[Job_Nr]
    messboxwait(" Invoice must be printed NOW!! ",0,0,1)
  end if
END FUNCTION ' CheckRdy4Inv()


' FUNCTION UpdateDocRef()
'   vloadif(dpath|"goodsout.vws")
'   FindJob(jobnr)
'   for i = 1 to records
'     lock-record
'       [Document] = docref
'     write-record
'     data goto record next
'   end for
'   EnterDocRef(docref,"collect1")
'   vloadif(dpath|"goodsout.vws")
' message "Alter stock level (& value?)"
' END FUNCTION ' UpdateDocRef()


FUNCTION EnterDocRef(ref1,ref2)
  vloadif(dpath|"doc_refs.vws")
  data enter lock
    [Doc_Ref] = ref1
    [Dated]   = today
    [Timed]   = now
    [Creator] = userid
    [Program] = ref2
  write-record
'   vunloadif("doc_refs.vws")
END FUNCTION ' EnterDocRef()


FUNCTION CuttingTicket()

END FUNCTION ' CuttingTicket()