'SALORD03 - combination of SALORD01 & CASHENT1 for quick entry of orders
' [Parent] entered at L582

external   fentrybox() messbox() vloadif() dpath shopmask scr findpopup()
external   sch scw progress() increment() ptval fgp bgp keybox() arytostr()
external   makeidx() userid cpath jobnr vatrate vunloadif() strcount() nr6
external   chkdate() navrecs() entryline() messline() $cashent $menu base
external   popuplist() remove() PrintReport() exception() strtoary() fge bge
external   messboxwait() colpopup() Background()
external   X_path _SWIP_Crystal() Xreppath

public     invtot ptstr custcode dsa abbrv_name $newcust $place psa
public     ptary[6] jobs[6] $dayftr #netinv #total_entered invnr

global     UpdApptRecs() $newstat $saltype CheckCorrect() PrintError() $invd
global     rcvd m4 PaymentMethod() Place_Paid() Approve() ReturnToMenu() $key
global     y lastbal $status custaddr1 EnterCustName() y1 y2 y3 $origin
global     CheckJobNr() TransactRcvd() GetAuthCode() newrec deladdr1 $authcode
global     shop locn H_tel O_tel $type custname $method x datereceipt M_tel
global     recnr tel_locn telnr fentline $ordstat $jobstr AddVarn() $emailaddr
global     EnterDetails() TransactUpmt() rcvdnr balancedue initbalance NewJobNr()
global     Balance() ProcessEntry() PrintReceipt() receiptnr MakeReceiptNr()
global     $mess cat #totalrecd #inv_total newbalance i $sales #vat $sundrycash
global     p1 p2 p3 p4 p5 p6 $test AddToArray() $msg fj SelectOrigin() $allreas
global     ReplaceHardSpace() $reas5 $free $reas1 $reas2 $reas3 $reas4 $reas
global     Job_Locn() s1 s2 s3 s4 s5 s6 s7 $locn PrintInterimOrder() EnterDetails2()
global     lastjob r1 c1 r2 c2 cl1 cl2 $PDQtype PDQ_Time() pdqtime $vat
global     $poplist $parent


MAIN
  single-step off
'   quiet off
  m4 = " Correct? (y/n) "
  $authcode = ""
  $sundrycash = "Y00000"
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  lock module invtot

  p4 = 1
  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

  $reas1="Original’order"
  $reas2="As’per’attached’order"
  $reas3="Labour’&’materials’supplied’per’Customer's’order"
  $reas4="As’per’supporting’documents"
  $reas5="Free’text"
  $free ="Labour xx,xxx - Materials xx,xxx  (exc. VAT)"

  while true
    x = CheckJobNr()                   ' check Job Nr exists in CUST_ORD
    if x = 0
      x = EnterDetails()               ' sic
      if x = 1
        continue while
      elseif x = -1
        ReturnToMenu()
      end if
    elseif x = -1
      exit while
    elseif x = 1
      $method = "Cheque"
    end if

    if $cashent = "Y"
      x = ProcessEntry()                         ' enter cash received
      x = PrintReceipt()                         ' print receipt
    end if
    vunloadif("cust_ord.vws")
    CheckCorrect()                       'check that Balance is the same
  end while

  vloadif(dpath|"cust_ord.vws")
  $ordstat = [Order_Status]            ' message "$ordstat is:"&str($ordstat)

  ReturnToMenu()

END MAIN


FUNCTION CheckJobNr()                     ' checks for JobNr - if not found
  fj = -1
  jobnr = ""
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  newrec = 0
  invtot = 0
  telnr = ""
  deladdr1 = ""
  fentline = " Enter Customer's Name (or 1st FIVE letters if existing customer)"
  while true
    Background()
    x = popuplist(9,32,13,"Order’Nr Invoice’Nr","Search by",1,0)
    if x = -1
      return (-1)
    end if
    if ptstr = "Order’Nr"
      while true
        if fj = -1
          x = fentrybox(" Enter Job Nr or {Esc} for new order ",6,shopmask,jobnr)
          if x = -1
            messbox(" Confirm NEW order to be entered? (y/n) ",1,1,1)
            if ptstr == "y"
              NewJobNr()
              messbox(" This will create a new order"&jobnr&"- continue? (y/n) ",1,1,1)
              if ptstr == "y"
                return (0)
              else
                return (-1)
              end if
            else
              return (-1)
            end if
          elseif x = 0
            if ptstr = ""
              continue while
            else
              jobnr = ptstr
              $key  = "Job"
              exit while
            end if
          end if
        end if
        exit while
      end while
    else
      while true
        if fj = -1
          x = fentrybox(" Enter Invoice Nr or {Esc} to exit ",6,nr6,invnr)
          if x = -1
            return (-1)
          elseif x = 0
            if ptstr = ""
              continue while
            else
              invnr = ptstr
              $key  = "Inv"
              exit while
            end if
          end if
        end if
        exit while
      end while
    end if
    progress(fgp,bgp," Checking for existing order ",0)
    vloadif(dpath|"cust_ord.vws")
    if $key = "Job"
      order change key "[Job_Nr]"
      data find "[Job_Nr]" equal jobnr options "gw"
      if cerror                               '   if none - then return
        messboxwait("151/ Job Nr not found ",0,0,1)
        continue while
      else
        screen clear box 1 1 sch scw 0 0 no-border
        initbalance = round([Balance_Due],2)
        custname = [CustOrd_Name]
        deladdr1 = [Delivery_Address_1]
        x = Balance()
        AddToArray()
        return (1)
      end if
    else
      order change key "[Inv_Nr]"
      data find "[Inv_Nr]" equal invnr options "gw"
      if cerror                               '   if none - then return
        messboxwait(" Invoice Nr not found ",0,0,1)
        continue while
      else
        screen clear box 1 1 sch scw 0 0 no-border
        initbalance = round([Balance_Due],2)
        jobnr       = [Job_Nr]
        custname    = [CustOrd_Name]
        deladdr1    = [Delivery_Address_1]
        x = Balance()
        AddToArray()
        return (1)
      end if
    end if
  end while
  AddToArray()
  return (1)
