'DEL_ONLY - Supply/Delivery orders - routine to check goods out

'10/11/95 - SelectReqns (L675) was rem'd out. Program was printing the whole
'           req'n file

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

public     #start #end #days ptstr ptval psa ptary[1] plist[1,1] $cust
public     ftgdate $ref custname

global     x startdate enddate y #recs i y1 y2 y3 col z
global     $date $dow $dfa $name $a1 $a2 $a3 $a4 $a5 $a6 $a7 w
global     $slotsrem #slotsrem #apptslots $jobstr sd
global     $popstr ftrname #appt $appth deladdr1 title1
global     regen() wreplstr() spc $pl EnterFittingDate() g fgc bgc
global     z1 z2 z3 z4 z5 z6 z7 z8 ReplaceHardSpace() $ftrcode
global     ReqnPopup() n SelectReqns() #prec #rec #count Footer() r1
global     drows pl t rec recs lc sc sym mr blen l c c2 r2 dc pc k pg tr
global     udelstr() uistrcnt() chkstr() refresh() namelist[1,1] $idx $stat
global     SplitDelivery() $dely $esc
global     prodMRC NewReqn() #del_cost #rem_len #refnr $ordstat #bline $mess
global     refcode #rem_cost $daynr $ftgnr $col1
global     ReqnDeliveryDates() CheckDay() $status
global     ClearFtgDateReqns() ReqnDely() ShowDely()
global     $b1 $b2 $b3 $b4 $b5 $b6 $b7 CheckSupplyDely() DeliveryDate()
global     EnterJobNr() ReturnToMenu() PrintDespatch() $col


MAIN
single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  while true
    clear global
    x = EnterJobNr()                    ' find Cust_Ord & update - L691
    if x = -1
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      exit while
    end if

    x = CheckSupplyDely()
    if x = 1
      messboxwait(" NOT Supply/Delivery ONLY ",0,0,1)
      continue while
    end if

    EnterFittingDate()

    x = ReqnDeliveryDates()
    if x = -1
      continue while
    elseif x = 1
      continue while
    end if

    PrintDespatch()

  end while
  ReturnToMenu()
END MAIN


FUNCTION CheckSupplyDely()
' check for supply/delivery only
  if left([Description],6) = "Supply"
    return (0)
  end if
  if left([Description],8) = "Delivery"
    return (0)
  end if
  return (1)
END FUNCTION 'CheckSupplyDely()


FUNCTION PrintDespatch()
local p1 p2 p3 p4 p5 p6
  p1 = "delivery.dfr"   ' p1 = report definition ("ord_stck.dfr")
  p2 = ""               ' p2 = title at top of choice popup ("LABEL")
  p3 = 1                ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
  p4 = 2                ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
  p5 = 1                ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE
  p6 = 1                ' p6 = nr of copies
  x=PrintReport(p1,p2,p3,p4,p5,p6)
END FUNCTION ' PrintDespatch()


FUNCTION ReturnToMenu()
  lock module jobnr
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  error off
  while true
    window close
    if cerror
      exit while
    end if
  end while
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION


FUNCTION EnterJobNr()                   ' finds Job & updates Cust_Ord
local l1 c3 c2 c1 ques $reqstr fj
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  smartpoke $_ins 0
  while true
    x = fentrybox(" Enter Order Nr for Delivery; {Esc} for Menu ",6,shopmask,"")
    if x = -1
      return (-1)                      ' ReturnToMenu
    end if
    jobnr = ptstr
    vloadif(dpath|"salord04.vw")           ' load view for updating
    order change key "[Job_Nr]"
    data find "[Job_Nr]" equal jobnr options "g"   '  find correct JOB
    if cerror
      messboxwait(" Job Nr -"&jobnr&"- NOT found ",0,0,1)
      return (-1)
    end if
    repaint off
    exit while
  end while
  custname = [Customer_Name]
  $ref     = [CustOrd_Name]
  return (0)
END FUNCTION ' EnterJobNr()


