'SALORD03 - combination of SALORD01 & CASHENT1 for quick entry of orders

'23/9/94 -  uses new field ([Type_Branch] L423) to indicate type of org'n
'          type are: "H-Head Office" "S-SHOP" "F-FRANCHISE"

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()
external   chkdate() navrecs() entryline() messline() $cashent $menu base
external   popuplist() remove() PrintReport() exception() strtoary() fge bge
external   messboxwait() colpopup()

public     invtot ptstr custcode dsa abbrv_name $newcust $place psa
public     ptary[6] jobs[6] $dayftr

global     $newstat $saltype NavMess_A() $abbrv RecsScroll()
global     rcvd m4 PaymentMethod() Place_Paid() Approve() ReturnToMenu()
global     y lastbal $status custaddr1 EnterCustName() y1 y2 y3
global     CheckJobNr() TransactRcvd() GetAuthCode() newrec deladdr1 $authcode
global     shop locn H_tel O_tel $type custname $method x datereceipt arc
global     orderdate recnr tel_locn telnr fentline $ordstat $jobstr z
global     EnterDetails() TransactUpmt() rcvdnr balancedue initbalance
global     Balance() ProcessEntry() PrintReceipt() receiptnr MakeReceiptNr()
global     $mess cat #totalrecd #inv_total newbalance i $sales #vat
global     p1 p2 p3 p4 p5 p6 $test AddToArray() $msg fj #netinv


MAIN
  single-step off
  quiet off
  m4 = " Correct? (y/n) "
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  lock module invtot

  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
  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

  while true
    x = CheckJobNr()                   ' check Job Nr exists in CUST_ORD
    if x = 0
      $newstat = "A"
      x = EnterDetails()               ' sic
      continue while
    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
  end while

  vloadif(dpath|"cust_ord.vws")
  $ordstat = [Order_Status]            ' message "$ordstat is:"&str($ordstat)

  ReturnToMenu()

END MAIN


FUNCTION EnterCustName()
  while true
'     if z = 0
    while true
      x = fentrybox(" Enter first five letters of Customer's Name or {Esc} ",5,"","")
      if x = 0
        if len(ptstr)=0
          continue while
        end if
        exit while
      elseif x = -1
        return (-1)
      end if
    end while
    abbrv_name = proper(ptstr)         'message "abbrv_name is:"&str(abbrv_name)

    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    vloadif(dpath|"ordstat2.vw")
    order change key "[Abbrv_Name]"
    data find "[Abbrv_Name]" equal abbrv_name options ""
    if cerror
      $abbrv=[Abbrv_Name]              'message "$abbrv is:"&str($abbrv)
      if trim($abbrv) == trim(abbrv_name)
      else
        messbox(" Name"&chr(34)|abbrv_name|chr(34)|" not on file ",0,1,1)
        continue while
      end if
    end if

    repaint on
    repaint
    ptval=0
    y1 = format(" Name                                Delivery Address","L71")
    y2 = format(" {Enter} selects - {Esc} exits ","M71")
    screen print 4 6 fgp bgp y1
    screen print 18 6 fgp bgp y2
    while true
      ptval = RecsScroll()
      if ptval = {Enter}
        repaint off
        jobnr = [Job_Nr]
        if [Balance_Due] < .01
          x=messbox(" No balance outstanding - continue with this order? (y/n) ",1,0,1)
          if ptstr == "n"
            repaint on
            repaint
            y1 = format(" Name                                Delivery Address","L71")
            y2 = format(" {Enter} selects - {Esc} exits ","M71")
            screen print 4 6 fgp bgp y1
            screen print 18 6 fgp bgp y2
            continue while
          end if
        end if
        return (0)
      elseif ptval = {Esc}
        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 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
  vloadif(dpath|"cust_ord.vws")
  order change physical
  invtot = 0
  telnr = ""
  deladdr1 = ""
  orderdate = today
  while true
    x = popuplist(9,33,13,"’’’Job’Nr Customer’Name","{Esc} to exit",1,0)
'     x = popuplist(9,33,13," Customer’Name ’’’Job’Nr","{Esc} to exit",1,0)
    if x = 0
      if ptstr = "Customer’Name"
        x = EnterCustName()
        if x = -1
          continue while
        elseif x = 0                   ' using current
          exit while
        end if
      else
        while true
          if fj = -1
            x = fentrybox(" Enter Job Nr or {Esc} to exit ",6,shopmask,jobnr)
            if x = -1
