' RETURNS - WHSE program for incoming/outgoing returns

external   messbox() vloadif() vunloadif() dpath scr shopmask fentrybox()
external   sch scw progress() fgp bgp messline() wraptext() nr6 bgi bgs nr5
external   userid menuchoice cpath entryline() navrecs() fge bge fgs nr8
external   remove() makeidx() Background() posncolpopup() colpoplines()
external   chkstr() strcount() colpopup() bpopdb() $menu messboxwait() fgi
external   increment() _SWIP_Crystal() Xreppath X_path

public     ptstr dsa ptval jobnr $refnr psa ptary[1] $screen

global     x $jobstr z k y1 y2 y3 y4 y2a y2b y2c y2d EnterCustName() abbrv_name l i $invoice
global     CheckNr() ShowAllReqs() #count fmt RecsScroll() NavMess_A() $invnr
global     ReturnToMenu() refresh() jobdesc ftgcomm ftginstr ftgscrn y slotrec
global     NavReqns() S_status c Return_StkA() Return_OTHER() prodcode
global     $invdate $ordstat #lengthrcvd #width $itemtype #prec PrintReturnsList()
global     navmess() bot psmode locn $carp AllocateRollNr() SetupDetails() CustScreenLine()
global     custaddr1  custaddr2  custcity custpostcode deladdr1 deladdr2 #inv
global     $status S_all $ccwcode $comments NewGoodsOut() suppcode
'  ReturnsStockRecord()
global     $ccwidx ChooseFitter()
'  Return2Manufr()
global     BoxText() #margin #netinv #totcost $reason Stk_RetnRecord()
global     ordvu_1 ordvu_2 OSentrybox() AnclStockRecord() $ftrcode $retns_entd
global     popuplist() colSf colSb uistrcnt() recs plist[1,1] mr sym blen
global     c2 r2 dc lc sc pl pc rec drows udelstr() nr pg tr returnnr $lststk
global     m1 m2 m3 m4 m5 ProcessReturn() desMRC $rollnr ordernr #unitcost
global     Return_StkO() OtherStockRecord()
'  ChooseIncomingOutgoing()


MAIN
single-step off
  file unload all
  Background()
  error off
  fmt = "L64"
  bot = 7

  while true
    window close
    if cerror
      exit while
    end if
  end while

' while true
'   x=ChooseIncomingOutgoing()
'   if x = 2
' '     exit while
'     Return2Manufr()
'
'   elseif x = 1				' coming back in
    while true
      $retns_entd="N"
      x=ChooseFitter()
      if x = -1
        exit while
      else
        while true
          x = CheckNr()                          ' check Job Nr exists in CUST_ORD
          if x = -1
            exit while
          end if
        end while
      end if
      if $retns_entd="Y"
'     messbox(" Job Nr ("&jobnr|") not found - search archives? (y/n) ",1,1,1)
        messbox("Printing list of returns",0,1,1)   'D. Lynn
        PrintReturnsList()
      end if
    end while

  ReturnToMenu()

END MAIN


FUNCTION ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  fopen dpath|userid|".jnr" as 1
  fwrite 1 from $jobstr
  fclose 1
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION CheckNr()                     ' checks for JobNr - if not found
  while true
    Background()
    $comments=""
    z = 0
    m1 = "˙˙˙˙Job˙Nr"
    m2 = "˙Customer˙Name"
    x = popuplist(9,30,13,m1&m2,"{Esc} to exit",1,0)
    if x = 0
      if ptstr = "Y"                   ' Job nr  "Job nr"
        ordvu_1 = "stkretn1.vw"
        vloadif(dpath|ordvu_1)
'         order change key "[Job_Nr]"
        x = OSentrybox(" Enter Order Nr or {Esc} to exit ",6,"","",jobnr)
        if x = -1
          return (-1)
        elseif x = 0
          jobnr = jobnr|ptstr     ' "jobnr) is:"&str(jobnr)
          x = SetupDetails()
        end if

      elseif ptstr = m2                'Customer˙Name
        k=remove("all_req1.idx")
        x = EnterCustName(z)
        if x = -1
          continue while

        elseif x = 0                   ' using current
          vloadif(dpath|ordvu_1)
          order change key "[Job_Nr]"
          x = SetupDetails()
          if x = -1
            continue while
          end if
        end if

      elseif ptstr = m1                '"˙˙ Job Nr"
        ordvu_1 = "stkretn1.vw"
        ordvu_2 = "ordstat2.vw"
        k=remove("all_req1.idx")
        vloadif(dpath|ordvu_1)
        order change key "[Job_Nr]"
        x = fentrybox(" Enter Order Nr or {Esc} to exit ",6,shopmask,"")
        if x = -1
          return (-1)
        elseif x = 0
          jobnr = ptstr
          x = SetupDetails()
        end if
      end if

    elseif x = -1
      return (-1)
    end if
  end while