END FUNCTION ' CheckJobNr()


FUNCTION Balance()
local y
  while true
    y = abs(initbalance)
    if round(initbalance,2) < 0
      messboxwait(jobnr&"- "|currency(initbalance)&"o'pd by"&custname|"’",0,1,1)
      return (0)
    elseif round(initbalance,2) = 0
      messboxwait(jobnr&"- no balance due from"&custname|"’",0,1,1)
      return (1)
    else
      messboxwait(jobnr&"- "|currency(initbalance)&"due from"&custname|"’",0,1,1)
      return (0)
    end if
  end while
END FUNCTION 'Balance()


FUNCTION EnterCustName()
  while true
    while true
      x = fentrybox(fentline,35,"","")
      if x = 0
        if ptstr = ""
          continue while
        end if
        exit while
      elseif x = -1
        return (-1)
      end if
    end while
    custname = ptstr

    vloadif(dpath|"custsel4.vw")
    order change key [Abbrv_Name]
    abbrv_name = proper(left(custname,5))
    data find "[Abbrv_Name]" equal abbrv_name options ""
    if cerror
      messbox(" Name not on file, is"&chr(34)|custname|chr(34)|" a new customer? (y/n)",1,0,1)
      if ptstr == "y"
        $newcust = "Y"
        custcode = jobnr
        return (0)
      end if
    end if
    vloadif(dpath|"custsel4.vw")

    repaint on
    repaint
    ptval=0
    y1 = format(" CUSTOMERS ALREADY HELD ON FILE ","M71")
    y2 = format(" {A}dd"&chr(34)|custname|chr(34)|" - {S}elect highlight - {Esc} exits ","M71")
    screen print 4 6 fgp bgp y1
    screen print 21 6 fgp bgp y2
    while true
      ptval = navrecs()
      if ptval = {S} or ptval = {s}
        if (deleted)
          messboxwait(" Deleted record - choose another ",0,0,1)
          continue while
        end if
        $origin  = [Source]            ' message "$origin is:"&str($origin)
        $newcust = "N"
        custname = [Customer_Name]
        abbrv_name = [Abbrv_Name]
        if len([Address_1]) <> 0       ' Same name
          $msg = custname&"of"&[Address_1]|"?" 'message "len($msg)) is:"&str(len($msg))
          messbox($msg,1,1,1)
          if ptstr == "y"
            messline(" Is Delivery address"&[Address_1]|"? - (y/n)",1,1,1,21,6,71)
            if ptstr == "y"
              while true
                deladdr1  = [Address_1]
                exit while
              end while
            else
              while true
                x = entryline(" Enter Delivery Address - Line 1 ",35,"","",21,6,71)
                if ptstr = ""
                  continue while
                end if
                if x = 0
                  deladdr1 = proper(ptstr)
                  exit while
                elseif x = -1
                  continue while
                end if
              end while
            end if
            custcode  = [Customer_Code]
'             $parent   = [Parent]
            custaddr1 = [Address_1]
            H_tel     = [Home_Tel]
            O_tel     = [Office_Tel]
          else
            y2 = format(" {A}dd"&chr(34)|custname|chr(34)|" - {S}elect highlight - {Esc} exits ","M71")
            screen print 21 6 fgp bgp y2
            continue while
          end if
          repaint off
          return (0)
        else                           'if [Address_1] > 0
          while true
            x = entryline(" Enter Delivery Address - Line 1 ",35,"","",21,6,71)
            if ptstr = ""
              continue while
            end if
            if x = 0
              repaint off
              deladdr1 = proper(ptstr)
              custcode  = [Customer_Code]
              return (0)
            elseif x = -1
              continue while
            end if
          end while
        end if

      elseif ptval = {A} or ptval = {a}
        messline(" Add"&chr(34)|custname|chr(34)&"to list of Customers? (y/n)",1,1,1,21,6,71)
        if ptstr ! "y"
          $newcust = "Y"
          if x = 0
            while true
              x = entryline(" Enter Delivery Address - Line 1 ",35,"","",21,6,71)
              if ptstr = ""
                continue while
              end if
              if x = 0
                deladdr1 = proper(ptstr)
                repaint off
                return (0)
              elseif x = -1
                return (-1)
              end if
            end while
            exit while
          end if
        else
          exit while
        end if
        repaint off
        return (0)

      elseif ptval = {Esc}
        return (-1)
      end if
    end while
  end while
END FUNCTION 'EnterCustName()


FUNCTION EnterDetails()
local  response prec# y
'   x = keybox("1Normal 1Cash’Sales 1Zero’rate","Enter type of Sale")
  x = keybox("1Normal 1Zero’rate","Enter type of Sale")
  if x = -1
    return (-1)
  end if
  $saltype = ptstr
  r1 = 8
  r2 = r1+6
  c1 = 17
  c2 = c1+48
  cl1 = 14
  cl2 = 3

  $newstat = "A"
  $method = "Cheque"
  if $saltype == "n"
    #vat = vatrate
    $vat = "S"
  elseif $saltype == "z"
    $vat = "Z"
    #vat = 0
  end if
  x = EnterCustName()
  if x = -1
    return (1)
  end if
