'HOLD_FTR - specific records in FTR_PAYT file can be held/released

external  dpath Background() vloadif() fentrybox() popuplist() shopmask
external  cpath bpopdb() vunloadif()  messboxwait() navrecs() messline()
external  entryline() addidxrec() messbox()

public    ptstr jobnr dsa ftrcode ptval ftgdate

global    x Fitters() ReturnToMenu() Process() ChooseFitter() y3 y4 y5
global    $name $nickname AmendPayts() HoldPayt() Release() ChangeFitter()
global    ContraEntry() SharePayment()
'  SplitPayment()
global    j q d a r $reas


MAIN
single-step off
  Background()
  file unload all
  while true
    x = fentrybox(" Enter Job Nr ",6,shopmask,"")
    if x = -1
      exit while
    end if
    jobnr = ptstr
    Process(1)
  end while
  ReturnToMenu()
END MAIN


FUNCTION Fitters()
local ppl
  while true
    x = popuplist(10,31,13,"Active˙fitters ˙All˙Fitters˙","Select by",1,0)
    if x = 0
      ppl = ptstr
      while true
        if ppl = "Active˙fitters"
          x = ChooseFitter("v")
          if x = -1
            exit while
          else
            Process(0)
            Background()
            vloadif(dpath|"ftr_list.vws")
          end if
        else
          x = ChooseFitter("a")
          if x = -1
            exit while
          else
            Process(0)
            Background()
            vloadif(dpath|"ftr_list.vws")
          end if
        end if
      end while
    else
      return(1)
    end if
  end while
END FUNCTION ' Fitters()


FUNCTION ReturnToMenu()
  Background()
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION ChooseFitter(t)
  vloadif(dpath|"ftr_list.vws")
  if t = "v"                           'active fitters
    data query execute "actv_ftr.dfq" index "actv_ftr.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Active]="YES"
'   and
'   not (deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  else
    data query execute "not_del.dfq" index "actv_ftr.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' not (deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  end if

  order sort now dictionary "nickname" fields "[Nickname]" ascending
'   while true
  x = bpopdb("ftr_list",5,"","[Nickname]","L9","[Fitter_Name]","L0","[Fitter_Code]",5,35,21,46,"Select",0)
  if x = -1
    repaint off
    vunloadif("ftr_list.vws")
    return(-1)
  else
    ftrcode   = ptstr                'message "ptstr is:"&str(ptstr)
    $name     = [Fitter_Name]        'message "$name is:"&str($name)
    $nickname = [Nickname]
  end if
  repaint off
  screen shortrestore dsa
  vunloadif("ftr_list.vws")
  return (0)
END FUNCTION  ' ChooseFitter()


FUNCTION Process(n)                    'n=0 query by ftr; n=1 query by job
local recnr jobseq ord bl m1
'   Background()
  repaint off
'   if n = 0
' repaint on
' repaint
' single-step on
'     vloadif(dpath|"holdftr1.vw")
'     order change key "[Ftr_Code]"
'     data query execute "holdftr1.dfq" index "hf1.idx"
' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' '   [Ftr_Code]=ftrcode
' '   and
' '   [Amount]-[Paid]>.01
' '   and
' '   not (deleted)
' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
'     if cerror
'       messboxwait(" No unpaid records found for"&$nickname,0,0,1)
'       vloadif(dpath|"ftr_list.vws")
'       return (1)
'     end if
'     y5 = format("˙Job Nr   Date                 Description                  Amount    Released ","L80")
'     y3 = format("˙Fitting payments outstanding for"&$nickname|" ","M80")
'     AmendPayts()
'
'   elseif n = 1

    vloadif(dpath|"holdftr2.vw")
    order change key "[JobNr]"
    data query execute "holdftr3.dfq" index "hf1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [JobNr]=jobnr
'   and
'   [Amount]>[Paid]
'   and
'   not (deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    if cerror
      messboxwait(" No fitting records found for"&jobnr,0,0,1)
      return (1)
    end if
    y5 = format("˙Fitter   Date                 Description                  Amount    Released ","L80")
    y3 = format("˙Fitting payments outstanding for"&jobnr|" ","M80")
    AmendPayts()
'   end if
END FUNCTION ' Process()


