'CONTRAS  - contras and adjustments to Sales Order balances

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() $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 DateRcvd() rcvd m4  Approve() ReturnToMenu() Reason()
global     y lastbal $status custaddr1 y1 y2 y3 GetAuthCode()
global     CheckJobNr() newrec deladdr1 $authcode GetRefundReason()
global     shop locn H_tel O_tel $type custname $method x datereceipt
global     orderdate recnr tel_locn telnr fentline $ordstat $jobstr
global     rcvdnr balancedue initbalance $abbrmethod
'  ProcessTransfer()
global     ProcessEntry() $mess cat #totalrecd #inv_total newbalance i $sales
global     p1 p2 p3 p4 p5 p6 $test $msg fj  EnterCash() TfrJobNr() tfrjob


MAIN
  single-step off
'   quiet off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off

  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

  $method = "Refund"
  $authcode = ""
  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 = -1
      exit while
    elseif x = 1
      continue while
    end if
    x = ProcessEntry()                 ' enter cash received
  end while

  ReturnToMenu()

END MAIN


' FUNCTION ProcessTransfer()
'   x = EnterCash()
'   if x = -1
'     return (-1)
'   end if
'   DateRcvd()
'   Reason()
'   $place = "H"
'   Approve()
'   vloadif(dpath|"new_cash.vw")
'   progress(15,10," Please wait ... entering details ",0)
'
' ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ' ³  Create new "cashrcvd" record for tfr FROM                         ³
' ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'   $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] = $abbrmethod
'     [Abbrv_M]           = "O"
'     [Amount_Received]   = rcvd
'     [Branch]            = locn
'     [Time]              = now
'     [Authorisation]     = "Transferred to"&tfrjob
'     [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
'
' ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ' ³  Create new "cashrcvd" record for tfr TO                           ³
' ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' '   $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]            = tfrjob
'     [Method_Of_Payment] = $abbrmethod
'     [Abbrv_M]           = "O"
'     [Amount_Received]   = rcvd
'     [Branch]            = locn
'     [Time]              = now
'     [Authorisation]     = "Transferred from"&jobnr
'     [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
' END FUNCTION ' ProcessTransfer()


FUNCTION ProcessEntry()
local $invd
  while true
    x = EnterCash()
    if x = -1
      return (-1)
    end if
    DateRcvd()

    x = Reason()
    if x = 1
      continue while
    end if

    $place = "H"
    x = Approve()
    if x = -1
      return (-1)
    else
      exit while
    end if
  end while

  vloadif(dpath|"new_cash.vw")
  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","X")("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")