'   progress(15,10," Please wait ... checking Job Nr ",0)
  vloadif(dpath|"cust_ord.vws")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options ""
  if cerror                               '   if none - then return
  else
    messbox(" Job Nr"&jobnr&"already used, creating another ",0,1,1)
    while true
      lastjob=right(jobnr,5)
      jobnr=left(jobnr,1)|right("00000"|str(value(lastjob)+1),5) 'message "jobnr is:"&str(jobnr)
      data find "[Job_Nr]" equal jobnr options ""
      if cerror                               '   if none - then return
        exit while
      else
        continue while
      end if
    end while
  end if
  data enter lock
    [Job_Nr]             = jobnr
    [Branch]             = left(jobnr,1)
    [CustOrd_Name]       = custname
    [Delivery_Address_1] = deladdr1
'     [Email_Addr]         = $emailaddr
    [Abbrv_Name]         = left(custname,5)
    [Date_Of_Order]      = today
    [VAT]                = $vat
    [Updated_By]         = userid
    [Last_Update]        = today
'     [Parent]             = $parent
  write-record
  recnr = precord
  EnterDetails2()

  vloadif(dpath|"cust_ord.vws")
  $type  = case left(jobnr,1)("C","S")("R","S")("S","S")("F","S")("P","F")("W","H")("T","H")("Y","H")
  $sales = case left(jobnr,1)("C","X")("R","R")("S","S")("F","F")("P","P")("W","W")("T","T")("Y","Y")
  if len(custname) = 0
    messboxwait(" Customer's name has been omitted - pls contact David @ HO ",0,0,1)
  end if
  if len(abbrv_name) = 0
    messboxwait(" Customer's abbrv'd name has been omitted - pls contact David @ HO ",0,0,1)
  end if
  #netinv = round(invtot*100/(100+#vat),2)

  data goto record record-number recnr
  lock-record
    [SalesAnalysis]      = $sales
    [Type_Branch]        = $type
    [Delivery_Address_1] = deladdr1
    [Invoice_Total]      = 0
    [Net_Invoice]        = 0
    [Balance_Due]        = 0
    [Customer_Code]      = custcode
    [Updated_By]         = userid
    [Last_Update]        = today
    [Order_Status]       = $newstat
    [PDA]                = "Y"
    [Origin]             = $origin
    [Completed]          = "N"
  write-record

  recnr = precord
  $status = "A"
  if $menu = "boss"
    $allreas = $reas1&$reas2&$reas3&$reas4&$reas5
  else
    $allreas = $reas1&$reas2&$reas3&$reas4
  end if
  while true
    x = popuplist(8,15,14,$allreas,"",1,0)
    if x = -1
      continue while
    elseif x = 0
      exit while
    end if
  end while
  if ptstr = $reas5
    while true
      x = entryline(" Variation description - the Customer reads this! ",50,"",$free,21,6,71)
      if x = -1
        return (-1)
      elseif x = 0
        if ptstr = ""
          continue while
        end if
        $reas = ptstr
        exit while
      end if
    end while
  else
    $reas = ptstr
  end if
  AddVarn(jobnr|"-00",invtot,$reas,"Original","Original",today)
  Background()
  messbox(" Print interim confirmation? (y/n) ",1,1,1)
  if ptstr == "y"
    PrintInterimOrder()
  end if
  AddToArray()
END FUNCTION 'EnterDetails()


FUNCTION EnterDetails2()
  vloadif(dpath|"custsel4.vw")
  @if(len(deladdr1)=0,"",deladdr1)
  while true
    while true
      x = entryline(" Enter Delivery Address - Line 1 ",35,"",deladdr1,21,6,71)
      if ptstr = ""
        continue while
      end if
      if x = 0
        deladdr1 = proper(ptstr)
        if $newcust = "Y"
          SelectOrigin()
        else
        end if
        exit while
      elseif x = -1
        continue while
      end if
    end while
    screen clear box r1 c1 r2 c2 cl1 cl2
    y1 = format(" "|jobnr&"-"&custname|" ","M46")
    screen print r1+1 c1+2 cl1 cl2 y1
    y1 = format(" Fit at:"&deladdr1,"L46")
    screen print r1+2 c1+2 cl1 cl2 y1
    if $newcust = "Y"
      while true
        x = popuplist(9,66,13,"Home Office None","",1,0)
        if x = 0
          tel_locn = ptstr
          exit while
        else
          continue while
        end if
      end while
      if tel_locn <> "None"
        while true
          x = entryline(" Enter"&tel_locn&"telephone number e.g. 020-8947-5432 ",15,"\0*14{[1234567890\-]}",telnr,21,6,71)
          screen clear box 20 1 21 scw 0 0 no-border
          if x = 0
            if ptstr = "0"
              continue while
            end if
            telnr = ptstr
            exit while
          else
            continue while
          end if
        end while
      else
        telnr = "0 - No Nr"
      end if
      y3 = format(" "|tel_locn&"Telephone:"&telnr,"L46")
      screen print r1+5 c1+2 cl1 cl2 y3
    else                               ' lookup existing nrs
      H_tel     = [Home_Tel]
      O_tel     = [Office_Tel]
      if len(H_tel) > 0
        x = entryline(" Confirm Home telephone number ",15,"\0*14{[1234567890\-]}",H_tel,21,6,71)
        if x = 0
          H_tel = ptstr
        end if
      end if
      if len(O_tel) > 0
        x = entryline(" Confirm Office telephone number ",15,"\0*14{[1234567890\-]}",O_tel,21,6,71)
        if x = 0
          O_tel = ptstr
        end if
      end if
      y3 = format(" Home:"&H_tel|"   Office:"&O_tel,"L46")
      screen print r1+5 c1+2 cl1 cl2 y3
    end if

    while true
      x = entryline(" Enter E-mail Address ",35,"",$emailaddr,21,6,71)
      if ptstr = ""