'               continue while
              return (-1)
            elseif x = 0
              if ptstr = ""
                continue while
              else
                jobnr = ptstr
                exit while
              end if
            end if
          end if
          exit while
        end while
        exit while
      end if
    elseif x = -1
      return (-1)
    end if
  end while

'   progress(fgp,bgp," Checking for existing order ",0)
  vloadif(dpath|"cust_ord.vws")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options "gw"
  if cerror                               '   if none - then return
    messboxwait(" Job NOT yet entered ",0,0,1)
    return (0)
  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

  AddToArray()

  return (1)

END FUNCTION ' CheckJobNr()


FUNCTION Balance()
local y
  while true
    y = abs(initbalance)
    if round(initbalance,2) < 0
      messboxwait(" Overpaid by "|currency(y),0,0,1)
      exit function
    elseif round(initbalance,2) = 0
      messbox(" No Balance outstanding ",0,0,1)
      return (1)
    else
      messboxwait(jobnr&"- "|currency(initbalance)&"due from"&custname|"’",0,1,1)
      return (0)
    end if
  end while
END FUNCTION 'Balance()


FUNCTION EnterDetails()
local  response prec# y orderdate ordermth thismth r1 c1 r2 c2 cl1 cl2
  while true                           ' Normal or CASH SALE
