'MAKE_EST - makes blank appointments for estimators - Sundays are marked by
'           a calculated field in EST_APPT.db
'           This has been setup to have a minimum of 4weeks in advance and
'           one week in arrears. Bank holidays are entered by looking-up
'	    Date in "BANKHOLS.VWS" when date is generated
' 21/02/94 - creates 7 appts/day
' 23/03/94 - creates mini date file for use when browsing different dates
'            in ALT_APPT.PF3
'  150917A
' Reference date added; Appts2Date added to FTR_LIST.VWS
' 31/10/02 - copied from MAKEAPPT.PF3

external   bpopdb() fentrybox() vloadif() dpath vunloadif() remove() sch scw
external   chkdate() messbox() navrecs() progress() fgp bgp tone() strcount()
external   progtag() chkstr() delstr() makeidx() addidxrec() messboxwait()
external   fgs bgs fgi bgi delidxrec() userid arytostr() cpath popuplist()
external   getidxrecs() to_busdate() Background()

public     ptstr ptval ptary[1] dsa estname estrcode firstdate lastdate appts2
public     indate daysfirstdate $date1 bankholdate dayslastdate

global     EndNextMonth() CreateAppts() MenuList()
'  PrepareAppt()
'  CreateMini()
global     x z y CurrentLastDay() ReadFittersAndDates() nrestimators $appts
global     estimator[1,2] BankHols() ChooseEstimators() ReturnToMenu() $newdate
global     UpdateList() SelectFitter() ArchiveOld() NewAppts() $available
global     CheckBankHols() DeleteAppts() Titles() idxname CreateRecord()

global     dfname fnum sview iview sprec sel_str scount pline pline_scr
global     Scr_Setup() startdate enddate Scr_Select() add_item() del_item()
global     Scr_Exit() abort() deladdr1 $instruct delpostcode Holiday()
global     nextdate monthend span deljobnr jobnr viewdate maxslots slotsrem
global     updaterec() addrec() #holdate holdes ReferenceDate() $dowavail
global     $nextbnkhol $daynr $dfa nickname #rec $keepdays


MAIN
single-step off
  file unload all
'   quiet off

  $keepdays = 60                          'nr of days to keep before Archiving

' message "Change back to ENT_APPT.OLD before using at WHSE"
  clear estimator[]

  MenuList()                             ' Choose create/blank etc

  ReturnToMenu()

END MAIN


FUNCTION Scr_Select()
local    k y1 m2 m1 m3 m4
  scount = 0
  sel_str = NULL
  repaint on
  repaint
  while TRUE
    screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE    ","M40"))
    k = navrecs()
    sprec = precord
    if k = {Esc}
      Background()
      return (-1)

    elseif k = {Enter}
      #rec = record
      x = chkstr(str(precord),sel_str)
      if x = 0
        beep
      else
        sel_str = sel_str&str(precord)
        scount = scount+1
        add_item(precord)
      end if
      if #rec = records
        data goto record first
      end if
      if records > 1
        data goto record next
      end if

    elseif k = {D} or k = {d}
      del_item()

    elseif k = {A} or k = {a}
      repaint off
'       Background()
      vunloadif("estr_sel.vw")
      data query execute "all_ftrs.dfq" index "est_sel.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ record <= records                                                  ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      vunloadif("estr_avl.vw")
      data goto window 1
      vloadif(dpath|"estr_sel.vw")
      order change index "est_sel.idx"
      return (1)

    elseif k = {F10}
      if len(sel_str)=0
        messboxwait(" No estimators were selected - retry ",0,0,1)
        continue while
      end if
      return (2)

    else
      beep
    end if

  end while
  repaint off
END FUNCTION  'Scr_Select()


FUNCTION CreateRecord()
local    bpop_ret nrwords codename nrcode
  vloadif(dpath|"estlist2.vw")           ' show list of estimators
  while true			
    x = fentrybox(" Enter Estimator's full name (e.g. Mark Smith) ",35,"","")
    if ptstr = ""
      continue while
    else
      estname = ptstr
      exit while
    end if
  end while

  while true			
    x = fentrybox(" Enter Estimator's nickname (e.g. Andy) ",8,"","")
    if ptstr = ""
      continue while
    else
      nickname = ptstr
      exit while
    end if
  end while

' create code for estimator   - 6 chars
' find last name
  nrcode = 1
  strcount(estname)
  nrwords = ptval