FUNCTION AmendPayts()
local y2 ta
'   repaint on
'   repaint
'   y4 = format("˙{H}old/{R}elease payments        {Esc} to exit ","M80")
'   screen print 4 1 15 1 y3
'   screen print 5 1 15 1 y5
'   screen print 19 1 15 1 y4
  ta=currency(filesum([Amount]))       'message "ta is:"&str(ta)
  a=blank
  $reas=blank
  ptval=0
  while ptval <> {Esc}
    order change key "[JobNr]"
'   order change physical
    data query execute "holdftr3.dfq" index "hf1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [JobNr]=jobnr
'   and
'   [Amount]>[Paid]
'   and
'   not (deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messboxwait(" No fitting records found for"&jobnr,0,0,1)
    return (1)
  end if
    repaint on
    repaint
    y2 = format("Total Fitting charges are"&ta,"M80")
    y4 = format("˙{H}old - {R}elease - {C}ontra - {S}hare - Change {F}itter - {Esc} ","M80")
    screen print 2 1 15 1 y3
    screen print 4 1 15 1 y5
    screen print 3 1 15 1 y2
    screen print 22 1 15 1 y4

    ptval = navrecs()

    if ptval = {H} or ptval = {h} ' alter Released to sum already paid - mark as "H"
      HoldPayt()
      screen print 19 1 15 1 y4

    elseif ptval = {R} or ptval = {r}
      Release()
      screen print 19 1 15 1 y4

    elseif ptval = {C} or ptval = {c}
      ContraEntry()
      screen print 19 1 15 1 y4

    elseif ptval = {S} or ptval = {s}
      SharePayment()
      screen print 19 1 15 1 y4

    elseif ptval = {F} or ptval = {f}
      messboxwait(" Not yet in use ",0,0,1)
'       ChangeFitter()
      screen print 19 1 15 1 y4

    elseif ptval = {Esc}
      vunloadif("holdftr2.vw")
      vunloadif("holdftr1.vw")
      Background()
    end if
  end while
END FUNCTION ' AmendPayts()