'         continue while
      end if
      if x = 0
        $emailaddr = ptstr
'         if $newcust = "Y"
'           SelectOrigin()
'         else
'         end if
        exit while
      elseif x = -1
        continue while
      end if
    end while

    y2 = format(" Date ordered:"&date2(today),"L46")
    screen print r1+3 c1+2 cl1 cl2 y2
    while true
      x = entryline(" Enter Invoice total (inc VAT) - dec. point must be entered ",8,"*8{[-1234567890.]}","",21,6,71)
      if x = 0
        if ptstr = ""
          continue while
        end if
        invtot = value(ptstr)
        if $menu <> "boss"
          if invtot = 0
            messbox(" Cannot enter ZERO invoices ",0,0,1)
            continue while
          end if
        end if
        exit while
      elseif x = -1
        continue while
      end if
    end while
    initbalance = invtot
    y3 = format(" Order value:"&currency(invtot)&"(inc. VAT @"&str(#vat)|"%) ","L46")
    screen print r1+4 c1+2 cl1 cl2 y3
    screen clear box 20 1 21 scw 0 0 no-border

    vloadif(dpath|"custsel4.vw")
    x = messline(" Confirm correct and continue with Order? (y/n) ",1,1,1,21,6,71)
    if ptstr == "y"
      repaint off
      if $newcust = "Y"
        repaint off
        custcode = jobnr
        if len(custname) = 0
          messboxwait(" Customer's name has been omitted - pls contact David @ HO ",0,0,1)
        end if
        if len(abbrv_name) = 0
          messboxwait(" Customer's abbrv'd name has been omitted - pls contact David @ HO ",0,0,1)
        end if
        data enter lock
          [Branch]        = left(custcode,1)
'           [Parent]        = "M"
          [Customer_Name] = custname
          [Abbrv_Name]    = abbrv_name
          [Email_Addr]    = $emailaddr
          [Customer_Code] = custcode
          [Profile]       = "A"
          [Credit_Status] = "C"
          if left(tel_locn,1) = "H"
            [Home_Tel] = telnr
          elseif left(tel_locn,1) = "O"
            [Office_Tel] = telnr
          else
            telnr = "None"
          end if
          [Updated_By]    = userid
          [Last_Update]   = today
          [ChkAddr]       = "Y"
          [Source]        = $origin
        write-record
        $parent="M"
      else
        lock-record
          [Home_Tel]   = H_tel
          [Office_Tel] = O_tel
        write-record
        $parent="M"
      end if
      return (0)
    else
      continue while
    end if
    repaint off
  end while
END FUNCTION 'EnterDetails2()


FUNCTION ReturnToMenu()
  lock module $newcust
  lock module jobnr
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all                      'message "$jobstr is:"&str($jobstr)
  fopen dpath|userid|".jnr" as 1
  fwrite 1 from $jobstr
  fclose 1
  if $ordstat = "A"
    transfer "salord02.rf3" in-memory
  else
    transfer cpath|"pm_menu.psl" in-memory
  end if
END FUNCTION ' ReturnToMenu()


FUNCTION EnterCash()
  vloadif(dpath|"cashrcvd.vws")
  smartpoke $_ins 0                      ' switch on OVR mode
  order change physical
  screen clear box 1 1 sch scw 0 0 no-border

  while true
    if initbalance < 0
      x = fentrybox(" Overpaid by "|currency(abs(initbalance))|". Enter Amount Received or {Esc} to exit ",8,"","")
      if x = -1
        messbox(" No Cash Receipt entered - returning to Menu ",0,0,1)
        lock module jobnr
        file unload all
        transfer cpath|"pm_menu.psl" in-memory
      elseif x = 0
        rcvd = value(ptstr)
        if $menu <> "boss"
          if rcvd < 0
            messboxwait(" Refunds must be entered by Head Office ",0,0,1)
            continue while
          end if
        end if
        exit while
      end if

    elseif initbalance = 0
      x = fentrybox(" No Balance outstanding - enter Amount Received or {Esc} to exit ",8,"","")
      if x = -1
        messbox(" No Cash Receipt entered - returning to Menu ",0,0,1)
        lock module jobnr
        file unload all
        transfer cpath|"pm_menu.psl" in-memory
      elseif x = 0
        rcvd = value(ptstr)
        if $menu <> "boss"
          if rcvd < 0
            messboxwait(" Refunds must be entered by Head Office ",0,0,1)
            continue while
          end if
        end if
        exit while
      end if

    else
      while true
        x = fentrybox(" "|currency(initbalance)&"due from"&trim(format(left(custname,20),"L20"))|" - enter Amount - {Esc} exits ",11,"","")
        if x = -1
          messbox(" No Cash Receipt entered - returning to Menu ",0,0,1)
          lock module jobnr
          file unload all
          transfer cpath|"pm_menu.psl" in-memory    '         ReturnToMenu()
        elseif x = 0
          if ptstr = ""
            continue while
          end if
          rcvd = value(ptstr)
          if $menu <> "boss"
            if rcvd < 0
              messboxwait(" Refunds must be entered by Head Office ",0,0,1)
              continue while
            end if
          end if
          exit while
        end if

      end while
      exit while
    end if
  end while
END FUNCTION ' EnterCash()


FUNCTION DateRcvd()
local m1
  while true
    if rcvd > 0
      m1 = " Enter Date of Receipt "
    else
      m1 = " ’Enter Date Refunded’ "
    end if
    x = fentrybox(m1,10,"##\/##\/####",today)
    if x = 0
      datereceipt = ptstr
      if chkdate(datereceipt,1) = -1
        messbox(" Incorrect date - re-enter ",0,0,1)
        continue while
      end if
      if days(datereceipt) > days(today)
        messbox(" Future dates not allowed ",0,0,1)
        continue while
      elseif days(datereceipt) < (days(today)-2)
        messbox(" Must be within last 2 days ",0,0,1)
        continue while
      end if
      exit while
    end if
  end while
END FUNCTION ' DateRcvd()


FUNCTION Approve()
local y  p1 p2 p3 p4 p5 y1 chkbal p6
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  while true
    y1 = format(left(" "|jobnr&"-"&custname|" ",44),"M44")
    if rcvd < 0
      screen print 7 21 fge bge y1
    else
      screen print 7 21 fgp bgp y1
    end if
    if rcvd > 0
      p1 = "Amount’received:’’’"|right("’’’’’’’’’’’’’’’’’’’’’’"|format(str(rcvd),"2R,$"),22)
    else
      p1 = "Amount’paid:’’’’’’’"|right("’’’’’’’’’’’’’’’’’’’’’’"|format(str(rcvd),"2R,$"),22)
    end if

    if rcvd > 0
      p2 = "Date’received:’’’’"|right("’’’’’’’’’’’’’’’’’’’’’’"|date2(datereceipt),22)
    else
      p2 = "Date’paid:’’’’’’’’"|right("’’’’’’’’’’’’’’’’’’’’’’"|date2(datereceipt),22)
    end if

    p3 = "Paid’by:’’’’’’’’’’"|right("’’’’’’’’’’’’’’’’’’’’’’"|$method,22)

    $authcode=ReplaceHardSpace(str($authcode))
    p6 = "Authority/comment:"|right("’’’’’’’’’’’’’’’’’’’’’’"|$authcode,22)

    if rcvd > 0
      p4 = "Money’received’at:"|right("’’’’’’’’’’’’’’’’’’’’’’"|$place,22)
    else
      p4 = "Refund’paid’from:’"|right("’’’’’’’’’’’’’’’’’’’’’’"|$place,22)
    end if

    chkbal = initbalance-rcvd          ' message "chkbal is:"&currency(chkbal)
    p5 = "’CORRECT!’(balance’WILL’be’"|currency(chkbal)|")’"

    if rcvd < 0
      x = colpopup(8,20,15,p1&p2&p3&p6&p4&p5,chr(24)&chr(25)&"and {Enter} to amend/accept",1,0,15,12,0,7)
    else
      x = colpopup(8,20,15,p1&p2&p3&p6&p4&p5,chr(24)&chr(25)&"and {Enter} to amend/accept",1,0,15,1,0,7)
    end if
    if x = -1
      messbox(" Abandon this Cash Received entry? (y/n) ",1,0,1)
      if ptstr == "y"
        lock module jobnr
        Background()
        file unload all
        transfer cpath|"pm_menu.psl" in-memory
      end if
    end if
    if ptstr ! "Amount"
      screen shortrestore dsa
      if $saltype = "c"
        rcvd = invtot
      else
        EnterCash()
      end if

    elseif ptstr ! date2(datereceipt)
      screen shortrestore dsa
      datereceipt = today

    elseif ptstr ! $method
      screen shortrestore dsa
      PaymentMethod()
    elseif ptstr ! $place
      screen shortrestore dsa
      Place_Paid()
    elseif ptstr == p5
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      exit while
    end if
  end while
END FUNCTION ' Approve()


FUNCTION ReplaceHardSpace(str1)
local j r m bw l_last #addn
  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
  return (m)
END FUNCTION ' ReplaceHardSpace()


FUNCTION TransactUpmt()
  vloadif(dpath|"cust_ord.vws")
  lastbal = round([Balance_Due],2)
  balancedue = lastbal - balancedue
  lock-record
    [Balance_Due] = balancedue
  write-record
END FUNCTION ' TransactUpmt()


FUNCTION MakeReceiptNr(receiptnr)
  increment(dpath|"receipts.dat",1)
  receiptnr = right("00000"|str(ptval),5)
  return (receiptnr)
END FUNCTION


FUNCTION PaymentMethod()
  while true
    screen shortrestore dsa
    $poplist = "Cheque Cash PDQ Direct"
    x = findpopup(8,10,15,$poplist,$method,"Payment",1,0)
    $method = ptstr
    if ptstr == "PDQ"
      GetAuthCode()
      PDQ_Time()
    else
      if jobnr = $sundrycash
        while true
          x = fentrybox(" Enter Payer's name & reference ",20,"",$authcode)
          if ptstr = ""
            continue while
          end if
          if x = 0
            exit while
          end if
        end while
        $authcode = ptstr
      else
        $authcode = "None"
      end if
    end if
    exit while
  end while
END FUNCTION  'PaymentMethod()


FUNCTION PDQ_Time()
  while true
    x = fentrybox(" Enter time of PDQ transaction ",5,"##\:##","")
    if ptstr = ""
      continue while
    end if
    pdqtime=ptstr
' message "pdqtime) is:"&str(pdqtime)
    if x = 0
      exit while
    end if
  end while
END FUNCTION  'PDQ_Time()


FUNCTION  GetAuthCode()
' local $poplist
  $poplist = "VISA Mastercard VISA’Delta Switch Solo"
'   x = popuplist(8,53,13,"2/3days 7’days 7/10’days 14’days Other","",1,0)
  x = popuplist(8,10,15,$poplist,"Payment",1,0)
  $PDQtype = case ptstr ("VISA","VISA")("Mastercard","MCRD")("VISA’Delta","VISD")("Switch","SWTC")("Solo","SOLO")
  if rcvd > 100
    while true
      x = fentrybox(" Enter Authorisation Code ",6,"*6{#}","")
      if ptstr = ""
        continue while
      end if
      if x = 0
        exit while
      end if
    end while
    $authcode = value(ptstr)
  end if
END FUNCTION  ' GetAuthCode()


FUNCTION Place_Paid()
local s1 s2 s3 s4 s5 s6 s7 $locn
  if $method = "Direct"
    $place = "Head’Office"
    locn = left($place,1)
    return (0)
  end if
  $locn = case left(jobnr,1) ("R","Raynes")("P","Putney")("S","Sheen")("T","Fulham")("F","Fulham") else "Head’Office"
  s1 = "Fulham"
  s2 = "Head’Office"
  s3 = "Raynes"
  s4 = "Sheen"
  s7 = "Putney"
  while true
    x = findpopup(8,60,15,s1&s2&s3&s7&s4,$locn,"Place",1,0)
    $place = ptstr
    locn = left($place,1)
    exit while
  end while
END FUNCTION 'Place_Paid()


FUNCTION ProcessEntry()
  while true
    if $saltype = "c"
      rcvd = invtot
      datereceipt = today
    else
      EnterCash()
      datereceipt = today
'       DateRcvd()
    end if

    PaymentMethod()

    Place_Paid()

    Approve()

' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ Generate Receipt Nr & create new record                            ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    receiptnr = MakeReceiptNr(receiptnr)
    vloadif(dpath|"new_cash.vw")

    balancedue = initbalance - rcvd
    if balancedue < 0
      y = messbox(" Job Nr"&jobnr&"overpaid by "|currency(abs(balancedue))|" - confirm (y/n) or {Esc} to abandon ",1,0,0)
      if y = -1
        messbox(" No Cash Receipt or Job entered - returning to Menu ",0,0,1)
        lock module jobnr
        file unload all
        transfer cpath|"pm_menu.psl" in-memory
      else
        screen clear box 1 1 sch scw 0 0 no-border
        if ptstr == "N"
          continue while
        end if
        exit while
      end if

    else
      if balancedue < 1
        if balancedue = 0
          exit while
        end if
        messbox(" Underpaid by"&str(abs(balancedue*100))|"p - entering as Underpayment",0,0,1)
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³  Create "cashrcvd" record for underpayment                         ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
        $sales = case left(jobnr,1)("C","X")("R","R")("S","S")("F","F")("P","P")("W","W")("T","T")("Y","Y")
        vloadif(dpath|"new_cash.vw")
        data enter lock
          [Date_Of_Receipt]   = datereceipt
          [SalAnal]           = $sales
          [Job_Nr]            = jobnr
          [Method_Of_Payment] = "UNDPMT"
          [Abbrv_M]           = "O"
          [Receipt_Nr]        = receiptnr
          [Amount_Received]   = balancedue
          [Time]              = now
          [Branch]            = locn
          [Entered_By]        = userid
          [Authorisation]     = ""
          [PDQtype]           = $PDQtype
          [Invoiced]          = "Y"
          [PDQ_Time]          = pdqtime
        write-record
        TransactUpmt()
      end if
      exit while
    end if
  end while

  progress(15,10," Please wait ... entering details ",0)
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³  Create new "cashrcvd" record                                      ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  $sales = case left(jobnr,1)("C","X")("R","R")("S","S")("F","F")("P","P")("W","W")("T","T")("Y","Y")
  vloadif(dpath|"cust_ord.vws")
  $invd = filelookup([Job_Nr],[Inv_Nr],jobnr)
  if len($invd) = 0
    $invd = "N"
  else
    $invd = "Y"
  end if

  vloadif(dpath|"new_cash.vw")
  data enter lock
    [Date_Of_Receipt]   = datereceipt
    [SalAnal]           = $sales
    [Job_Nr]            = jobnr
    [Method_Of_Payment] = $method
    [Abbrv_M]           = left($method,1)
    [Receipt_Nr]        = receiptnr
    [Amount_Received]   = rcvd
    [Branch]            = locn
    [Time]              = now
    [Authorisation]     = $authcode
    [PDQtype]           = $PDQtype
    [Entered_By]        = userid
    lastbal             = value([Balance_Due])     'message "lastbal is:"&str(lastbal)
    newbalance          = lastbal - rcvd        'message "newbalance is:"&str(newbalance)
    [Balance_Due]       = newbalance
    [Invoiced]          = $invd
    [PDQ_Time]          = pdqtime
  write-record
  rcvdnr = precord
  TransactRcvd()
END FUNCTION ' ProcessEntry()


FUNCTION TransactRcvd()
  messbox(" Balance shown as remaining is"&currency([Balance_Due])&"- correct? (y/n) ",1,0,1)
  if ptstr == "n"
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    progress(15,10," Re-calculating balance ",0)
    vloadif(dpath|"cust_ord.vws")
    #inv_total = [Invoice_Total]       'message "#inv_total is:"&str(#inv_total)
    vloadif(dpath|"cash_bal.vw")
    order change key "[Job_Nr]"
    data query execute "cash_bal.dfq" index "cash_bal.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    if cerror
      #totalrecd = 0                          ' message "#totalrecd is:"&str(#totalrecd)
    else
      #totalrecd = filesum([Amount_Received]) ' message "#totalrecd is:"&str(#totalrecd)
    end if                                    ' message "#inv_total is:"&str(#inv_total)
    newbalance = #inv_total - #totalrecd      ' message "newbalance is:"&str(newbalance)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    messbox(" Balance held in database is confirmed as"&currency(newbalance)&"- correct? (y/n) ",1,0,1)
    if ptstr == "n"
      screen clear box 1 1 sch scw 0 0 no-border
      messbox(" Report details to Head Office ",0,1,1)
      $mess = jobnr&"- incorrect balance"&currency(newbalance)&"shown in CUST_ORD file"
      cat = "SUNDRY"
      x = exception(userid,today,time24,cat,$mess)
      vunloadif(dpath|"unread1.vw")
      vloadif(dpath|"cust_ord.vws")
    end if
  end if
END FUNCTION ' TransactcRcvd()


FUNCTION AddToArray()
local $new $newcust $hold h
  y = strtoary(custname)
  $newcust = ""
  for i = 1 to ptval
    if i = 1
      $newcust = ptary[i]                ' NB - space is Alt-255
    else
      $newcust = $newcust|"’"|ptary[i]    ' NB - space is Alt-255
    end if
  end for
  $new = jobnr|"’"|$newcust            ' HARD space
  for i = 1 to 6
    if left(jobs[i],6) = jobnr         ' jobnr already held
      $hold = jobs[i]
      for h = i-1 to 1 step -1
        if len(jobs[h]) = 0
          jobs[h+1] = ""
        else
          jobs[h+1] = jobs[h]
        end if
      end for
      jobs[1] = $hold
      return (0)
    end if
  end for
  for i = 5 to 1 step -1
    if len(jobs[i]) = 0
      jobs[i+1] = ""
    else
      jobs[i+1] = jobs[i]
    end if
  end for
  redimension ptary[6]
  jobs[1] = $new
  for i = 1 to 6
    ptary[i] = jobs[i]
  end for
END FUNCTION ' AddToArray()


FUNCTION UpdApptRecs()
local #apptnr
  repaint off
  vloadif(dpath|"bookappt.vw")
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "job_reqn.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror                            ' if none - then return
    return (0)                         ' no appts made yet
  end if
  for i = 1 to records
    $dayftr = left([DFA],11)
    #apptnr = [Appointment_Order]
    lock-record
      [Entered_By] = userid
      [Date_Altered] = today
      [Time] = now
      [Status] = $newstat
    write-record

    repaint off
    vloadif(dpath|"apptdate.vws")         ' message "jobnr is:"&str(jobnr)
    order change key "[DayFitter]"
    data find "[DayFitter]" equal $dayftr options ""
    if cerror
      return (0)
    end if
    lock-record
      dbput("[B"|str(#apptnr)|"]",$newstat)
    write-record
    vloadif(dpath|"bookappt.vw")
    data goto record next
  end for
END FUNCTION 'UpdApptRecs()


FUNCTION CheckCorrect()
  vloadif(dpath|"cust_ord.vws")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options ""
  if cerror                               '   if none - then return
    x = messboxwait(" Record "|jobnr|" not written to file - inform Head Office ",1,0,0)
    return (1)
  end if
  #total_entered = [Invoice_Total]
  messbox(" Confirm Sales value for"&jobnr&"should be"&currency(#total_entered)|"? (y/n) ",1,0,1)
  if ptstr == "y"
    return (0)
  else
    PrintError()
    return (1)
  end if
END FUNCTION 'CheckCorrect()


FUNCTION PrintError()
  while true
    x = fentrybox(" What should the Invoice total (inc VAT) have been? ",8,"*8{[-1234567890.]}","")
    if x = 0
      if ptstr = ""
        continue while
      end if
      invtot = value(ptstr)
      if $menu <> "boss"
        if invtot = 0
          messbox(" Cannot enter ZERO invoices ",0,0,1)
          continue while
        end if
      end if
      exit while
    elseif x = -1
      continue while
    end if
  end while
  #netinv = round(invtot*100/(100+#vat),2)
  x = remove("printme.idx")
  x = makeidx("cust_ord","printme.idx",precord,3)
  order change index "printme.idx"
  p1 = "inverror.dfr"
  PrintReport(p1,p2,p3,p4,p5,p6)
  return (0)
END FUNCTION 'PrintError()


FUNCTION AddVarn(varnr,#gross,$reas,$ref,$notif,$varndate)
local balancedue lastbal newtotal oldtotal newnet oldnet #prec x
  vloadif(dpath|"addvarn3.vw")
  data enter lock
    [Var_Nr]        = varnr
    [VarnJobNr]     = left(varnr,6)
    [Amount_Gross]  = #gross
    [Reason]        = $reas
    [Customers_Ref] = $ref
    [Notif_Method]  = $notif
    [Date]          = $varndate
    [Entered_By]    = userid
  write-record
  lastbal = round([Balance_Due],2)
  balancedue = lastbal + #gross
  oldtotal = round([Invoice_Total],2)
  newtotal = oldtotal + #gross
  oldnet   = round([Net_Invoice],2)
  newnet   = oldnet + round(#gross*100/(100+#vat),2)
  lock-record
    [Balance_Due]   = balancedue
    [Invoice_Total] = newtotal
    [Net_Invoice]   = newnet
  write-record
END FUNCTION 'AddVarn()


FUNCTION SelectOrigin()
  while true
    x = popuplist(11,60,22,"’’’’’’’’ Recommendation Not’known Other Advertisement Passing Exhibition","",1,0)
    $origin = case ptstr ("Recommendation","R")("Not’known","N")("Other","O")("Advertisement","A")("Passing","P")("Exhibition","X")("Trade’Contact","T")("’’’’’’’’","$")
    if $origin = "$"    ' HARD spaces
      continue while
    else
      exit while
    end if
  end while
END FUNCTION 'SelectOrigin()


FUNCTION PrintInterimOrder()
local $index $file scrn
  scrn=apinfo(ap_filex)         'message "Screen is:"&str(x)
  Background()
  vloadif(dpath|"intorder.vw")
  data goto record record-number recnr
  $index = "onlyone.idx"
  $file = "cust_ord"
  remove($index)
  x = makeidx($file,$index,str(precord),3)    '   message "x is:"&str(x)
  order change index $index
  p3 = 1                               '
  p1 = "INTORDER.dfr"   ' p1 = report definition ("ord_stck.dfr")
  PrintReport(p1,p2,p3,p4,p5,p6)
  vloadif(dpath|scrn)
END FUNCTION ' PrintInterimOrder()


FUNCTION NewJobNr()
local leftjob currec
  s1 = "Warehouse"
  s2 = "Trade"
  s3 = "Fulham"
  s4 = "Raynes"
  s5 = "Sheen"
  s7 = "Putney"

  if base="O"                         ' choice of Warehouse etc
    leftjob=Job_Locn()

  elseif base="F"
    while true
      x = popuplist(8,57,15,s3&S7&s2,"Order",1,0)
      if x = -1
        continue while
      end if
      $place = ptstr
      messbox(" Confirm"&upper($place)&"job? (y/n) ",1,1,1)
      if ptstr == "y"
        leftjob=left($place,1)
        exit while
      else
        continue while
      end if
    end while

'     messbox(" Confirm FULHAM job? (y/n) ",1,1,1)
'     if ptstr == "y"
'       leftjob = base
'     else
'       leftjob=Job_Locn()
'     end if

  elseif base="S"
    while true
      x = popuplist(8,57,15,s5&s4,"Order",1,0)
      if x = -1
        continue while
      end if
      $place = ptstr
      messbox(" Confirm"&upper($place)&"job? (y/n) ",1,1,1)
      if ptstr == "y"
        leftjob=left($place,1)
        exit while
      else
        continue while
      end if
    end while

'     messbox(" Confirm SHEEN job? (y/n) ",1,1,1)
'     if ptstr == "y"
'       leftjob = base
'     else
'       leftjob=Job_Locn()
'     end if

  else
    leftjob=Job_Locn()
  end if

  vloadif(dpath|"cust_ord.vws")
  data goto record last
  while true
    if left([Job_Nr],1)=leftjob
      lastjob=right([Job_Nr],5)
      jobnr=leftjob|right("00000"|str(value(lastjob)+1),5)
      currec=precord
      data find "[Job_Nr]" equal jobnr options "g"
      if cerror                               '   if none - then return
        exit while
      else
        data goto record record-number currec
        data goto record previous
      end if
    else
      data goto record previous
    end if
  end while
END FUNCTION 'NewJobNr()


FUNCTION Job_Locn()
  s1 = "Warehouse"
  s2 = "Trade"
  s3 = "Fulham"
  s4 = "Raynes"
  s5 = "Sheen"
  s7 = "Putney"
  while true
    x = popuplist(8,37,15,s3&s7&s4&s5&s2&s1,"Order",1,0)
    if x = -1
      continue while
    end if
    $place = ptstr
    messbox(" Confirm"&upper($place)&"job? (y/n) ",1,1,1)
    if ptstr == "y"
      return (left($place,1))
    else
      continue while
    end if
  end while
END FUNCTION 'Job_Locn()


FUNCTION PrintReceipt()
  vloadif(dpath|"cshrcvd1.vw")
  order change physical
  remove("cashrcpt.idx")
  makeidx("cashrcvd","cashrcpt.idx",rcvdnr,5)
  order change index "cashrcpt.idx"
  screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Print Receipt? (y/n) ",1,1,1)
  if ptstr == "y"
    Background()
    messboxwait(" Insert paper for Cash Receipt ",0,1,1)
    while true
'       p1 = "cshrcv_b.dfr"
'       PrintReport(p1,p2,p3,p4,p5,p6)
  vunloadif("Xaddvarn.vws")
  remove(X_path|"Xaddvarn.*")
  data query execute "not_del.dfq" data-file X_path|"Xaddvarn" fields "[Customer_Code|Br_Fax]"
' [Var_Nr;Date;CustOrd_Name;Amount_Gross;shop;Date_To;Nr_Orders;Avg_Order;Tot_Order_Net;Tot_Order_Gross]"
  _SWIP_Crystal(Xreppath|"cshrcpt2","P",0,1,"")
  _SWIP_Crystal(Xreppath|"cshrcpt2","S",0,1,"Cash Receipt")
'   _SWIP_Crystal(Xreppath|"$inv_1","EP",0,1
  vloadif(dpath|"cshrcvd1.vw")
      messbox(" Has Cash Receipt printed correctly? (y/n) ",1,1,1)
      if ptstr == "y"                      '  store file & exit
        return (0)
      else
        messbox(" Abandon? (y/n) ",1,1,1)
        if ptstr == "y"                      '  store file & exit
          return (0)
        else
        continue while
        end if
      end if
    end while
  end if
END FUNCTION ' PrintReceipt()

' external   X_path _SWIP_Crystal() Xreppath
'   remove(X_path|"X_mth_o.*")
'
'   vunloadif("X_inv_a.vws")
'   ClearHardSpaces()
'   data query execute "not_del.dfq" Smart4 X_path|"X_mth_o" fields\
'   "[Var_Nr;Date;CustOrd_Name;Amount_Gross;shop;Date_To;Nr_Orders;Avg_Order;Tot_Order_Net;Tot_Order_Gross]"
'   _SWIP_Crystal(Xreppath|"$inv_1","P",0,1,"")
'   _SWIP_Crystal(Xreppath|"$inv_1","EP",0,1,invpath|$nextinvnr|".pdf")

