'MAKEAPPT - makes blank appointments for fitters - Sundays are marked by
'           a calculated field in APPNTMNT.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


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

public     ptstr ptval ptary[1] dsa ftrname ftrcode firstdate lastdate
public     indate daysfirstdate $date1 bankholdate dayslastdate

global     EndNextMonth() PrepareAppt() CreateMini() CreateAppts() MenuList()
global     x z y CurrentLastDay() ReadFittersAndDates() nrfitters $appts
global     fitters[1] BankHols() ChooseFitters() ReturnToMenu()
global     UpdateList() SelectFitter() SelectAll() ArchiveOld()
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() PrintLabels()
global     $newdate $daynr $dfa


MAIN
single-step off
quiet off
message "Change back to ENT_APPT.OLD before using at WHSE"
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off

  clear fitters[]

  MenuList()                             ' Choose create/blank etc

  ReturnToMenu()
'   UnloadFilesA()                          ' Unload all files

END MAIN


FUNCTION MenuList()
local l1 l2 l3 l4 l5 l6
  CurrentLastDay()			' find latest date in MINIDATE.VWS
  while true
'     l1 = "ÿÿÿÿÿÿÿÿÿMarkÿABSENCES"    ' now done from NAV_APPT
'     l2 = "ÿÿÿÿÿÿRe-instateÿABSENCES"
    l3 = "ÿÿÿÿCreateÿNewÿAppointmentsÿÿÿÿ"
    l4 = "ÿÿÿÿUpdateÿFitters'ÿrecords"
    l5 = "ÿÿÿÿCreateÿFitter'sÿrecord"
    l6 = "ÿÿÿUpdateÿBankÿHolidayÿList"
'     x = popuplist(8,25,14,l3&l1&l2&l4&l5&l6," Appointments created to"&date2(lastdate)|" ",1,0)
    x = popuplist(8,25,14,l3&l4&l5&l6," Appointments created to"&date2(lastdate)|" ",1,0)
    if x = 0
      if ptstr = l1
        execute "daysoff.rf3" in-memory
      elseif ptstr = l2
        execute "dayson.rf3" in-memory
      elseif ptstr = l6
        Holiday()
      elseif ptstr = l4
        UpdateList()
      elseif ptstr = l5
        CreateRecord()
      elseif ptstr = l3
        x = ChooseFitters()
        if x = -1
'           vunloadif("scratch.vw")
          vunloadif(iview)
'           vunloadif("scr_sel.vw")
          vunloadif(sview)
          while true
            error off
            window close
            if cerror
              exit while
            end if
          end while
          continue while
        end if
        lastdate = EndNextMonth(lastdate)' Ask for new finishing date - suggest one month ahead of existing last date

        CheckBankHols()

        ReadFittersAndDates()            ' Make array of Fitter Codes

        if nrfitters > 1
          ReferenceDate()
        end if

        PrintLabels()

        CreateAppts()                    ' Make new appts

        CreateMini()                     ' Make minidate file

        ArchiveOld()			 ' archive all non-blank records

        ReturnToMenu()

      end if
    elseif x = -1
      ReturnToMenu()
    else
      message "Error:"&str(x)
    end if
  end while
END FUNCTION  'MenuList()


FUNCTION CreateRecord()
local    bpop_ret ftrcode
  vloadif(dpath|"ftrlist1.vw")           ' show list of fitters
  data enter lock
    repaint on
    repaint
    data update only-one
  write-record
  screen clear box 1 1 sch scw 0 0 no-border
END FUNCTION 'CreateRecord()


FUNCTION CheckBankHols()
local monthlist
while true
  vloadif(dpath|"bankhols.vws")
  if days(filemax([Dates])) < days(lastdate)
    x = messbox(" Bring Bank Holiday list up-to-date - last entry is"&date2(filemax([Dates])),0,0,1)
    if x = 0
      ReturnToMenu()
    else
      message "Messbox failed at Line 38:"&str(x)
    end if
  end if
  exit while
end while
END FUNCTION 'CheckBankHols()


FUNCTION CreateAppts()
local    #appts fittercode s_row s_col d f datecode daytitle
  vloadif(dpath|"creatapp.vw")
  order change key "[Date_Code]"
  daysfirstdate = days(today)
  dayslastdate = days(lastdate)
  span = (dayslastdate-days(today))

  for d = 0 to span                 ' for each day
    progress(fgp,bgp," Creating appointments for"&date2(days(today) + d)|" ",0)
    for f = 1 to nrfitters              ' for each fitter
      fittercode = fitters[f]
      datecode = str(date2(daysfirstdate + d)&fittercode)
' message "datecode is:"&str(datecode)
      data find "[Date_Code]" equal datecode options "g"
      if cerror