' check unique code
  while true
    estrcode = upper(left(group(estname,nrwords),3))|"00"|str(nrcode)
    data find "[Estimr_Code]" equal estrcode options ""
    if cerror                               '   if none - then return
      exit while
    end if
    nrcode = nrcode + 1
  end while

  data enter lock
    [Estimr_Code] = estrcode
    [Estimr_Name] = estname
    [Nickname]    = nickname
  write-record

  lock-record
    repaint on
    repaint
    data update only-one
  write-record
  screen clear box 1 1 sch scw 0 0 no-border
END FUNCTION 'CreateRecord()


FUNCTION MenuList()
local l1 l2 l3 l4 l5 l6 l7
  CurrentLastDay()			' find latest date in MINIDATE.VWS
' appts2
  while true
    Background()
    l2 = "ÿÿÿÿÿActive/Inactiveÿlist"
    l3 = "ÿÿÿÿCreateÿNewÿAppointmentsÿÿÿÿ"
    l4 = "ÿÿÿÿUpdateÿEstimators'ÿrecords"
    l5 = "ÿÿÿÿCreateÿEstimator'sÿrecord"
    l6 = "ÿÿÿUpdateÿBankÿHolidayÿList"
    l7 = "ÿÿÿÿÿÿÿÿÿRunÿPrepAppt"
    x = popuplist(8,25,15,l3&l4&l5&l2&l6&l7," Appointments created to"&date2(appts2)|" ",1,0)
    if x = 0
      if ptstr = l2
        execute "fitter01.rf3" in-memory

      elseif ptstr = l6
        Holiday()

      elseif ptstr = l4
        UpdateList()

      elseif ptstr = l5
        CreateRecord()

      elseif ptstr = l3
        x=NewAppts()
        if x = 1
          continue while
        elseif x = 0
          messbox(" Run PREP_EST now? (y/n)",1,0,1)
          if ptstr == "y"
            execute "PREP_EST.RF3" in-memory
          end if
        end if
      elseif ptstr = l7
        messboxwait(" Ensure that no-one is using the diary or will use until notified ",0,0,1)
        messbox(" Run PREP_EST now? (y/n)",1,0,1)
        if ptstr == "y"
          execute "PREP_EST.RF3" in-memory
        end if
      end if

    elseif x = -1
      return (0)
    end if
  end while
END FUNCTION  'MenuList()


FUNCTION  NewAppts()
local rfd
  x = ChooseEstimators()
' message "nrestimators is:"&str(nrestimators)
' message "x is:"&str(x)
  if x = -1
    vunloadif(iview)
    vunloadif(sview)
    while true
      error off
      window close
      if cerror
        exit while
      end if
    end while
    return (1)
  elseif x = 0
    vunloadif(iview)
    vunloadif(sview)
    while true
      error off
      window close
      if cerror
        exit while
      end if
    end while
    return (1)
  end if
' message "nrestimators is:"&str(nrestimators)
  lastdate = EndNextMonth(lastdate)' Ask for new finishing date - suggest one month ahead of existing last date
  CheckBankHols()

  rfd = ReadFittersAndDates()            ' Make array of Fitter Codes
' message "rfd is:"&str(rfd)
  if rfd = -1
    return (1)
  end if
'   if nrestimators > 1
'     ReferenceDate()
'   end if
  CreateAppts()                    ' Make new appts
'   CreateMini()                     ' Make minidate file
  ArchiveOld()			 ' archive all non-blank records
  messboxwait(" New EST_DATE file needed - DO NOT RUN PREP_EST UNLESS OFFLINE",0,0,1)
  return (0)
END FUNCTION  'NewAppts()


FUNCTION CheckBankHols()
local monthlist
while true
  vloadif(dpath|"bankhols.vws")
  if days(filemax([Dates])) < days(lastdate)
    x = messbox(" Update Bank Holiday list - last entry is"&date2(filemax([Dates])),0,0,1)
    return (0)
  end if
  exit while
end while
END FUNCTION 'CheckBankHols()