END FUNCTION ' CheckNr()


FUNCTION SetupDetails()
local $chstr
  data find "[Job_Nr]" equal jobnr options "gw"
  if cerror
    messbox(" Job Nr ("&jobnr|") not found - search archives? (y/n) ",1,1,1)
    return (-1)
  end if

'     vloadif(dpath|ordvu_1)
'     jobdesc  = [Description]
'     ftginstr = [Instructions]
'     ftgcomm  = [Fitting_Comment]
'     jobdesc  = @if(len(jobdesc)=0,"Not known",jobdesc)
'     ftginstr = @if(len(ftginstr)=0,"Not known",ftginstr)
'     ftgcomm  = @if(len(ftgcomm)=0,"Not known",ftgcomm)
'     slotrec  = [Appt_Slots]
    $ordstat = [Order_Status]

'     $invoice = [Completed]
'     $invnr   = [Inv_Nr]
'     $invdate = [Invoice_Date]
'     #netinv  = [Net_Invoice]
'   end if
  repaint on
  repaint
  screen save 1 1 7 scw S_all
  repaint off
'   vunloadif(ordvu_1)
'   $chstr = "Customer Fittings Instructions Orders Requisitions Receipts Comments"
'   $chstr = "Customer Fittings Instructions Orders Requisitions Receipts Email Comments"

  x = ShowAllReqs()

END FUNCTION ' SetupDetails()


FUNCTION ShowAllReqs()
local y2 y1 y3 y4
  progress(15,10," Please wait ... finding requisitions ",0)
  repaint off
  vloadif(dpath|"gds_rcvd.vws")
  vloadif(dpath|"supplier.vws")
  vloadif(dpath|"purchord.vws")
  vloadif(dpath|"stkretn3.vw")
  order change key "[JobNr]"
  data query execute "all_reqn.dfq" index "all_req1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    screen shortrestore psa
'     x = remove("all_reqn.idx")                ' create temp index for allocation
'     x = makeidx("requsn","all_reqn.idx","0",1)
'     if x = -1
'       "makeidx() failed"
'     end if
    messboxwait(" NO requisitions entered yet ",0,0,1)
    return (1)
  else                               ' order by ListOrder & prodMRC
    data query execute "returns1.dfq" index "all_req2.idx"
  end if
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ [Item_Type]<>"F"                                        ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    screen shortrestore psa
'     x = remove("all_reqn.idx")                ' create temp index for allocation
'     x = makeidx("requsn","all_reqn.idx","0",1)
'     if x = -1
'        "makeidx() failed"
'     end if
    messboxwait(" NO materials requisitions entered yet ",0,0,1)
    return (1)
  else                               ' order by ListOrder & prodMRC
    order sort now dictionary "all_reqn.idx" fields "[Lst_Stck;Product_MRC]" ascending
    #count = records
    repaint on
    repaint
    screen shortrestore S_all
  end if
  ptval=0
  while true
    ptval = NavReqns()
    if ptval = {Esc}
      repaint off
      vunloadif("gds_rcvd.vws")
      vunloadif("supplier.vws")
      vunloadif("purchord.vws")
      vunloadif("stkretn3.vw")
      screen clear box 7 1 sch scw 0 0 no-border
      return (-1)
    end if
  end while
  repaint off
END FUNCTION ' ShowAllReqs()


