'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

' 061112 - fitters sorted by OTHER/FITTER/ESTIMATOR

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 ftrname ftrcode firstdate lastdate appts2
public     indate daysfirstdate $date1 bankholdate dayslastdate

global     EndNextMonth() PrepareAppt() CreateAppts() MenuList()
'  CreateMini()
global     x z y CurrentLastDay() ReadFittersAndDates() nrfitters $appts
global     fitters[1,2] BankHols() ChooseFitters() 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 fitters[]

  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
      		vunloadif("ftrs_sel.vw")
      		data query execute "all_ftrs.dfq" index "ftr_sel.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ record <= records                                                  ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' 			order sort now dictionary "ftr_sel.idx" fields "[Ftr_Est;Nickname]" descending
      	vunloadif("ftrs_avl.vw")
      	data goto window 1
      	vloadif(dpath|"ftrs_sel.vw")
      	order change index "ftr_sel.idx"
      	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|"ftrlist2.vw")           ' show list of fitters
  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

  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)
    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 l7
  	CurrentLastDay()			' find latest date in MINIDATE.VWS
' message "appts2) is:"&str(appts2)
  	while true
    		Background()
    		l2 = "ÿÿÿÿÿActive/Inactiveÿlist"
    		l3 = "ÿÿÿÿCreateÿNewÿAppointmentsÿÿÿÿ"
    		l4 = "ÿÿÿÿUpdateÿFitters'ÿrecords"
    		l5 = "ÿÿÿÿCreateÿFitter'sÿrecord"
    		l6 = "ÿÿÿUpdateÿBankÿHolidayÿList"