FUNCTION SelectReqns() ' entappt3.vw loaded
local #tline #lcol #split $str_list linenr str1 j r m rp d
  #tline = 6
  #lcol  = 12
  #bline = 20
  redimension namelist[records,7]
  redimension ptary[records]
  for n = 1 to records
    namelist[n,1] = precord
    str1 = [Product_MRC]
    m = ""
    for j = 1 to len(str1)
      r = mid(str1,j,1)
      if r = " "
        r = "˙"                          ' replace hard space
      end if
      m = m|r
    end for
    namelist[n,2] = m
    namelist[n,3] = [Length_Quantity]
    namelist[n,4] = @if([Expect_Fitting_Date]=blank,"˙˙˙˙˙˙˙˙",date2([Expect_Fitting_Date]))
    namelist[n,5] = [Status]
    if [Item_Type] = "B" or [Item_Type] = "J" or [Item_Type] = "T" or [Item_Type] = "W"
      namelist[n,6] = date2([Date_Ordered])|[Delivery_Quoted]
    end if
    namelist[n,7] = [Item_Type]
    ptary[n] = left(namelist[n,2]|repeat("˙",35),35)|"˙"|right("˙˙˙˙˙˙"|format(str(namelist[n,3]),"2r"),6)
    data goto record next
  end for
  #split = len(ptary[1]) + 2 + #lcol

  x = arytostr(records)    'message "x is:"&str(x)
  $str_list = ptstr
  remove("sel_reqn.idx")
  makeidx("requsn","sel_reqn.idx",0,5)
  screen shortrestore psa
  screen print #bline+1 1 15 1 (format("{D}eliver on"&date2(ftgdate)&"- {C}ancel delivery","M80"))
  screen print #bline+2 1 15 1 (format("{S}plit del'y  {A}LL reqn's  {F10}=finish  {Esc}=exit","M80"))
  screen print #bline+3 1 15 1 (format("","M80"))
  screen print #bline+3 3 14 1 (format("Resvd/Init","M10"))
  screen print #bline+3 17 13 1 (format("UNDELIVERED","M11"))
  screen print #bline+3 32 15 1 (format("Alloc'd/Rec'd","M13"))
  screen print #bline+3 49 12 1 (format("HELD","M4"))
  screen print #bline+3 57 7 1 (format("Despatched","M10"))
  screen print #bline+3 71 8 1 (format("Deleted","M7"))
  rp = ReqnPopup(#tline,#lcol,#bline-1,$str_list,"",1,0,linenr,"")
  if rp = -1
    return (-1)
  elseif rp = 2                     ' Split Delivery
    return (2)
  end if
  data query execute "blankdat.dfq" index "blankdat.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Expect_Fitting_Date]=blank
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    return (1)
  end if
  return (0)
END FUNCTION ' SelectReqns()


FUNCTION ReqnPopup(r0,c1,br,list,msg,num,mnu,linenr,y_tot)
local t hml hm cnum mscn pad padc ret y_tot1
local colSf colSb recval #needed nr #rec2 $fg
  sd = 0
  r1 = r0
  $idx    = ""
  fgc     = 4
  bgc     = 1
  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
  ptstr=NULL
  hm = NULL
  sym = spsymmap(37)
  cnum=0
  blen=0
  l=blen
  for c=1 to recs                      ' plist[c,1] is toggle for symmap
    plist[c,2]=group(list,c)           ' description
    plist[c,3]=c                       ' nr order in popup
    plist[c,4]="A"                     ' toggle A/S for adding/removing idx
    l=len(plist[c,2])
    error off
    if days(date2(namelist[c,4])) > 0
      plist[c,1]=1                     ' message "Date to fit"
    else
      plist[c,1]=0                     ' message "NO Date"
    end if
    if l>blen
      blen=l
    end if
    plist[c,5]=namelist[c,1]           ' plist[c,5] is precord
  end for
  c2=c1+blen+2+10
  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-10)
    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 fgp bgp
  pc=1
  for c=1 to pl
    case namelist[c,5]
      when "R"
        $col = 14
      when "I"
        if namelist[c,7] = "B" or namelist[c,7] = "J" or namelist[c,7] = "T" or namelist[c,7] = "W"
          $col = 13
        else
          $col = 14
        end if
      when "A"
        $col = 15
      when "H"
        $col = 12
      when "D"
        $col = 8
      when "F"
        $col = 10
      when "L"
        $col = 7
    end case
    screen print c+r1 lc+1 $col bgp namelist[c,4]&plist[c,2]
  end for
  c=1
  rec=1
  screen print c+r1 lc+1 fgi bgi namelist[c,4]&plist[c,2]
  drows = pl
  while true
    if c = pl
      screen print c+r1 lc+1 fgi bgi namelist[c,4]&plist[c,2]
      exit while
    elseif c = linenr+1
      screen print c+r1 lc+1 fgi bgi namelist[c,4]&plist[c,2]
      exit while
    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
      continue while
    end if
  end while

  while TRUE
    k=inchar                           'message "k is:"&str(k)
    case namelist[c,5]
      when "R"
        $col = 14
      when "I"
        if namelist[c,7] = "B" or namelist[c,7] = "J" or namelist[c,7] = "T" or namelist[c,7] = "W"
          $col = 13
        else
          $col = 14
        end if
      when "A"
        $col = 15
      when "H"
        $col = 12
      when "D"
        $col = 8
      when "F"
        $col = 10
      when "L"
        $col = 7
    end case
    screen print c+r1 lc+1 $col bgp namelist[c,4]&plist[c,2]

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

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

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

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

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

    elseif k={^End}
      rec = recs-pl+1
      c = 1
      refresh(c,r1,c1,r2,c2,pad,colSf,colSb)
      c = pl
      rec = recs
      ShowDely()

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

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

    elseif k={s}
      $stat = namelist[c,5]
      if $stat = "A" or $stat = "I"
        screen print c+r1 lc+1 fgi bgi namelist[c,4]&plist[c,2]
        sd = SplitDelivery()
        if sd = 0
          repaint off
          return (2)
        end if
        Footer()
      end if

    elseif k={a}                     ' deliver ALL on ftgdate
      if sd = 0
        screen print c+r1 lc+1 fgi bgi namelist[c,4]&plist[c,2]
        x = messline(" Confirm delivery of ALL valid req'ns on"&date2(ftgdate)|"? (y/n) ",1,1,1,21,1,80)
        if ptstr == "Y"
          for rec = 1 to recs
            $stat = namelist[rec,5]
            if $stat = "A" or $stat = "I"  'message $stat&"Booked out on"&date2(ftgdate)
              namelist[rec,4] = date2(ftgdate)
              plist[rec,1] = 1
            end if
            case namelist[c,5]
              when "R"
                $col = 14
              when "I"
                if namelist[c,7] = "B" or namelist[c,7] = "J" or namelist[c,7] = "T" or namelist[c,7] = "W"
                  $col = 13
              else
                $col = 14
              end if
              when "A"
                $col = 15
              when "H"
                $col = 12
              when "D"
                $col = 8
              when "F"
                $col = 10
              when "L"
                $col = 7
            end case
            screen print c+r1 lc+1 $col bgp namelist[rec,4]&plist[rec,2]
          end for
        end if
        Footer()
      end if
      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={c}                 'message "namelist[rec,5] is:"&str(namelist[rec,5])
      if plist[c,1] = 1              ' DATE held
        namelist[c,4] = "˙˙˙˙˙˙˙˙"     ' date2([Expect_Fitting_Date])
        plist[c,1] = 0
      end if
      Footer()

    elseif k={d}                  'message "namelist[rec,5] is:"&str(namelist[rec,5])
      screen print c+r1 lc+1 fgi bgi namelist[c,4]&plist[c,2]
      $stat = namelist[c,5]
      if namelist[c,7] = "B" or namelist[c,7] = "J" or namelist[c,7] = "T" or namelist[c,7] = "W"
        $dely = "Ordered:"&date2(left(namelist[c,6],8))&"- Delivery:"&right(namelist[c,6],len(namelist[c,6])-8)
      else
        $dely = "Not Allocated"
      end if
      if $stat <> "A"             'message "Not for despatch e.g. completed, held etc"
        case $stat
          when "R"
            $mess = "Reserved"
          when "I"
            $mess = $dely
          when "H"
            $mess = "Held - contact H/O"
          when "D"
            $mess = "Deleted"
          when "F"
            $mess = "Despatched"
          when "L"
            $mess = "Being processed"
          when "I"
            $mess = $dely
        end case
        $mess = format($mess,"M52")
        case namelist[c,5]
          when "R"
            $col1 = 14
          when "I"
            if namelist[c,7] = "B" or namelist[c,7] = "J" or namelist[c,7] = "T" or namelist[c,7] = "W"
              $col1 = 13
            else
              $col1 = 14
            end if
          when "A"
            $col1 = 15
          when "H"
            $col1 = 12
          when "D"
            $col1 = 8
          when "F"
            $col1 = 10
          when "L"
            $col1 = 7
        end case
        screen print c+r1 lc+1 fgp $col1 $mess
        continue while
      end if

      if plist[c,1] = 0              ' No DATE held
        namelist[c,4] = date2(ftgdate)
        plist[c,1] = 1
      end if
      Footer()

    elseif k={Esc}
      messbox(" Any changes will be lost! Confirm {Esc}? (y/n) ",1,0,1)
      if ptstr == "Y"
        $esc = "Y"
        ret=null
        exit while
      end if

    elseif k={F10}
      DeliveryDate()
      data query execute "delivery.dfq" index "delivery.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ days([Expect_Fitting_Date]) = days(ftgdate)                        ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
      exit while
    end if
    screen print c+r1 lc+1 fgi bgi namelist[c,4]&plist[c,2]
  end while
  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]
  ptstr = trim($idx)
  ptval = nr
  if $esc = "Y"
    return (-1)
  end if
  return (0)