FUNCTION NavReqns()
local x psmode pd pq #percentmargin
  smartpeek $_spndmes psmode
  if psmode = 1
    smartpoke $_spndmes 0
  end if
  while TRUE
    y4 = format("˙Req'ns in purple have not been fully scheduled for delivery ","M78")
    screen print 9 2 13 1 y4
    y3 = format("˙"|chr(24)&chr(25)&"req'ns ("|str(#count)|")    {P}urchase details   {Esc} to exit ","M78")
    screen print 10 2 15 1 y3
    screen save scrheight 1 scrheight scrwidth bot
    x = inchar
    if x = {Down}
      data goto record next

    elseif x = {Up}
      data goto record previous

    elseif x = {PgDn}
      data goto page next

    elseif x = {PgUp}
      data goto page previous

    elseif x = {^End}
      data goto record last

    elseif x = {^Home}
      data goto record first

'     elseif x = {P} or x = {p}
'       NavMess()
    elseif x = {Enter}
      ProcessReturn()
    else
      exit while
    end if
  end while
  if psmode = 1
    smartpoke $_spndmes 1
  end if
  return (x)
END FUNCTION   'NavReqns()


FUNCTION NavMess()
local col1 pd pq pr psc psn psr psp pq1 pinv piv pss dld
  if [Item_Type] = "B" or [Item_Type]="W" or [Item_Type]="J" or [Item_Type]="T" or [Item_Type]="O"
    pr = [Date_Allocated]              ' "pr is:"&date2(pr)
    $refnr = [Reference_Nr]            ' "$refnr is:"&str($refnr)
    error off
    pd = filelookup([purchord.Order_Nr],[purchord.Date_Ordered],$refnr) ' "pd is:"&str(pd)
    if cerror
      messboxwait(" Reference NOT found in PURCHORD.DB ",0,0,1)
      return (1)
    else
      pq  = filelookup([purchord.Order_Nr],[purchord.Delivery_Quoted],$refnr)
      pq1 = @if(pq=null,"N/Q",pq)    ' "pq1 is:"&str(pq1)
      psc = filelookup([purchord.Order_Nr],[purchord.Supplier_Code],$refnr)
      psr = filelookup([purchord.Order_Nr],[purchord.Order_Reference],$refnr)
      pss = filelookup([purchord.Order_Nr],[purchord.Del],$refnr)
      psn = filelookup([supplier.Supplier_Code],[supplier.Name],psc)
      psp = filelookup([supplier.Supplier_Code],[supplier.Telephone],psc)
      dld = case pss ("W","Warehouse")("F","Fulham")("R","Raynes")("P","Putney")("S","Sheen")("O","Collected")("I","On Site")
      if value(pr)=0 ' NOT received
        y2 = format("Ordered on"&date2(pd)&"- for delivery:"&pq1,fmt)
        y2a = format(left("From:"&psn&"-"&psp,66),fmt)
        y2c = format(left("Ref:"|psr,66),fmt)   ' "len(y2a) is:"&str(len(y2a))
        y2b = format("",fmt)   ' "y2 is:"&str(y2)
        y2d = format(left("Deliver to:"&dld,66),fmt)   ' "y2d is:"&str(len(y2a))
      else
        y2a = format(left("From:"&psn&"-"&psp,66),fmt)
        y2c = format(left("Ref:"|psr,66),fmt)   ' "len(y2a) is:"&str(len(y2a))
        y2d = format(left("Delivered to:"&dld,66),fmt)   ' "y2d is:"&str(len(y2a))
        pinv= filelookup([gds_rcvd.Order_Nr],[gds_rcvd.Invoice_Nr],$refnr)
        if $menu == "offc" or $menu == "boss"
          piv = filelookup([gds_rcvd.Order_Nr],[gds_rcvd.Invoice_Cost],$refnr)
          y2b = format(left(@if(pinv=blank,"","Invoice amount"&currency(piv)),65),fmt)
        else
          y2b = format("",fmt)   ' "y2 is:"&str(y2)
        end if
        y2  = format(left(@if(pinv=blank,"Order received on"&date2(pr)&"(Invoice not rec'd)","Order received on"&date2(pr)|"˙(Inv Nr"&pinv|")"),65),fmt)
      end if
      col1 = 1
    end if
    if BoxText(1,7,7,73,10,5,"L",1,0,0) = 0
      wait 7
      screen shortrestore psa
    end if
  else
    return (1)
  end if
END FUNCTION   'NavMess()


FUNCTION BoxText(r1,c1,r2,c2,fg,bg,jst,sprn,sml,pg)
local dr a b $line fmt
  b = dr
  clear psa
  screen save r1 c1 r2 c2 psa
  screen clear box r1 c1 r2 c2 fg bg
  screen print (r1+1) c1+2 fg bg format fmt y2
  screen print (r1+2) c1+2 fg bg format fmt y2a
  screen print (r1+3) c1+2 fg bg format fmt y2c
  screen print (r1+4) c1+2 fg bg format fmt y2b
  screen print (r1+5) c1+2 fg bg format fmt y2d
  screen save r1 c1 r2 c2 dsa
  redimension ptary[1]
  ptval = a
  return (0)
END FUNCTION   'BoxText(r1,c1,r2,c2,fg,bg,ts,jst,sprn,sml,pg)


FUNCTION EnterCustName(z)
  while true
    if z = 0
      while true
        x = fentrybox(" Enter first 7 letters of Name (inc. capitals) - {Esc} ",7,"","")
        if x = 0
          if len(ptstr)=0
            continue while
          end if
          exit while
        elseif x = -1
          return (-1)
        end if
      end while
      abbrv_name = ptstr
      Background()
      ordvu_1 = "stkretn1.vw"
      ordvu_2 = "ordstat2.vw"
      vloadif(dpath|ordvu_2)
      order change key "[Abbrv_Name]"
      data find "[Abbrv_Name]" equal abbrv_name options ""
      if cerror
'         messbox(" Name"&chr(34)|abbrv_name|chr(34)|" not on file - search archives? (y/n) ",1,1,1)
'         if ptstr == "y"
'           arc = 1
'           x = CheckArcOrders(1)
'           if x = -1
'             return (-1)
'           else
'             Background()
'             ordvu_1 = "a_ordst4.vw"
'             ordvu_2 = "a_ordst2.vw"
'             jobnr = [Job_Nr]
'             return (2) ' using archived files
'           end if
'         else
          continue while
'         end if
      else

      end if
    else
      ordvu_1 = "stkretn1.vw"
      ordvu_2 = "ordstat2.vw"
      vloadif(dpath|ordvu_2)
    end if
    CustScreenLine()
    while true
      ptval = RecsScroll()
      if ptval = {Enter}
        repaint off
        jobnr = [Job_Nr]
        vloadif(dpath|ordvu_1)
        order change key "[Job_Nr]"
        x = SetupDetails()
        vloadif(dpath|ordvu_2)
        CustScreenLine()
        continue while

'       elseif ptval = {a}
'         x = CheckArcOrders(1)
'         if x = -1
'           exit while
'         else
'           screen clear box 1 1 sch scw 0 0 no-border
'           repaint off
'           jobnr = [Job_Nr]
'           return (2) ' using archived files
'         end if

      elseif ptval = {Esc}             ' "Escaping from EnterCustNAme - L705"
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        return (-1)
      end if
    end while
  end while
END FUNCTION 'EnterCustName()


FUNCTION CustScreenLine()
  repaint on
  repaint
  ptval=0
  y1 = format(" Name                                Delivery Address","L71")
  y2 = format(" {A}rchived orders - {Enter} selects - {Esc} exits ","M71")
  screen print 4 6 fgp bgp y1
  screen print 18 6 fgp bgp y2
END FUNCTION ' CustScreenLine()


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()


FUNCTION NavMess_A()
local ftgdate ordstat mess1 col1 mess2
  col1 = 12
  ftgdate = [Fitting_Date]             ' "ftgdate) is:"&date2(ftgdate)
  ordstat = [Order_Status]             '  "ordstat) is:"&str(ordstat)
  jobnr   = [Job_Nr]                   '  "jobnr) is:"&str(jobnr)
  mess1   =  format("Job Nr"&[Job_Nr]&"- Ftg Date:"&format(@if([Fitting_Date]=blank,"NONE!",date2([Fitting_Date])),"L10")&"- Status:"&[$case],"M71")
  if [Invoice_Total] < 0
    mess2 =  format("Credit note for:"&currency(abs([Invoice_Total]))&"- balance o/s:"&currency([Balance_Due]),"M71")
  else
    mess2 =  format("Inv Nr"&[Inv_Nr]&"Order value:"&currency([Invoice_Total])&"- balance o/s:"&format(currency([Balance_Due]),"R9"),"M71")
'     mess2 =  format("Order value:"&currency([Invoice_Total])&"- balance o/s:"&format(currency([Balance_Due]),"R9"),"M71")
  end if
  screen print 19 6 15 col1 mess1
'   if arc = 0
'     screen print 20 6 15 col1 mess2
'   end if
END FUNCTION   'NavMess_A()


FUNCTION OSentrybox(msg,elen,msk,dfalt,$init)
local tgt lmsg mbox r1 r2 c1 c2 c3 c4 errscn
ptstr = NULL
tgt = BLANK
lmsg=len(msg)
mbox = scrwidth
if (lmsg+4) > scrwidth
     return (-2)
end if
r1 = scr-4
r2 = scr+2
if lmsg >= elen
     c3 = int((mbox-lmsg)/2)+1
'      c4 = int((mbox-elen)/2)+1
     c4 = int((mbox-elen)/2)+2
     c2 = c3 + lmsg + 1
     c1 = c3-2
else
     c3 = int((mbox-lmsg)/2)+1
     c4 = int((mbox-elen)/2)+1
     if c4 < 3
          c4 = 3
     end if
     c2 = c4 + elen + 1
     if c2 > scrwidth
          c2 = scrwidth
     end if
     c1 = c4-2
end if
if c1 <= 0
     c1 = 1
end if
if (c1-1) < 12
     while (c1-1) < (scrwidth-c2)
          c2=c2+1
     end while
end if

if c2 > scrwidth
     return (-2)
end if

' ############## New for SHADE ##############################
' screen save r1 c1 r2+1 c2+1 psa                 'NEW
screen save r1 c1 r2 c2 psa                 'ORIGINAL
'   screen save r1 c1 r2 c2 psa                 'WAS
' SCREEN SAVE r1+1 c1+1 r2+1 c2+1 $screen		'NEW
' _shade() 						'NEW
' SCREEN SHORTRESTORE $screen				'NEW
' ############## END of New for SHADE #######################

  screen clear box r1 c1 r2 c2 fgp bgp
  screen print r1+2 c3 fgp bgp msg
  if exact(msk,NULL)=FALSE
    screen print scr c4 fgi bgi $init
    screen input scr c4+1 fgi bgi elen tgt MASK msk dfalt
  else
    if dfalt = NULL
      screen print scr c4 fgi bgi $init
      screen input scr c4+1 fgi bgi elen tgt
    else
      screen print scr c4 fgi bgi $init
      screen input scr c4+1 fgi bgi elen tgt dfalt
    end if
  end if
  screen save r1 c1 r2 c2 dsa
  screen shortrestore psa
  if tgt = BLANK
    ptstr = NULL
    return (-1)
  else
    ptstr = str(tgt)
    return (0)
  end if
END FUNCTION 'OSentrybox()


function popuplist(r1,c1,br,list,msg,num,mnu)
local t hml hm cnum mscn pad padc ret

  colSf = fgp
  colSb = bgp
  if exact(trim(list),NULL)=FALSE
    recs = uistrcnt(list)
    if recs = 0
      return (-3)
    end if
  else
    return (-2)
  end if

  redimension plist[recs,3]
  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(28)
  cnum=0
  blen=0
  l=blen
  for c=1 to recs
    plist[c,2]=group(list,c)
    l=len(plist[c,2])
    plist[c,1]=0
    if l>blen
      blen=l
    end if
  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+3 c2+pad+1 psa     'NEW
screen save r1 c1 r2+2 c2+pad psa     'ORIGINAL
' ############## New for SHADE ##############################
' SCREEN SAVE r1+1 c1+1 r2+2 c2+pad+1 $screen		'NEW
' _shade() 						'NEW
' SCREEN SHORTRESTORE $screen				'NEW
' ############## END of New for SHADE #######################

screen clear box r1 c1 r2+1 c2+pad fgp bgp
pc=1

  for c=1 to pl
    screen print c+r1 lc fgp bgp 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

  while TRUE
    k=inchar                          ' "k is:"&str(k)
    screen print r1+c lc fgp bgp plist[rec,2]
    if plist[rec,1]=1
      screen print r1+c sc fgp bgp 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) fgp bgp 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
        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 num = 1
                    ret=trim(plist[rec,2])
                    exit while
          end if
          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
     elseif k={Esc}
               ret=null
               exit while

    elseif k=48
      ptstr="I"
      $invnr="0"
      ptval = nr
      return (0)

    elseif k=49
      ptstr="I"
      $invnr="1"
      ptval = nr
      return (0)

    elseif k=50
      ptstr="I"
      $invnr="2"
      ptval = nr
      return (0)

    elseif k=51
      ptstr="I"
      $invnr="3"
      ptval = nr
      return (0)

    elseif k=52
      ptstr="I"
      $invnr="4"
      ptval = nr
      return (0)

    elseif k=53
      ptstr="I"
      $invnr="5"
      ptval = nr
      return (0)

    elseif k=54
      ptstr="I"
      $invnr="6"
      ptval = nr
      return (0)

    elseif k=55
      ptstr="I"
      $invnr="7"
      ptval = nr
      return (0)

    elseif k=56
      ptstr="I"
      $invnr="8"
      ptval = nr
      return (0)

    elseif k=57
      ptstr="I"
      $invnr="9"
      ptval = nr
      return (0)

    elseif k=102 or k=70
      ptstr="Y"
      jobnr="F"
      ptval = nr
      return (0)

    elseif k=114 or k=82
      ptstr="Y"
      jobnr="R"
      ptval = nr
      return (0)

    elseif k=112 or k=80
      ptstr="Y"
      jobnr="P"
      ptval = nr
      return (0)

     elseif k=115 or k=83
      ptstr="Y"
      jobnr="S"
      ptval = nr
      return (0)

     elseif k=116 or k=84
      ptstr="Y"
      jobnr="T"
      ptval = nr
      return (0)

     elseif k=119 or k=87
      ptstr="Y"
      jobnr="W"
      ptval = nr
      return (0)

     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  'popuplist()


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
'-------------------------------------
'sl   = string group
'i    = counter for group() function
's    = string counter increment
'lo   = low search record
'hi   = high search record
'c    = temporary equation to find NULL
'-------------------------------------
'returns  count of strings in string
'         group
'-------------------------------------
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
'-------------------------------------
's    = string to check
'sl   = string group
't    = targeted string to check
'i    = counter for group() function
'n    = new string group
'f    = list changed flag
'-------------------------------------
'returns:  success =  list less item
'          failure =  original list
'-------------------------------------
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  ProcessReturn()		' ALL_REQN.VW loaded
local r1 r2 r3
  r1="Surplus˙from˙job"
  r2="Return˙to˙Mfr"
  r3="Future˙delivery"
  x = popuplist(8,53,13,r1&r2&r3,"Reason",1,0)
  if ptstr=r3
    $reason="FD"
  elseif ptstr=r2
    $reason="RM"
  elseif ptstr=r1
    $reason="SJ"
  end if
if $reason<>"FD"
  while true
    x = fentrybox(" Enter notes re Return (MUST BE ENTERED) ",75,"",$comments)
    if x = -1
      continue while
    end if
    $comments = ptstr
' y=len($comments)
    if len($comments)=0
      messboxwait(" Must enter comment/notes ",0,0,1)
      continue while
    else
      exit while
    end if
  end while
end if

  prodcode=	[Product_Code]
  vloadif(dpath|"products.vws")		' "prodcode) is:"&str(prodcode)
  suppcode = filelookup([products.Product_Code],[products.Supplier_Code],prodcode) '  "suppcode) is:"&str(suppcode)
  vloadif(dpath|"stkretn3.vw")

  desMRC=	[Description_MRC]
  #width=	[Width]
  $refnr=       [Reference_Nr]            ' "L1121 - $refnr is:"&str($refnr)
'   $rollnr=	"NA"
'   locn=	"NA"

  $ccwcode=	[CCW_Code]
  $lststk=	[Lst_Stck]
'   #unitcost=	[Unit_Cost]

  if [Item_Type]="A"			'  "Ancillaries"
    Return_StkA()

'     vloadif(dpath|ordvu_1)		' mark REQUSN.DB record to show returns present
    vloadif(dpath|"stkretn3.vw")
    lock-record
      [Returns]="Y"
    write-record
    screen save 1 1 7 scw S_all

    vloadif(dpath|"stkretn3.vw")
    repaint on
    repaint
    screen shortrestore S_all

  else					'  "Anything else"
    Return_StkO()

' create record in STK_RETN.DB

' create record in returns.db

'     vloadif(dpath|ordvu_1)		'
    vloadif(dpath|"stkretn3.vw")
    lock-record
      [Returns]="Y"
    write-record
    screen save 1 1 7 scw S_all
    vloadif(dpath|"stkretn3.vw")
    repaint on
    repaint
    screen shortrestore S_all
  end if
end function ' ProcessReturn()


function Return_StkA()
  #lengthrcvd=[Length_Quantity]
  $rollnr=	"NA"
  locn=	"NA"

'enter stock to return
  while true
    x = entryline("Enter length/amount returned",8,nr8,#lengthrcvd,22,5,72)
    if x = 0
      if value(ptstr) = 0
        continue while
'       elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5
'         #lengthrcvd = value(ptstr)
'         exit while
      else
        ptval = value(ptstr)
        #lengthrcvd = ptval
        exit while
      end if
    end if
  end while
'       #lengthrcvd = ptstr

  x=AnclStockRecord()
  if x=-1
    return (-1)
  end if

  Stk_RetnRecord()			' enter record in STK_RETN.DB

  NewGoodsOut()				' enter record in GOODSOUT.DB

end function ' Return_StkA()


function Return_StkO()			' all EXCEPT STK ANCL
  #lengthrcvd=[Length_Quantity]
' prodcode
' desMRC
' $rollnr
' #width
' locn
' ordernr
' #lengthrcvd
' $ccwcode
' #unitcost

'enter stock to return
  while true
    x = entryline("Enter length/amount returned",8,nr8,#lengthrcvd,22,5,72)
    if x = 0
      if value(ptstr) = 0
        continue while
      else
        ptval = value(ptstr)
        #lengthrcvd = ptval
        exit while
      end if
    end if
  end while

  x=OtherStockRecord()
  if x=-1
    return (-1)
  end if

  Stk_RetnRecord()			' enter record in STK_RETN.DB

'   NewGoodsOut()

end function ' Return_StkO()


FUNCTION OtherStockRecord()
local p1
  repaint off
  x = colpopup(4,3,19,"Warehouse Shop Site","To be Stored in",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 L M N O P","",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,"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
  end if

  $ccwcode = ""

  vloadif(dpath|"stk_retn.vws")

  AllocateRollNr()                    ' generate unique Roll Nr

END FUNCTION ' ReturnsStockRecord()


function Stk_RetnRecord()		' enter record in STK_RETN.DB
  increment(dpath|"stk_retd.dat",1)
  returnnr = right("000000"|str(ptval),6)
  vloadif(dpath|"stk_retn.vws")       ' load Returns file
' message "#lengthrcvd is:"&str(#lengthrcvd)
' message "prodcode) is:"&str(prodcode)
' message "suppcode) is:"&str(suppcode)
' message "desMRC) is:"&str(desMRC)
' message "$rollnr) is:"&str($rollnr)
' message "#width) is:"&str(#width)
' message "locn) is:"&str(locn)
' message "ordernr) is:"&str(ordernr)
' message "#lengthrcvd) is:"&str(#lengthrcvd)
' message "$ccwcode) is:"&str($ccwcode)
' message "#unitcost) is:"&str(#unitcost)

  data enter lock                 ' enter record in STK_RETN.DB
    [DateRecd]        = today
    [Product_Code]    = prodcode
    [Description_MRC] = desMRC
    [RollNr]          = $rollnr
    [Width]           = #width
    [Location]        = locn
    [StockOrder]      = ordernr
    [ReferenceNr]     = $refnr
    [AmtReturned]     = #lengthrcvd
    [Balance]         = #lengthrcvd
    [PhysicalBalance] = #lengthrcvd
    [BAR]             = #lengthrcvd
    [Active]          = "Y"
    [CCW_Code]        = $ccwcode
    [Unit_Cost]       = #unitcost
    [Comments]        = $comments
    [RetnCode]	      = $reason
    [FtrCode]	      = $ftrcode
    [RetnNr]	      = returnnr	
    [Job_Nr]	      = jobnr
    [LstStk]	      = $lststk    	
    [Supplier_Code]   = suppcode	
  write-record
  $retns_entd="Y"
end function ' Stk_RetnRecord()


function Return_OTHER()

end function ' Return_OTHER()


FUNCTION AnclStockRecord()             '
local presentstock newstock
  prodcode = [Product_Code]            ' find product code of ancillary

  presentstock = [Quant_OS]		' "presentstock) is:"&str(presentstock)
  newstock = presentstock + #lengthrcvd	' "newstock is:"&str(newstock)

' reduce balance on REQUSN.DB
  lock-record
    [Quant_OS] = newstock
  write-record

  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
    messboxwait(" Product NOT found in STK_ANCL file - notify Head Office ",0,0,1)
    return (-1)
  else
    lock-record
      presentstock = [PhysicalBalance]
      newstock = presentstock + #lengthrcvd
      [PhysicalBalance] = newstock
      [Quantity_In_Stock] = [Quantity_In_Stock]+newstock
    write-record
  end if
END FUNCTION ' AnclStockRecord()


FUNCTION AllocateRollNr()
local datenumber
  datenumber = left(date2(today),2)|mid(date2(today),4,2)
  while true
    increment(dpath|"retn_nr.dat",1)
    $rollnr = str(datenumber)|right(date2(today),2)|"/"|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 ChooseFitter()
  $retns_entd="N"
  vloadif(dpath|"ftr_list.vws")
'   if t = "v"                           'active fitters
  data query execute "actvftr1.dfq" index "actv_ftr.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Active]="YES"
'   and
'   [Ftr_Est]="F"
'   and
'   not (deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
'   else
'   data query execute "not_del.dfq" index "actv_ftr.idx"
' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ' not (deleted)
' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
'   end if
  order sort now dictionary "nickname" fields "[Nickname]" ascending
  while true
    x = bpopdb("ftr_list",5,"","[Nickname]","L8","[Fitter_Name]","L0","[Fitter_Code]",5,35,21,45,"",0)
    if x = -1
      repaint off
      vunloadif("ftr_list.vws")
      return(-1)
    else
      $ftrcode   = ptstr                ' "ptstr is:"&str(ptstr)
'       $name     = [Fitter_Name]        ' "$name is:"&str($name)
'       $nickname = [Nickname]
'       vloadif(dpath|"ftr_list.vws")
      exit while
    end if
  end while
  repaint off
END FUNCTION  ' ChooseFitter()


FUNCTION  PrintReturnsList()
  vloadif(dpath|"stkretn2.vw")		'
  order change physical
  data query execute "retnlist.dfq" index "sinvprc1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   not (deleted)
'   and
'   [Printed]=blank
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messboxwait(" No unprocessed Returns from fitters ",0,0,1)
    return (1)
  else
    remove(X_path|"X_rtnlst.*")
    order sort now dictionary "retnlst2.idx" fields "[LstStk]" ascending
    data query execute "not_del.dfq" Smart4 X_path|"X_rtnlst" fields "[ViewDesc;AmtReturned;Width;Location;Comments;Fitter_Name;LstStk;Fitter_Name;RetnCode]"
    vunloadif("X_rtnlst.vws")
    _SWIP_Crystal(Xreppath|"retnlst2","P",0,1,"")
  end if
  vloadif(dpath|"stkretn2.vw")		'
  data goto record first
  for i = 1 to records
    lock-record
      [Printed]=today
    write-record
    data goto record next
  end for
  return (0)
END FUNCTION  ' PrintReturnsList()


FUNCTION NewGoodsOut()
'   if #delcost = 0
'     messboxwait(" ZERO cost entered in GOODSOUT file - inform Office (ref"|$refnr|") ",0,0,1)
'   end if
  vloadif(dpath|"goodsout.vws")

'     [Cost]      = #delcost

  data enter lock
    [FtrCode]   = $ftrcode
    [Itemtype]  = $itemtype
    [Date_Out]  = date2(today)
    [QuantOut]  = -#lengthrcvd
'     [Cost]      = #delcost
    [Requsn_Nr] = $refnr
    [RollNr]    = $rollnr
'     [CPL_Ref]   = $rollnr
    [Job_Nr]    = jobnr
    [Created_By]= userid
  write-record
END FUNCTION 'NewGoodsOut()
'
'
' FUNCTION ChooseIncomingOutgoing()
'   m1 = "˙˙Coming˙from˙Fitter"
'   m2 = "Going˙to˙Manufacturer"
'   x = popuplist(9,30,13,m1&m2,"{Esc} to exit",1,0)
'   if x = 0
'     if ptstr = m1                   ' coming back in
'       return (1)
'     elseif ptstr=m2
'       return (2)
'     end if
'   end if
' END FUNCTION 'ChooseIncomingOutgoing()
'
'
' FUNCTION Return2Manufr()
' 'show all unprocessed (i.e. Return2Manufr note NOT printed for $reason="RM")
'
'   vloadif(dpath|"retn2mfr.vw")
'   data query execute "rtn2mfr1.dfq" index "rtn2mfr1.idx"
' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' '   [MR_sheet]=blank
' '   and
' '   [RetnCode]="RM"
' '   and
' '   not (deleted)
' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
' '   data query execute "not_del.dfq" index "actv_ftr.idx"
' ' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ' ' not (deleted)
' ' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
' '   order sort now dictionary "nickname" fields "[Nickname]" ascending
'   while true
'     x = bpopdb("retn2mfr",5,"","[Vdesc]","L70","[Supplier_Code]","L0","[ReferenceNr]",5,5,21,75,"",0)
'     if x = -1
'       repaint off
' '       vunloadif("ftr_list.vws")
'       return(-1)
'     else
' '       $nickname = [Nickname]
' '       vloadif(dpath|"ftr_list.vws")
'       exit while
'     end if
'   end while
' repaint on
' repaint
' single-step on
'
' 'print returns sheets - 1 with carrier; 1 (signed by carrier) passed to HO for filing
'
' 'if OK, mark line item (in STK_RETN) with date
' END FUNCTION 'Return2Manufr()