'      	l7 = "ÿÿÿÿÿÿÿÿÿRunÿPrepAppt"
    		l7 = "ÿÿÿRunÿPrepAptFÿandÿPrepAptE"
    		x = popuplist(11,40,20,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 PREPAPPT and PREPAPTE now? (y/n)",1,0,1)
'           			if ptstr == "y"
'             				execute "PREPAPPT.RF3" in-memory
'             				execute "PREPAPTE.RF3" in-memory
'           			end if
        			end if
      		elseif ptstr = l7
        			messboxwait(" Ensure that no-one is using the diary nor will use it until notified ",0,0,1)
        			messbox(" Prepare Fitters Diary now? (y/n)",1,0,1)
        			if ptstr == "y"
          			execute "PREPAPTF.RF3" in-memory
        			end if
	        			messbox(" Prepare Estimators Diary now? (y/n)",1,0,1)
          			if ptstr == "y"
            			execute "PREPAPTE.RF3" in-memory
          			end if
      		end if
    		elseif x = -1
      		return (0)
    		end if
  	end while
END FUNCTION  'MenuList()


FUNCTION  NewAppts()
local rfd
  x = ChooseFitters()
  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
  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
    return (1)
  end if
'   if nrfitters > 1
'     ReferenceDate()
'   end if
  	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)
  	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 fittercode s_row s_col d f datecode daytitle nextdatename
  	vloadif(dpath|"creatapp.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 nrfitters              ' for each fitter
      		fittercode = fitters[f,1]        'message "fittercode) is:"&str(fittercode)
      		$available = fitters[f,2]        'message "$available is:"&str($available)
      		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"
' 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)
        			x=chkstr(str($dowavail),$available)
        			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
' message "daytitle) is:"&str(daytitle)

        			vloadif(dpath|"creatapp.vw")
        			for #appts = 1 to 7            ' 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|fittercode|str(#appts)'message "$dfa is:"&str($dfa)
          			data enter lock
            				[Fitter_Code] = fittercode
            				[Date]        = $newdate
            				[Day_Nr]      = $daynr
            				[DFA]         = $dfa
            				[Job_Nr]      = daytitle
            				[Date_Code]   = datecode
            				[Appointment_Order] = str(#appts)
            				[Post_Job]    = daytitle
          			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|"appntmnt.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
' message "lastdate) is:"&str(lastdate)
' message "MA L364 appts2) is:"&str(appts2)
  	vunloadif("appntmnt.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
'   messbox(" Run PREPAPPT now? (y/n)",1,0,1)
'   if ptstr == "n"
'     transfer cpath|"pm_menu.psl" in-memory
'   else
'     execute "PREPAPPT.RF3" in-memory
'   end if
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|"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 = {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
Scr_Setup()
      		x=Scr_Select()
      		if x = 1			' ALL fitters selected
        			y = "ALL available"
        			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
    		vloadif(dpath|"ftrs_sel.vw")
    		messbox(" Create appointments for"&y&"fitters? (y/n) ",1,1,1)
    		if ptstr == "y"
      		nrfitters = records                  'message "nrfitters) is:"&str(nrfitters)
      		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
  	clearerror
  	idxname = "ftr_sel.idx"
  	dfname= "ftr_list"
  	fnum=6
  	sview = "ftrs_sel.vw"
  	iview = "ftrs_avl.vw"
  	screen clear box pline 1 pline scw 0 0 no-border
  	x=remove("ftr_sel.idx")
' message "L619\ x is:"&str(x)
  	x=makeidx(dfname,idxname,0,fnum)
' message "makeidx is:"&str(x)
  	vloadif(dpath|"ftrs_sel.vw")
  	order change index "ftr_sel"
  	window split vertical 40
  	data goto window next
  	x=vloadif(dpath|"ftrs_avl.vw")          ' 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|"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 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}
        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|"listappt.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|"listappt.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|"listappt.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 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
      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}
      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(11,54,23,"ChristmasÿDay BoxingÿDay NewÿYear GoodÿFriday EasterÿMonday MayÿDay SpringÿBankÿHoliday SummerÿBankÿHoliday","",1,0)
    x=popuplist(11,54,23,"ChristmasÿDay BoxingÿDay NewÿYear GoodÿFriday EasterÿMonday MayÿDay JubileeÿBankÿHoliday 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(11,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 nrfitters
  	vloadif(dpath|"ftrlist1.vw")           ' goto fitters' file
  	repaint off
  	order change index "ftr_sel.idx" ' ordered on index created in ChooseFitters()
' message "MA L1056 records is:"&str(records)
  	redimension fitters[records,2]             ' ?? is this needed - how is it changed for poplist
  	nrfitters = records
  	rec_ptr = 1
  	data goto record first
  	while record <= records
    		fitters[rec_ptr,1] = [Fitter_Code] 'message "fitters[rec_ptr,1]) is:"&str(fitters[rec_ptr,1])
    		fitters[rec_ptr,2] = [Available]   'message "fitters[rec_ptr,2]) is:"&str(fitters[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("appt_arc.vws")
  	remove("appt_arc.db")
  	remove("appt_arc.vws")
  	vloadif(dpath|"appntmnt.vws")
  	if file(dpath|"old_appt.vws") = 1
    		progtag(fgi,bgi," Archiving & appending appointments ")
'     		data query execute "nonblank.dfq" Smart4 "appt_arc" fields "[Date;Appointment_Order;Fitter_Code;Post_Job]"
    		data query execute "nonblank.dfq" Smart4 "appt_arc" fields "[Date;Appointment_Order;Fitter_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_appt.vws")
      		if cerror
        			messboxwait(" Archive file not loaded ",0,0,1)
        			return (0)
      		end if
      		data goto record last
' repaint on
' repaint
' single-step on
      		data utilities append "appt_arc.vws"
      		keys F10
    		end if
  	else
    		data query execute "nonblank.dfq" Smart4 dpath|"old_appt" fields "[Date;Appointment_Order;REQUSN_Nr;Fitter_Code;Job_Nr]"
'  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|"appntmnt.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|"appntmnt.vws"
END FUNCTION ' ArchiveOld()
' data utilities append "appt_arc.vws"