'prog_ord  - Progressive Order Book

external  dpath popuplist() bpopdb() Background() cpath vloadif() fgp bbd
external  messbox() vunloadif() progress() psa remove() makeidx() sch scw
external  $menu messboxwait() dsa

public    ptstr n $initial ptval jobnr bot ptary[1]

global    x ReturnToMenu() FindOSOrders() NavReqns() NavMess() ShowAllReqs()
global    #count S_all y3 y4 $refnr y2 y2a y2b y2c y2d pq1 fmt BoxText()


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

  while true
    x = popuplist(9,30,14,"Fulham Putney Raynes˙Park Sheen Warehouse","",1,0)
    if x = -1
      exit while
    end if
    FindOSOrders(left(ptstr,1))
  end while

  ReturnToMenu()

END MAIN


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


FUNCTION FindOSOrders(n)
local y2
  repaint off
  $initial=n
' message "n is:"&str($initial)
  progress(15,10," Please wait ......... Finding records",0)

'==========================================================================
' FIND ONLY THOSE ORDERS FOR CHOSEN SHOP
'==========================================================================
  vloadif(dpath|"purchord.vws")
  order change key "[JobNr]"
  data query execute "pob_1.dfq" index "pob_1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' left([Order_Nr],1)=$initial
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messboxwait(" No outstanding Purchase Orders ",0,0,1)
    return (0)
  end if

'==========================================================================
' FIND OUTSTANDING ORDERS
'==========================================================================
'   vloadif(dpath|"purchord.vws")
'   order change key "[JobNr]"
  data query execute "pob_2.dfq" index "pob_2.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' [Order_Status]="P"
' AND NOT (DELETED)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messboxwait(" No outstanding Purchase Orders ",0,0,1)
    return (0)
  end if
  order sort now dictionary "pob_3.idx" fields "[Date_Ordered]" descending
  vunloadif("purchord.vws")
  vloadif(dpath|"pob_1.vw")
  order change index "pob_3.idx"
  while true
    y2 = format("  Job Nr   Customer's Name           Material               Ordered   Delivery  ","M80")
    screen print 3 1 fgp bbd y2
    x = bpopdb("pob_1",4,"i","[LineDesc]","L78","[JobNr]","L6","[JobNr]",4,1,22,80,"",0)
    if x=-1
      vunloadif("pob_1.vw")
      exit while
    else
      jobnr=ptstr
      ShowAllReqs()
      vloadif(dpath|"pob_1.vw")
    end if
  end while
END FUNCTION ' ProcessChoice()


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|"all_reqn.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
      message "makeidx() failed"
    end if
    messboxwait(" NO 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("all_reqn.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
  y4 = format("˙Req'ns in purple have not been fully scheduled for delivery ","M78")
  screen print 8 2 13 1 y4
  y3 = format("˙"|chr(24)&chr(25)&"req'ns ("|str(#count)|")    {P}urchase details   {Esc} to exit ","M78")
  screen print 9 2 15 1 y3
  screen save scrheight 1 scrheight scrwidth bot
  smartpeek $_spndmes psmode
  if psmode = 1
    smartpoke $_spndmes 0
  end if
  while TRUE
    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()

    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]              'message "pr is:"&date2(pr)
    $refnr = [Reference_Nr]            'message "$refnr is:"&str($refnr)
    error off
    pd = filelookup([purchord.Order_Nr],[purchord.Date_Ordered],$refnr) 'message "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)    '
      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)   'message "len(y2a) is:"&str(len(y2a))
        y2b = format("",fmt)   'message "y2 is:"&str(y2)
        y2d = format(left("Deliver to:"&dld,66),fmt)   '
      else
        y2a = format(left("From:"&psn&"-"&psp,66),fmt)
        y2c = format(left("Ref:"|psr,66),fmt)   'message "len(y2a) is:"&str(len(y2a))
        y2d = format(left("Delivered to:"&dld,66),fmt)   'message "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)   'message "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
    x=BoxText(1,7,7,73,10,5,"L",1,0,0)
    if x=0
      wait 10
      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)