FUNCTION CreateAppts()
local #appts estimatorcode s_row s_col d f datecode daytitle nextdatename
  vloadif(dpath|"createst.vw")
  order change key "[Date_Code]"
  daysfirstdate = days(today)          'message "date2(lastdate) is:"&str(date2(lastdate))
  dayslastdate = days(lastdate)        'message "dayslastdate is:"&str(dayslastdate)
  span = (dayslastdate-days(today))    'message "span is:"&str(span)
  for d = 0 to span                    'for each day
    progress(fgp,bgp," Creating appointments for"&date2(days(today) + d)|" ",0)
    for f = 1 to nrestimators              ' for each estimator
      estimatorcode = estimator[f,1]   'message "estimatorcode) is:"&str(estimatorcode)
      $available = estimator[f,2]      'message "$available is:"&str($available)
      datecode = str(date2(daysfirstdate + d)&estimatorcode) 'message "datecode is:"&str(datecode)
      data find "[Date_Code]" equal datecode options "g"
      if cerror
' message "Cannot find"&datecode&"-creating new appt"
' message "d is:"&str(d)
' date2(days(firstdate) + d) '
' message "date2(daysfirstdate) is:"&str(date2(daysfirstdate))
        nextdate = date2(daysfirstdate + d) 'message "nextdate is:"&str(nextdate)
        nextdatename = dayname(nextdate)    'message "nextdatename is:"&str(nextdatename)
        $dowavail=case nextdatename ("Monday",1)("Tuesday",2)("Wednesday",3)("Thursday",4)("Friday",5)("Saturday",6)("Sunday",7) 'message "$dowavail is:"&str($dowavail)
' message "$available is:"&str($available)
        x = chkstr(str($dowavail),$available)
' message "316/ x is:"&str(x)
        if x = 0
        else
          continue for
        end if
        vloadif(dpath|"bankhols.vws")
        data find "[Dates]" equal nextdate options "g"
        if cerror		' if not found in BANKHOLS file
          if dayname(nextdate) == "Sunday"
            daytitle = "SUNDAY"
          else
            daytitle = "None"
          end if
        else
          daytitle = "BNKHOL"
        end if
        vloadif(dpath|"createst.vw")
        for #appts = 1 to 7            'message "estimatorcode is:"&str(estimatorcode)
