'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()

public    ptstr jobnr dsa ftrcode ptval

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


MAIN
single-step off
  Background()
  file unload all

'choose fitter/job
  while true
    x = popuplist(10,33,13,"Fitter Job˙Nr","",1,0)
    if x = -1
      exit while
    end if
    if ptstr = "Fitter"
      Fitters()
    else
      while true
        x = fentrybox(" Enter Job Nr ",6,shopmask,"")
        if x = -1
          exit while
        end if
        jobnr = ptstr
        Process(1)
'         exit while
      end while
    end if
  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]
    Process(0)
    Background()
    vloadif(dpath|"ftr_list.vws")
  end if
'   end while
  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)
  ptval=0
  while ptval <> {Esc}
  repaint on
  repaint
  y2 = format("Total Fitting charges are"&ta,"M80")
  y4 = format("˙{H}old - {R}elease - {C}ontra - {S}plit - 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}
      SplitPayment()
      screen print 19 1 15 1 y4

    elseif ptval = {F} or ptval = {f}
      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
  #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
  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,19,1,80)
  if ptstr == "y"
    lock-record
      [Action]   = "N"
      [Notes]    = blank
      [Released] = [Released]+[Paid]
    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 - enter as negative amount and release for payment
  ftrcode = [Ftr_Code]
  $nickname = [Nickname]
  ftgdate = [FtdDate]
  j       = [JobNr]
  q       = [Address]
  d       = [Desc]

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

'reason
    while true
      x = entryline(" Enter reason for holding ",20,"","",19,1,80)
      if x = -1
        continue while
      elseif ptstr = ""
        continue while
      else
        $reas = ptstr
        exit while
      end if
    end while

'   vloadif(dpath|"ftr_payt.vws")
  data enter lock
    [Ftr_Code] = ftrcode
    [Date_Ftd] = ftgdate
    [Amount]   = -a
    [Released] = -a
    [Action]   = "N"
    [JobNr]    = j
'     [ReqRef]   = r
    [Notes]    = $reas
    [Address]  = q
    [Desc] = d
  write-record
END FUNCTION ' ContraEntry()


FUNCTION SplitPayment() ' only use where part is to be Held and the remainder released
local wh whe new_amount
' enter amount to be withheld - cannot be more than [Amount]-[Paid]
  wh = [Amount]-[Paid]                  'message "wh is:"&str(wh)
  repaint off
  while true
    x = fentrybox(" Enter amount to withhold ",8,"*8{[-1234567890.]}",wh)
    if x = 0
      if ptstr = ""
        continue while
      end if
      whe = value(ptstr)
        if whe > wh ' ([Amount]-[Paid])
          messboxwait(" Cannot withhold more than"&currency(wh),0,0,1)
          continue while
        end if
      exit while
    end if
  end while

' create new record in FTR_PAYT and copy all details from original; mark as Held
  x = ChooseFitter("a")                   'message "x is:"&str(x)
  if x = -1
    return (-1)
'   else
  end if

'   vloadif(dpath|"ftr_payt.vws")
  vloadif(dpath|"holdftr2.vw")

  ftgdate=[Date_Ftd]
  j=[JobNr]
  $reas=[Notes]
  q=[Address]
  d=[Desc]

' message "ftrcode is:"&str(ftrcode)
' message "$nickname is:"&str($nickname)
' message "d is:"&str(d)
' message "q is:"&str(q)
' message "j is:"&str(j)
' message "$reas is:"&str($reas)
' message "ftgdate is:"&str(ftgdate)
' message "whe is:"&str(whe)

' reduce original and mark as Released
  new_amount = [Amount]-whe
  lock-record
    [Amount]=new_amount
    [Released]=new_amount
  write-record

  data enter lock
    [Ftr_Code] = ftrcode
    [Nickname] = $nickname
    [Date_Ftd] = ftgdate
    [Amount]   = whe
    [Released] = whe
    [Action]   = "N"
    [JobNr]    = j
'     [ReqRef]   = r
    [Notes]    = $reas
    [Address]  = q
    [Desc]     = d
'     [Paid]     =
'     [Date_Paid]=
  write-record
  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

'   x = addidxrec("hf1.idx",str(precord),7)
' message "x is:"&str(x)
'   order change index "hf1.idx"
END FUNCTION ' SplitPayment()