'CPL_PREP - temp version using LST_STCK - NEW version req'd
'29/01/96 - checks that deposit has been received (from non-account customers)
'           before printing w/sheet

external   fentrybox() messbox() vloadif() vunloadif() dpath shopmask scr
external   sch scw progress() fgp bgp messline() PrintReport() remove() base
external   userid menuchoice cpath entryline() makeidx() messboxwait()
external   fgi bgi Find_Del() $menu reqnpath

public     ptstr ftrname custname deladdr1 deladdr2 deladdr3 deladdr4 psa dsa
public     offtel hometel mobile ftginstr ftgcomm cr_status balancedue jobnr
public     ftgdate

global     CheckNr() CheckJob() $ordstat ReturnToMenu() x NameAddressAsk()
global     PrintWorkSheet() p1 p2 p3 p4 p5 p6 invtotal salanal current1


MAIN
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  single-step off
  file unload all
  current1 = reqnpath|jobnr|".idx"

  p2 = ""   ' p2 = title at top of choice popup ("LABEL")
  p3 = 1    ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
  p5 = 1    ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE
  p6 = 1    ' p6 = nr of copies

  case base              ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
    when "O"
      p4 = 2
    when "W"
      p4 = 2
    otherwise
      p4 = 1
  end case

  while true
    x = CheckNr()                          ' check Job Nr exists in CUST_ORD
    if x = -1
      ReturnToMenu()
      exit while
    end if
  end while
END MAIN


FUNCTION CheckJob()
local $e #e mess1
  $e = [Description]
  #e = len([Description])
  $e = left($e,#e-1)

  while true
    if $e ! "Deliveryÿonly"
      exit while
    elseif $e ! "Supplyÿonly"
      exit while
    else
      if days([Fitting_Date]) = 0
        messboxwait(" NO fitting date yet entered - cannot be printed ",0,0,1)
        return (1)
      end if
      exit while
    end if
  end while

  custname = [CustOrd_Name]
  deladdr1 = [Delivery_Address_1]
  $ordstat = [Order_Status]            'message "$ordstat is:"&str($ordstat)
  ftgdate  = [Fitting_Date]
  ftrname  = [Nickname]
  if $ordstat <> "P"
    mess1 = case $ordstat ("A","no customer details or requ'ns")("U","no requ'ns entered")\
("R","not yet authorised")("H","job held")("V","rejected by Head Office")\
("D","already despatched") else "cannot print"
    messboxwait(" Cannot print"&jobnr&"-"&mess1,0,0,1)
    return (-1)
  else
'     messbox(" Search for deleted records? (y/n) ",1,1,1)
'     if ptstr == "y"
'       x = Find_Del(jobnr,1)
'       if x <> 0
'         messboxwait("Deleted record ("|str(x)|") for this job ... call David C",0,0,1)
'         return (-1)
'       end if
'     end if
'     screen clear box 1 1 sch scw 0 0 no-border
'     repaint off

    vloadif(dpath|"lst_stck.vw")       'message "Reset previous screen "
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    x = NameAddressAsk(custname,"fit at:"&deladdr1)
    if ptstr == "y"
      return (0)
    else
      return (-1)
    end if
  end if
END FUNCTION ' CheckJob()


FUNCTION CheckNr()                     ' checks for JobNr - if not found
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  vloadif(dpath|"lst_stck.vw")
  order change key "[Job_Nr]"
  while true
    x = fentrybox(" Job Nr to prepare list for - {Esc} to exit ",6,shopmask,"")
    if x = -1
      ReturnToMenu()
    end if
    jobnr = ptstr

    progress(fgp,bgp," Checking for existing order ",0)
    order change key "[Job_Nr]"
    data find "[Job_Nr]" equal jobnr options "gw"
    if cerror                               '   if none - then return
      messbox(" Job not found - re-enter ",0,0,1)
      return (-1)
    else
      x = CheckJob()                        ' confirm correct
      if x = 0                              ' YES print
        PrintWorkSheet()
        return (0)
      elseif x = -1
        screen clear box 1 1 sch scw 0 0 no-border
        continue while
      elseif x = 1
        screen clear box 1 1 sch scw 0 0 no-border
        continue while
      end if
    end if
  end while
END FUNCTION ' CheckNr()


FUNCTION PrintWorkSheet()
  repaint off
  vloadif(dpath|"ftrwks_s.vw")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options "gw"
  if cerror                               '   if none - then return
    messbox(" Job not found - no worksheet printed ",0,0,1)
    return (-1)
  else
  ' get variables
    ftrname   = [Nickname]
    custname  = [CustOrd_Name]
    deladdr1  = [Delivery_Address_1]
    deladdr2  = [Delivery_Address_2]
    deladdr3  = [Del_City]
    deladdr4  = [Del_Postcode]
    offtel    = [Office_Tel]
    hometel   = [Home_Tel]
    ftginstr  = [Instructions]
    ftgcomm   = [Fitting_Comment]
    cr_status = [Credit_Status]
    mobile    = [Mobile/Other_Nr]
    balancedue= [Balance_Due]
    invtotal  = [Invoice_Total]
    salanal   = [SalesAnalysis]

' if DEPOSIT NOT received, report to DG
' message "cr_status is:"&str(cr_status)
' message "balancedue is:"&str(balancedue)
' message "invtotal is:"&str(invtotal)
' message "Sales is:"&str(salanal)

  if salanal <> "X"
    if balancedue = invtotal           ' NO deposit rec'd
      if cr_status <> "A"
        if $menu == "boss"
          messbox(" NO deposit received, continue & print worksheet? (y/n) ",1,0,1)
          if ptstr == "n"
            return (1)
          end if
        else
          messboxwait(" NO deposit received, refer to DG before despatching ",0,0,1)
          return (1)
        end if
      end if
    end if
  end if

' find req'ns (not deleted) for jobnr
    vloadif(dpath|"lststk_a.vw")
' message "current1) is:"&str(current1)
    if file(current1) = 1
      order change index current1
      if records = 0
        messboxwait(" No requisitions for this job ",0,0,1)
        return (1)
      end if
    else
      order change key "[Job_Nr]"
      data query execute "job_reqn.dfq" index current1
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Job_Nr] = jobnr
'   and
'   not(deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      if cerror
        messboxwait(" No requisitions for this job ",0,0,1)
        return (1)
      end if
    end if