' message " for each appt continue creating"
          $newdate = date2(daysfirstdate + d) 'message "$newdate is:"&str($newdate)
          $daynr = str(days($newdate))        'message "$daynr is:"&str($daynr)
          $dfa = $daynr|estimatorcode|str(#appts)'message "$dfa is:"&str($dfa)
' message "daytitle is:"&str(daytitle)
' message "datecode is:"&str(datecode)
' message "#appts is:"&str(#appts)
          data enter lock
            [Estimr_Code] = estimatorcode
            [Date]        = $newdate
            [Day_Nr]      = $daynr
            [DFA]         = $dfa
            [Job_Nr]      = daytitle
            [Date_Code]   = datecode
            [Appointment_Order] = str(#appts)
          write-record
        end for
      else
' message "Found"&datecode&"- NOT creating new appt"
        continue for
      end if
    end for
  end for
END FUNCTION  ' CreateAppts()


FUNCTION CurrentLastDay()
  Background()
  vloadif(dpath|"est_appt.vws")          '
  if precords = 0
    messbox(" No appointments yet created ",0,0,1)
  else
    order change key "[Date]"
    data goto record last
    lastdate = [Date]                     ' find latest date in existing file
    appts2   = [Date]                     ' find latest date in existing file
  end if
  vunloadif("est_appt.vws")          '
END FUNCTION ' CurrentLastDay()


FUNCTION EndNextMonth(newdate)           ' calculates to the Saturday at least 4 wks
' this ignores Leap Years!!
local    offset maxdays newmonth indate weekday
' calculate 28 days ahead & find DOW
  offset = 28                            ' ie 1 month - 59 for two months
  monthend = days(today) + offset
  weekday = dayname(monthend)

  offset = case weekday("Sunday",6)("Monday",5)("Tuesday",4)("Wednesday",3) \
                 ("Thursday",2)("Friday",1)("Saturday",0)
  monthend = date2(monthend + offset)

'   if days(lastdate) > days(monthend)
'     messbox(" All necessary appointments already created ",0,0,1)
'     return (0)
'   end if

  while TRUE
    if fentrybox(" Appointments go to"&date2(lastdate)&"- create up to?",10,"##\/##\/####",monthend) = 0
      indate = ptstr
      if chkdate(indate,1) < 0
        beep
        messbox(indate&"is a bad date! Enter again (y/n) ?",1,0,1)
        if ptstr == "n"
          indate = NULL
          exit while
        end if
      else
        exit while
      end if
'     else
'       indate = NULL
'       exit while
    end if
  end while
  return (indate)
END FUNCTION  ' EndNextMonth(newdate)           ' use "offset" to change how many months ahead


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


FUNCTION BankHols()
local #counter
  while true
    #counter = 1
      Background()
    bankholdate = ""
    while TRUE
      screen clear box 1 1 sch scw 0 0 no-border
      if fentrybox(" Enter a date (dd/mm/yyyy): ",10,"##\/##\/####",bankholdate) = 0
        bankholdate = ptstr
          if chkdate(bankholdate,1) < 0
            beep
            messbox(bankholdate&"is a bad date! Enter again (y/n) ?",1,0,1)
            if ptstr == "n"
              bankholdate = NULL
              exit while
            end if
          else
            exit while
          end if
      else
        bankholdate = NULL
        exit while
      end if
      progress(fgp,bgp," Altering appointments ",0)
    end while
    exit while
  end while

  vloadif(dpath|"createst.vw")              ' goto appt_tmp
  order change physical
  repaint off
  order change key "[Date]"
  data query execute "dates.dfq" index "dates.idx"  ' query day selected
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Date] = days(bankholdate)                                         ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messbox(" Date not found ",0,0,1)
    exit function
  end if
  progress(fgp,bgp," Altering appointments ",0)
  data goto record first
  for #counter = 1 to records
    if [Job_Nr] == "None"              ' if a Job_Nr is not yet allocated
      [Job_Nr] = "BNKHOL"              ' mark all appts as "BnkHol"
    elseif [Job_Nr] = blank            ' if a Job_Nr is not yet allocated
      [Job_Nr] = "BNKHOL"              ' mark all appts as "BnkHol"
    end if
    data goto record next
  end for
  order change physical
END FUNCTION


FUNCTION UpdateList()
local    bpop_ret
  vloadif(dpath|"estlist1.vw")           ' show list of estimators
  bpop_ret = bpopdb("estlist1",6,"","[Estimr_Name]","L40","[Estimr_Code]","L0","[Estimr_Code]",10,25,15,55,"Select",1)
  repaint on
  repaint
  ptval=0
  while ptval <> {Esc}
    ptval = navrecs()
    if ptval = {Enter}
      data update only-one
    elseif ptval = {Esc}
      messbox(" Finished? (y/n) ",1,1,1)
      if ptstr ! "y"
        exit while
      end if
    end if
  end while
  screen clear box 1 1 sch scw 0 0 no-border
END FUNCTION ' UpdateList()


FUNCTION ChooseEstimators()                'L149
  while true
    repaint off
    iview = "estr_avl.vw"
    vloadif(dpath|iview)
    order change physical
    remove("est_sel.idx")
    data query execute "act_ftrs.dfq" index "act_ests.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [Active] = "YES"                                        ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      messboxwait(" No estimators have been marked as `ACTIVE' ",0,0,1)
      return (-1)
    end if
    order sort now dictionary "estname.idx" fields "[Estimr_Name]" ascending
    if Scr_Setup() = 0
      x = Scr_Select()
      if x = 1			' ALL estimators selected
        y = "ALL available"
        repaint off
      elseif x = 2		' some estimators selected
        y = "selected"
        repaint off
      elseif x = 0                ' NO estimators selected
        return (0)
      elseif x = -1
        return (-1)
      end if
      Scr_Exit(0)
    else
      abort()
      Scr_Exit(-1)
    end if
    vloadif(dpath|"estr_sel.vw")
    messbox(" Create appointments for"&y&"estimators? (y/n) ",1,1,1)
    if ptstr == "y"
      nrestimators = records                  'message "nrestimators is:"&str(nrestimators)
      exit while
    end if
  end while
  return (1)
END FUNCTION ' ChooseEstimators()


FUNCTION Add_item(p)
local    crec
  repaint off
  screen print pline-1 1 fgi bgi format "L"|str(scw) (format("    ADD   ","M40"))
  data goto window next
  crec = record
  order change physical
  x=addidxrec("est_sel",p,1)
' message "x is:"&str(x)
' if x=-1
' message "addidxrec wrong"
' end if
  repaint on
  order change index "est_sel.idx"
  screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE    ","M40"))
  data goto window next
  screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE    ","M40"))
END FUNCTION   'add_item()


FUNCTION Del_item()
local    crec k cpos y
  repaint off
  data goto window next
  repaint
  screen shortrestore pline_scr
  while TRUE
    repaint on
    screen print pline-1 1 fgi bgi format "L"|str(scw) (format("    ACTIVE   ","M40"))
    k = navrecs()
    sprec = precord
    crec = record
    if k = {Esc}
      exit while
    elseif k = {D} or k = {d}
      repaint off
      order change physical
      delidxrec("est_sel",crec,1)
      scount = scount-1
      repaint on
      order change index "est_sel"
      x = chkstr(str(sprec),sel_str)
      if x = 0
        y = delstr(str(sprec),sel_str)
        if y = 0
          sel_str = ptstr
        end if
      end if
      if records = 0
        exit while
      end if
    else
      beep
    end if
  end while
  repaint on
  screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE   ","M40"))
  data goto window next
  screen shortrestore pline_scr
END FUNCTION   'del_item()


FUNCTION Scr_Setup()
local    c f x
  smartpeek $_l1 pline
  screen save pline 1 pline scw pline_scr
  repaint off
  error off
  clearerror
  while cerror = 0
    window close
  end while
  clearerror
  idxname = "est_sel.idx"
  dfname= "est_list"
  fnum=6
  sview = "estr_sel.vw"
  iview = "estr_avl.vw"
  screen clear box pline 1 pline scw 0 0 no-border
  remove(idxname)
  makeidx(dfname,idxname,0,fnum)
  vloadif(dpath|sview)
  order change index "est_sel"
  window split vertical 40
  data goto window next
  vloadif(dpath|iview)          ' release .02
  return (case lerror (0,0) else -1)
END FUNCTION  'scr_setup()


FUNCTION Scr_Exit(e)
  window close
  error on
END FUNCTION


FUNCTION Abort()
  beep
  screen print pline 2 fgs bgs " Sorry... not able to initialize! Press any key to end "
  inchar
END FUNCTION


FUNCTION SelectFitter()
local    bpop_ret
  screen shortrestore dsa
  vloadif(dpath|"estlist1.vw")
  bpop_ret = bpopdb("estlist1",6,"","[NickName]","L17","[Estimr_Code]","L0","[Estimr_Code]",7,61,15,80,"",0)
  if bpop_ret = -1
    return (-1)
  end if
  estrcode = ptstr
  estname = [Nickname]
  repaint off
END FUNCTION '  SelectFitter()


FUNCTION DeleteAppts()
' vloadif(dpath|"list_est.vw") & order by index before calling this function
local    slotsavail daysshown lastact
  repaint off
  daysshown = 20
  lastact = ""
  while true
    Titles()
    ptval=0
    while ptval <> {Esc}
      ptval = navrecs()
      if ptval = {R} or ptval = {r}
        data goto record next
        if [Job_Nr] == "None"
          continue while
        end if
        deljobnr = [Job_Nr]
        messbox(" Delete appointment for"&deljobnr&"on"&viewdate|"? (y/n)",1,0,1)
        if ptstr == "n"
          continue while
        end if
        if dayname([Date]) == "SUNDAY"
          lock-record
            [Job_Nr] = "SUNDAY"
            [DelAddr&Code] = ""
            [Entered_By] = userid
            [Date_Altered] = today
            [Time] = now
            [N_name] = ""
          write-record
        else
          lock-record
            [Job_Nr] = "None"
            [DelAddr&Code] = ""
            [Entered_By] = userid
            [Date_Altered] = today
            [Time] = now
            [N_name] = ""
          write-record
        end if
        repaint off
        vloadif(dpath|"cust_ord.vws")
        order change key "[Job_Nr]"
        data find "[Job_Nr]" equal deljobnr options ""
        lock-record
          [Slots_Rem] = [Slots_Rem] + 1
        write-record
        maxslots = [Appt_Slots]
        slotsrem = [Slots_Rem]
        deladdr1 = [Delivery_Address_1]
        delpostcode = [Del_Postcode]
        $instruct = [Instructions]
        vloadif(dpath|"list_est.vw")
        if slotsrem > 1
          z = (str(slotsrem)&"more appointments")
        else
          z = case slotsrem(1,"One more appointment")(0,"No more appointments")
        end if

        Titles()
        screen print 17 5 bgs fgs (format(z&"needed for"&deljobnr&"@"&deladdr1&delpostcode,"M70"))
        screen print 18 5 15 12 (format(left($instruct,70),"M70"))
      elseif ptval = {E} or ptval = {e}
        if [Job_Nr] == "None"	  	'check that APPNTMNT record is available
          continue while
        end if

        deljobnr = [Job_Nr]
        messbox(" Delete appointment for"&deljobnr&"on"&viewdate|"? (y/n)",1,0,1)
        if ptstr == "n"		      	' confirm deletion?
          continue while
        end if
        if dayname([Date]) == "SUNDAY"
          lock-record
            [Job_Nr] = "SUNDAY"
            [DelAddr&Code] = ""
            [Entered_By] = userid
            [Date_Altered] = today
            [Time] = now
            [N_name] = ""
          write-record
        else
          lock-record
            [Job_Nr] = "None"
            [DelAddr&Code] = ""
            [Entered_By] = userid
            [Date_Altered] = today
            [Time] = now
            [N_name] = ""
          write-record
        end if

        repaint off
        vloadif(dpath|"cust_ord.vws")
        order change key "[Job_Nr]"
        data find "[Job_Nr]" equal deljobnr options ""
        lock-record
          [Slots_Rem] = [Slots_Rem] + 1
        write-record
        maxslots = [Appt_Slots]
        slotsrem = [Slots_Rem]
        deladdr1 = [Delivery_Address_1]
        delpostcode = [Del_Postcode]
        $instruct = [Instructions]
        vloadif(dpath|"list_est.vw")
        if slotsrem > 1
          z = (str(slotsrem)&"more appointments")
        else
          z = case slotsrem(1,"One more appointment")(0,"No more appointments")
        end if

        Titles()
        screen print 17 5 bgs fgs (format(z&"needed for"&deljobnr&"@"&deladdr1&delpostcode,"M70"))
        screen print 18 5 15 12 (format(left($instruct,70),"M70"))

      elseif ptval = {D} or ptval = {d}
        repaint off
        vloadif(dpath|"minidate.vws")
        data find "[Ftg_Date]" equal date2(viewdate) options ""
        x = bpopdb("minidate",8,"","[Ftg_date]","D2","[Ftg_Date]","L0","[Ftg_Date]",7,9,15,19,"",0)
        if x = 0
          viewdate = date2(ptstr)
        elseif x = -1
          vloadif(dpath|"list_est.vw")
          continue while
        end if
        repaint off
        exit function
      end if
    end while				' end of NAVREC() loop

    repaint off

  ' check that all appt slots for estimator for chosen day have been deleted
    if slotsrem = maxslots	' remove Fitting_Date from CUST_ORD & REQUSN
      screen clear box 17 1 18 scw 0 0 no-border
      vloadif(dpath|"cust_ord.vws")
      order change key "[Job_Nr]"
      data find "[Job_Nr]" equal deljobnr options ""
      lock-record
        [Fitting_Date] = blank	' remove Fitting_Date from CUST_ORD
      write-record

'  remove viewdate as Expect_Fitting_Date in REQUSN's ************************
      vloadif(dpath|"REQUSN.vws")           ' load requsn file
      repaint off
      order change physical
      order change key "[Job_Nr]"
      data query execute "delapreq.dfq"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Job_Nr] = deljobnr replace [Expect_Fitting_Date] = blank          ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      return (-1)
    else
      messbox(" Not all appointments have been allocated for"&deljobnr|" ",0,0,1)
      continue while
    end if
  end while
END FUNCTION ' DeleteAppts()


FUNCTION Titles()
  repaint on
  repaint
  screen print 6 20 bgs fgs (format("Fittings for"&estname,"M41"))
  screen print 7 20 bgs fgs (format("On"&dayname(viewdate)|","&date3(viewdate),"M41"))
  screen print 15 20 bgs fgs (format("{E}rase ({R}epeat erase) appointments","M41"))
  screen print 16 20 bgs fgs (format("Change {D}ate - {Esc} exits","M41"))
END FUNCTION ' Titles()


' FUNCTION PrepareAppt()
' local    changeest $span i
'   repaint off
'   z = ""
'   deljobnr = ""
'   changeest = "n"
'
'   while true
'     vloadif(dpath|"est_list.vws")      'message "estname) is:"&str(estname)
'     estrcode = filelookup([Nickname],[Estimr_Code],estname)
'
'     vloadif(dpath|"list_est.vw")
'     order change physical
'
'     smartpeek $_lastkey z              ' see if the loop started from {F}
'     if changeest == "n"                ' = estimators in bpopdb()
'       startdate = viewdate
'       enddate = date2(date(startdate)+1)
'
'       data find "[Date]" equal startdate options ""
'       if cerror
'         messbox(" Appointments not yet created for this date ",0,0,1)
'         return (-2)
'       end if
'       x = precord
'
'       data find "[Date]" equal enddate options ""
'       y = precord
'
'       $span = y - x
'
'       redimension ptary[$span]
'       for i = 1 to $span
'         ptary[i] = x 'str(precord)
'         x = x + 1
'       end for
'
'       x = arytostr($span)
'       if x = 0
'         $appts = ptstr
'       end if
'
'       remove("day_ftrs.idx")
'
'       makeidx("appntmnt","day_ftrs.idx",$appts,1)
'       repaint off
'     end if
'     order change index "day_ftrs.idx"
' '     data query execute "list_ftr.dfq" index "findappt.idx"
' repaint on
' repaint
' single-step on
'     data query execute "list_est.dfq" index "findappt.idx"
' ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ' ³   [Estimr_Code] = estrcode                                          ³
' ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'     if cerror
'       message "Bad query"
'     end if
'     x = DeleteAppts()
'     if x = -1
'       vunloadif("list_est.vw")
'       vunloadif("est_list.vws")
'       exit function
'     end if
'   end while
' END FUNCTION 'PrepareAppt()


FUNCTION Holiday()
  vloadif(dpath|"bnkhols1.vw")
  data goto record last
  repaint on
  repaint

  ptval=0
  while ptval <> {Esc}
    ptval = navrecs()
    if ptval = {A} or ptval = {a}
      addrec()
    elseif ptval = {U} or ptval = {u}
      updaterec()
    elseif ptval = {Esc}
      Background()
      vunloadif("bankhols.vw")
      return (1)
    end if
  end while
END FUNCTION ' Holiday()


FUNCTION AddRec()
  repaint off
  vloadif(dpath|"bnkhols1.vw")
  $nextbnkhol = date2(filemax([Dates]))
  while true
    while true			
      x = fentrybox(" Enter date of holiday ",10,"##\/##\/####",$nextbnkhol)
      if x = 0
        #holdate = ptstr
        if chkdate(#holdate,1) < 0
          tone("error")
          messbox(#holdate&"is a bad date! Enter again ",0,0,1)
        elseif days(#holdate) < days(today)
          tone("error")
          messbox(" Only future entries allowed ",0,0,1)
        else
          exit while
        end if
      end if
    end while
    screen shortrestore dsa
    x = popuplist(8,54,23,"ChristmasÿDay BoxingÿDay NewÿYear GoodÿFriday EasterÿMonday MayÿDay SpringÿBankÿHoliday SummerÿBankÿHoliday","",1,0)
    holdes = ptstr
    case holdes
      when "GoodÿFriday"
        if dayname(#holdate)<>"Friday"
          messbox(" Incorrect date - re-enter ",0,0,1)
          continue while
        end if
      when "EasterÿMonday"
        if dayname(#holdate)<>"Monday"
          messbox(" Incorrect date - re-enter ",0,0,1)
          continue while
        end if
      when "MayÿDay"
        if dayname(#holdate)<>"Monday"
          messbox(" Incorrect date - re-enter ",0,0,1)
          continue while
        end if
      when "SpringÿBankÿHoliday"
        if dayname(#holdate)<>"Monday"
          messbox(" Incorrect date - re-enter ",0,0,1)
          continue while
        end if
      when "SummerÿBankÿHoliday"
        if dayname(#holdate)<>"Monday"
          messbox(" Incorrect date - re-enter ",0,0,1)
          continue while
        end if
    end case
  exit while
end while

  data enter lock
    [Dates] = #holdate
    [Description] = holdes
  write-record

'   data goto view "reprsel2.vw"
  repaint on
  repaint
END FUNCTION


FUNCTION updaterec()
local z #prec

  #holdate = [Dates]
  holdes = [Description]

while true			
  while true			
    x = fentrybox(" Enter date of holiday ",10,"##\/##\/####",date2(#holdate))
    if x = 0
      #holdate = ptstr
      if chkdate(#holdate,1) < 0
        tone("error")
        messbox(#holdate&"is a bad date! Enter again (y/n) ?",1,0,1)
        if ptstr == "n"
          #holdate = NULL
          return (0)
        end if
      else
        exit while
      end if
    end if
  end while

  screen shortrestore dsa
  x = popuplist(8,54,23,"ChristmasÿDay BoxingÿDay NewÿYear GoodÿFriday EasterÿMonday MayÿDay SpringÿBankÿHoliday SummerÿBankÿHoliday","",1,0)
  holdes = ptstr
  case holdes
    when "GoodÿFriday"
      if dayname(#holdate)<>"Friday"
        messbox(" Incorrect date - re-enter ",0,0,1)
        continue while
      end if
    when "EasterÿMonday"
      if dayname(#holdate)<>"Monday"
        messbox(" Incorrect date - re-enter ",0,0,1)
        continue while
      end if
    when "MayÿDay"
      if dayname(#holdate)<>"Monday"
        messbox(" Incorrect date - re-enter ",0,0,1)
        continue while
      end if
    when "SpringÿBankÿHoliday"
      if dayname(#holdate)<>"Monday"
        messbox(" Incorrect date - re-enter ",0,0,1)
        continue while
      end if
    when "SummerÿBankÿHoliday"
      if dayname(#holdate)<>"Monday"
        messbox(" Incorrect date - re-enter ",0,0,1)
        continue while
      end if
  end case
  exit while
end while

  lock-record
    [Dates] = #holdate
    [Description] = holdes
  write-record
  repaint on
  repaint
END FUNCTION ' UpdateRec()


FUNCTION ReadFittersAndDates()             ' RFD
local    rec_ptr
'   clear nrestimators
  vloadif(dpath|"estlist1.vw")           ' goto estimators' file
  repaint off
  order change index "est_sel.idx" ' ordered on index created in ChooseFitters()
  redimension estimator[records,2]             ' ?? is this needed - how is it changed for poplist
  nrestimators = records
  rec_ptr = 1
  data goto record first
  while record <= records
    estimator[rec_ptr,1] = [Estimr_Code] 'message "estimator[rec_ptr,1]) is:"&str(estimator[rec_ptr,1])
    estimator[rec_ptr,2] = [Available]   'message "estimator[rec_ptr,2]) is:"&str(estimator[rec_ptr,2])
    data goto record next
    rec_ptr = rec_ptr + 1
  end while
END FUNCTION  ' ReadFittersAndDates()             ' RFC


FUNCTION ReferenceDate()
  messbox(" Will"&date2(lastdate)&"be the new Reference Date? (y/n) ",1,1,1)
  if ptstr ! "y"
' write date to APPT_REF.DAT
  end if
END FUNCTION ' ReferenceDate()


FUNCTION ArchiveOld()
local $todayname
  daysfirstdate = days(today)
  $todayname = dayname(today)
  $date1 = daysfirstdate - $keepdays    'message "$date1 is:"&str($date1)
  progress(fgp,bgp," Archiving appointments prior to"&dayname($date1)&date3($date1)&" ",1)
  progtag(fgi,bgi," Selecting previous appointments ")
' select all non-blank records prior to $date1 & query to temp file
  vunloadif("est_arc.vws")
  remove("est_arc.db")
  remove("est_arc.vws")
  vloadif(dpath|"est_appt.vws")
  if file(dpath|"old_est.vws") = 1
    progtag(fgi,bgi," Archiving & appending appointments ")
    data query execute "nonblank.dfq" Smart4 "appt_arc" fields "[Date;Appointment_Order;Est_Code;Job_Nr]"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   days([Date]) < days($date1)
'   replace delete
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      messbox(" No appointments selected for archive ",0,0,1)
    else                               'concatenate temp file to archive file
      vloadif(dpath|"old_est.vws")
      if cerror
        messboxwait(" Archive file not loaded ",0,0,1)
        return (0)
      end if
      data goto record last
      data utilities append "est_arc.vws"
      keys F10
    end if
  else
    data query execute "nonblank.dfq" Smart4 dpath|"old_ests" fields "[Date;Appointment_Order;REQUSN_Nr;Estimr_Code;Job_Nr]"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'  days([Date]) < days($date1)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ



'  days([Date]) < days($date1)
    if cerror
      messbox(" No appointments selected for archive ",0,0,1)
    end if
  end if

' replace delete all records before $date1
  progtag(fgi,bgi," Removing blank appointments ")
  vloadif(dpath|"est_appt.vws")
  order change key "[Date]"
  data query execute "nonblank.dfq" index "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³  days([Date]) < $date1 replace delete                              ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' purge file
  file unload all
  progtag(fgi,bgi," Purging deleted appointments from file ")
  data utilities purge dpath|"est_appt.vws"
END FUNCTION ' ArchiveOld()