END FUNCTION  'ReqnPopup()


FUNCTION ShowDely()
  $stat = namelist[c,5]
  if namelist[c,7] = "B" or namelist[c,7] = "J" or namelist[c,7] = "T" or namelist[c,7] = "W"
    $dely = "Ordered:"&date2(left(namelist[c,6],8))&"- Delivery:"&right(namelist[c,6],len(namelist[c,6])-8)
  else
    return (1)
  end if
  if $stat <> "I"             '
    return (1)
  else
    $mess = $dely
  end if
  $mess = format($mess,"M52")
  $col1 = 13
  screen print c+r1 lc+1 fgp $col1 $mess
  inchar
END FUNCTION 'ShowDely()


FUNCTION ReqnDeliveryDates()
local sr
  progress(15,1," Processing requisitions .... ",0)
  repaint off
  vloadif(dpath|"entappt4.vw")
  order change key "[Job_Nr]"
  data query execute "reqn_del.dfq" index "jobappt1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Job_Nr] = jobnr
'   and
'   [Expect_Fitting_Date]=blank
'   and
'   not(deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messboxwait(" No undelivered requisitions for this job ",0,0,1)
    return (1)
  end if
  if cerror
    #refnr = 0
  end if
  #refnr = value(filemax([#refnr]))  'message "#refnr is:"&str(#refnr)
  data query execute "del_only.dfq" index "job_appt.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Item_Type] <> "O"