' message "Cannot find"&datecode&"-creating new appt"
        nextdate = date2(daysfirstdate + d)
        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|"creatapp.vw")
        for #appts = 1 to 7            ' for each appt continue creating
          $newdate = date2(daysfirstdate + d)
          if to_busdate($newdate,1)=0
            $daynr = ptstr
          end if
          $dfa = $daynr|fittercode|str(#appts)
          data enter lock
            [Fitter_Code] = fittercode
            [Date]        = $newdate
            [Day_Nr]      = $daynr
            [DFA]         = $dfa
            [Job_Nr]      = daytitle
            [Appointment_Order] = str(#appts)
          write-record
        end for
      else
        continue for
      end if
    end for
  end for
'  MenuList()                            ' return to menu
END FUNCTION  ' CreateAppts()


FUNCTION CurrentLastDay()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  vloadif(dpath|"creatapp.vw")          '
  if precords = 0
    messbox(" No appointments yet created ",0,0,1)
  else
    data goto record last
    lastdate = [Date]                     ' find latest date in existing file
  end if
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)
    ReturnToMenu()
  end if

  while TRUE
    if fentrybox(" Appointments go to"&date2(lastdate)&"- create up to?",8,"##\/##\/##",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()
  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 BankHols()
local #counter
  while true
    #counter = 1
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    bankholdate = ""
    while TRUE
      screen clear box 1 1 sch scw 0 0 no-border
      if fentrybox(" Enter a date (dd/mm/yy): ",8,"##\/##\/##",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|"creatapp.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 ftrcode
  vloadif(dpath|"ftrlist1.vw")           ' show list of fitters
  bpop_ret = bpopdb("ftrlist1",6,"","[Fitter Name]","L40","[Fitter_Code]","L0","[Fitter_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 = {A} or ptval = {a}
'       data enter lock
'       data update only-one
'       write-record
    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 ChooseFitters()                'L149
while true
  order change physical
  remove("ftr_sel.idx")
  if scr_setup() = 0
    x = scr_select()
    if x = 1			' ALL fitters selected
      y = "ALL"
      repaint off
    elseif x = 2		' some fitters selected
      y = "selected"
      repaint off
    elseif x = -1
      return (-1)
    end if
    scr_exit(0)
  else
    abort()
    scr_exit(-1)
  end if
  messbox(" Create appointments for"&y&"fitters? (y/n) ",1,1,1)
  if ptstr == "y"
'     getidxrecs("ftr_sel.idx",3)
    nrfitters = records                  ' message "nrfitters is:"&str(nrfitters)
    exit while
  end if
end while
END FUNCTION ' ChooseFitters()


FUNCTION Scr_select()
local    k y1 m2 m1 m3 m4
  scount = 0
  sel_str = NULL
' y1 = format("Selected to make Appointments for              Available Fitters      ","M80")
  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}
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      return (-1)
    elseif k = {Enter}
      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
      data goto record next
    elseif k = {D} or k = {d}
      del_item()
    elseif k = {A} or k = {a}
      SelectAll()
      return (1)
    elseif k = {F10}
      return (2)
    else
      beep
    end if
  end while
  repaint off
END FUNCTION  'Scr_Select()

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
  addidxrec("ftr_sel",p,1)
  repaint on
  order change index "ftr_sel"
  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("ftr_sel",crec,1)
      scount = scount-1
      repaint on
      order change index "ftr_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
' window border
  clearerror
  idxname = "ftr_sel.idx"
  dfname= "ftr_list"
  fnum=6
'   sview = "scr_sel.vw"
  sview = "ftrs_sel.vw"
'   iview = "scratch.vw"
  iview = "ftrs_avl.vw"
  screen clear box pline 1 pline scw 0 0 no-border
'   remove("ftr_sel.idx")
  remove(idxname)
'   makeidx(dfname,"ftr_sel",0,fnum)
  makeidx(dfname,idxname,0,fnum)
  vloadif(dpath|sview)
  order change index "ftr_sel"
  window split vertical 40
  data goto window next
  vloadif(dpath|iview)          ' release .02
  order change key [Fitter_Code]
  return (case lerror (0,0) else -1)
END FUNCTION  'scr_setup()


FUNCTION Scr_Exit(e)
  window close
' window border
  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|"ftrlist1.vw")
  bpop_ret = bpopdb("ftrlist1",6,"","[NickName]","L17","[Fitter_Code]","L0","[Fitter_Code]",7,61,15,80,"",0)
  if bpop_ret = -1
    return (-1)
  end if
  ftrcode = ptstr
  ftrname = [Nickname]
  repaint off
END FUNCTION '  SelectFitter()


FUNCTION SelectAll()
'   screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  vunloadif("ftrs_sel.vw")
  vloadif(dpath|"ftrlist1.vw")           ' goto fitters' file
  order change physical
  repaint off
  data query execute "all_ftrs.dfq" index "ftr_sel.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is: not(deleted)                                             ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  vunloadif("ftrlist1.vw")           ' goto fitters' file
END FUNCTION ' SelectAll()


FUNCTION ArchiveOld()
local $keepdays $todayname
'   screen clear box 1 1 sch scw 0 0 no-border
'   repaint off
  daysfirstdate = days(today)
  $todayname = dayname(today)
  $keepdays = case $todayname ("Monday",7)("Tuesday",8)("Wednesday",9)("Thursday",10)("Friday",4)("Saturday",5)("Sunday",6)
  $date1 = daysfirstdate - $keepdays
  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("appt_arc.vws")
  remove("appt_arc.db")
  remove("appt_arc.vws")
  vloadif(dpath|"appntmnt.vws")

  if file(dpath|"old_appt.vws") = 1

    data query execute "nonblank.dfq" data-file "appt_arc" fields "[Date;Appointment_Order;REQUSN_Nr;Fitter_Code;Job_Nr]"
    ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
    ' ³ QUERY is:   [REQUSN_Nr] <> blank
    '		and
    '  		[Date] < ($date1)                                      ³
    ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      messbox(" No appointments selected for archive ",0,0,1)
    end if
    ' concatenate temp file to archive file
    vloadif(dpath|"old_appt.vws")
    if cerror
      message "Archive file not loaded"
      ReturnToMenu()
    end if
    data utilities append dpath|"old_appt.vws"
  else
    data query execute "nonblank.dfq" data-file dpath|"old_appt" fields "[Date;Appointment_Order;REQUSN_Nr;Fitter_Code;Job_Nr]"
    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|"appntmnt.vws")
  order change key "[Date]"
  data query execute "del_appt.dfq" index "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³  [Date] < $date1 replace delete                                    ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' purge file
  file unload all
  progtag(fgi,bgi," Purging deleted appointments from file ")
  data utilities purge dpath|"appntmnt.vws"
END FUNCTION ' ArchiveOld()


FUNCTION CreateMini()
local    #appts fittercode s_row s_col d f datecode daytitle
  $date1 = days(today)
  vloadif(dpath|"minidate.vws")
  data query execute "delete.dfq"
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º[Date] < $date1 replace delete                                      º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  vunloadif("minidate.vws")
  data utilities purge dpath|"minidate.vws"
  vloadif(dpath|"minidate.vws")

  $date1 = date2(today)
  for d = 0 to span                 ' for each day
    progress(fgp,bgp," Creating Minidate file for"&$date1|" ",0)
    data enter lock
      [Ftg_Date] = $date1
    write-record
    $date1 = date2(days(today)+d+1)
  end for
END FUNCTION  ' CreateMini()


FUNCTION DeleteAppts()
' vloadif(dpath|"listappt.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}
 '       if lastact = "e"
          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]
    '       return to LISTAPPT
          vloadif(dpath|"listappt.vw")