FUNCTION HoldPayt() ' alter Released to sum already paid - mark as "H"
local #rel #hold $reas
  if [Action] = "H"
    messboxwait(" Already marked as HELD ",0,0,1)
    return (0)
  end if
  repaint off
  #hold=[Amount]-[Paid]
  x = messline(" Hold payment of unpaid amount of"&fixed(#hold,2)|"? (y/n) ",1,1,1,22,1,80)
  if ptstr == "y"
    while true
      x = popuplist(8,33,13,"Not˙finished Complaint Other","",1,0)
      if ptstr = "Other"
        x = entryline(" Enter reason for holding ",20,"","",21,1,80)
        $reas = ptstr
        exit while
'       if x = -1
'         continue while
'       elseif ptstr = ""
'         continue while
      else
        $reas = ptstr
        exit while
      end if
    end while

    lock-record
      [Action] = "H"
      [Notes]  = $reas
      [Released]=[Paid]
    write-record
  end if
END FUNCTION ' HoldPayt()


FUNCTION Release()
local #rel #hold #paid
  repaint off
  if [Action] <> "H"
    messboxwait(" Already RELEASED ",0,0,1)
    return (0)
  end if
  #hold=[Amount]-[Paid]
  x = messline(" Release payment of unpaid amount of"&fixed(#hold,2)|"? (y/n) ",1,1,1,21,1,80)
  if ptstr == "y"
    #rel=[Released]
' message "#rel is:"&str(#rel)
#paid=[Paid]
' message "#paid is:"&str(#paid)

    lock-record
      [Action]   = "N"
      [Notes]    = blank
'       [Released] = #rel+#paid
      [Released] = #hold
    write-record
    data goto record next
' data utilities recalc-all
' repaint
  end if
END FUNCTION ' Release()


FUNCTION ChangeFitter()
' choose fitter from popdb; confirm and replace; one line item at a time
  x = ChooseFitter("a")
  if x = -1
    return (-1)
  else
'     Process(0)
'     Background()
'     vloadif(dpath|"ftr_list.vws")
  end if
END FUNCTION ' ChangeFitter()


FUNCTION ContraEntry()
'enter reason and amount
  ftrcode = [Ftr_Code]
  $nickname = [Nickname]
  ftgdate = [FtdDate]          'message "ftgdate is:"&str(ftgdate)
  j       = [JobNr]
  q       = [Address]
  d       = [Desc]

'enter amount
  while true
    x = fentrybox(" Enter amount of contra (minus if deducting a shared pay't) ",8,"*8{[-1234567890.]}",a)
    if x = 0
      if ptstr = ""
        continue while
      end if
      a = value(ptstr)
      exit while
    else
      return (-1)
    end if
  end while

'   while true
'     x = fentrybox(" Enter Reservation reference ",6,"*2AU*4#","")
'     if x = -1
'       continue while
'     end if
'     $resref = ptstr
'     messbox(" Confirm Reservation reference"&$resref|"? (y/n) ",1,1,1)
'     if ptstr == "Y"
'       exit while
'     else
'       continue while
'     end if
'   end while

'reason
  while true
    x = fentrybox(" Enter reason for holding ",40,"",$reas)
    if x = -1
      return (-1)
    elseif ptstr = ""
      continue while
    else
      $reas = ptstr
      exit while
    end if
  end while
  repaint off
' ?same fitter
  messbox(" Is this contra for"&$nickname&"? (y/n) ",1,1,1)
' yn - 1 allow Yes/No;o=disallow
' col- 1 for pleasing; 0 for error
' esc- 1 do NOT allow Esc;0=allow Esc
  if ptstr == "n"
    x = ChooseFitter("a")
  end if
' message "ftrcode is:"&str(ftrcode)
' message "$nickname is:"&str($nickname)

  vloadif(dpath|"holdftr2.vw")
  messbox(" Contra for"&$nickname&"of"&currency(a)&"for"&$reas|"? (y/n) ",1,1,1)
  if ptstr == "n"
'     exit while
'   else
    return (-1)
  end if

  data enter lock
    [Ftr_Code] = ftrcode
    [Date_Ftd] = ftgdate
    [Amount]   = a
    [Released] = a
    [Action]   = "N"
    [JobNr]    = j
'     [ReqRef]   = r
'     [Notes]    = $reas
    [Address]  = q
    [Desc]     = $reas
    [Nickname] = $nickname
  write-record
END FUNCTION ' ContraEntry()


FUNCTION SharePayment()
'enter reason and amount
local #tframount ftrcode_FM $nickname_FM ftrcode_TO $nickname_TO

while true
  ftrcode_FM = [Ftr_Code]
  $nickname_FM  = [Nickname]
  ftgdate = [FtdDate]                 'message "ftgdate is:"&str(ftgdate)

  j       = [JobNr]
  q       = [Address]
  d       = [Desc]

  x=messbox(" Is this payment being shared by"&$nickname_FM|"? (y/n) ",1,1,0)
  if x=-1
    repaint off
' repaint
' single-step on
    exit while
  else
    if ptstr == "n"
      data goto record next
      continue while
    end if
  end if

'enter amount
  while true
    x = fentrybox(" Enter amount to be transferred ",8,"*8{[-1234567890.]}",#tframount)
    if x = 0
      if ptstr = ""
        continue while
      end if
      #tframount = value(ptstr)
      exit while
    else
      return (-1)
    end if
  end while

'       $reas = ptstr
  repaint off
  messboxwait(" Now choose the Fitter this payment is going to ",0,0,1)
  x = ChooseFitter("a")
  ftrcode_TO = ftrcode
  $nickname_TO = $nickname

' message "ftrcode TO is:"&str(ftrcode_TO)
' message "$nickname TO is:"&str($nickname_TO)

  vloadif(dpath|"holdftr2.vw")
  messbox(" Share payment of"&currency(#tframount)&"with"&$nickname_TO|"? (y/n) ",1,1,1)
  if ptstr == "n"
'     exit while
'   else
    return (-1)
  end if

  data enter lock
    [Ftr_Code] = ftrcode_FM
    [Date_Ftd] = ftgdate
    [Amount]   = -#tframount
    [Released] = -#tframount
    [Action]   = "N"
    [JobNr]    = j
'     [ReqRef]   = r
'     [Notes]    = $reas
    [Address]  = q
'     [Desc]     = $reas
    [Desc]     = "Shared with"&$nickname_TO
    [Nickname] = $nickname_FM
  write-record
  data enter lock
    [Ftr_Code] = ftrcode_TO
    [Date_Ftd] = ftgdate
    [Amount]   = #tframount
    [Released] = #tframount
    [Action]   = "N"
    [JobNr]    = j
'     [ReqRef]   = r
'     [Notes]    = $reas
    [Address]  = q
    [Desc]     = "Shared with"&$nickname_FM
    [Nickname] = $nickname_TO
  write-record
  exit while
end while
END FUNCTION 'SharePayment()