'GDS_RCV1 - goods received into stock - new COLOURS index created when req'd
' rejected deliveries entered in GDS_RCVD & PNDG_STK
' 11/09/95 - permanent indices for Suppliers now used - created in SRVRPROG
' 21/10/95 - "AllReceived()" added to check for whether ALL Bespoke goods
'            have been received and if so, change the Order_Status
' 26/10/95 - AllReceived rem'd out temporarily
' 20/09/05 - roll ticket routine at L2435; amend for checking that ticket has printed


external   fentrybox() sch scw messbox() vloadif() vunloadif() dpath fge bge
external   reqnmask progress() fgp bgp vkeybox() shopmask bpopdb() scr psa
external   date2num() increment() chkdate() popuplist() dsa fgi bgi chkstr()
external   delidxrec() makeidx() strcount() strtoary() chg_dsc() remove()
external   bgs fgs PrintReport() entryline() messline() colpopup() userid
external   redfentry() spath addidxrec() navrecs() arytostr() delstr() ipath
external   messboxwait() #maxleft #minleft pipath cpath Background()
external   X_path _SWIP_Crystal() Xreppath

public     ptstr ptval ptary[1] codes[1] $escape resvn[1,1] $rollnr prodcode
public     suppcode jobnr $ccwcode $dateout ua1 nrdates #widthrcvd #lengthrcvd
public     $tktnr $totkts $tkt suppname custname #origlength

global     answer ordernr FindOrder() rej_reason #recnr Check_CCW() $uos na
global     FindSupplier() SearchType() $unitdes #margin #prec
global     CarpetStockRecord() AnclStockRecord() type $purordstat #totalcost
global     AllocateRollNr() #bline $comment_P $stock AllReceived()
global     StockType() ProcessGoods() search recnr stockfound r1 r2 c1 c2 cl1 cl2
global     ReturnToMenu() x z desMRC prodSUPP correctorder RecordReceipt()
global     y1 y2 y3 ordlength ordwidth ordref backing $ccwidx FindCustomer()
global     delquot specterm orderby orderdate prodMRC prodtype precnr locn
global     acceptdel prodrcvd bckgrcvd colrcvd CheckLength() CheckWidth()
global     minlength maxlength maxwidth minwidth EnterRcvd()
global     EnterReject() action reportnr delnr datercvd receiptnr bckg_del
global     ShowList() AllocateBespoke() $itemtype $vw_scn ShowLabel() #width
global     PrintRejectLabel() rej_record y $comment_S lencom #unitcost
global     PrintAcceptLabel() O_S_Allocns() #OSbalance $carp  #refnr
global     LoadScreens() ShowReqns() $unitcost $selected Unallocated()
global     #needed #new_bal Titles() #avail #unresvd #tline #ordbal_OS
global     #old_bal $uar $reqncost uaridx allocrec AllocateStock()
global     Reset_BL() Reset_BR() CancelResvns() $width #old_bar #new_bar
global     i AllocateSimilar() refresh() colSf colSb S_full #2bdeld
global     c k dc lc sc recs l blen pl mr pc sym pg rec tr nr SelectOrders()
global     plist[1,3] drows lnr reqnpopup() #listcount poplist[1] $S_windows
global     namelist[1,6] linenr j $str_list #lcol NewTotal() custcode RemoveGdsOut()
global     uistrcnt() udelstr() n recval FindRoll() #recs refcode $customview
global     sim_ccw m $allocn #split s_reqpop $recs $reclist $duedate dateout[1,1]
global     UpdGdsOut() UpdateAppt() ChkDeliveries() BuildList() p1 p2 p3 p4 p5 p6
global     #quantos #costos #costout #prec1 $rollreserve	

' sipath = $drive|":\indices\supp_inv\"'index path for price lists
' pipath = $drive|":\indices\os_purch\"'index path for O/S purch's
' ipath  = $drive|":\index\"           'index path for sundry idx's
' locn @ L1781
MAIN
single-step off
  Background()
  file unload all
  error off
  p2 = ""               ' p2 = title at top of choice popup ("LABEL")
  p3 = 1                ' p3 = printer to be used (1=HPIII_QC; 3=EPSON 850 etc)
' message "Printer set for HP 3"
  p4 = 1                ' 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
  $vw_scn = "gdsrcv_S"
  while true
    window close
    if cerror
      exit while
    end if
  end while
  #margin = 0.05  'error allowable on delivery before asking for confirmation

  while true
    x = SelectOrders()
    if x = -1
      exit while
    end if
  end while

  ReturnToMenu()

END MAIN


FUNCTION O_S_Allocns()
  vloadif(dpath|"unallocn.vw")
  order change key "[CCW_Code]"
  data query execute "unallCCW.dfq" index "unallccw.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [CCW_Code] = $ccwcode and [Status] = "I"                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (0)
  end if
  return (1)
END FUNCTION ' O_S_Allocns()


FUNCTION AllReceived()
local  tmax x
  error off
  vloadif(dpath|"chk_recd.vw")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options ""
  x=[Tmax]
  if x = 1                             'message "Incomplete bespoke!"
    lock-record
      [Recd_Status]="P"
    write-record
  else                                 'message "Any bespoke received"
    lock-record
      [Recd_Status]="C"
    write-record
' check for complete order status
    if [Slots_Rem]=0
      if [Stock_Status]="C"
        if [Order_Status]="P"
          lock-record
            [Order_Status]="S"
          write-record
          messboxwait("Sanction process to carry out when all goods-in have been done",0,0,1)
          execute "sanction.rf3" in-memory    ' update APPTDATE
        end if
      end if
    end if

  end if
END FUNCTION ' AllReceived()


