'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

' Archive & Clearing Blanks moved to PREPAPPT.PF3

' 14/06/95 - all blank appts prior to today now removed and archived after
'            one month

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

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() #arc_time
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 nickname #rec


MAIN
single-step off
  file unload all
  quiet off
'   #arc_time = 30                       ' days
' 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 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}
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      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}
      SelectAll()
      return (1)

    elseif k = {F10}
      if len(sel_str)=0
        messboxwait(" No fitters 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 ftrcode nrwords codename nrcode
  vloadif(dpath|"ftrlist3.vw")           ' show list of fitters
' enter name of Fitter     - 35 chars
  while true			
    x = fentrybox(" Enter Fitter's full name (e.g. Mark Smith) ",35,"","")
    if ptstr = ""
      continue while
    else
      ftrname = ptstr
      exit while
    end if
  end while

' enter nickname of Fitter - 8 chars
  while true			
    x = fentrybox(" Enter Fitter's nickname (e.g. Smithy) ",8,"","")
    if ptstr = ""
      continue while
    else
      nickname = ptstr
      exit while
    end if
  end while

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

' check unique code
  while true
    ftrcode = upper(left(group(ftrname,nrwords),3))|"00"|str(nrcode)
' message "ftrcode is:"&str(ftrcode)
    data find "[Fitter_Code]" equal ftrcode options ""
    if cerror                               '   if none - then return
      exit while
    end if
    nrcode = nrcode + 1
  end while

  data enter lock
    [Fitter_Code] = ftrcode
    [Fitter Name] = ftrname
    [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 rfd
  CurrentLastDay()			' find latest date in MINIDATE.VWS
  while true
'     l1 = "ÿÿÿÿÿÿÿÿÿMarkÿABSENCES"    ' now done from NAV_APPT
    l2 = "ÿÿÿÿÿActive/Inactiveÿlist"
    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&l2&l6," Appointments created to"&date2(lastdate)|" ",1,0)
    x = popuplist(8,25,14,l3&l4&l5&l2&l6," Appointments created to"&date2(lastdate)|" ",1,0)
    if x = 0
      if ptstr = l2
        execute "fitter01.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(iview)
          vunloadif(sview)
          while true
            error off
            window close
            if cerror
              exit while
            end if
          end while
          continue while
        elseif x = 0
          vunloadif(iview)
          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()

        rfd = ReadFittersAndDates()            ' Make array of Fitter Codes
        if rfd = -1
          continue while
        end if

        if nrfitters > 1
          ReferenceDate()
        end if

        PrintLabels()

        CreateAppts()                    ' Make new appts

        CreateMini()                     ' Make minidate file

'         ArchiveOld()			 ' archive all non-blank records

        messboxwait(" New APPTDATE file needed - DO NOT RUN PREPAPPT UNLESS OFFLINE",0,0,1)

        ReturnToMenu()

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


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)
    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
  repaint off
  iview = "ftrs_avl.vw"
  vloadif(dpath|iview)
  order change physical
  remove("ftr_sel.idx")
  data query execute "act_ftrs.dfq" index "act_ftrs.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ QUERY is:  [Active] = "YES"                                        ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messboxwait(" No fitters have been marked as `ACTIVE' ",0,0,1)
    return (-1)
  end if
  order sort now dictionary "ftrname.idx" fields "[Fitter_Name]" ascending
  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 = 0                ' NO fitters selected
      return (0)
    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)
message "ptval is:"&str(ptval)
    nrfitters = records                  '
    exit while
  end if
end while
return (1)
END FUNCTION ' ChooseFitters()


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
repaint on
repaint
single-step on
END FUNCTION ' SelectAll()


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()
'
'
'    ArchiveOld()			 ' archive all non-blank records
' FUNCTION ArchiveOld()
' local $keepdays $todayname
' '   daysfirstdate = days(today)
'   $todayname = dayname(today)
' '   $keepdays = case $todayname ("Monday",7)("Tuesday",8)("Wednesday",9)("Thursday",10)("Friday",4)("Saturday",5)("Sunday",6)
' '   $date1 = daystoday - $keepdays
'   $date1 = days(today) - #arc_time
' '   progress(fgp,bgp," Archiving appointments prior to"&dayname($date1)&date3($date1)&" ",1)
'   progress(fgp,bgp," Archiving appointments prior to"&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)
'     '   replace delete                                                     ³
'     ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'     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 BLANK records before today
'   progtag(fgi,bgi," Removing blank appointments before today ")
'   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()