by Jack Wheeler
| Jack's previous articles (user-customizable field attributes and week-at-a-glance) laid the groundwork for the appointment scheduler. Fortunately Jack has provided a download that you can study. Or you can reach Jack at jwl1@jps.net. |
My client is a company with 7 departments and the head of each one is a boss! No, this is not the beginning of a fairly tale, there actually are 7 bosses and each one has full authority over that segment of the business. The first thing I noticed is they all have different needs for a calendar. One person needed to pick up supplies every Tuesday at 9:30am and it took an hour. Another person has a list of calls to make the first Tuesday of every month, while a third has to prepare a report for the CEO every two weeks on a Wednesday at 3:00pm. And yet they all had to attend a staff meeting every Monday at 10:00am for two hours. WOW, this was going to be a chore!
Again I looked at Symantecs' Act3 and loved the scheduling form they have developed. I imitated the form and applied my own coding. The pages of the form are as follows:
When an appointment is saved,a script is played that makes sure that all the necessary fields are filled in and then proceeds to save of the appointment record. Theis script will also call on other scripts with the script_play() method.
OnChange script for Multi-state Button (note: all these scripts are in the download):
DIM ax_choice as C
DIM ax_response as N
DIM ax_dialog as P
ON ERROR GOTO ax_error_trap
DIM ax_error_trap_desc as C
DIM ax_error_trap_offset as C
DIM ax_error_trap_msg as C
DIM ax_error_trap_response as N
ax_error_trap_desc = "Action Script"
ax_error_trap_offset = "0"
ax_error_trap_desc = "Branch"
ax_error_trap_offset = "1"
ax_choice = TWOSTBTN1.text
select
case alltrim(upper("DEFAULT"))==alltrim(upper(ax_choice))
ax_error_trap_desc = "Inline Xbasic"
ax_error_trap_offset = "3"
Parentform:Cond2.Refresh()
case alltrim(upper("FREQ"))==alltrim(upper(ax_choice))
ax_error_trap_desc = "Inline Xbasic"
ax_error_trap_offset = "6"
parentform:Cond2.Refresh()
case alltrim(upper("NEW"))==alltrim(upper(ax_choice))
ax_error_trap_desc = "New Record"
ax_error_trap_offset = "9"
PARENT.new_record()
case alltrim(upper("SAVE"))==alltrim(upper(ax_choice))
ax_error_trap_desc = "Inline Xbasic"
ax_error_trap_offset = "12"
''XBasic
'on error goto line
dim shared newdate as d
dim rec as n
dim recs as n
dim shared days as n
dim shared ta as p
dim shared t as p
dim shared t1 as p
dim shared ts as p
dim shared frm as p
dim No as c
dim no2 as c
dim Num as n
dim num2 as n
dim filenameN as n
dim filenameM as c
dim filename as c
dim filename1 as c
dim filename2 as c
dim filename3 as c
dim filename4 as c
dim fieldobj as p
dim fieldobj1 as p
dim fieldobj2 as p
dim fieldobj3 as p
dim fieldobj4 as p
dim rec as n
dim nbr as c
dim h as n
dim i as n
dim j as n
dim k as n
dim l as n
dim m as n
dim cu as c
dim nme as c
dim cus as c
dim tme as c
dim timevalue as c
dim name as c
dim comp as c
dim sdt as d
dim edt as d
dim durat as n
DIM SHARED A AS N
dim record_data as b
dim mode as c
dim tmend as c
frm=topparent.this
mode=frm.mode_get()
if frm:type0.value=" " then
ui_msg_box("Hey!!!!!","You forgot the Kind of Appointment you
have")
frm:type0.activate()
end
end if
if frm:group1.value=" " then
ui_msg_box("Affiliate of??","What is the company")
frm:Company.activate()
end
end if
If frm:duration0.text="0" then
ui_msg_box("WHOOPS","How LONG for your appointment?")
frm:duration0.activate()
end
End If
If frm:Priority0.value=" " then
ui_msg_box("Oh No!","Is this an important appointment?")
frm:Priority0.activate()
end
End If
If frm:Salesman0.value=" " then
ui_msg_box("What Happened?","Who are you having this
appointment with?")
frm:salesman0.activate()
end
End If
If frm:Note1.value=" " then
ui_msg_box("Did you Forget?","What is the appointment
Concerning")
frm:Note1.activate()
end
end if
If frm:rep1.value=" " then
ui_msg_box("Who Are You","Please place your name in this
box")
frm:rep1.activate()
end
End If
topparent.COMMIT()
DIM shared OLD_DATE AS D
DIM shared OLD_COMPANY AS C
DIM shared OLD_NOTE AS C
DIM shared OLD_TIME AS C
dim shared old_priority as c
dim shared old_duration as n
t1=table.current()
if old_date<>{} then
sdt=old_date
if mode="CHANGE" then
if old_cus1 <> frm:checkbox1.value.or.old_cus2 <>
frm:checkbox2.value.or.old_cus3 <> frm:checkbox3.value.or.old_cus4
<> frm:checkbox4.value.or.old_cus5 <>
frm:checkbox5.value.or.old_cus6 <> frm:checkbox6.value.or.old_cus7
<> frm:checkbox7.value.or.old_cus8 <>
frm:checkbox8.value.or.old_cus9 <> frm:checkbox9.value.or.old_cus10
<> frm:checkbox10.value.or.old_cus11 <>
frm:checkbox11.value.or.old_cus12 <> frm:checkbox12.value.or.old_cus13
<> frm:checkbox13.value.or.old_cus14 <>
frm:checkbox14.value.or.old_cus15 <> frm:checkbox15.value.or.old_cus16
<> frm:checkbox16.value.or.old_cus17 <>
frm:checkbox17.value.or.old_cus18 <> frm:checkbox18.value.or.old_cus19
<> frm:checkbox19.value.or.old_cus20 <>
frm:checkbox20.value.or.old_cus21 <> frm:checkbox21.value.or.\
old_cus22 <> frm:checkbox22.value.or.old_cus23 <>
frm:checkbox23.value.or.old_cus24 <> frm:checkbox24.value.or.old_cus25
<> frm:checkbox25.value.or.old_cus26 <>
frm:checkbox26.value.or.old_cus27 <> frm:checkbox27.value.or.old_cus28
<> frm:checkbox28.value.or.old_cus29 <>
frm:checkbox29.value.or.old_cus30 <> frm:checkbox30.value.or.old_cus31
<> frm:checkbox31.value then
script_play("ActivityMain")
goto new
end if
IF
cdate(OLD_DATE)<>cdate(SDT).or.old_duration<>frm:duration0.value.or.old_time<>frm:time0.value.or.frm:days.value<>old_days.or.frm:weeks.value<>old_weeks.or.old_months<>frm:months.value.or.\
old_m <> frm:m.value.or.old_th <> frm:th.value.or.old_w <>
frm:w.value.or.old_t <> frm:t.value.or.old_sat <>
frm:sat.value.or.old_sun <> frm:sun.value.or.old_fri <>
frm:f.value.or. \
old_time<>alltrim(frm:time0.value).or.old_priority<>frm:priority0.value.or.old_repeat<>frm:repeat.value
then
for h= 1 to 180
if sdt>old_edate then
goto new
end if
dim ts1 as p
dim no1 as c
dim tme1 as c
select
case dow(sdt)=1
ts1=table.open("scheduler6")
case dow(sdt)=2
ts1=table.open("scheduler")
case dow(sdt)=3
ts1=table.open("scheduler1")
case dow(sdt)=4
ts1=table.open("scheduler2")
case dow(sdt)=5
ts1=table.open("scheduler3")
case dow(sdt)=6
ts1=table.open("scheduler4")
case dow(sdt)=7
ts1=table.open("scheduler5")
end select
rec=ts1.RECORDS_GET()
iF rec>0 ThEN
ts1.index_primary_put("D1")
No1=TimeName(old_time)
comp=old_company
nme=old_rep
timeValue=old_time
durat=old_duration
tmend = totime(toseconds(old_time)+(60*old_duration),11,0)
no2=timename(tmend)
tme1=old_time
recs=ts1.FETCH_FIND(sdt)
if recs>0 then
ts1.change_begin()
filename="N"+No1
fieldobj=ts1.field_get(filename)
fieldobj.blank_put()
num=val(No)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts1.field_get(filename3)
tme1=fieldobj3.value_get()
If
old_priority="h".and.between(toseconds(tme1),toseconds(old_time),toseconds(old_time)+(60*(old_duration)-1))
then
fieldobj=ts1.field_get(filename)
fieldobj.blank_put()
end if
If
old_priority="m".and.between(toseconds(tme1),toseconds(old_time),toseconds(old_time)+(60*(old_duration)-1))
then
fieldobj1=ts1.field_get(filename1)
fieldobj1.blank_put()
end if
If
old_priority="l".and.between(toseconds(tme1),toseconds(old_time),toseconds(old_time)+(60*(old_duration)-1))
then
fieldobj2=ts1.field_get(filename2)
fieldobj2.blank_put()
end if
next
ts1.change_end(.t.)
end if
end if
ta.index_primary_put("reptime")
recs=ta.fetch_find(alltrim(comp)+alltrim(nme)+cdate(sdt)+alltrim(timeValue))
if recs>0 then
ta.change_begin()
ta.regarding="Appointment has been cancelled or changed
"+dtoc(date())
ta.change_end(.t.)
end if
t1.index_primary_put("Activity")
recs=t1.FETCH_FIND(cdate(newdate)+cdate(frm:edate.value)+alltrim(nme)+alltrim(comp)+alltrim(timevalue))
if recs>0 then
t1.change_begin()
t1.delete()
t1.change_end(.t.)
end if
If old_days>0.and.old_days<200 then
sdt = sdt+days
elseif old_weeks>0.and.old_weeks<53 then
if old_th=.t. then
sdt=weekday(sdt,old_weeks)+3
elseif old_w=.t. then
sdt=weekday(sdt,old_weeks)+2
elseif old_t=.t. then
sdt=weekday(sdt,old_weeks)+1
elseif old_m=.t. then
sdt=weekday(sdt,old_weeks)
elseif old_fri=.t. then
sdt=weekday(sdt,old_weeks)+4
elseif old_sat=.t. then
sdt=weekday(sdt,old_weeks)+5
elseif old_sun=.t. then
sdt=weekday(sdt,old_weeks)+6
else
sdt=weekday(sdt,old_weeks)
end if
elseif
old_months>0.and.old_months<25.and.old_repeat>0.and.old_repeat<5
then
dim m as n
m=old_months
If old_m=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))
elseif old_t=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+1
elseif old_w=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+2
elseif old_th=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+3
elseif old_fri=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+4
elseif old_sat=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+5
elseif old_sun=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+6
End If
elseif old_months>0.and.old_months<25.and.old_repeat=5
dim m as n
m=old_months
sdt=endofmonth(addmonths(sdt,m))
end if
next
end if
end if
end if
new:
newdate=t1.sdate
comp=frm:group1.text
sdt=newdate
nme=frm:rep1.text
timeValue=frm:time0.value
durat=frm:duration0.value
No=TimeName(frm:time0.text)
tmend = totime(toseconds(frm:time0.text)+(60*frm:duration0.value),11,0)
no2=timename(tmend)
if
frm:checkbox1.value=1.or.frm:checkbox2.value=1.or.frm:checkbox3.value=1.or.frm:checkbox4.value=1.or.frm:checkbox5.value=1.or.frm:checkbox6.value=1.or.frm:checkbox7.value=1.or.frm:checkbox8.value=1.or.frm:checkbox9.value=1.or.frm:checkbox10.value=1.or.frm:checkbox11.value=1.or.frm:checkbox12.value=1.or.frm:checkbox13.value=1.or.frm:checkbox14.value=1.or.frm:checkbox15.value=1.or.frm:checkbox16.value=1.or.frm:checkbox17.value=1.or.frm:checkbox18.value=1.or.frm:checkbox19.value=1.or.frm:checkbox20.value=1.or.frm:checkbox21.value=1.or.\
frm:checkbox22.value=1.or.frm:checkbox23.value=1.or.frm:checkbox24.value=1.or.frm:checkbox25.value=1.or.frm:checkbox26.value=1.or.frm:checkbox27.value=1.or.frm:checkbox28.value=1.or.frm:checkbox29.value=1.or.frm:checkbox30.value=1.or.frm:checkbox31.value=1
script_play("ActivityMain1")
statusbar.clear()
UI_MSG_box("Your Done","Your custom appointments have been
made")
end
end if
'days=t1.days
for h = 1 to 180
statusbar.robot()
If newdate>t1.edate then
statusbar.clear()
UI_MSG_box("Your Done","Your appointments have been
made")
end
End If
If h = 1 then
else
k=t1.recno()
t1.index_primary_put("Activity")
recs=t1.FETCH_FIND(cdate(newdate)+cdate(frm:edate.value)+alltrim(nme)+alltrim(comp)+alltrim(timevalue))
if recs>0 then
t1.change_begin()
t1.duration=durat
t1.type=frm:type0.text
t1.priority=frm:PRIORITY0.text
t1.note="changed appointment "+dtoc(date())+"
"+frm:note1.text
t1.change_end(.t.)
else
t1.index_primary_put("")
t1.fetch_find(k)
record_data=t1.record_data_get()
t1.enter_begin()
t1.record_data_set(record_data)
t1.enter_end(.t.)
t1.change_begin()
t1.sdate=newdate
t1.change_end(.t.)
end if
end if
select
case dow(Newdate)=1
ts=table.open("scheduler6")
case dow(Newdate)=2
ts=table.open("scheduler")
case dow(Newdate)=3
ts=table.open("scheduler1")
case dow(Newdate)=4
ts=table.open("scheduler2")
case dow(Newdate)=5
ts=table.open("scheduler3")
case dow(Newdate)=6
ts=table.open("scheduler4")
case dow(Newdate)=7
ts=table.open("scheduler5")
end select
rec=ts.RECORDS_GET()
iF rec>0 ThEN
ts.index_primary_put("D1")
recs=ts.FETCH_FIND(sdt)
if recs>0 then
If frm:priority0.value="h" then
If overbook(sdt,timeValue,durat,ts)=.t. then
end
end if
end if
ts.change_begin()
ts.rep=nme
ts.time=timeValue
ts.d1=newdate
ts.priority=frm:priority0.text
ts.frequency=durat
ts.company=comp
filename="N"+No
fieldobj=ts.field_get(filename)
name=fieldobj.value_get()
'fieldobj.value_put(f:filename.text+ " "+frm:salesman0.text+"
"+frm:Note1.text+" "+frm:type0.text)
fieldobj.value_put(alltrim(name)+ " "+frm:salesman0.text+"
"+frm:type0.text)
num=val(No)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts.field_get(filename3)
tme=fieldobj3.value_get()
If
frm:priority0.text="h".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj=ts.field_get(filename)
fieldobj.value_put("B")
end if
If
frm:priority0.text="m".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj1=ts.field_get(filename1)
fieldobj1.value_put("R")
end if
If
frm:priority0.text="l".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj2=ts.field_get(filename2)
fieldobj2.value_put("Y")
end if
next
ts.change_end(.t.)
else
ts.enter_begin()
ts.rep=nme
ts.time=timeValue
ts.d1=newdate
ts.priority=frm:priority0.text
ts.frequency=durat
ts.company=frm:group1.text
filename="N"+No
fieldobj=ts.field_get(filename)
name=fieldobj.value_get()
'fieldobj.value_put(f:filename.text+ " "+frm:salesman0.text+"
"+frm:Note1.text+" "+frm:type0.text)
fieldobj.value_put(alltrim(name)+ " "+frm:salesman0.text+"
"+frm:type0.text)
num=val(No)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts.field_get(filename3)
tme=fieldobj3.value_get()
If
frm:priority0.text="h".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj=ts.field_get(filename)
fieldobj.value_put("B")
end if
If
frm:priority0.text="m".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj1=ts.field_get(filename1)
fieldobj1.value_put("R")
end if
If
frm:priority0.text="l".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj2=ts.field_get(filename2)
fieldobj2.value_put("Y")
end if
next
ts.enter_end(.t.)
end if
else
ts.enter_begin()
ts.rep=nme
ts.time=timeValue
ts.d1=newdate
ts.priority=frm:priority0.text
ts.frequency=durat
ts.company=comp
filename="N"+No
fieldobj=ts.field_get(filename)
name=fieldobj.value_get()
'fieldobj.value_put(f:filename.text+ " "+frm:salesman0.text+"
"+frm:Note1.text+" "+frm:type0.text)
fieldobj.value_put(alltrim(name)+ " "+frm:salesman0.text+"
"+frm:type0.text)
num=val(No)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts.field_get(filename3)
tme=fieldobj3.value_get()
If
frm:priority0.text="h".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj=ts.field_get(filename)
fieldobj.value_put("B")
end if
If
frm:priority0.text="m".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj1=ts.field_get(filename1)
fieldobj1.value_put("R")
end if
If
frm:priority0.text="l".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj2=ts.field_get(filename2)
fieldobj2.value_put("Y")
end if
next
ts.enter_end(.t.)
end if
ta=table.open("Activities")
rec=ta.records_get()
if rec<1 then
ta.enter_begin()
ta.rep=nme
ta.regarding=FRM:note1.TEXT
ta.date=newdate
ta.time=timeValue
ta.priority=ts.priority
ta.frequency=durat
ta.company=comp
ta.enter_end(.t.)
else
ta.index_primary_put("reptime")
recs=ta.fetch_find(alltrim(comp)+alltrim(nme)+cdate(sdt)+alltrim(timeValue))
if recs>0 then
ta.change_begin()
ta.company=comp
ta.rep=nme
ta.time=timeValue
ta.regarding="CHANGED this appointment"+dtoc(DATE())+"
"+FRM:NOTE1.TEXT
ta.date=newdate
ta.priority=ts.priority
ta.frequency=durat
ta.change_end(.t.)
else
ta.enter_begin()
ta.rep=nme
ta.regarding=FRM:note1.TEXT
ta.date=Newdate
ta.time=timeValue
ta.priority=ts.priority
ta.frequency=durat
ta.company=comp
ta.enter_end(.t.)
end if
end if
ts.close()
TA.CLOSE()
If t1.days>0.and.t1.days<200 then
sdt = sdt+t1.days
elseif t1.weeks>0.and.t1.weeks<53 then
if T1.thur=.t. then
sdt=weekday(sdt,T1.weeks)+3
elseif T1.w=.t. then
sdt=weekday(sdt,T1.weeks)+2
elseif T1.t=.t. then
sdt=weekday(sdt,T1.weeks)+1
elseif T1.m=.t. then
sdt=weekday(sdt,T1.weeks)
elseif T1.f=.t. then
sdt=weekday(sdt,T1.weeks)+4
elseif T1.sat=.t. then
sdt=weekday(sdt,T1.weeks)+5
elseif T1.sun=.t. then
sdt=weekday(sdt,T1.weeks)+6
else
sdt=weekday(sdt,T1.weeks)
end if
elseif
T1.months>0.and.T1.months<25.and.T1.repeat>0.and.T1.repeat<5 then
dim m as n
m=T1.months
If T1.m=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))
elseif T1.t=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+1
elseif T1.w=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+2
elseif T1.thur=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+3
elseif T1.f=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+4
elseif T1.sat=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+5
elseif T1.sun=.t. then
sdt=weekact(ctod(alltrim(str(month(addmonths(sdt,m))))+"/"+alltrim(str(day(weekact(sdt))))+"/"+alltrim(str(year(addmonths(sdt,m))))))+6
End If
elseif T1.months>0.and.T1.months<25.and.T1.repeat=5 then
dim m as n
m=T1.months
sdt=endofmonth(addmonths(sdt,m))
else
sdt=addmonths(sdt,1)
end if
newdate=sdt
next
statusbar.clear()
end
end select
END
ax_error_trap:
ax_error_trap_msg = "Trapped error in action command: [" +
ax_error_trap_offset + "] " + chr(13) + chr(13) + "Command:
" + ax_error_trap_desc + chr(13) + "Error: " + error_text_get()
ax_error_trap_response = ui_msg_box("Action Program Error",
ax_error_trap_msg, 2)
IF ax_error_trap_response = 4 THEN Retry
RESUME 0
ELSEIF ax_error_trap_response = 5 THEN Ignore
RESUME NEXT
ELSE Abort
END
END IF
****
**** End
You will see that the scripts call new functions that I had to design for this application. They will be included on the download. If the user changes the appointment I need to erase the old appointment. Here is the code for that:
Script Schedule Main
''XBasic
option strict
dim shared newdate as d
dim rec as n
dim recs as n
dim shared days as n
dim shared ta as p
dim shared t as p
dim shared t1 as p
dim shared ts as p
dim shared frm as p
dim No as c
dim no2 as c
dim Num as n
dim num2 as n
dim filenameN as n
dim filenameM as c
dim filename as c
dim filename1 as c
dim filename2 as c
dim filename3 as c
dim filename4 as c
dim fieldobj as p
dim fieldobj1 as p
dim fieldobj2 as p
dim fieldobj3 as p
dim fieldobj4 as p
dim rec as n
dim nbr as c
dim h as n
dim i as n
dim j as n
dim k as n
dim l as n
dim m as n
dim cu as c
dim nme as c
dim cus as c
dim tme as c
dim timevalue as c
dim name as c
dim comp as c
dim sdt as d
dim edt as d
dim durat as n
DIM SHARED A AS N
dim record_data as b
dim mode as c
dim tmend as c
dim numb as n
dim m as n
t1=table.current()
numb=t1.recno()
m=old_months
sdt=old_date
for l=1 to 31
sdt=old_date
t1.index_primary_put("")
t1.fetch_find(numb)
cu="old_cus"+alltrim(str(l))
'fieldobj=obj(cu)
'filenameN=eval(fieldobj)
if eval(cu)=1 .and.sdt< old_edate then
if
sdt>=ctod(alltrim(str(month(sdt)))+"/"+alltrim(str(l))+"/"+alltrim(str(year(sdt))))
then
sdt=ctod(alltrim(str(month(addmonths(t1.sdate,m))))+"/"+alltrim(str(l))+"/"+alltrim(str(year(addmonths(t1.sdate,m)))))
else
sdt=ctod(alltrim(str(month(t1.sdate)))+"/"+alltrim(str(l))+"/"+alltrim(str(year(t1.sdate))))
end if
for h= 1 to 180
if sdt<old_edate then
dim ts1 as p
dim no1 as c
dim tme1 as c
select
case dow(sdt)=1
ts1=table.open("scheduler6")
case dow(sdt)=2
ts1=table.open("scheduler")
case dow(sdt)=3
ts1=table.open("scheduler1")
case dow(sdt)=4
ts1=table.open("scheduler2")
case dow(sdt)=5
ts1=table.open("scheduler3")
case dow(sdt)=6
ts1=table.open("scheduler4")
case dow(sdt)=7
ts1=table.open("scheduler5")
end select
ts1.index_primary_put("D1")
No1=TimeName(old_time)
comp=old_company
nme=old_rep
timeValue=old_time
durat=old_duration
tmend = totime(toseconds(old_time)+(60*old_duration),11,0)
no2=timename(tmend)
tme1=old_time
rec=ts1.RECORDS_GET()
recs=ts1.FETCH_FIND(sdt)
iF rec>0 ThEN
if recs>0 then
ts1.change_begin()
filename="N"+No1
fieldobj=ts1.field_get(filename)
fieldobj.blank_put()
num=val(No1)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts1.field_get(filename3)
tme1=fieldobj3.value_get()
If
old_priority="h".and.between(toseconds(tme1),toseconds(old_time),toseconds(old_time)+(60*(old_duration)-1))
then
fieldobj=ts1.field_get(filename)
fieldobj.blank_put()
end if
If
old_priority="m".and.between(toseconds(tme1),toseconds(old_time),toseconds(old_time)+(60*(old_duration)-1))
then
fieldobj1=ts1.field_get(filename1)
fieldobj1.blank_put()
end if
If
old_priority="l".and.between(toseconds(tme1),toseconds(old_time),toseconds(old_time)+(60*(old_duration)-1))
then
fieldobj2=ts1.field_get(filename2)
fieldobj2.blank_put()
end if
next i
ts1.change_end(.t.)
end if
end if
ta=table.open("activities")
ta.index_primary_put("reptime")
recs=ta.fetch_find(alltrim(comp)+alltrim(nme)+cdate(sdt)+alltrim(timeValue))
if recs>0 then
ta.change_begin()
ta.regarding="Appointment has been cancelled or changed
"+dtoc(date())
ta.change_end(.t.)
end if
ta.close()
t1.index_primary_put("Activity")
recs=t1.FETCH_FIND(cdate(sdt)+cdate(old_date)+alltrim(nme)+alltrim(comp)+alltrim(timevalue))
if recs>0 then
t1.change_begin()
t1.delete()
t1.change_end(.t.)
end if
sdt=addmonths(sdt,m)
end if
next h
end if
next l
Now I must schedule new appointments. Here is the code for that
ScheduleMain1
''XBasic
option strict
dim shared newdate as d
dim rec as n
dim recs as n
dim shared days as n
dim shared ta as p
dim shared t as p
dim shared t1 as p
dim shared ts as p
dim shared frm as p
dim No as c
dim no2 as c
dim Num as n
dim num2 as n
dim filenameN as n
dim filenameM as c
dim filename as c
dim filename1 as c
dim filename2 as c
dim filename3 as c
dim filename4 as c
dim fieldobj as p
dim fieldobj1 as p
dim fieldobj2 as p
dim fieldobj3 as p
dim fieldobj4 as p
dim rec as n
dim nbr as c
dim h as n
dim i as n
dim j as n
dim k as n
dim l as n
dim m as n
dim cu as c
dim nme as c
dim cus as c
dim tme as c
dim timevalue as c
dim name as c
dim comp as c
dim sdt as d
dim edt as d
dim durat as n
DIM SHARED A AS N
dim record_data as b
dim mode as c
dim tmend as c
dim m as n
dim numb as n
t1=table.current()
numb=t1.recno()
m=t1.months
newdate=t1.sdate
sdt=newdate
nme=frm:rep1.text
timeValue=frm:time0.value
durat=frm:duration0.value
No=TimeName(frm:time0.text)
tmend = totime(toseconds(frm:time0.text)+(60*frm:duration0.value),11,0)
no2=timename(tmend)
for l=1 to 31
t1.index_primary_put()
t1.fetch_find(numb)
sdt=t1.sdate
cu="cus"+alltrim(str(l))
fieldobj=t1.field_get(cu)
filenameN=fieldobj.value_get()
if filenameN=1 .and.sdt< t1.edate then
if
sdt>=ctod(alltrim(str(month(sdt)))+"/"+alltrim(str(l))+"/"+alltrim(str(year(sdt))))
then
sdt=ctod(alltrim(str(month(addmonths(t1.sdate,m))))+"/"+alltrim(str(l))+"/"+alltrim(str(year(addmonths(t1.sdate,m)))))
else
sdt=ctod(alltrim(str(month(t1.sdate)))+"/"+alltrim(str(l))+"/"+alltrim(str(year(t1.sdate))))
end if
for h = 1 to 180
statusbar.robot()
newdate=sdt
If newdate>t1.edate then
goto start
End If
If h = 1 then
else
k=t1.recno()
t1.index_primary_put("Activity")
recs=t1.FETCH_FIND(cdate(newdate)+cdate(frm:edate.value)+alltrim(nme)+alltrim(comp)+alltrim(timevalue))
if recs>0 then
t1.change_begin()
t1.duration=durat
t1.type=frm:type0.text
t1.priority=frm:PRIORITY0.text
t1.note="changed appointment"=dtoc(date())+"
"+frm:note1.text
t1.change_end(.t.)
else
t1.index_primary_put("")
t1.fetch_find(k)
record_data=t1.record_data_get()
t1.enter_begin()
t1.record_data_set(record_data)
t1.enter_end(.t.)
t1.change_begin()
t1.sdate=newdate
t1.change_end(.t.)
end if
end if
select
case dow(Newdate)=1
ts=table.open("scheduler6")
case dow(Newdate)=2
ts=table.open("scheduler")
case dow(Newdate)=3
ts=table.open("scheduler1")
case dow(Newdate)=4
ts=table.open("scheduler2")
case dow(Newdate)=5
ts=table.open("scheduler3")
case dow(Newdate)=6
ts=table.open("scheduler4")
case dow(Newdate)=7
ts=table.open("scheduler5")
end select
rec=ts.RECORDS_GET()
iF rec>0 ThEN
ts.index_primary_put("D1")
recs=ts.FETCH_FIND(sdt)
if recs>0 then
If frm:priority0.value="h" then
If overbook(sdt,timeValue,durat,ts)=.t. then
end
end if
end if
ts.change_begin()
ts.rep=nme
ts.time=timeValue
ts.d1=newdate
ts.priority=frm:priority0.text
ts.frequency=durat
ts.company=comp
filename="N"+No
fieldobj=ts.field_get(filename)
name=fieldobj.value_get()
'fieldobj.value_put(f:filename.text+ " "+frm:salesman0.text+"
"+frm:Note1.text+" "+frm:type0.text)
fieldobj.value_put(alltrim(name)+ " "+frm:salesman0.text+"
"+frm:type0.text)
num=val(No)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts.field_get(filename3)
tme=fieldobj3.value_get()
If
frm:priority0.text="h".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj=ts.field_get(filename)
fieldobj.value_put("B")
end if
If
frm:priority0.text="m".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj1=ts.field_get(filename1)
fieldobj1.value_put("R")
end if
If
frm:priority0.text="l".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj2=ts.field_get(filename2)
fieldobj2.value_put("Y")
end if
next j
ts.change_end(.t.)
else
ts.enter_begin()
ts.rep=nme
ts.time=timeValue
ts.d1=newdate
ts.priority=frm:priority0.text
ts.frequency=durat
ts.company=frm:group1.text
filename="N"+No
fieldobj=ts.field_get(filename)
name=fieldobj.value_get()
'fieldobj.value_put(f:filename.text+ " "+frm:salesman0.text+"
"+frm:Note1.text+" "+frm:type0.text)
fieldobj.value_put(alltrim(name)+ " "+frm:salesman0.text+"
"+frm:type0.text)
num=val(No)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts.field_get(filename3)
tme=fieldobj3.value_get()
If
frm:priority0.text="h".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj=ts.field_get(filename)
fieldobj.value_put("B")
end if
If
frm:priority0.text="m".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj1=ts.field_get(filename1)
fieldobj1.value_put("R")
end if
If
frm:priority0.text="l".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj2=ts.field_get(filename2)
fieldobj2.value_put("Y")
end if
next j
ts.enter_end(.t.)
end if
else
ts.enter_begin()
ts.rep=nme
ts.time=timeValue
ts.d1=newdate
ts.priority=frm:priority0.text
ts.frequency=durat
ts.company=comp
filename="N"+No
fieldobj=ts.field_get(filename)
name=fieldobj.value_get()
'fieldobj.value_put(f:filename.text+ " "+frm:salesman0.text+"
"+frm:Note1.text+" "+frm:type0.text)
fieldobj.value_put(alltrim(name)+ " "+frm:salesman0.text+"
"+frm:type0.text)
num=val(No)-1
num2= val(no2)
dim j as n
j=(num2)-(num)
for i=1 to j
filename="A"+alltrim(str(num+i)) 'blue p=h
filename1="B"+alltrim(str(num+i)) 'red p=m
filename2="C"+alltrim(str(num+i)) 'yellow p=l
filename3="T"+alltrim(str(num+i)) 'Time var
fieldobj3=ts.field_get(filename3)
tme=fieldobj3.value_get()
If
frm:priority0.text="h".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj=ts.field_get(filename)
fieldobj.value_put("B")
end if
If
frm:priority0.text="m".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj1=ts.field_get(filename1)
fieldobj1.value_put("R")
end if
If
frm:priority0.text="l".and.between(toseconds(tme),toseconds(frm:time0.text
),toseconds(frm:time0.text)+(60*val(frm:duration0.text)-1)) then
fieldobj2=ts.field_get(filename2)
fieldobj2.value_put("Y")
end if
next j
ts.enter_end(.t.)
end if
ta=table.open("Activities")
rec=ta.records_get()
if rec<1 then
ta.enter_begin()
ta.rep=nme
ta.regarding=FRM:note1.TEXT
ta.date=newdate
ta.time=timeValue
ta.priority=ts.priority
ta.frequency=durat
ta.company=comp
ta.enter_end(.t.)
else
ta.index_primary_put("reptime")
recs=ta.fetch_find(alltrim(comp)+alltrim(nme)+cdate(sdt)+alltrim(timeValue))
if recs>0 then
ta.change_begin()
ta.company=comp
ta.rep=nme
ta.time=timeValue
ta.regarding="CHANGED this appointment"+dtoc(DATE())+"
"+FRM:NOTE1.TEXT
ta.date=newdate
ta.priority=ts.priority
ta.frequency=durat
ta.change_end(.t.)
else
ta.enter_begin()
ta.rep=nme
ta.regarding=FRM:note1.TEXT
ta.date=Newdate
ta.time=timeValue
ta.priority=ts.priority
ta.frequency=durat
ta.company=comp
ta.enter_end(.t.)
end if
end if
ts.close()
TA.CLOSE()
sdt=addmonths(sdt,m)
next
end if
start:
next l
end
Now you have it the scripts etc. I must admit this has been revised four or five times and I am still not perfectly satisfied because it is still slow and bouncy. The update process takes between 7 and 15 seconds and the form updates in 5 seconds as you change dates.
The beauty of such a form is the ease of including all the data into your tables. You have a nice visual representation of all the appointments plus a calendar printout to start with. All the functions are called out and included. All you have to do is show us how to speed this up. Are you up to the task? I hope this will be a great tool for your toolbox and I trust it will speed your development process.
2/19/00
Don't forget, we need your feedback to make this site better!