'   and
'   not(deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    return (1)
  end if

  while true
    sr = SelectReqns()                '1=reqn's selected; 0=NONE sel'd
    if sr = 0
      return (1)
    elseif sr = -1
      return (-1)
    elseif sr = 1
      return (0)
    elseif sr = 2                     ' Split Delivery
' add new record to index
      order change physical
      addidxrec("job_appt.idx",#prec,3)
      order change index "job_appt.idx"
      continue while
    end if
    exit while
  end while
END FUNCTION ' ReqnDeliveryDates()


FUNCTION EnterFittingDate()           ' n=2 Select; n=0/1 Do not select
  while true
    x = fentrybox(" Enter Delivery Date ",8,"##\/##\/##",today)
    if x = 0
      ftgdate = ptstr
      if chkdate(ftgdate,1) = -1
        messbox(" Incorrect date - re-enter ",0,0,1)
        continue while
      end if
      if days(ftgdate) < days(today)
        messboxwait(" Can ONLY book out for today or future dates ",0,0,1)
        continue while
      end if
      exit while
    else
      continue while
    end if
  end while
END FUNCTION ' EnterFittingDate()


FUNCTION CheckDay()
local i $a
  for i=1 to 7
    let $a=indirect("[A"|str(i)|"]")
    if $a = jobnr
      return (0)
    end if
  end for
  return (1)
END FUNCTION 'CheckDay()


function regen(z,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
local x t drows
  screen clear box r1 c1 r2 c2 fg bg
  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 fg bg format fmt ptary[t]
        drows=drows+1
      end if
    end if
  end for
  return (drows)
end function  'regen()


FUNCTION wreplstr(s,f,r)
local t l p
  t = s
  l = len(f)
  p = 0
  while iserr(find(f,t,p)) = FALSE
    p = find(f,t,p)
    t  = replace(t,find(f,t,p),l,r)
  end while
  return (t)
END FUNCTION


FUNCTION ReplaceHardSpace(str1)
local j r m bw l_last #addn
'   bw = 35                              ' boxwidth
  bw = 43                              ' boxwidth
  m = ""
  for j = 1 to len(str1)
    r = mid(str1,j,1)
    if r = " "
      r = "˙"                          ' replace hard space
    end if
    m = m|r
  end for

  if len(m) < bw
    #addn = bw-len(m)
  else
    #addn = mod(len(m),bw)
  end if
  m = m|repeat("˙",#addn)
  return (m)
END FUNCTION ' ReplaceHardSpace()


function refresh(z,r1,c1,r2,c2,pad,b1,b2)
local x t $col
  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
        $col = case namelist[t,5] ("R",14)("I",14)("A",15)("D",8)("F",10)("H",12)("L",7)
        case namelist[c,5]
          when "R"
            $col = 14
          when "I"
            if namelist[c,7] = "B" or namelist[c,7] = "J" or namelist[c,7] = "T" or namelist[c,7] = "W"
              $col = 13
            else
              $col = 14
            end if
          when "A"
            $col = 15
          when "H"
            $col = 12
          when "D"
            $col = 8
          when "F"
            $col = 10
          when "L"
            $col = 7
        end case

        screen print x+1+r1 lc+1 $col bgp namelist[t,4]&plist[t,2]
        drows=drows+1
      end if
    end if
  end for
end function  'refresh()


FUNCTION chkstr(s,sl)
local t i
  i=0
  while exact(t,NULL)=FALSE
    i=i+1
    t = group(sl,i)
    if t = s
      return (0)
    end if
  end while
  return (-1)
end function  'chkstr()


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 SplitDelivery()
local #origlen #del_now #precreqn #recreqn #orig_cost
' get quantity of Original reqn
  $status   = namelist[c,5]
  #origlen  = namelist[c,3]
  prodMRC   = namelist[c,2]
  #precreqn = namelist[c,1]            'message "#precreqn is:"&str(#precreqn)
  #recreqn  = plist[c,3]               'message "#recreqn is:"&str(#recreqn)

  while true
    while true
      x = entryline(" Amount of"&chr(34)|prodMRC|chr(34)&"to deliver on"&date2(ftgdate)|" ",5,"","",21,1,80)
      if x = -1
        return (-1)
      end if
      #del_now = value(ptstr)             ' message "#delnow is:"&str(#delnow)
      if #del_now > 0 and #del_now < #origlen
        exit while
      end if
    end while

    x = messline(fixed(#del_now,2)&"of"&chr(34)|prodMRC|chr(34)&"to deliver on"&date2(ftgdate)|"? (y/n) ",1,1,1,21,1,80)
    if ptstr == "y"
      exit while
    end if
  end while

' alter reqn to show reduced amount & COST!
  data goto record record-number #recreqn
  #orig_cost = [Cost]                  ' message "#orig_cost is:"&str(#orig_cost)
  #del_cost  = #orig_cost*#del_now/#origlen 'message "#del_cost is:"&str(#del_cost)
  #rem_cost  = #orig_cost-#del_cost    ' message "#rem_cost is:"&str(#rem_cost)

  lock-record
    [Length_Quantity] = #del_now
    [Cost]            = #del_cost
  write-record
  #rem_len     = #origlen - #del_now

  NewReqn()

' change plist[rec,2] to show new number?
  namelist[c,3] = fixed(#del_now,2)
  plist[c,1] = 1
  namelist[c,4] = date2(ftgdate)
  plist[c,2] = "˙"|left(namelist[c,2]|repeat("˙",35),35)|"˙"|right("˙˙˙˙˙˙"|format(str(namelist[c,3]),"2r"),6)
  return (0)
END FUNCTION ' SplitDelivery()


FUNCTION NewReqn()
local #newliststck prodcode desMRC $itemtype $auth #ordwidth $ccwcode $rollnr
local $backing #prodrec $stat
' get details of reqn from REQUSN.DB
  prodcode     = [Product_Code]
  #newliststck = [Lst_Stck]
  desMRC       = [Description_MRC]
  $itemtype    = [Item_Type]
  $stat        = [Status]
  $auth        = [Comment]
  #ordwidth    = [Width]
  $ccwcode     = [CCW_Code]
  $rollnr      = [Roll_Nr]
  $backing     = [R_Backing]
  #prodrec     = [prodrec]

' create refcode for new reqn
  #refnr  = #refnr + 1
  refcode = jobnr|"-"|str(right("00"|str(#refnr),2))  ' message "refcode is:"&str(refcode)

  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]             = $stat
    [Length_Quantity]    = #rem_len
    [Date_Requisitioned] = today
    [Cost]               = fixed(#rem_cost,2)
    [Comment]            = $auth
    [Width]              = #ordwidth
    [Created/Changed_By] = userid
    [CCW_Code]           = $ccwcode
    [Roll_Nr]            = $rollnr
    [R_Backing]          = $backing
    [prodrec]            = #prodrec
  write-record
  #prec = precord
END FUNCTION ' NewReqn()


FUNCTION Footer()
  screen clear box 21 1 sch scw 0 0 no-border
  screen print #bline+1 1 15 1 (format("{D}eliver on"&date2(ftgdate)&"- {C}ancel delivery","M80"))
  if sd = 1
    screen print #bline+2 1 15 1 (format("{S}plit del'y  {F10}=finish  {Esc}=exit","M80"))
  else
    screen print #bline+2 1 15 1 (format("{S}plit del'y  {A}LL reqn's  {F10}=finish  {Esc}=exit","M80"))
  end if
  screen print #bline+3 1 15 1 (format("","M80"))
  screen print #bline+3 3 10 1 (format("Reserved/Initial","M20"))
  screen print #bline+3 24 15 1 (format("Allocated/Received","M20"))
  screen print #bline+3 44 12 1 (format("HELD","M10"))
  screen print #bline+3 55 7 1 (format("Despatched","M10"))
  screen print #bline+3 68 8 1 (format("Deleted","M10"))
END FUNCTION 'Footer()


FUNCTION ReqnDely()
  jobnr = ""
  $dfa = [DayFitter]|str(col-3)    ' message "$dfa is:"&str($dfa)
  y=indirect("[A"|str(col-3)|"]")
  if indirect("[A"|str(col-3)|"]") = "None"
    return (1)
  elseif indirect("[A"|str(col-3)|"]") = "SUNDAY"
    return (1)
  elseif indirect("[A"|str(col-3)|"]") = "BNKHOL"
    return (1)
  elseif indirect("[A"|str(col-3)|"]") = "ABSENT"
    return (1)
  elseif indirect("[A"|str(col-3)|"]") = "ŪŪŪŪŪŪŪŪ"
    return (1)
  else
    ftgdate = [Date]
    jobnr = indirect("[A"|str(col-3)|"]") 'message "jobnr) is:"&str(jobnr)
    $ftrcode = right([DayFitter],6)       'message "$ftrcode is:"&str($ftrcode)
    ReqnDeliveryDates()
  end if
  return (0)
END FUNCTION ' ReqnDely()


FUNCTION ClearFtgDateReqns()
local fd
  vloadif(dpath|"entappt4.vw")
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "jobappt1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Job_Nr] = jobnr
'   and
'   not(deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messboxwait(" No requisitions entered for this job ",0,0,1)
    return (0)
  end if
  data query execute "reqnno_J.dfq" index "job_appt.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Item_Type] <> "O"
'   and
'   not(deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    return (0)
  end if
  data goto record first
  error off
  for fd = 1 to records
    if days(date2([Expect_Fitting_Date])) > days(today)
      lock-record
        [Expect_Fitting_Date]=blank
        [Ftr_Code] = ""
      write-record
    end if
    data goto record next
  end for
END FUNCTION ' ClearFtgDateReqns()


FUNCTION DeliveryDate()
local fd
' alter Expect_Fitting_Date in REQUSN
  vloadif(dpath|"entappt4.vw")
  data goto record first
  error off
  for fd = 1 to records
    if days(date2(namelist[fd,4])) > 0
      lock-record
        [Expect_Fitting_Date]=date2(namelist[fd,4])
        [Ftr_Code] = "NON999"
        [Status]   = "F"
      write-record
    else
      lock-record
        [Expect_Fitting_Date]=blank
        [Ftr_Code] = ""
      write-record
    end if
    data goto record next
  end for
END FUNCTION 'DeliveryDate()