'     screen shortrestore psa
    x = keybox("1Normal 1Cash’Sales 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

    if $saltype == "n" or $saltype == "z"                   ' NORMAL sale
      $method = "Cheque"
      if ptstr == "n"
        #vat = vatrate
      elseif ptstr == "z"
        #vat = 0
      end if
      x = EnterCustName()
      if x = -1
        return (1)
      end if

' message "custcode after EnterCustName is:"&str(custcode)
      screen clear box r1 c1 r2 c2 cl1 cl2
      y1 = format(" "|jobnr&"-"&custname|" ","M46")
      screen print r1+1 c1+2 cl1 cl2 y1

      @if(len(deladdr1)=0,"",deladdr1)
      while true
        x = entryline(" Enter Delivery Address - Line 1 ",35,"",deladdr1,20,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
      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. 0171-498-1455 ",15,"\0*14{[1234567890\-]}",telnr,20,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,20,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,20,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

      thismth = value(mid(date2(today),4,2))   '     @if(len(orderdate)=0,today,date2(orderdate))
      while true
'       x = entryline(" Enter Date of Order ",8,"##\/##\/##",date2(orderdate),20,6,71)
        x = entryline(" Enter Date of Order ",8,"##\/##\/##",@if(len(orderdate)=0,today,date2(orderdate)),20,6,71)
        if x = 0
          orderdate = ptstr
          if chkdate(orderdate,1) = -1
            messbox(" Incorrect date - re-enter ",0,0,1)
            continue while
          end if
          ordermth = value(mid(date2(orderdate),4,2))
          if thismth = 1
            if ordermth = 12
              messbox(" Dec - Cannot enter for next month - re-enter ",0,0,1)
              continue while
            end if
          end if
          if thismth > ordermth
            messbox(" Cannot enter for last month - re-enter ",0,0,1)
            continue while
          elseif thismth < ordermth
            messbox(" Cannot enter for next month - re-enter ",0,0,1)
            continue while
          end if
          exit while
        end if
      end while
      y2 = format(" Date ordered:"&date2(orderdate),"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.]}","",20,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
          return (-1)
        end if
      end while
      initbalance = invtot

'       y3 = format(" Order value:"&currency(invtot),"L46")
      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,20,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)
            [Customer_Name] = custname
            [Abbrv_Name]    = abbrv_name
            [Customer_Code] = custcode
            [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
          write-record
        else
          lock-record
            [Home_Tel]   = H_tel
            [Office_Tel] = O_tel
          write-record
        end if
        exit while
      else
        screen clear box 1 1 sch scw 0 0 no-border
        fentline = " Enter Customer's Name "
        continue while
      end if
      repaint off


    else                               ' CASH SALE
      #vat = vatrate
'       abbrv_name = "CASH "
      custcode = left(jobnr,1)|"00000"
      $method = "Cash"
'       custname = "CASH SALE"
      deladdr1 = "None"
      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(" Cash Sale - no fitting address ","L46")
      screen print r1+2 c1+2 cl1 cl2 y1 'deladdr
      y3 = format(" Phone:   N/A","L46")
      screen print r1+5 c1+2 cl1 cl2 y3 'phone

      while true
        fentline = " Enter Customer's Name for Cash Sale"
        x = fentrybox(fentline,35,"","")
        if x = 0
          if ptstr = ""
            continue while
          end if
          exit while
        end if
      end while
      custname = ptstr
      abbrv_name = proper(left(custname,5))

      thismth = value(mid(date2(today),4,2))   '     @if(len(orderdate)=0,today,date2(orderdate))
      while true
        x = entryline(" Enter Date of Order ",8,"##\/##\/##",@if(len(orderdate)=0,today,date2(orderdate)),20,6,71)
        if x = 0
          orderdate = ptstr
          if chkdate(orderdate,1) = -1
            messbox(" Incorrect date - re-enter ",0,0,1)
            continue while
          end if
          ordermth = value(mid(date2(orderdate),4,2))
          if thismth = 1
            if ordermth = 12
              messbox(" Dec - Cannot enter for next month - re-enter ",0,0,1)
              continue while
            end if
          end if
          if thismth > ordermth
            messbox(" Cannot enter for last month - re-enter ",0,0,1)
            continue while
          elseif thismth < ordermth
            messbox(" Cannot enter for next month - re-enter ",0,0,1)
            continue while
          end if
          exit while
        end if
      end while
      y2 = format(" Date ordered:"&date2(orderdate),"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.]}","",20,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")
'       y3 = format(" Order value:"&currency(invtot)|"(inc. VAT @"&#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,20,6,71)
      if ptstr == "y"
        repaint off
        exit while
      else
        screen clear box 1 1 sch scw 0 0 no-border
        fentline = " Enter Customer's Name "
        continue while
      end if
      repaint off
    end if
  end while

  vloadif(dpath|"cust_ord.vws")
  $type  = case left(jobnr,1)("C","S")("R","S")("S","S")("F","S")("P","F")("W","H")("T","H")
  $sales = case left(jobnr,1)("C","X")("R","R")("S","S")("F","F")("P","X")("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 enter lock
    [Job_Nr]             = jobnr
    [Branch]             = left(jobnr,1)
    [SalesAnalysis]      = $sales
    [Type_Branch]        = $type
    [CustOrd_Name]       = custname
    [Abbrv_Name]         = left(custname,5)
    [Delivery_Address_1] = deladdr1
    [Date_Of_Order]      = orderdate
    [Invoice_Total]      = invtot
    [Net_Invoice]        = #netinv
    [Balance_Due]        = invtot
    [Customer_Code]      = custcode
    [Updated_By]         = userid
    [Last_Update]        = today
    [Order_Status]       = $newstat
  write-record
  recnr = precord
  $status = "A"
  AddToArray()
END FUNCTION 'EnterDetails()


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 rcvd < 0
          messboxwait(" Refunds must be entered by Head Office ",0,0,1)
          continue while
        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
'         ReturnToMenu()
      elseif x = 0
        rcvd = value(ptstr)
        if rcvd < 0
          messboxwait(" Refunds must be entered by Head Office ",0,0,1)
          continue while
        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
          rcvd = value(ptstr)
          if rcvd < 0
            messboxwait(" Refunds must be entered by Head Office ",0,0,1)
            continue while
          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,8,"##\/##\/##",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
      end if
      exit while
    end if
  end while
END FUNCTION ' DateRcvd()


FUNCTION Approve()
local   p1 p2 p3 p4 p5 y1 chkbal
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  while true
    y1 = format(left(" "|jobnr&"-"&custname|" ",40),"M40")
    if rcvd < 0
      screen print 7 20 fge bge y1
    else
      screen print 7 20 fgp bgp y1
    end if
    if rcvd > 0
      p1 = "Amount’received:"|right("’’’’’’’’’’’’’’’’’’’’’’"|format(str(rcvd),"2R,$"),21)
    else
      p1 = "Amount’paid:’’’’"|right("’’’’’’’’’’’’’’’’’’’’’’"|format(str(rcvd),"2R,$"),21)
    end if
'     p2 = "Date’received:"|right("’’’’’’’’’’’’’’’’’’’’’"|date2(datereceipt),22)
    if rcvd > 0
      p2 = "Date’received:"|right("’’’’’’’’’’’’’’’’’’’’’"|date2(datereceipt),22)
    else
      p2 = "Date’paid:’’’’"|right("’’’’’’’’’’’’’’’’’’’’’"|date2(datereceipt),22)
    end if
    p3 = "Payment/auth's'n:"|right("’’’’’’’’’’’’’’’’’’’’’’"|$method|"/"|str($authcode),19)
    if rcvd > 0
      p4 = "Money’received’at:"|right("’’’’’’’’’’’’’’’’’’’’’’"|$place,18)
    else
      p4 = "Refund’paid’from:’"|right("’’’’’’’’’’’’’’’’’’’’’’"|$place,18)
    end if
    chkbal = initbalance-rcvd          ' message "chkbal is:"&currency(chkbal)
'     p5 = "’’’’’’’’’’’’’’CORRECT!’’’’’’’’’’’’’’"
    p5 = "’CORRECT!’(balance’WILL’be’"|currency(chkbal)|")’"
'     x = popuplist(8,20,15,p1&p2&p3&p4&p5,chr(24)&chr(25)&"and {Enter} to amend/accept",1,0)
    if rcvd < 0
      x = colpopup(8,20,15,p1&p2&p3&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&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
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
        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
      if $saltype = "c"
        datereceipt = today
      else
        DateRcvd()
      end if

    elseif ptstr ! $method
      screen shortrestore dsa
'       if rcvd < 0
'         $method = "Refund"
'       else
        PaymentMethod()
'       end if
    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 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 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"
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    progress(15,10," Printing receipt .... please wait ",0)
    p1 = "cshrcv_n.dfr"
    PrintReport(p1,p2,p3,p4,p5,p6)
  end if
END FUNCTION ' PrintReceipt()


FUNCTION MakeReceiptNr(receiptnr)
  increment(dpath|"receipts.dat",1)
  receiptnr = right("00000"|str(ptval),5)
  return (receiptnr)
END FUNCTION


FUNCTION PaymentMethod()
local $poplist
  while true
    screen shortrestore dsa
    $poplist = "Cheque Cash PDQ"
    x = findpopup(8,10,15,$poplist,$method,"Payment",1,0)
    $method = ptstr
    if ptstr == "PDQ"
      GetAuthCode()
    else
      $authcode = "None"
    end if
    exit while
  end while
END FUNCTION  'PaymentMethod()


FUNCTION  GetAuthCode()
  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 $locn
  $locn = case left(jobnr,1) ("R","Raynes")("S","Sheen")("F","Fulham") else "Head’Office"
  s1 = "Fulham"
  s2 = "Head’Office"
  s3 = "Raynes"
  s4 = "Sheen"
  while true
    x = findpopup(8,60,15,s1&s2&s3&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()
      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","X")("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
        write-record
        TransactUpmt()
      end if
      exit while
    end if

  end while

  progress(15,10," Please wait ... entering details ",0)
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³  Create new "cashrcvd" record                                      ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  vloadif(dpath|"new_cash.vw")
'   $type  = case left(jobnr,1)("C","S")("R","S")("S","S")("F","S")("P","F")("W","H")("T","H")
  $sales = case left(jobnr,1)("C","X")("R","R")("S","S")("F","F")("P","X")("W","W")("T","T")("Y","Y")
  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
    [Entered_By]        = userid
    lastbal             = value([Balance_Due])     'message "lastbal is:"&str(lastbal)
    newbalance          = lastbal - rcvd        'message "newbalance is:"&str(newbalance)
    [Balance_Due]       = newbalance
  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 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]             'message "ftgdate) is:"&date2(ftgdate)
  ordstat = [Order_Status]             ' message "ordstat) is:"&str(ordstat)
  jobnr   = [Job_Nr]                   ' message "jobnr) is:"&str(jobnr)
  mess1   =  format("Job Nr"&[Job_Nr]&"- Ftg Date:"&format(@if([Fitting_Date]=blank,"NONE!",date2([Fitting_Date])),"L8")&"- 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("Order value:"&currency([Invoice_Total])&"- balance o/s:"&format(currency([Balance_Due]),"R8"),"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()