FUNCTION Check_CCW()
  $stock = left(prodcode|"ÿ"|desMRC|"ÿ"|"Y"|"ÿ"|str(fixed(#width,2))|repeat("ÿ",36),36)
  repaint off
  vloadif(dpath|"colours.vws")
  error off
  $ccwcode = filelookup([Colours.CodeColourWidth],[Colours.CCW_Code],$stock)
  if cerror
    messbox(" New Colour Code being created ",0,0,1)
    while true
      increment(dpath|"colours.dat",1)
      $ccwcode = right("000000"|str(ptval),6)  ' create new CCW Code
      order change key "[CCW_Code]"
      data find "[CCW_Code]" equal $ccwcode options ""    ' check unique
      if cerror                               '   if none - then return
        exit while
      end if
    end while
    data enter lock
      [Product_Code]    = prodcode
      [CCW_Code]        = $ccwcode
      [CodeColourWidth] = $stock
      [Width]           = #width
      [Description_MRC] = desMRC
    write-record
  else                                 ' add to index
'     x = addidxrec()
  end if
  return (0)
END FUNCTION 'Check_CCW()


FUNCTION EnterRcvd()
' 0=no o/s orders from supplier; 1=o/s orders 'message "Before - precord is:"&str(precord)
  #recnr    = precord
  $itemtype = [Item_Type]
  if $itemtype = "A"
    x = AnclStockRecord()                ' update stock record
  else                               ' if type == "C"
    x = CarpetStockRecord()
  end if

  vunloadif("gdsrcv1.vw")
  vloadif(dpath|$vw_scn|".vw")         ' vloadif(dpath|"gdsrcv1.vw")
  if records > 0
    if $purordstat <> "P"                 ' if order completed, delete from
      order change physical            ' current idx
      x = delidxrec(pipath|"P_"|suppcode|".idx",recnr,2)
      if x <> 0
        messboxwait(" Mark!! please note: ("|str(x)|"-"|suppcode|"-"|pipath&") thanks - David (L177) ",0,0,1)
        order change key "[Supplier_Code]"
        data query execute "notdel_s.dfq" index pipath|"P_"|suppcode|".idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Supplier_Code] = suppcode and [Order_Status] = "P"                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
        if cerror
          screen clear box 1 1 sch scw 0 0 no-border
          messbox(" No outstanding deliveries from"&suppname,0,0,1)
          x=makeidx(dpath|"purchord.vws",pipath|"P_"|suppcode|".idx","0",5)
          screen clear box 1 1 sch scw 0 0 no-border
          return (0)
        end if
      end if
      order change index pipath|"P_"|suppcode|".idx"
      return (1)

    else                     ' $purordstat = P
      order change physical
      order change index pipath|"P_"|suppcode|".idx"
      return (1)
    end if

  else
    screen clear box 1 1 sch scw 0 0 no-border
    messbox(" No outstanding deliveries from"&suppname|" ",0,0,1)
    order change physical
    return (0)
  end if
END FUNCTION ' EnterRcvd()


FUNCTION ProcessGoods()
local $reason i
  recnr      = record
  precnr     = precord
  prodcode   = [Product_Code]
  acceptdel  = ""
  rej_reason = ""
  backing    = [Backing]
  prodSUPP   = [Product_Supplier]
  desMRC     = [Carpet_Color]
  ordwidth   = [Width]
#origlength  = [Length_Quantity]
  ordlength  = [Balance_OS]
  ordref     = [Order_Reference]
  orderby    = [Ordered_By]
  orderdate  = [Date_Ordered]
  #unitcost  = [Unit_Cost]
  $unitdes   = [Unit_Desc]
  $comment_P = [Comments]
  suppcode   = [Supplier_Code]
  $uos       = [Unit_Of_Sale]
' message "suppcode is:"&str(suppcode)
  vloadif(dpath|"supplier.vws")
  suppname = filelookup([Supplier_Code],[Name],suppcode)
  vunloadif("supplier.vws")

  r1 = 3
  r2 = r1+2
  c1 = 19
  c2 = c1+42
  cl1 = 15
  cl2 = 12
  if $comment_P <> "None"
    screen clear box r1 c1 r2 c2 cl1 cl2
    y1 = format($comment_P,"M40")
    screen print r1+1 c1+1 cl1 cl2 y1
  end if

  vloadif(dpath|$vw_scn|".vw")
  while true
    while true
      x = entryline(" Confirm date of receipt ",10,"##\/##\/####",date2(today),#bline,1,80)
      if x = 0
        datercvd = ptstr
        if chkdate(datercvd,1) = -1
          messbox(" Incorrect date - re-enter ",0,0,1)
  	continue while
        end if
        exit while
      end if
    end while
    screen clear box #bline+1 1 #bline+1 80 0 0 no-border

    while true
      messline(" Confirm supplier is"&suppname&"? (y/n) ",1,1,1,#bline,1,80)
      if ptstr == "y"
        exit while
      else
        correctorder = "n"
        vunloadif("gdsrcv_s.vw")
        return (-3)          ' wrong supplier
      end if
    end while

    while true
      messline(" Confirm product is"&chr(34)|prodsupp|chr(34)|"? (y/n) ",1,1,1,#bline,1,80)
      if ptstr == "y"
        prodrcvd = prodsupp
        exit while
      else
        while true
          acceptdel = "n"
          rej_reason = "Product"
          x = entryline(" Enter Product name ",20,"","",#bline,1,80)
          if x = 0
            prodrcvd = ptstr
            exit while
          end if
        end while
        exit while
      end if
    end while

    if backing <> "NONE"
      while true
        while true
          x = colpopup(6,72,19,"JUTE FOAM GELL IMPV FELT VINY WAFF LATX STND OVER NONE","Backing",1,0,14,1,0,15)
          if x = 0
            bckg_del = ptstr
          elseif x = -1
            continue while
          end if
          exit while
        end while

        if backing <> bckg_del
          messline(" Backing ordered was"&backing&"- confirm"&ptstr&"was received? (y/n) ",1,1,1,#bline,1,80)
          if ptstr == "y"
            acceptdel = "n"
            x = chkstr("Backing",rej_reason)
            if x = -1
              rej_reason = rej_reason&"Backing"
            end if
            exit while
          else
            continue while
          end if
        else
          acceptdel = "y"
          exit while
        end if
      end while
    end if

    repaint off
    colrcvd = desMRC
    if colrcvd <> "N/A"
      while true
        messline(" Confirm colour is"&chr(34)|colrcvd|chr(34)&"? (y/n) ",1,1,1,#bline,1,80)
        if ptstr == "y"
          exit while
        else
          screen shortrestore psa
          while true
            acceptdel = "n"
            x = chkstr("Colour",rej_reason)
            if x = -1
              rej_reason = rej_reason&"Colour"
            end if
            x = entryline(" Enter Colour received ",20,"*20{X}","",#bline,1,80)
            if x = 0
              colrcvd = ptstr
              exit while
            end if
          end while
        end if
      end while
    end if
    x = CheckLength()                ' 0=reject; 1=correct length del'd;
                                     ' 2=SHORT but accept; 3= LONG but accept
    if x = 2                         ' establish $ordstat
      #2bdeld = #OSbalance-#lengthrcvd
      if abs(#2bdeld)>0.01
        messline(" Are there any more deliveries for this item line? (y/n) ",1,1,1,#bline,1,80)
        if ptstr == "n"
          messline(fixed(#2bdeld,2)|"m. still O/S - are there more deliveries? (y/n) ",1,0,1,#bline,1,80)
          if ptstr == "n"
            $purordstat = "C"
          else
            $purordstat = "P"
          end if
        else
          $purordstat = "P"
        end if
      else
        $purordstat = "C"
      end if
    elseif x = 0
      x = entryline(" Any other reasons for rejection ",25,"*25{X}","",#bline,1,80)
      if x = 0
        $reason = ptstr
        lencom = len($reason)
        y = strtoary($reason)
        $reason = ""
        for i = 1 to ptval
          if ptval = 0
            exit for
          end if
          if i = 1
            $reason = ptary[i]                ' NB - space is Alt-255
          else
            $reason = $reason|"ÿ"|ptary[i]    ' NB - space is Alt-255
          end if
        end for
        rej_reason = rej_reason&$reason
      end if
      while true
        ShowList(15,33,rej_reason,lencom)
        if messbox(" Delivery rejected for following reasons - confirm? (y/n) ",1,1,1) = 0
          if ptstr == "y"
            Background()
            messbox(" Incorrect delivery - report being prepared ",0,0,1)
            EnterReject()
            vloadif(dpath|$vw_scn|".vw")
            exit while
          else
            continue while
          end if
        end if
      end while
    elseif x = 1
      $purordstat = "C"
    elseif x = 3                         ' establish $ordstat
      #2bdeld = #OSbalance-#lengthrcvd
      messline(" Are there any more deliveries for this item line? (y/n) ",1,1,1,#bline,1,80)
      if ptstr == "n"
        $purordstat = "C"
      else
        $purordstat = "P"
      end if
    end if
    if $unitdes <> "Units"
      CheckWidth()
    else
      #widthrcvd = 1
    end if
    entryline(" Any other comments ",50,"*50{X}",$comment_P,#bline,1,80)
    $comment_P = ptstr
    vloadif(dpath|$vw_scn|".vw")
    x = EnterRcvd()          '0=no o/s orders from supplier; 1=o/s orders
    if x = 1
      return (1)
    elseif x = 0
      return (0)
    end if
  end while
END FUNCTION ' ProcessGoods()


FUNCTION FindOrder()
  messboxwait(" Routine NOT yet in use ",0,0,1)
END FUNCTION 'FindOrder()


FUNCTION StockType()
  while true
    screen print 7 33 15 1 (format(" Goods Received ","M16"))
    x = popuplist(8,33,13,"ÿÿÿCarpet ÿAncillaries","{Esc} exits",1,0)
    if x = 0
      if ptstr == "ÿAncillaries"
        type = "A"
        exit while
      elseif ptstr == "ÿÿÿCarpet"
        type = "C"
        exit while
      else
        beep
      end if
    elseif x = -1
      return (-1)
    end if
  end while
  screen shortrestore dsa
END FUNCTION 'StockType()


FUNCTION SearchType()
  while true
    vunloadif($vw_scn|".vw")
    y1 = "ÿÿÿÿSupplierÿÿÿÿ"
    y2 = "ÿÿÿÿÿJobÿNrÿÿÿÿÿ"
    y3 = "ÿÿÿÿOrderÿNrÿÿÿÿ"
    screen print 7 30 15 1 (format(" Goods Received ","M20"))
    x = popuplist(8,30,13,y1&y2,"Search by?",1,0)
    if x = 0
      if ptstr = y3                    ' "OrderÿNr"
        $vw_scn = "gdsrcv_O"
        x = FindOrder()
        if x = 0
          continue while
        elseif x = -2
          continue while
        end if
        exit while
      elseif ptstr = y1                ' "Supplier"
        $vw_scn = "gdsrcv_S"
        x = FindSupplier()
        exit while
      end if
    elseif x = -1
      return (-1)
    end if
  end while
END FUNCTION ' SearchType()


FUNCTION FindSupplier()
local #srecnr
  #srecnr = 1
  while true
    while true
      vloadif(dpath|"supplier.vws")
      order change physical
      order sort now dictionary "suppname" fields "[Name]" ascending
      repaint off
      y1 = format(" Choose Supplier and press {Enter} ","M38")
      screen print 7 21 15 1 y1
      screen print 20 21 15 1 (format(" {Enter} views orders - {Esc} exits ","M38"))
      data goto record record-number #srecnr
      x = bpopdb("supplier",6,"","[Name]","l35","[Supplier_Code]","L6","[Supplier_Code]",8,21,19,58,"",0)
      if x = 0
        exit while
      elseif x = -1
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        return (-1)
      end if
    end while
    suppcode = ptstr
    suppname = [Name]
    #srecnr = record                   'message "#srecnr is:"&str(#srecnr)
    Background()
    progress(15,10," Finding Orders from"&suppname|" ",0)
    vloadif(dpath|"gdsrcv1.vw")
    order change index pipath|"P_"|suppcode|".idx"
    if records = 0
      screen clear box 1 1 sch scw 0 0 no-border
      messbox(" No outstanding deliveries from"&suppname,0,0,1)
      screen clear box 1 1 sch scw 0 0 no-border
      continue while
'       return (1)
    else
      while true
        clear $rollnr
        Background()
        if records > 12
          #bline = 22
        else
          #bline = 10 + records
        end if
        y1 = format("Deliveries awaited from"&suppname,"M78")
        y2 = format(" (* = incomplete order)  {Enter} to select order - {Esc} to quit ","M80")
        y3 = format("  Order  Product                        Colour           O/S Length  Width Bckg","L80")
        screen clear box 4 1 6 scw 15 1
        screen print 5 2 fgp bgp y1
        screen print 7 1 fgp bgp y3
        screen print #bline 1 fgp bgp y2
        vloadif(dpath|$vw_scn|".vw")
        order change index pipath|"P_"|suppcode|".idx"
        error off
        data query execute "not_del.dfq" index "not_delv.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
        if cerror
          screen clear box 1 1 sch scw 0 0 no-border
          messbox(" No outstanding deliveries from"&suppname,0,0,1)
          screen clear box 1 1 sch scw 0 0 no-border
         exit while
'           return (1)
        end if
        x = bpopdb($vw_scn,6,"s"&suppcode,"[Search_Supplier]","L78","[Supplier_Code]","L6","[Order_Nr]",8,1,21,80,"",0)
        if x = 0
          screen shortrestore dsa
          repaint off
          #OSbalance = [Balance_OS]
          ordernr = [Order_Nr]
          x = ProcessGoods()   '-3=wrong supplier; 0=no o/s orders; 1=o/s orders
          if x = -3                      ' wrong supplier - go to bpop
            exit while

          elseif x = 1
            vloadif(dpath|$vw_scn|".vw")
            continue while

          elseif x = 0
            screen clear box 1 1 sch scw 0 0 no-border
            messbox(" No outstanding deliveries from"&suppname,0,0,1)
            screen clear box 1 1 sch scw 0 0 no-border
            exit while
          end if

        else          'if x = -1 or any other value ie BPOP did not work
          Background()
          exit while
        end

      end while
      Background()
    end if
  end while
END FUNCTION 'FindSupplier()


FUNCTION AnclStockRecord()             ' GDS_RCV1 is loaded
local presentstock newstock
  prodcode = [Product_Code]               ' find product code of ancillary
  stockfound = "y"
  while stockfound = "y"
    error off
    vloadif(dpath|"stk_ancl.vws")       ' load Stock file
    order change key "[Product_Code]"
    data find "[Product_Code]" equal prodcode options ""    ' find stock record
    if cerror
      data enter lock
        [Product_Code] = prodcode
        [PhysicalBalance] = #lengthrcvd
      write-record
      newstock = #lengthrcvd
    else
      lock-record
        presentstock = [PhysicalBalance]
        newstock = presentstock + #lengthrcvd
        [PhysicalBalance] = newstock
        [Quantity_In_Stock] = [Quantity_In_Stock]+newstock
      write-record
    end if
    RecordReceipt()
    exit while
  end while
END FUNCTION ' AnclStockRecord()


FUNCTION RecordReceipt()
'   messboxwait(" In RecordReceipt - DC only ",0,0,1)
  increment(dpath|"gds_rcvd.dat",1)
  receiptnr = "GI"|right("000000"|str(ptval),6)

  vloadif(dpath|"gds_rcvd.vws")
  if #widthrcvd = 0
    #widthrcvd = 1
  end if

  if $uos = "U3"
    #totalcost = #lengthrcvd
  elseif $uos = "U1"
    #totalcost = #lengthrcvd * #unitcost  '
  elseif $uos = "U2"
    #totalcost = #lengthrcvd * #widthrcvd * #unitcost  '
  end if
  data enter lock                         ' make assignments to GDS_RCVD
    [Date_Received]   = date2(datercvd)      ' mark date of receipt
    [Product_Supplier]= prodsupp
    [Supplier_Code]   = suppcode
    [Branch]          = left(ordernr,1)
    [Receipt_Nr]      = receiptnr
    [Status]          = "A"
    [Order_Nr]        = ordernr
    [Product_Code]    = prodcode
    [Width_Received]  = #widthrcvd
    [Colour]          = desMRC
    [Length_Received] = #lengthrcvd    ' enter quantity rec'd
    [Unit_Cost]       = #unitcost
    [Total_Cost]      = #totalcost
    [Last_Update]     = today
    [Updated_By]      = userid
    [RollNr]          = $rollnr
  write-record
  vloadif(dpath|$vw_scn|".vw")
  if [Balance_OS] - #lengthrcvd < 0
    #ordbal_OS = 0
  else
    #ordbal_OS = [Balance_OS] - #lengthrcvd
  end if
  lock-record                          ' make assignments to PURCHORD
    [Order_Status]    = $purordstat
    [Balance_OS]      = #ordbal_OS
  write-record
END FUNCTION 'RecordReceipt()


FUNCTION CheckWidth()
  while true
    while true
      x = entryline(" Enter Width received ",5,"",null,#bline,1,80)
      if x = 0
        #widthrcvd = val(ptstr)
        if #widthrcvd = 0
          messboxwait(" Zero width entered - enter correct width ",0,0,1)
          continue while
        end if
        exit while
      else
        continue while
      end if
    end while
    minwidth = ordwidth - 0.05
    maxwidth = ordwidth + 0.05
    if minwidth > #widthrcvd
      while true
        x = messline(" Width disagrees with Order - do not accept "&format(str(#widthrcvd),"2r")|"m? (y/n) ",1,0,1,#bline,1,80)
        if x = 0
          if ptstr == "y"
            exit while
          else
            exit function
          end if
        end if
      end while

      x = messline(" Re-enter width received? (y/n)  -  No = Reject ",1,0,1,#bline,1,80)
      if x = 0
        if ptstr == "y"
          continue while
        else
          acceptdel = "n"
          x = chkstr("Width",rej_reason)
          if x = -1
            rej_reason = rej_reason&"Width"
          end if
          exit function
        end if
      end if
    elseif #widthrcvd > maxwidth
      while true
        x = messline(" Width disagrees with Order - do not accept "&format(str(#widthrcvd),"2r")|"m? (y/n) ",1,0,1,#bline,1,80)
'         x = messline(" Width disagrees with Order - accept "&format(str(#widthrcvd),"2r")|"m? (y/n) ",1,0,1,#bline,1,80)
        if x = 0
          if ptstr == "y"
            exit while
          else
            exit function
          end if
        end if
      end while

      x = messline(" Re-enter width received? (y/n)  -  No = Reject ",1,0,1,#bline,1,80)
      if x = 0
        if ptstr == "y"
          continue while
        else
          acceptdel = "n"
          x = chkstr("Width",rej_reason)
          if x = -1
            rej_reason = rej_reason&"Width"
          end if
          exit function
        end if
      end if
    else
      exit function
    end if
  end while
END FUNCTION 'CheckWidth()


FUNCTION AllocateRollNr()
local datenumber
  datenumber = left(date2(datercvd),2)|mid(date2(datercvd),4,2)
  while true
    increment(dpath|"rollnr.dat",1)
    $rollnr = str(datenumber)|right(date2(datercvd),1)|"/"|right("00"|str(ptval),2)
    order change key "[RollNr]"
    data find "[RollNr]" equal $rollnr options ""
    if cerror                               '   if none - then return
      exit while
    end if
  end while
  messboxwait(" Roll Nr assigned is"&str($rollnr)|" ",0,2,1)
END FUNCTION 'AllocateRollNr()


FUNCTION ReturnToMenu()
  Background()
  smartpoke $_ins 1
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION ShowList(trow,lcol,list,maxlen)
local c recs r2 c2
  if strtoary(list) = 0
    recs = ptval
  end if
  r2 = trow + recs + 1
  c2 = lcol + 3 + max(maxlen,7)
  screen clear box trow lcol r2 c2 fgp bgp
  for c=1 to recs
    screen print c+trow lcol+2 fgp bgp ptary[c]
  end for
END FUNCTION ' ShowList()


FUNCTION ShowLabel()
local r1 c1 r2 c2 cl1 cl2 y4 y5
  vloadif(dpath|$customview)
  order change index "label.idx"
  r1 = 9
  r2 = r1+5
  c1 = 18
  c2 = c1+41
  cl1 = 15
  cl2 = 1
  repaint off
  y1 = format(" The Carpet Label has not been printed ","M42")
  y2 = format(" Details shown below ","M42")
  screen print r1-2 c1 fge bge y1
  screen print r1-1 c1 fge bge y2
  screen clear box r1 c1 r2 c2 cl1 cl2
  y1 = format([Product_Code]&"/"&[StockOrder]&"ÿÿÿRoll:"&[RollNr],"L39")
  y2 = format([Product_MRC],"L39")
  y3 = format([Description_MRC]&"ÿ/ÿ"&[Backing],"L39")
  y4 = format("Length rec'd:"&fixed([Stock_Delivered],2)|"m","L39")
  screen print r1+1 c1+2 cl1 cl2 y1
  screen print r1+2 c1+2 cl1 cl2 y2
  screen print r1+3 c1+2 cl1 cl2 y3
  screen print r1+4 c1+2 cl1 cl2 y4
  y5 = format(" Press any key when ready ","M42")
  screen print r1+6 c1 fge bge y5
  inchar
  order change physical
END FUNCTION 'ShowLabel()


FUNCTION Unallocated()
  error off
  #lcol  = 5
  #bline = 18
  #tline = 6
  #split = 52

  Background()
  uaridx = "unallccw.idx"         ' message "uaridx is:"&str(uaridx)
  x = LoadScreens()           ' load REQUSN & UAR views
  if x = -3
    return (1)
  end if

  error off
  order change index uaridx
  repaint off
  while true
    x = ShowReqns()      ' show unallocated REQUSN's to move and select REQUSN.
    repaint off
    error off
'     window unlink
    while true
      window close
      if cerror
        exit while
      end if
    end while

    if x = -3                   ' no unallocated REQUSN's left
      return (1)
    elseif x = -1               ' {Esc} pressed
      Background()
      return (0)
    end if
  end while
END FUNCTION ' Unallocated()


FUNCTION ShowReqns()
local $puar
  ptval=0
  order change physical          ' query unallocated REQUSN's in UAR_B_J
  if file(uaridx) = 1
    order change index uaridx
    window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
  else
    order change key "[Item_Type]"
    data query execute "UAR_ITEM" index "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³[Item_Type] = "C"                                                   ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      messbox(" No unallocated requisitions - returning to Menu ",0,0,1)
      return (-3)
    end if

    order sort now dictionary "qnow1" fields "[Product_Code;Description_MRC]" ascending
    data query execute "UAR_ROLL" index "qnow2"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³[RollNr] = "00000/00" and not(deleted)                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      messbox(" No unallocated requisitions - returning to Menu ",0,0,1)
      return (-3)
    else
      window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
    end if
  end if

  repaint on
  repaint
  Titles()
  while true
    ptval = navrecs()
    if ptval = {A} or ptval = {a}
      #needed = [Length_Quantity]
      jobnr = [Job_Nr]
      allocrec = record
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check that it has not been allocated                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      if [RollNr]<>"00000/00"
        continue while			
      end if
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check that there is carpet available                               ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      repaint off
      data goto window 2
      if tablemax([Balance]) < #needed
        messbox(" Insufficient stock for req'n - contact Head Office",0,0,1)
        data goto window 1
        smartpoke $_key {Up}
        repaint on
        repaint
        Titles()
        continue while			
      elseif tablecount([Balance]) = 0
        messbox(" Insufficient stock for req'n - contact Head Office",0,0,1)
        data goto window 1
        smartpoke $_key {Up}
        repaint on
        repaint
        Titles()
        continue while			
      end if

      #avail = [Balance]
      #unresvd = [BAR]

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check for reservations                                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      data goto window 1
      vloadif(dpath|"UAR_B_J.vw")

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Check BAR is sufficient for requsn                                 ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Get details of requisition & set up windows                        ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      prodcode = [Product_Code]
      desMRC = [Description_MRC]
      prodMRC = [Product_MRC]
      $width = [Width]
      $reqncost = [Cost]
      $unitcost = value($reqncost)/value(#needed) ' cost per lineal run
      $uar = record
      $puar = precord

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up popuplist()                                                 ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      screen save 1 1 sch scw S_full
      $ccwcode = [CCW_Code]
      x = AllocateSimilar()
      vloadif(dpath|"rolmetDJ.vw")
      if x = -1
        data goto window 1
        data goto record first
        repaint on
        repaint
        Titles()
        continue while			
      end if

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows                                                     ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      Reset_BR()             ' ? not needed with pops
      order change index uaridx
      data goto record record-number allocrec
      repaint on
      repaint
      Titles()

    elseif ptval = {Esc}               ' check for other unalloc'd req'ns for this shop
      order change physical
      return (-1)
    end if
  end while
  return (-1)
END FUNCTION ' ShowReqns()


FUNCTION Reset_BL()
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows with Bright in Left(Req'ns) window                  ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  data goto window 1
  vloadif(dpath|"UAR_B_J.vw")
  order change index uaridx
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  data goto window 1
  error off
  window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
END FUNCTION ' Reset_BL


FUNCTION Reset_BR()
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Set up windows with Bright in Right(Carpets) window                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  data goto window 1
  vloadif(dpath|"UAR_B_J.vw")
  order change index uaridx
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  repaint on
  data goto window 1
  error off
  window link "[CCW_Code]" "rolmetDJ.vw" "[CCW_Code]"
END FUNCTION ' Reset_BR


FUNCTION LoadScreens()
  error off
  window split vertical #split
  vloadif(dpath|"UAR_B_J.vw")
  if cerror
    return (-3)
  end if
  data goto window 2
  vloadif(dpath|"rolmetDJ.vw")
  if cerror
    return (-3)
  end if
  data goto window 1
  window split horizontal 20
  data goto window 3
  vloadif(dpath|"UAR_DESC.vw")
  data goto window 2
  error off
  window link "[Product_Code]" "UAR_DESC.vw" "[Product_Code]"
  data goto window 1
END FUNCTION ' LoadScreens()


FUNCTION Titles()
  screen print 3 4 15 1 (format("Unallocated Requisitions for"&prodsupp,"M75"))
  screen print 4 4 15 1 (format("                  UNALLOCATED                      STOCK HELD ","L75"))
  screen print 5 4 15 1 (format("   Roll Nr   Job Nr       Colour         Needed   Balance  BAR  Roll","L75"))
  screen print 19 4 15 1 (format(" ","M75"))
  screen print 20 4 15 1 (format("  ","L21"))
  screen print 20 53 15 1 (format("  ","L26"))
  screen print 21 4 15 1 (format(" {A}llocate requisition(s) - {Esc} to exit ","M75"))
END FUNCTION 'Titles()


FUNCTION CheckReservations()		' in Window 1 - UAR_B_J.vw
  vloadif(dpath|"requsn.vws")
  order change key "[Job_Nr]"		' find any o/s reservations and deal
  data find "[Job_Nr]" equal jobnr options ""
  if cerror				' no reservations found
    return (0)
  end if

  data query execute "job_reqn.dfq" index "o.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' [Job_Nr] = jobnr
' and
' not(deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (0)
  end if
  data query execute "chk_rsvn.dfq" index "os_rsvns"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' º [Reserved] = "R"    '(R)eserved / (D)ormant
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (0)
  else					' show reservations in navrec()
    vloadif(dpath|"chk_rsvn.vw")
    ptval=0
    while ptval <> {Esc}
      ptval = navrecs()
      if ptval = {C} or ptval = {c}
        lock-record                   ' cancel requisition & delete record
          [Date_Reserved]      = today
          [Created/Changed_By] = userid
          [Status]             = "D"
          [RollNr]            = "NA"
          [Reserved]           = "D"
        write-record
        data delete record
        vloadif(dpath|"UAR_B_J.vw")
        continue while
      elseif ptval = {V} or ptval = {v}  ' verify? change fields in REQUSN
' confirm - length - Colour - pordmrc

      end if
    end while
  end if
END FUNCTION 'CheckReservations()


FUNCTION CancelResvns()    		
local i m y y1 z j $resref #resdel $resname $resauth
' return to - vloadif(dpath|"stk_carp.vws")
  vloadif(dpath|"requsn.vws")
  order change key "[RollReserve]"
  data query execute "cancrsvn.dfq" index "cancrsvn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [RollReserve] = "R"|$rollnr                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror                               '   if none - then return
    vloadif(dpath|"stk_carp.vws")
    return (-1)
  end if

  redimension ptary[records]
  for i = 1 to records
    y = [Job_Nr]|"ÿÿ"|date2([Date_Reserved])|"ÿÿ"|format([Comment],"L20")|"ÿ"|format(str([Length_Quantity]),"2r")|"m"
    y1 = ""
    for j = 1 to len(y)
      z = mid(y,j,1)
      if z = " "
        z = "ÿ"
      end if
      y1 = y1|z
    end for
    ptary[i] = y1
    data goto record next
  end for

  x = arytostr(records)
  if x = 0
    m = ptstr
  end if

  while true
    z = 15 - records
    x = popuplist(z,17,17,m,"Choose Reservation to delete",1,0)
    if x = -1
      vloadif(dpath|"stk_carp.vws")
      return (-1)
    end if
    y1 = ""
    for j = 1 to len(ptstr)
      z = mid(ptstr,j,1)
      if z = "ÿ"       			' change to SOFT space
        z = " "
      end if
      y1 = y1|z
    end for
    ptstr = y1


    $resref = left(ptstr,6)
    #resdel = mid(ptstr,39,5)
    $resname = mid(ptstr,26,14)
    $resauth = mid(ptstr,19,6)

    screen shortrestore dsa
    messline(" Delete reservation of"|str(#resdel)|"m for"&trim($resname)|"? (y/n) ",1,0,1,21,6,71)
    if ptstr == "y"
      messline(" Confirm you have informed"&$resauth|"? (y/n) ",1,0,1,21,6,71)
      if ptstr == "y"

        if #new_bar + value(#resdel) < 0  ' check that there will be sufficient after this cancellation
          y = value(#new_bar + value(#resdel))
          x = messline(" This deletion will not provide sufficient - delete anyway? (y/n) ",1,0,1,21,6,71)
          if ptstr == "n"
            continue while
          end if
        end if

        order change key "[Job_Nr]"
        data find "[Job_Nr]" equal $resref options ""
        lock-record                   ' cancel requisition & delete record
          [Comment]            = "Resv'n canc'd"
          [Date_Status_Changed]= today
          [Created/Changed_By] = userid
          [Status]             = "D"
          [Reserved]           = "D"
          [RollNr]            = "NA"	' ????????
          [RollReserve]        = ""
        write-record
        data delete record

  ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
  ' ³  Increase [BAR] by amount of cancelled reservation              ³
  ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
        vloadif(dpath|"stk_carp.vws")
        #new_bal = [BAR] + value(#resdel)	 'message "#res_bal) is:"&str(#res_bal)
        lock-record
          [BAR] = #new_bal
        write-record
        exit while
      else
        vloadif(dpath|"stk_carp.vws")
        return (-1)
      end if
    else
      vloadif(dpath|"stk_carp.vws")
      return (-1)
    end if
  end while
  vloadif(dpath|"stk_carp.vws")
END FUNCTION ' CancelResvns()


FUNCTION  AllocateSimilar()
  sim_ccw = ""
  data goto record first

  for i = 1 to records
    if [CCW_Code] = $ccwcode        ' message "Matches!"
      if [RollNr] = "00000/00"
        sim_ccw = sim_ccw&str(record)    ' message "sim_ccw is:"&str(sim_ccw)
      end if
    end if
    data goto record next
  end for

  x = strcount(sim_ccw)
  if x = 0
    #listcount = ptval
  end if

  if #listcount > 1
    redimension poplist[#listcount]
    redimension namelist[#listcount,6]

    for n = 1 to #listcount
      z = value(group(sim_ccw,n))        'message "z is:"&str(z)
      data goto record record-number z
      if [RollNr] = "00000/00"
        namelist[n,1] = precord
        namelist[n,2] = [Description_MRC]
        namelist[n,3] = [Length_Quantity]
        namelist[n,4] = [RollNr]
'         namelist[n,5] = [Product_Code]
        namelist[n,5] = [Job_Nr]
        namelist[n,6] = "A"
      end if
    end for

    redimension ptary[#listcount]
    while true                       ' message "$area_list is:"&str($area_list)
      for n = 1 to #listcount
        poplist[n] = @if(namelist[n,4]="00000/00","ÿÿÿÿÿÿ",namelist[n,4])|"ÿÿ"|namelist[n,5]|"ÿÿ"|left(namelist[n,2]|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",20)|"ÿ"|right("ÿÿÿÿÿÿ"|format(str(namelist[n,3]),"2r"),6)
        ptary[n]   = poplist[n]
      end for
      x = arytostr(#listcount)    ' message "x is:"&str(x) ' message ptstr
      $str_list = ptstr

      screen clear box #tline #lcol #bline #split-1 0 0 no-border
      screen print 21 4 15 1 (format(" ","M73"))
      x = reqnpopup(#tline,#lcol,#bline-1,$str_list,"",0,1,linenr)  ' message "x is:"&str(x)
      $selected = ptstr
      screen shortrestore dsa
      screen save #tline #lcol #bline-1 #split s_reqpop
      if x = 0
        x = FindRoll()
        if x = 0         	       ' in window 2 - "rolmeetB.vw"
          #new_bal = value(#old_bal) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
          #new_bar = value(#old_bar) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
          lock-record
            [Balance] = #new_bal
            [BAR]     = #new_bar
          write-record                   'If OK - assign Roll Nr to REQUSN record.
          data goto window 1
          x = strcount($selected)
          if x = 0
            #recs = ptval
          end if
          x = strcount($reclist)
          if x = 0
            #recs = ptval
          end if
          x = remove("rollnrs.idx")                ' create temp index for allocation
          x = makeidx("requsn","rollnrs.idx",str($reclist),1)
          order change index "rollnrs.idx"
          $duedate = upper(mid(addmonths(date1(today),0),4,3))|"ÿ"|right(addmonths(date1(today),0),2)
          while record<=records
            lock-record
              [Status]             = "A"
              [RollNr]             = $rollnr
              [Date_Allocated]     = today
              [DueDate]            = $duedate
              [Date_Requisitioned] = today
              [Created/Changed_By] = userid
            write-record                   'If OK - assign Roll Nr to REQUSN record.
            ordernr = [Reference_Nr]   'message "ordernr/reqnr is:"&str(ordernr)
            x = UpdGdsOut($rollnr,ordernr)
            data goto record next
          end while
          $reclist = ""
          order change index "unallccw.idx"
          return (0)

        elseif x = -1
          messbox(" Cannot allocate from available rolls - retry? (y/n) ",1,0,1)
          if ptstr == "y"
            $reclist = ""
            continue while
          else
            $reclist = ""
            return (-1)
          end if
        end if

      elseif x = -1
        x = messline(" Abandon this allocation? (y/n) ",1,1,1,21,25,30)
        if ptstr == "y"
          $reclist = ""
          return (-1)
        end if
      end if
    end while

  else                                 ' allocating only one
    data goto record record-number value(sim_ccw)
    while true                       ' message "$area_list is:"&str($area_list)
      screen save #tline #lcol #bline #split s_reqpop
      x = FindRoll()
      if x = 0
        #new_bal = value(#old_bal) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
        #new_bar = value(#old_bar) - value(#needed) ' reduce balance by "REQUSN.Length_Quantity"
        lock-record
          [Balance] = #new_bal
          [BAR]     = #new_bar
        write-record                   'If OK - assign Roll Nr to REQUSN record.
        data goto window 1             ' in UAR_B_J.vw
        $duedate = upper(mid(addmonths(date1(today),0),4,3))|"ÿ"|right(addmonths(date1(today),0),2)
        lock-record
          [Status]             = "A"
          [RollNr]             = $rollnr
          [Date_Allocated]     = today
          [DueDate]            = $duedate
          [Date_Requisitioned] = today
          [Created/Changed_By] = userid
        write-record                   'If OK - assign Roll Nr to REQUSN record.
        ordernr = [Reference_Nr]   'message "ordernr/reqnr is:"&str(ordernr)
        x = UpdGdsOut($rollnr,ordernr)
        return (0)

      elseif x = -1
        x = messline(" Abandon this allocation? (y/n) ",1,1,1,21,7,69)
        if ptstr == "y"
          return (-1)
        end if
      end if
    end while
  end if
END FUNCTION '  AllocateSimilar()


FUNCTION refresh(z,r1,c1,r2,c2,pad,b1,b2)
local x t
  screen clear box r1 c1 r2+1 c2+pad b1 b2
  drows = 0
  for x=0 to pl-1
    t = rec-z+x+1
    if t > recs
      exit for
    else
      if t > 0
        screen print x+1+r1 lc b1 b2 plist[t,2]
        drows=drows+1
        if plist[t,1]=1
          screen print x+1+r1 sc b1 b2 sym
        end if
      end if
    end if
  end for
end function  'refresh()


FUNCTION uistrcnt(sl)
local i s lo hi c
s=20
while exact(group(sl,s),NULL)=FALSE
     s=s+20
end while
hi = s
lo = 1
while lo <= hi
     i = int((lo+hi)/2)
     c = group(sl,i)
     if c = NULL
          hi = i-1
     else
          lo = i+1
     end if
end while
while (exact(group(sl,i),NULL)=TRUE and i>0)
     i=i-1
end while
return (i)
END FUNCTION  'uistrcnt()


FUNCTION udelstr(s,sl)
local t i n f
f=0
i=0
n=NULL
ptstr = NULL
while TRUE
     i=i+1
     t = group(sl,i)
     if exact(t,NULL)=TRUE
          exit while
     elseif t = s
          f=1
     else
          n=n&t
     end if
end while
if f = 1
     ptstr = trim(n)
     return (0)
end if
ptstr = sl
return (-1)
END FUNCTION  'udelstr()


FUNCTION reqnpopup(r1,c1,br,list,msg,num,mnu,linenr)
local t hml hm cnum mscn pad padc ret
  colSf = fgp
  colSb = bgp
  recval = 0
  #needed = 0
  if exact(trim(list),NULL)=FALSE
    recs = uistrcnt(list)
    if recs = 0
      return (-3)
    end if
  else
    return (-2)
  end if

  redimension plist[recs,5]
  smartpeek $_l1 hml

  if br-r1<1
     return (-4)
  elseif br+1 > scrheight
     mr=scrheight-1
     msg = ""
  else
     mr=br
  end if
  if br >= hml
     mnu = 0
  end if

  screen save hml 1 hml scrwidth mscn
  if recs > scrheight
     if mnu = 1
          screen clear box hml 1 hml scrwidth 0 0 no-border
          screen print hml 1 bgi bgs "Building list..."
     end if
  end if
  ptstr=NULL
  if mnu = 1
     hm =  case num (0,"Enter = select/unselect   F10 = done   Esc = exit") \
                    (1,"Enter = select   Esc = exit      (select: 1 item)") \
                    else "Enter = select/unselect   F10 = done   Esc = exit  " & \
                         "   (select up to:" & str(num) & "items)"
  else
     hm = NULL
  end if
  sym = spsymmap(37)
  cnum=0
  blen=0
  l=blen
  for c=1 to recs
    plist[c,2]=group(list,c)
    plist[c,4]="S"                    ' changes to "A" before first addn
    l=len(plist[c,2])
    plist[c,1]=0
    if l>blen
      blen=l
    end if
    plist[c,5]=namelist[c,1]
  end for
  c2=c1+blen+2
  r2=r1+recs
  if r2>mr
     r2=mr
  end if
  dc=(c2-c1)
  lc=c1+1
  pad = case num (1,1) else 2
  sc=c1+pad-1
  pl=(r2-r1)
  padc = repeat(chr(32),pad)
  for i = 1 to recs
     pc = 1
     plist[i,2]=padc|format(plist[i,2],"l",dc-1)
     plist[i,3] = i
     if i = pl
          pc=pc+1
     end if
  end for
  if recs > scrheight
    screen shortrestore mscn
  end if
  screen save r1 c1 r2+2 c2+pad psa
  screen clear box r1 c1 r2+1 c2+pad 15 0 no-border
  pc=1
  for c=1 to pl
     screen print c+r1 lc 15 0 plist[c,2]
  end for
  if msg > null
     screen print r2+2 c1 fgi bgi str(format(left(msg,dc+pad+1),"M"|str(dc+pad+1)))
  end if
  if mnu = 1
     screen clear box hml 1 hml scrwidth fgs bgs no-border
     screen print hml 1 fgs bgs (format(hm,"L"|str(scrwidth)))
  end if

  c=1
  rec=1
  screen print r1+c lc fgi bgi plist[rec,2]
  drows = pl
  screen print r1+c lc 15 0 plist[rec,2]

  while true
    if c = pl
      screen print r1+c lc fgi bgi plist[rec,2]
      exit while
    elseif c = linenr+1
      screen print r1+c lc fgi bgi plist[rec,2]
      exit while
    else
      if c = pl
        screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1
      end if
      c= case c (pl,c) else (c+1)
      rec=rec+1
      continue while
    end if
  end while

  while TRUE
    k=inchar
    screen print r1+c lc 15 0 plist[rec,2]
    if plist[rec,1]=1
      screen print r1+c sc 15 0 sym
    end if
    if k={Down}
      if rec=recs
        if recs<=pl
          rec=1
          c=1
        else
          beep
        end if
          else
               if c = pl
                    screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1
               end if
               c= case c (pl,c) else (c+1)
               rec=rec+1
          end if
     elseif k={Up}
          if rec=1
               if recs <= pl
                    rec = recs
                    c = pl
               else
                    beep
               end if
          else
               if c = 1
'                     screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1
                    screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1
               end if
               c= case c (1,c) else (c-1)
               rec=rec-1
          end if
     elseif k={Home}
          if c>1
               if rec =(rec-c)+1
                    rec = 1
               else
                    rec =(rec-c)+1
               end if
               c=1
          else
               rec=1
               c=1
          end if
     elseif k={^Home}
          if rec = c
               rec = 1
               c=1
          else
               rec = 1
               c=1
               refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
          end if
     elseif k={End}
          if rec < recs and c < pl
               if drows < pl
                    rec = recs-pl+1
                    refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                    rec = recs
                    c = pl
               else
                    if rec+(pl-c) < recs
                         rec = rec+(pl-c)
                         c = pl
                    else
                         rec = recs
                         c = pl
                    end if
               end if
          end if
     elseif k={^End}
          rec = recs-pl+1
          c = 1
          refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
          c = pl
          rec = recs
     elseif k={PgDn}
          if rec = recs and c = pl
               beep
          elseif c <= pl
               if rec = recs or rec+pl >= recs
                    rec = recs-pl+1
                    c = 1
                    refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                    c = pl
                    rec = recs
               else
                    rec = rec+pl
                    refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
               end if
          end if
     elseif k={PgUp}
          if rec = 1 and c = 1
               beep
          else
               if recs > pl
                    if (rec-pl)-c <= 1
                         c = rec-pl
                         if c < 1
                              c = 1
                         end if
                         rec = 1
                         refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                         rec = c
                    else
                         rec=(rec-pl)
                         refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
                    end if
               else
                    if rec > 1
                         rec=1
                         c=1
                    end if
               end if
          end if
     elseif k={Enter}
          screen print r1+c lc fgi bgi plist[rec,2]
          if plist[rec,1] = 1
               if udelstr(trim(plist[rec,2]),ret) = 0
                    ret = ptstr
               end if
               plist[rec,1] = 0
               cnum=cnum-1
          else
               if cnum = num and not(num=0)
                    beep
               else
                    ret=trim(ret&plist[rec,2])
                    plist[rec,1] = 1
                    cnum=cnum+1
               end if
          end if
          if rec < recs
               smartpoke $_key {Down}
          end if

          IF plist[rec,4] = "A"
            plist[rec,4] = "S"
          elseif plist[rec,4] = "S"
            plist[rec,4] = "A"
          end if

          NewTotal()
          if #needed = 0
            screen print 21 25 15 1 "No requisitions to allocate"
          else
            y = "Total to allocate is:"&fixed(#needed,2)|"m"
            screen print 19 25 14 1 y
          end if
     elseif k={Esc}
               ret=null
               exit while
     elseif k={F10}
         for c=recs to 1 step -1
              if plist[c,1]=1
                   ret=ret & trim(plist[c,2])
              end if
         end for
         exit while
     end if
  if k<> {Enter}
     screen print r1+c lc fgi bgi plist[rec,2]
  end if
     if plist[rec,1]=1
          screen print r1+c sc fgi bgi sym
     end if
  end while
  screen save r1 c1 r2+2 c2+1+pad dsa
  screen shortrestore mscn
  screen shortrestore psa
  nr = c
  clear c k dc lc sc recs c2 r2 l blen pl mr pc sym pg i rec tr drows
  redimension  plist[1,3]
  if trim(ret) = NULL
    ptstr = NULL
    return (-1)
  else
     ptstr = trim(ret)
     ptval = nr
     return (0)
  end if
END FUNCTION  'reqnpopup()


FUNCTION NewTotal()
  recval = left(right(plist[rec,2],6),5)      '
  $recs  = str(plist[rec,5])
  n = len(recval)
  clear x
  for i = 1 to n
    if mid(recval,i,1) = "ÿ"
      continue for
    end if
    x = x|mid(recval,i,1)
  end for
  recval = value(x)
  if plist[rec,4] = "A"
    #needed = #needed + value(recval)
    $reclist = $reclist&$recs
  else
    #needed  = #needed - value(recval)
    delstr($recs,$reclist)
    $reclist = ptstr
  end if
END FUNCTION  'NewTotal()


FUNCTION FindRoll()
local alln_nrs bal_aval remainder
  $allocn = "N"
  data goto window 2

  $ccwcode = [CCW_Code]
  vloadif(dpath|"rolmet_a.vw")
  order change index spath|$ccwcode|".idx"
  order sort now dictionary "z" fields "[Balance]" ascending
  screen shortrestore s_reqpop
  data goto record record-number 1

  while record <= records
    remainder = 0
    #old_bar = [BAR]
    #old_bal = [Balance]
    if #old_bar < #needed              ' BAR > needed
      data goto record next
      continue while
    end if
    remainder = #old_bar - #needed
    if $itemtype = "C"
      if remainder < #maxleft and remainder > #minleft
        data goto record next
        continue while
      end if
    end if

    $rollnr = [RollNr]
    messline(" Confirm allocation of"&fixed(#needed,2)|"m from"&fixed(#old_bal,2)|"m of ROLL"&$rollnr|"? (y/n) ",1,1,1,21,7,69)
    if ptstr == "y"
      $allocn = "Y"
      return (0)
    else
      data goto record next
    end if
  end while
  return (-1)
END FUNCTION 'FindRoll()


FUNCTION CarpetStockRecord()
  repaint off
  x = colpopup(4,1,19,"Warehouse Shop Site Cadogan","",1,0,14,1,0,15)
  locn      = str(ptstr)
  prodcode  = [Product_Code]
  #width    = [Width]
  $itemtype = [Item_Type]
'|
  if locn="Warehouse"
    while true
      x = colpopup(4,10,19,"Unitÿ19 Unitÿ32 Showroom Container","",1,0,14,1,0,15)
      locn      = str(ptstr)
      if locn="Unitÿ19"
        x = colpopup(4,21,19,"A B C D E F G H J K","",1,0,14,1,0,15)
        locn="19"|str(ptstr)
        x = colpopup(4,26,19,"1 2 3 4","Level",1,0,14,1,0,15)
        locn=locn|str(ptstr)
        messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
        if ptstr=="y"
          exit while
        end if
      elseif locn="Unitÿ32"
        x = colpopup(4,21,19,"L M N P Q R S T U V W X Y Z ANCL SMPL","",1,0,14,1,0,15)
        if ptstr="ANCL" or ptstr="SMPL"
          locn=ptstr
          messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
          if ptstr=="y"
            exit while
          else
            continue while
          end if
        end if
        locn="32"|str(ptstr)
        x = colpopup(4,26,19,"1 2 3 4","Level",1,0,14,1,0,15)
        locn=locn|str(ptstr)
        messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
        if ptstr=="y"
          exit while
        end if
      elseif locn="Showroom"
        x=messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
        if ptstr=="y"
          locn="SHOW"
          exit while
        end if
      elseif locn="Container"
        x=messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
        if ptstr=="y"
          locn="CNTR"
          exit while
        end if
      end if
    end while

  elseif locn="Cadogan"
'     x=messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
'     if ptstr=="y"
    locn="CDGN"
' message "Enter Cadogan roll nr"
    entryline(" Enter Cadogan's roll reference ",50,"*50{X}",$comment_P,#bline,1,80)
    $comment_P = ptstr
'     exit while
' a    end if
  end if

  $ccwcode = ""
  case $itemtype

    when "B"
      p1 = "gdsrcv_B.dfr"
      $carp = "besp"
      FindCustomer()
      vloadif(dpath|"stk_besp.vws")

    when "J"
      p1 = "gdsrcv_B.dfr"
      $carp = "besp"
      FindCustomer()
      vloadif(dpath|"stk_besp.vws")

    when "W"
      p1 = "gdsrcv_B.dfr"
      $carp = "besp"
      FindCustomer()
      vloadif(dpath|"stk_besp.vws")

    when "T"
      p1 = "gdsrcv_B.dfr"
      $carp = "besp"
      FindCustomer()
      vloadif(dpath|"stk_besp.vws")

    when "C"
      Check_CCW()
      p1 = "gdsrcv_S.dfr"
      $carp = "carp"
      vloadif(dpath|"stk_carp.vws")

    when "S"
      Check_CCW()
      p1 = "gdsrcv_S.dfr"
      $carp = "carp"
      vloadif(dpath|"stk_carp.vws")

    when "V"
      Check_CCW()
      p1 = "gdsrcv_S.dfr"
      $carp = "carp"
      vloadif(dpath|"stk_carp.vws")

    when "O"
      p1 = "gdsrcv_S.dfr"
      $carp = "carp"
      vloadif(dpath|"stk_carp.vws")
  end case

  AllocateRollNr()                    ' generate unique Roll Nr
  $rollreserve="R"|$rollnr		'message "$rollreserve is:"&str($rollreserve)
  data enter lock                 '
    [DateRecd]        = datercvd
    [Product_Code]    = prodcode
    [Description_MRC] = desMRC
    [RollNr]          = $rollnr
    [Width]           = #width
    [Location]        = locn
    [StockOrder]      = ordernr
    [Stock_Delivered] = #lengthrcvd
    [Balance]         = #lengthrcvd
    [PhysicalBalance] = #lengthrcvd
    [BAR]             = #lengthrcvd
    [Active]          = "Y"
    [CCW_Code]        = $ccwcode
    [Unit_Cost]       = #unitcost
    [Comments]        = $comment_P
    [RollReserve]     = $rollreserve	
  write-record

  case $itemtype
    when "B"
      lock-record
        [Balance]         = 0
        [BAR]             = 0
        [Active]          = "N"
      write-record
    when "J"
      lock-record
        [Balance]         = 0
        [BAR]             = 0
        [Active]          = "N"
      write-record
    when "W"
      lock-record
        [Balance]         = 0
        [BAR]             = 0
        [Active]          = "N"
      write-record
    when "T"
      lock-record
        [Balance]         = 0
        [BAR]             = 0
        [Active]          = "N"
      write-record
  end case

  $ccwidx = $ccwcode|".idx"
  #prec = precord
  if bckg_del <> "OVER"
    x = PrintAcceptLabel()
    if x = -1
      ShowLabel()                        ' message "Show label details"
    end if
  end if
  RecordReceipt()
  case $itemtype
    when "B"
      AllocateBespoke()
    when "J"
      AllocateBespoke()
    when "W"
      AllocateBespoke()
    when "T"
      AllocateBespoke()
    when "O"
      AllocateBespoke()
    when "C"
      x = AllocateStock()
      if x = 0                           ' if not alloc'd
        return (0)                       ' do not add to index of ???
      else
        return (1)                       ' add to index to ???
      end if

    when "S"
      x = AllocateStock()
      if x = 0                           ' if not alloc'd
        return (0)                       ' do not add to index of ???
      else
        return (1)                       ' add to index to ???
      end if

  end case
END FUNCTION ' CarpetStockRecord()


FUNCTION AllocateStock()
  if file(spath|$ccwidx) = 1
    x = addidxrec(spath|$ccwidx,#prec,2)
    if x = -1                          ' create new index by query
      order change key "[CCW_Code]"
      data query execute "ccw_indx.dfq" index spath|$ccwidx
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [CCW_Code] = $ccwidx and not (deleted)                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    end if
  else                                 ' create new index
    x = makeidx("stk_carp",spath|$ccwidx,#prec,1)
    if x = -1                          ' create new index by query
      order change key "[CCW_Code]"
      data query execute "ccw_indx.dfq" index spath|$ccwidx
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [CCW_Code] = $ccwidx and not (deleted)                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    end if
  end if
  x = O_S_Allocns()
  if x = 0                             ' none to allocate
    messboxwait(" No allocations o/s for this carpet ",0,0,1)
    return (1)                         ' add to index of ???
  else
    x = Unallocated()                  ' allocate now
' if not done (precords before = precords after) - mark [Active] = "N" & report to DG
    if x = 0                           ' if not alloc'd
      return (0)                       ' do not add to index of ???
    else
      return (1)                       ' add to index to ???
    end if
  end if
  if x = 1                             ' existing alloc'ns made or none to do
  end if
END FUNCTION ' AllocateStock()


FUNCTION CheckLength() ' 0=reject; 1=correct length del'd;
                       ' 2=SHORT but accept; 3= LONG but accept
while true
  while entryline(" Enter Length/Quantity received ",8,"",null,#bline,1,80) = 0
    if ptstr = ""
      continue while
    else
      #lengthrcvd = val(ptstr)
      if #lengthrcvd = 0
        messboxwait(" Zero length entered - enter correct length ",0,0,1)
        continue while
      end if
      exit while
    end if
  end while

  minlength = ordlength - #margin
  maxlength = ordlength + #margin

  if minlength > #lengthrcvd
    while messline(" SHORT delivery!! ("|fixed(#lengthrcvd,2)|"m) re-enter? (y/n) ",1,0,1,#bline,1,80) = 0
      if ptstr == "n"                  ' length correct - do not re-enter
        messline(" Accept this delivery? (y/n) ",1,0,1,#bline,1,80)
        if ptstr == "y"
          return (2)
        else
          messline(" Confirm that you are rejecting delivery? (y/n) ",1,0,1,#bline,1,80)
          if ptstr == "n"
            continue while
          else
            acceptdel = "n"
            x = chkstr("Length",rej_reason)
            if x = -1
              rej_reason = rej_reason&"Length"
            end if
            return (0)
          end if
        end if
      else                             ' re-enter length
        exit while
      end if
    end while

  elseif #lengthrcvd > maxlength
    while messline(" OVER delivery!! ("|fixed(#lengthrcvd,2)|")  re-enter? (y/n) ",1,0,1,#bline,1,80) = 0
      if ptstr == "n" ' length correct - do not re-enter
        messline(" Accept this delivery? (y/n) ",1,0,1,#bline,1,80)
        if ptstr == "y"
          return (3)
        else
          messline(" Confirm that you are rejecting delivery? (y/n) ",1,0,1,#bline,1,80)
          if ptstr == "n"
            continue while
          else
            acceptdel = "n"
            x = chkstr("Length",rej_reason)
            if x = -1
              rej_reason = rej_reason&"Length"
            end if
            return (0)
          end if
        end if
      else                             ' re-enter length
        exit while
      end if
    end while

  else                                 ' #lengthrcvd = maxlength
    return (1)
  end if
end while
END FUNCTION ' CheckLength()


FUNCTION EnterReject()
' enter reason/notes/action
  while true
    x = fentrybox(" Describe action taken about incorrect delivery ",25,"*25X","")
    if x = 0
      action = rej_reason&ptstr
      if action = ""
        x = messbox(" Action must be entered ",0,0,1)
        continue while
      end if
      exit while
    else
      message "FENTRY Error:"&str(x)
    end if
  end while

  while true
    x = fentrybox(" Enter Supplier's Delivery Note number ",10,"*50X","")
    if x = 0
      delnr = upper(ptstr)
      exit while
    else
      message "FENTRY Error:"&str(x)
    end if
  end while

  vloadif(dpath|"gds_rcvd.vws")
  increment(dpath|"gds_rcvd.dat",1)
  receiptnr = "GI"|right("000000"|str(ptval),6)
  messbox(" Receipt Nr is"&str(receiptnr)|" ",0,1,1)

  #totalcost = #lengthrcvd * #widthrcvd * #unitcost
  data enter lock                       ' make assignments to GDS_RCVD
    [Date_Received]   = date2(datercvd) ' mark date of receipt
    [Supplier_Code]   = suppcode
    [Branch]          = left(ordernr,1)
    [Receipt_Nr]      = receiptnr
    [Status]          = "R"
    [Order_Nr]        = ordernr
    [Product_Code]    = prodcode
    [Width_Received]  = #widthrcvd
    [Colour]          = desMRC
    [Length_Received] = #lengthrcvd     ' enter quantity rec'd
    [Unit_Cost]       = #unitcost
    [Total_Cost]      = #totalcost
    [Last_Update]     = today
    [Updated_By]      = userid
  write-record

' make note in PURCHORD??

  vloadif(dpath|"pndg_stk.vws")
  data enter lock                         ' make assignments to GDS_RCVD
    [Receipt_Nr]      = receiptnr
    [Supplier_Name]   = suppname
    [Product_Ord]     = prodsupp
    [Product_Del]     = prodrcvd
    [Color_Ord]       = desMRC
    [Color_Del]       = colrcvd
    [Backing_Ord]     = backing
    [Backing_Del]     = bckg_del
    [Length_Ord]      = ordlength
    [Length_Del]      = #lengthrcvd
    [Width_Ord]       = ordwidth
    [Width_Del]       = #widthrcvd
    [Order_Reference] = ordref
    [Ordered_By]      = orderby
    [Date_Ordered]    = orderdate
    [Del_Note]        = delnr
    [Order_Nr]        = ordernr
    [Comment]         = action
    [Date_Received]   = date2(datercvd)
  write-record
  rej_record = precord
  PrintRejectLabel()
END FUNCTION ' EnterReject()


FUNCTION PrintRejectLabel()
local $prn $prn_nr $port
  vloadif(dpath|"pndg_stk.vws")
  remove("label.idx")
  makeidx("pndg_stk","label.idx",rej_record,3)
  order change index "label.idx"
  PrintReport("rej_labl.dfr","",p3,p4,p5,p6)	' print label to reject
  PrintReport("rej_stk.dfr","",p3,p4,p5,p6)	        ' print report about rejection
'   PrintReport("rej_labl.dfr","",2,3,1,1)	' print label to reject
'   PrintReport("rej_stk.dfr","",1,2,1,1)	' print report about rejection
  order change physical
END FUNCTION ' PrintRejectLabel()


FUNCTION SelectOrders()
  while true
    x = popuplist(8,35,13,"Supplier ÿJobÿNr","",1,0)
    if x = -1
      return (-1)
    end if
    if ptstr = "Supplier"
      $vw_scn = "gdsrcv_S"
      x = FindSupplier()
      vunloadif($vw_scn|".vw")
      vunloadif("gdsrcv1.vw")
      Background()
    else
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Find Job Nr                                                        ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      x = fentrybox(" Order reference Nr of delivery ",6,shopmask,"")
      if x = -1
        continue while
      else
        jobnr = ptstr
      end if

      while true
        vloadif(dpath|$vw_scn|".vw")
        order change key "[JobNr]"
        data query execute "ord_ref.dfq" index "not_delv.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [JobNr] = jobnr
'   and
'   [Order_Status]="P"
'   and
'   not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
        if cerror
          screen clear box 1 1 sch scw 0 0 no-border
          messbox(" No outstanding deliveries for"&jobnr,0,0,1)
          screen clear box 1 1 sch scw 0 0 no-border
          exit while
        end if
        Background()
        if records > 12
          #bline = 22
        else
          #bline = 10 + records
        end if
        y1 = format("Deliveries awaited for"&jobnr,"M78")
        y2 = format(" (* = incomplete order)  {Enter} to select order - {Esc} to quit ","M80")
        y3 = format("  Order  Product                        Colour           O/S Length  Width Bckg","L80")
        screen clear box 4 1 6 scw 15 1
        screen print 5 2 fgp bgp y1
        screen print 7 1 fgp bgp y3
        screen print #bline 1 fgp bgp y2
        vloadif(dpath|$vw_scn|".vw")
        x = bpopdb($vw_scn,6,"s"&suppcode,"[Search_Supplier]","L78","[Supplier_Code]","L6","[Order_Nr]",8,1,21,80,"",0)
        if x = 0
          screen shortrestore dsa
          repaint off
          #OSbalance = [Balance_OS]
          ordernr = [Order_Nr]
          pg = ProcessGoods()   '-3=wrong supplier; 0=no o/s orders; 1=o/s orders
          if pg = -3                      ' wrong supplier - go to bpop
            exit while

          elseif pg = 1
            vloadif(dpath|$vw_scn|".vw")
            continue while

          elseif pg = 0
            screen clear box 1 1 sch scw 0 0 no-border
            messboxwait(" No outstanding deliveries for"&jobnr,0,0,1)
            screen clear box 1 1 sch scw 0 0 no-border
            return (1)
          end if

        else          'if x = -1 or any other value ie BPOP did not work
          Background()
          return (1)
        end if
      end while
    end if
  end while
END FUNCTION 'SelectOrders()


FUNCTION UpdGdsOut(roll,reqnnr)
local origview
  progress(15,10," Please wait ...... updating Appointments Diary ",0)
  repaint off
  origview=apinfo(ap_filex)
  vloadif(dpath|"goodsout.vws")
  jobnr = left(reqnnr,6)               ' message "jobnr is:"&str(jobnr)
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "gds_reqn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ³ and
' ³ not (deleted)                                                      ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror                               '   if none - then return
    vloadif(dpath|origview)
    return (1)
  end if
  data find "[Requsn_Nr]" equal reqnnr options ""
  if cerror                               '   if none - then return
    vloadif(dpath|origview)
    return (1)
  else
    while true
      if [RollNr] == "BESPOK" or [RollNr] == "00000/00"
        lock-record
          [RollNr] = roll
        write-record
      else
        messboxwait("Already allocated as"&[RollNr]|"ÿ- inform Office ",0,0,1)
        vloadif(dpath|origview)
        return (1)
      end if
      if record = records
        exit while
      end if
      data goto record next
      data find "[Requsn_Nr]" equal reqnnr options ""
      if cerror
        exit while
      end if
    end while
  end if

  UpdateAppt()

  vloadif(dpath|origview)
  return (0)
END FUNCTION 'UpdGdsOut()


FUNCTION ChkDeliveries()
  BuildList()
  repaint off
  for i = 1 to nrdates
    order change index "gds_reqn.idx"
    $dateout=dateout[i,1]
    data query execute "chk_delv.dfq" index "chk_delv.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ date2([Date_Out])=$dateout
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      continue for
    else
' for each date find if
      if filesum([QuantOut],[RollNr]="BESPOK" or [RollNr]="00000/00")>0
        dateout[i,2]=1                       'message "Deliveries o/s!!"
      else
        dateout[i,2]=0                       'message "Deliveries ready"
      end if
    end if
  end for
END FUNCTION 'ChkDeliveries()


FUNCTION BuildList()
local y $do $list
  $list = ""
  order sort now dictionary "dateout.idx" fields "[Date_Out]" ascending
  for i = 1 to records
    $do = date2([Date_Out])
    if chkstr($do,$list) = -1            ' NOT in list
      $list = $list&$do
    end if
    data goto record next
  end for
  strcount($list)
  nrdates = ptval
  redimension dateout[nrdates,2]
  for i = 1 to nrdates
    dateout[i,1]=group($list,i)        'message "dateout[i,1] is:"&str(dateout[i,1])
  end for
END FUNCTION ' BuildList()


FUNCTION UpdateAppt()
local cd ua2 l
  cd = ChkDeliveries()
  for i = 1 to nrdates
    ua2 = dateout[i,2]                 'message "0=Ready; 1=Not in:"&str(ua2)
    if ua2 = 1
      continue for
    else
      ua1 = dateout[i,1]               'message "checking dateout :"&str(ua1)
      vloadif(dpath|"appntmnt.vws")
      order change key "[Job_Nr]"
      while record<=records
        data find "[Job_Nr]" equal jobnr options ""
        if cerror                               '   if none - then return
          exit while
        else
          if date2([Date]) = ua1
            if [Status] = "O"
              lock-record
                [Status]="D"
              write-record
            end if
            data goto record next
          else
            data goto record next
          end if
        end if
      end while
      vunloadif("appntmnt.vws")

      vloadif(dpath|"apptdate.vws")
      order change physical
      data query execute "upd_appt.dfq" index "upd_appt.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ date2([Date])=ua1
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      data goto record first
      for l = 1 to records
        for k = 1 to 7
          if indirect("[A"|str(k)|"]") = jobnr
            if indirect("[B"|str(k)|"]")="O"
              lock-record
                dbput("[B"|str(k)|"]","D")
              write-record
              data goto record next
            end if
          end if
        end for
        data goto record next
      end for
    end if
  end for
END FUNCTION 'UpdateAppt()


FUNCTION PrintAcceptLabel()
local $prn $prn_nr $carpdatafile
  remove("label.idx")
  $carpdatafile = "stk_"|$carp                 ' message "$carpdatafile is:"&str($carpdatafile)
  x=makeidx($carpdatafile,"label.idx",#prec,5) ' message "x is:"&str(x)
  $customview = $carp|"rcvd.vw"                ' message "$customview is:"&str($customview)
  vloadif(dpath|$customview)
  order change index "label.idx"
  while true
    x = fentrybox(" If you need duplicates, enter TOTAL nr of tickets to print ",2,"*2{#}","1")
    if x = -1
      continue while
    end if
    $totkts = value(ptstr)
    messbox(" Confirm total of"&str($totkts)&"tickets to print? (y/n) ",1,1,1)
    if ptstr == "Y"
      exit while
    else
      continue while
    end if
  end while
  for i = 1 to $totkts
    $tkt = str(i)
    vunloadif("X_rlltkt.vws")
    x=remove(X_path|"X_rlltkt.*")								' message "ptstr is:"&str(ptstr)
    data query execute "not_del.dfq" Smart4 X_path|"X_rlltkt" fields "[Product_Code;Description_MRC;Roll_Nr;Stock_Delivered;Width;Location;Product_MRC;Backing;StockOrder;RollNr;RcvdDate;Supplier;WidthRcvd;JobNr;Customer;TicketNr;TicketTotal]"
'     _SWIP_Crystal(Xreppath|"rolltkt1","P",0,1,"")
    _SWIP_Crystal(Xreppath|"Z_rlltkt","P",0,1,"")
    vloadif(dpath|$customview)
  end for
  vunloadif("X_rlltkt.vws")
'   vloadif(dpath|$customview)
  if x = -1
    order change physical
    return (-1)
  end if
  order change physical
END FUNCTION ' PrintAcceptLabel()


FUNCTION FindCustomer()
  jobnr = [JobNr]
  vloadif(dpath|"cust_ord.vws")
  error off
  custname = filelookup([Job_Nr],[CustOrd_Name],jobnr)
  if cerror
    custname = ""
  end if
  vunloadif("cust_ord.vws")
END FUNCTION ' FindCustomer()


FUNCTION AllocateBespoke()
local #newliststck #reqncost $backing #prodrec #ordwidth #oldlength
local #balancecost #newbalance #rcvdcost #newcost
  vloadif(dpath|"REQUSN.vws")		' find Reference Nr
  order change key "[Reference_Nr]"
  data find "[Reference_Nr]" equal ordernr options ""
' message "Purchase order status is:"&str($purordstat)

  if $purordstat = "P"
    #ordwidth    = [Width]
    #newliststck = [Lst_Stck]
    prodcode     = [Product_Code]
    prodMRC      = [Product_MRC]
    desMRC       = [Description_MRC]
    $itemtype    = [Item_Type]
    #reqncost    = [Cost]
    $ccwcode     = [CCW_Code]
    $backing     = [R_Backing]
    #prodrec     = [prodrec]
    custcode     = [CustCode]
    #oldlength   = [Length_Quantity]
'     #newbalance  = #oldlength-#lengthrcvd
    #newcost     = (#ordbal_OS/#oldlength)*#reqncost
    lock-record
      [Length_Quantity] = #ordbal_OS
      [Comment]         = "Part delivery:  rec'd:"&str(#lengthrcvd)
      [Cost]            = #newcost
    write-record
    jobnr = left([Reference_Nr],6)     ' message "#ordbal_OS is:"&str(#ordbal_OS)
    vloadif(dpath|"cus_ent4.vw")		' find Reference Nr
    order change key "[Job_Nr]"
    data query execute "job_reqn.dfq" index "refnr.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      #refnr = 0
    end if
    #refnr = filemax([#refnr])         ' message "#refnr is:"&str(#refnr)
    if cerror
      #refnr = 0
    end if
    refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2)) '
' create new req'n for balance of o/s order
    #rcvdcost = (#lengthrcvd/#oldlength)*#reqncost
    data enter lock
      [Lst_Stck]           = #newliststck
      [Reference_Nr]       = refcode        ' assign [Reference_Nr] to record
      [Branch]             = left(refcode,1)
      [Product_Code]       = prodcode
      [Product_MRC]        = prodMRC
      [Description_MRC]    = desMRC
      [Item_Type]          = $itemtype
      [Status]             = "A"
      [Length_Quantity]    = #lengthrcvd
      [Date_Requisitioned] = today
      [Cost]               = #rcvdcost
      [Comment]            = "Partial delivery"
      [Width]              = #ordwidth
      [Created/Changed_By] = userid
      [CCW_Code]           = $ccwcode
      [RollNr]            = $rollnr
      [Date_Allocated]     = today
      [R_Backing]          = $backing
      [prodrec]            = #prodrec
      [CustCode]           = custcode
    write-record
    RemoveGdsOut()
    vloadif(dpath|$vw_scn|".vw")

  elseif $purordstat = "C"
    if abs(#2bdeld)>.1                ' Incorrect BUT accepted
      jobnr = left(ordernr,6)
      RemoveGdsOut()
      vloadif(dpath|"REQUSN.vws")		' find Reference Nr
      order change key "[Reference_Nr]"
      data find "[Reference_Nr]" equal ordernr options ""
      lock-record
        [RollNr]              = $rollnr
        [Length_Quantity]     = #lengthrcvd
        [Quant_OS]            = #lengthrcvd
        [Cost_OS]             = [Cost]
        [Status]              = "A"
        [Date_Allocated]      = today
        [Date_Status_Changed] = today
      write-record
      vloadif(dpath|$vw_scn|".vw")
      return (0)

    else                               ' CORRECT!
      lock-record
        [RollNr]              = $rollnr
'         [Length_Quantity]     = #lengthrcvd
'         [Quant_OS]            = #2bdeld
        [Status]              = "A"
        [Date_Allocated]      = today
        [Date_Status_Changed] = today
      write-record
      ordernr = [Reference_Nr]   'message "ordernr/reqnr is:"&str(ordernr)
      x = UpdGdsOut($rollnr,ordernr)
      vloadif(dpath|"requsn.vws")        ' find Reference Nr
      jobnr = left([Reference_Nr],6)     ' message "#ordbal_OS is:"&str(#ordbal_OS)
      vloadif(dpath|$vw_scn|".vw")
      return (0)
    end if
  end if
END FUNCTION ' AllocateBespoke()


FUNCTION RemoveGdsOut()
local #quantout refnr #q_os
  vloadif(dpath|"goodsout.vws")
'find all records for this Job
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "job_reqn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Job_Nr] = jobnr
'   and
'   not(deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (0)
  end if

' find ALL undelivered records and cancel them
  data query execute "undelvd1.dfq" index "undelivd.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Document]=blank
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (0)
  end if

  while record <= records  ' for each record mark as deleted
    #quantout = [QuantOut]
    #costout  = [Cost]
    refnr     = [Requsn_Nr]
    vloadif(dpath|"requsn.vws")
    order change key "[Reference_Nr]"
    data find "[Reference_Nr]" equal refnr options ""
    if cerror                               '   if none - then return
    else
      #costos = [Cost_OS]
      #q_os   = [Quant_OS]
      lock-record
        [Quant_OS] = #q_os+#quantout
        [Cost_OS]  = #costos+#costout
      write-record
      clear #q_os #quantout #costos #costout
    end if
    vloadif(dpath|"goodsout.vws")
    data delete record
    data goto record next
  end while
  order change key "[Requsn_Nr]"
  data find "[Requsn_Nr]" equal ordernr options ""
  data delete record
  #prec1=precord
  vunloadif("goodsout.vws")
  x=remove("label.idx")                'message "x is:"&str(x)
  x=makeidx("goodsout","label.idx",str(#prec1),3) 'message "x is:"&str(x)
  vloadif(dpath|"rmvgdout.vw")
  order change index "label.idx"
  p3 = 1                ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
  p4 = 1                ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
  PrintReport("rmvgdout.dfr","",p3,p4,p5,p6)	'print report to SHOP
  data delete record
END FUNCTION ' RemoveGdsOut()