'FITTER01 - used for entering, updating, printing Fitter's details

external   cpath dpath navrecs() vloadif() messbox() fentrybox() pagerec()
external   vunloadif() sch scw $menu PrintReport() messboxwait() progress()
external   fgp bgp

public     ptval ptstr $ftrcode

global     ftrname #prec viewrec() updaterec() printrecs() addrec() x $name1
global     ReturnToMenu() $name2 $nick activate()

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

  vloadif(dpath|"ftrsel2.vw")
  order change key "[Fitter_Name]"
  repaint on
  repaint

  ptval=0
  while true
    ptval = navrecs()
    if ptval = {Enter}
      viewrec()

    elseif ptval = {A} or ptval = {a}
      addrec()

    elseif ptval = {C} or ptval = {c}
      activate()

    elseif ptval = {U} or ptval = {u}
      updaterec()

    elseif ptval = {P} or ptval = {p}
      messboxwait(" Printing not available at present ",0,0,1)
'       printrecs()

    elseif ptval = {Esc}
      exit while
    end if
  end while

  ReturnToMenu()

END MAIN


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


FUNCTION addrec()
local nr ln
  repaint off
  vloadif(dpath|"ftrview1.vw")
  while true
    while true
      x = fentrybox(" Enter Surname or Company name ",30,"","")
      if x = -1
        return (-1)
      end if
      if ptstr = ""
        continue while
      end if
      $name1 = ptstr
      exit while
    end while

    nr = 0
    while true
      nr=nr+1
      $ftrcode = upper(left($name1,3))|right("000"|str(nr),3) ' create Fitter Code & check unique
      data goto record first
      data find "[Fitter_Code]" equal $ftrcode options ""
      if cerror
        exit while
      end if
    end while

    while true
      ln = 30 - len($name1)
      x = fentrybox(" Enter Christian name (if any) ",ln,"","")
      if x = -1
        return (-1)
      end if
      if ptstr = ""
        continue while
      end if
      $name2 = ptstr
      exit while
    end while

    $name2 = $name2&$name1
    messbox(" Confirm name"&$name2|"? (y/n) ",1,1,1)
    if ptstr == "Y"
      exit while
    else
      continue while
    end if
  end while

  while true
    x = fentrybox(" Enter Nickname/Christian name ",8,"","")
    if x = -1
      return (-1)
    end if
    if ptstr = ""
      continue while
    end if
    $nick = ptstr
    exit while
  end while

  data enter lock
    [Fitter_Code] = $ftrcode
    [Fitter_Name] = $name2
    [Nickname]    = $nick
  write-record

  lock-record
    reply on nothing to 3015
    repaint on
    data update only-one
    repaint off
  write-record
  data goto view "ftrsel2.vw"
  repaint on
  repaint
END FUNCTION


FUNCTION viewrec()
  #prec = precord
  vloadif(dpath|"ftrview.vw")
  data goto record record-number #prec
  repaint on
  pagerec(1,0)
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  data goto view "ftrsel2.vw"
  data goto record record-number #prec
  repaint on
  repaint
END FUNCTION


FUNCTION printrecs()
  vloadif(dpath|"ftrview.vw")
  progress(fgp,bgp,"Printing brief details of all Fitters",0)
  PrintReport("ftrpart.dfr","",1,2,1,1)
  data goto view "ftrsel2.vw"
  repaint on
  repaint
END FUNCTION


FUNCTION activate()
  if [Active] = "YES"
    lock-record
      [Active] = "NO"
    write-record
  else
    lock-record
      [Active] = "YES"
    write-record
  end if
  data goto record next
END FUNCTION 'activate()


FUNCTION updaterec()
  #prec = precord
  vloadif(dpath|"ftrview2.vw")
  data goto record record-number #prec
  lock-record
    reply on nothing to 3015
    repaint on
    data update only-one
    repaint off
  write-record
  data goto view "ftrsel2.vw"
  repaint on
  repaint
END FUNCTION