' message "jobnr is:"&str(jobnr)
  data enter lock
    [Date_Of_Receipt]   = datereceipt
    [SalAnal]           = $sales
    [Job_Nr]            = jobnr
    [Method_Of_Payment] = $abbrmethod
    [Abbrv_M]           = "O"
    [Amount_Received]   = rcvd
    [Branch]            = $place
    [Time]              = now
    [Authorisation]     = $authcode
    [Banked]            = today
    [Invoiced]          = $invd
    [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
END FUNCTION ' ProcessEntry()


FUNCTION CheckJobNr()                     ' checks for JobNr - if not found
' local    response
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  newrec = 0
  orderdate = today
  custname = ""
  invtot = 0
  orderdate = today
  screen clear box 1 1 sch scw 0 0 no-border
  while true
    x = fentrybox(" Enter Job Nr or {Esc} to exit ",6,shopmask,"")
    if x = -1
      return (-1)
    elseif x = 0
      exit while
    end if
  end while
  jobnr = ptstr

  vloadif(dpath|"ordstat4.vw")
  order change key "[Job_Nr]"
  progress(fgp,bgp," Checking for original order ",0)
  data find "[Job_Nr]" equal jobnr options ""
  if cerror                               '   if none - then return
    messbox("ÿJob Nr not yet entered - cannot process Contra ",0,1,1)
    return (1)
  else
' is this correct
    repaint on
    repaint
    messbox(" Is this the original Order Nr? (y/n) ",1,1,1)
    if ptstr == "n"
      return (1)
    end if
    repaint off
    custcode = [Customer_Code]
    custname = [CustOrd_Name]
  end if
  progress(fgp,bgp," Checking for existing order ",0)
  data find "[Job_Nr]" equal jobnr options "gw"
  if cerror                               '   if none - then return
    messboxwait(" Job NOT yet entered ",0,0,1)
    return (1)
  else
    initbalance = round([Balance_Due],2)
    custname = [CustOrd_Name]
    deladdr1 = [Delivery_Address_1]
    return (0)
  end if
END FUNCTION ' CheckJobNr()


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


FUNCTION DateRcvd()
local m1
  while true
    m1 = " Enter Date of Transaction "
    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
      end if
      exit while
    end if
  end while
END FUNCTION ' DateRcvd()


FUNCTION TfrJobNr()
  while true
    x = fentrybox(" Job Nr to transfer"&currency(rcvd)&"to or {Esc} to exit ",6,shopmask,"")
    if x = -1
      return (-1)
    elseif x = 0
      if ptstr = ""
        continue while
      else
        tfrjob = ptstr
        exit while
      end if
    end if
    exit while
  end while
END FUNCTION  'TfrJobNr()


FUNCTION GetRefundReason()
  while true
    x = fentrybox(" Enter Reasons/comments etc ",16,"",$authcode)
    if ptstr = ""
      continue while
    end if
    if x = 0
      $authcode = ptstr
      if len($authcode) = 0
        messboxwait(" MUST enter reason/comments ",0,0,1)
        continue while
      end if
      exit while
    end if
  end while
  $authcode=$type&$authcode
END FUNCTION  ' GetRefundReason()


FUNCTION GetAuthCode()
  while true
    x = fentrybox(" Enter Reasons/comments etc ",20,"",$authcode)
    if ptstr = ""
      continue while
    end if
    if x = 0
      $authcode = ptstr
      if len($authcode) = 0
        messboxwait(" MUST enter reason/comments ",0,0,1)
        continue while
      end if
      exit while
    end if
  end while
END FUNCTION 'GetAuthCode()


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 of contra, refund etc ({Esc} exits) ",10,"","")
      if x = -1
        return (-1)
      elseif x = 0
        rcvd = value(ptstr)
        exit while
      end if
    elseif initbalance = 0
      x = fentrybox(" No Balance o/s - enter amount of contra, refund etc ({Esc} exits) ",8,"","")
      if x = -1
        return (-1)
      elseif x = 0
        rcvd = value(ptstr)
        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
          return (-1)
        elseif x = 0
          rcvd = value(ptstr)
          exit while
        end if
      end while
      exit while
    end if
  end while
END FUNCTION ' EnterCash()


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")
    screen print 7 20 fgp bgp y1
    p1 = "Amountÿ"|right("ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ"|format(str(rcvd),"2R,$"),29)
    p2 = "Dateÿÿÿ"|right("ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ"|date2(datereceipt),29)
    p3 = "Reasonÿ"|right("ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ"|$method,29)
    chkbal = initbalance-rcvd          ' message "chkbal is:"&currency(chkbal)
    p5 = "ÿCORRECT!ÿ(balanceÿWILLÿbeÿ"|currency(chkbal)|")ÿ"

    x = colpopup(8,20,15,p1&p2&p3&p5,chr(24)&chr(25)&"and {Enter} to amend/accept",1,0,15,1,0,7)
    if x = -1
      messbox(" Abandon this entry? (y/n) ",1,0,1)
      if ptstr == "y"
        return (-1)
      end if
    end if

    if ptstr ! "Amount"
'       screen shortrestore dsa
      EnterCash()

    elseif ptstr ! date2(datereceipt)
'       screen shortrestore dsa
      DateRcvd()

    elseif ptstr ! $method
      screen shortrestore dsa
      Reason()

    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
  bw = 30                              ' 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 Reason()
local $poplist m1 m2 m3 m4 m5
  screen shortrestore dsa
  m1 = "Sundryÿadj't"
  m2 = "Ret'dÿcheque"
  m3 = "Refund"
  m4 = "Credit"
  m5 = "TfrÿReceipt"
  $poplist = m1&m2&m3&m4&m5
  x = popuplist(8,7,18,$poplist,"Adjustments",1,0)
  $method = ptstr                      'message "$method is:"&str($method)
  $abbrmethod = case ptstr ("Sundryÿadj't","ADJUST") ("Ret'dÿcheque","RTDCHQ") ("Refund","REFUND")("TfrÿReceipt","TFRRCT")("Credit","CREDIT")
  if $abbrmethod = "REFUND"
    screen shortrestore dsa
    x = popuplist(14,7,18,"Cheque PDQ","Method",1,0)
    $type = case ptstr ("Cheque","CHQ") ("PDQ","PDQ")
  end if
  if $abbrmethod = "REFUND"            '("Refund","REFUND")
    if rcvd > 0
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      messboxwait(" Refunds MUST be entered as minus figures ",0,0,1)
      $method = "Refund"
      return (1)
    end if
    GetRefundReason()

  elseif $abbrmethod = "RTDCHQ"        '("Ret'dÿcheque","RTDCHQ")
    if rcvd > 0
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      messboxwait(" Returned cheques MUST be entered as minus figures ",0,0,1)
      $method = "Ret'dÿcheque"
      return (1)
    end if
    GetAuthCode()
  else                                 '("Sundryÿadj't","ADJUST")
    GetAuthCode()
  end if
END FUNCTION  'Reason()