'          order change index "findappt.idx"
          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"))
'        end if
      elseif ptval = {E} or ptval = {e}
'        lastact = "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]
  '       return to LISTAPPT
        vloadif(dpath|"listappt.vw")
'        order change index "findappt.idx"
        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|"listappt.vw")
          continue while
        else
          message str(x)
        end if
        repaint off
        exit function
      end if
    end while				' end of NAVREC() loop

    repaint off

  ' check that all appt slots for fitter 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"&ftrname,"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    changeftr $span i
  repaint off
  z = ""
  deljobnr = ""
  changeftr = "n"

  while true
    vloadif(dpath|"ftr_list.vws")
'message "ftrname) is:"&str(ftrname)
    ftrcode = filelookup([Nickname],[Fitter_Code],ftrname)

    vloadif(dpath|"listappt.vw")
    order change physical

    smartpeek $_lastkey z              ' see if the loop started from {F}
    if changeftr == "n"                ' = fitters 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
      else
        message "x is:"&str(x)
      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"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³   [Fitter_Code] = ftrcode                                          ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      message "Bad query"
    end if
    x = DeleteAppts()
    if x = -1
      vunloadif("listappt.vw")
      vunloadif("ftr_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}
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      vunloadif("bankhols.vw")
      return (1)
    end if
  end while
END FUNCTION ' Holiday()


FUNCTION AddRec()
'   reprname = ""
  repaint off
  vloadif(dpath|"bnkhols1.vw")
  while true			
    x = fentrybox(" Enter date of holiday ",8,"##\/##\/##","")
    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

  x = fentrybox(" Which holiday is this? ",25,"","")
  holdes = ptstr

  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			
    x = fentrybox(" Enter date of holiday ",8,"##\/##\/##",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

  x = fentrybox(" Which holiday is this? ",25,"",holdes)
  holdes = ptstr

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


FUNCTION ReadFittersAndDates()             ' RFD
local    rec_ptr
  clear nrfitters
  vloadif(dpath|"ftrlist1.vw")           ' goto fitters' file
  repaint off
  order change index "ftr_sel.idx" ' ordered on index created in ChooseFitters()
  redimension fitters[records]             ' ?? is this needed - how is it changed for poplist
  nrfitters = records
  rec_ptr = 1
  data goto record first
  while record <= records
    fitters[rec_ptr] = [Fitter_Code]
    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 PrintLabels()
  messboxwait(" Printing labels ",0,0,1)
END FUNCTION ' PrintLabels()