' query again to remove type "O" reqns (ie commission)
    data query execute "No_typeO.dfq" index "no_typeO.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Item_Type] <> "O"
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' sort by LstOrder
    order sort execute dictionary "lst_stck" index "lst_stck"
    PrintReport("ftrwks_F.dfr","Job Worksheet",p3,p4,p5,p6)
    return (0)
  end if
END FUNCTION 'PrintWorkSheet()


FUNCTION ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION NameAddressAsk(msg1,msg2)
local fc2 bc2 fc1 bc1 r1 r2 c1 c2 c3 lmsg mbox k err q cc endmess f1
  q = 1
  err = 0
  endmess = " Correct? (y/n) "
  k=0
  fc1=fgp
  bc1=bgp
  fc2=fgi
  bc2=bgi

  mbox = scrwidth
  lmsg=max(len(msg1),len(msg2),len(endmess)+2)
  if lmsg + 4 > scrwidth
    return (-2)
  end if
  r1 = scr-2
  r2 = scr+2
  c3 = int((mbox-lmsg)/2)+1
  c1 = c3-2
  c2 = c3+lmsg+1
  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
  cc = scrwidth/2-(len(endmess)/2)+1
  screen save r1 c1 r2 c2 psa
  screen clear box r1 c1 r2 c2 fc1 bc1
  screen print scr-1 c3 fgp bgp FORMAT "M"|str(lmsg) msg1
  screen print scr c3 fgp bgp FORMAT "M"|str(lmsg) msg2
  screen print scr+1 cc fc2 bc2 endmess
  screen save r1 c1 r2 c2 dsa
  WHILE "yn" !! k
    locate  scr+1 (cc+len(endmess)-1) 1
    k=inchar
    k = lower(chr(k))
  END WHILE

  locate  scr (c3+lmsg) 0
  screen shortrestore psa
  if k = 0
    ptstr = NULL
  else
    ptstr = k
  end if
  return (err)
END FUNCTION' NameAddressAsk()