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

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     ReturnToMenu() 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     colSf colSb recs plist[1,1] mr sym blen
' global     c2 r2 dc lc sc pl pc rec drows udelstr() nr pg tr returnnr $lststk
global     c2 r2 dc lc sc pl pc rec drows 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
      $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
    screen shortrestore S_all
    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 goto record last
      data find "[Abbrv_Name]" equal abbrv_name options "b"
      data goto record previous
      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
repaint off
' repaint
' single-step on
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
  screen shortrestore S_all
  while true
'     x = entryline("Enter length/amount returned",8,nr8,#lengthrcvd,22,5,72)
    x = fentrybox("Enter length/amount returned",8,nr8,#lengthrcvd)
    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" data-file X_path|"X_rtnlst" fields "[ViewDesc;AmtReturned;Width;Location;Comments;Fitter_Name;LstStk;Fitter_Name;RetnCode;Reason4Rtn]"
    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()



'     screen shortrestore S_all