rem 12/13/86 common used for terminal characteristics
common today$,warm$,trmtyp$,clear$,bell$,clreol$
common escape$,poscmd$,posofs%,rowcol$
rem - program AGGENDAS.BAS
rem - copyright 1982, by Peter C. Hawxhurst
rem - revised 11/14/1982
rem - variable tabulation ************************
rem   a$       = appointment file field
rem   appoint$ = appointment input
rem   check$   = time check variable
rem   command$ = user command
rem   d        = number of day in week
rem   d$       = file date field
rem   d1$      = month of file date field
rem   d2$      = day of file date field
rem   date0$    = transaction date
rem   date1$   = month of transaction date
rem   date2$   = day of transaction date
rem   day$     = logical day of week
rem   f        = factor for determining d
rem   i%       = for/next loop counter
rem   m$       = number of logical month
rem   month$   = logical month of year
rem   p1       = day for determining d from date0$
rem   p2       = month for   "       "   "   "
rem   p3       = year for    "       "   "   "
rem   q$       = continue input dummy
rem   q1$      = printout question input
rem   q2$      = continue search input
rem   s1       = end switch
rem   s2       = first pass switch
rem   s3       = executed switch
rem   s4       = change found/error switch
rem   s5       = file pass thru stop switch
rem   search%  = search counter
rem   spot%    = cursor spotting point
rem   t$       = file time field
rem   t1$      = time to be changed/deleted
rem   t2$      = time to be matched
rem   time0$   = appointment times available
rem   x%       = dummy value for file rename
rem   xpos%    = horizontal cursor location
rem   ypos%    = vertical cursor location
rem - program structure **************************
gosub 100 : rem - housekeeping
10 if s1=1 then 20
gosub 200 : rem - process
goto 10
20 gosub 300 : rem - end of job
%chain 100,10000,50,500
print clear$
chain "HANDYSYS.COM" : rem - needed by CB80
100 rem - housekeeping subroutine ****************
let s2=1
date0$=today$
open "APPOINTS.DAT" as 1
if end #1 then 120
read #1;d$,t$,a$
120 return
200 rem - process subroutine *********************
if s2=1 then gosub 500 : rem - screen
210 s2=0:s3=0:gosub 600 : rem - cursor 1
print bell$;
print "> ";
while not constat%:wend:cmnd$=ucase$(chr$(conchar%))
ypos%=51-31:xpos%=77-31:gosub 14000
if cmnd$="" then print bell$;
if cmnd$="" then 210
cmnd$=ucase$(cmnd$)
if cmnd$="A" then gosub 700 : rem - add
if cmnd$="N" then gosub 800 : rem - change
if cmnd$="D" then gosub 900 : rem - delete
if cmnd$="E" then s1=1
if cmnd$="E" then 220
if cmnd$="F" then gosub 1000 : rem - future
if cmnd$="P" then gosub 2500 : rem - printout 2
if cmnd$="R" then gosub 2600 : rem - reschedule
if cmnd$="S" then gosub 2700 : rem - search
if s3=1 then 220
gosub 1100 : rem - bell:goto 210
220 return
300 rem - end of job subroutine ******************
close 1
print clear$
return
500 rem - screen subroutine **********************
gosub 1700 : rem - day
gosub 1800 : rem - month
print clear$
gosub 16000: rem - tone on
print tab(2);" AGENDA for ";:gosub 18000:rem - tone off
print day$;", ";month$;val(mid$(date0$,4,2));"- ";
print right$(date0$,4):gosub 16000:rem - tone on
print:print
for i%=1 to 6
read time0$
if len(time0$)>4 then 510
print tab(3);time0$
goto 520
510 print tab(2);time0$
520 print tab(4);":30"
next i%
530 for i%=1 to 6
read time0$
ypos%=34-31+2*i%:xpos%=59-31:gosub 15000
print time0$
ypos%=35-31+2*i%:xpos%=60-31:gosub 15000
print ":30"
next i%
restore
ypos%=49-31:xpos%=33-31:gosub 15000
for i%=1 to 49:print "-";:next i%:print
print tab(2);"(A)dd";tab(9);"(D)elete";
print tab(19);"(E)xit";tab(26);"(F)uture";
print tab(36);"(N)ext day";
print tab(2);"(P)rintout";tab(14);"(R)eschedule";
print tab(28);"(S)earch for entry"
gosub 18000 : rem tone off
gosub 2000 : rem - post
return
600 rem - cursor 1 subroutine ********************
ypos%=51-31:xpos%=78-31:gosub 14000
ypos%=51-31:xpos%=78-31:gosub 15000
return
700 rem - add subroutine *************************
710 if end #1 then 720
read #1;d$,t$,a$
goto 710
720 gosub 1300 : rem - cursor 2
input "Enter appointment time >";line t$
if t$="" then print bell$;
if t$="" then 720
if t$=escape$ then 740
check$=t$
gosub 1900 : rem - check time
if e1=0 then 725
gosub 1100:goto 720
725 gosub 2400 : rem - check exist
if e1=0 then 730
goto 720
730 gosub 1300 : rem - cursor 2
input "Enter name/reason >";line a$
if a$="" then print bell$;
if a$="" then 730
if a$=escape$ then 740
if len(a$)<19 then 735
gosub 1100 : rem - bell
gosub 1300 : rem - cursor 2
print bell$;
input "Only space for 18 characters. Press - RETURN >"; line q$
goto 730
735 gosub 2100 : rem - post 2
print #1;date0$,t$,a$
740 close 1
open "APPOINTS.DAT" as 1
gosub 1300 : rem - cursor 2
s3=1
return
800 rem - next subroutine **********************
nd$=str$(val(mid$(date0$,4,2))+1)
if val(nd$)<10 then nd$="0"+str$(val(mid$(date0$,4,2))+1)
future$=left$(date0$,3)+nd$+right$(date0$,5)
date0$=future$
gosub 10000 : rem - date check
if e1=0 then 820
nd$="01"
nm$=str$(val(left$(date0$,2))+1)
if val(nm$)<13 then 810
nm$="01"
ny$=str$(val(right$(date0$,4))+1)
date0$=nm$+"/"+nd$+"/"+ny$
goto 820
810 future$=nm$+"/"+nd$+right$(date0$,5)
date0$=future$
820 gosub 1020 : rem - future
return
900 rem - delete subroutine **********************
910 gosub 1300 : rem - cursor 2
input "Enter time of appointment to delete >";line t1$
if t1$="" then print bell$;
if t1$="" then 910
if t1$=escape$ then 995
check$=t1$
gosub 1900 : rem - check time
if e1=0 then 920
gosub 1100:goto 910
920 create "TRANS" as 2
930 close 1
open "APPOINTS.DAT" as 1
940 if end #1 then 970
read #1;d$,t$,a$
if d$=date0$ then 960
950 print #2;d$,t$,a$
goto 940
960 if t1$=t$ then s4=1
if t1$=t$ then 940
goto 950
970 delete 1
close 2
x%=rename("APPOINTS.DAT","TRANS")
if s4=1 then 980
gosub 1100 : rem - bell
gosub 1300 : rem - cursor 2
input "Appointment does not exist; press - RETURN >";line q$
goto 990
980 gosub 2200 : rem - unpost 1
990 open "APPOINTS.DAT" as 1
995 gosub 1300 : rem - cursor 2
s3=1
s4=0
return
1000 rem - future subroutine *********************
1010 gosub 1300 : rem - cursor 2
input "Enter future date as MM/DD/YYYY >";line date0$
if date0$="" then print bell$;
if date0$="" then 1010
if date0$=escape$ then 1030
gosub 10000 : rem - date check
if e1=0 then 1020
gosub 1100: goto 1010
1020 close 1
open "APPOINTS.DAT" as 1
gosub 2300 : rem - unpost 2
ypos%=33-31:xpos%=45-31:gosub 14000
gosub 1700 : rem - day
gosub 1800 : rem - month
ypos%=33-31:xpos%=45-31:gosub 15000
print day$;", ";month$;val(mid$(date0$,4,2));"- ";right$(date0$,4)
gosub 2000 : rem - post 1
1030 gosub 1300 : rem - cursor 2
s3=1
return
1100 rem - bell subroutine ***********************
print bell$
return
1200 rem - create trans subroutine
create "TRANS" as 1
close 1
return
1300 rem - cursor 2 subroutine *******************
ypos%=53-31:xpos%=33-31:gosub 14000
ypos%=53-31:xpos%=33-31:gosub 15000
return
1700 rem - day subroutine ************************
p1$=left$(date0$,2):p2$=mid$(date0$,4,2)
p3$=right$(date0$,4)
p1=val(p1$):p2=val(p2$):p3=val(p3$)
if p1>2 then 1710
f=365*p3+p2+31*(p1-1)+int((p3-1)/4)-int(.75*int((p3-1)/100)+1)
goto 1720
1710 f=365*p3+p2+31*(p1-1)-int(.4*p1+2.3)+int(p3/4)-int(.75*(int(p3/100)+1))
1720 d=f-(int(f/7)*7)
if d=0 then let day$="Saturday"
if d=1 then let day$="Sunday"
if d=2 then let day$="Monday"
if d=3 then let day$="Tuesday"
if d=4 then let day$="Wednesday"
if d=5 then let day$="Thursday"
if d=6 then let day$="Friday"
return
1800 rem - month subroutine **********************
let m$=left$(date0$,2)
if val(m$)=1 then let month$="January"
if val(m$)=2 then let month$="February"
if val(m$)=3 then let month$="March"
if val(m$)=4 then let month$="April"
if val(m$)=5 then let month$="May"
if val(m$)=6 then let month$="June"
if val(m$)=7 then let month$="July"
if val(m$)=8 then let month$="August"
if val(m$)=9 then let month$="September"
if val(m$)=10 then let month$="October"
if val(m$)=11 then let month$="November"
if val(m$)=12 then let month$="December"
return
1900 rem - check time subroutine *****************
e1=0
for i%=1 to 13
read time0$
if time0$=check$ then let i%=13
if check$=left$(time0$,2)+":30" then let i%=13
if check$=left$(time0$,1)+":30" then let i%=13
next i%
if time0$="END" then let e1=1
restore
return
2000 rem - post 1 subroutine *********************
2010 if a$="Today's date" then 2015
if d$=date0$ then 2020
2015 if end #1 then 2060
read #1;d$,t$,a$
goto 2010
2020 for i%=1 to 12
read time0$
if t$=time0$ then 2040
if len(t$)=5 then 2030
if len(time0$)<5 and t$=left$(time0$,1)+":30" then 2040
goto 2050
2030 if t$=left$(time0$,2)+":30" then 2040
goto 2050
2040 if right$(t$,3)=":30" then ypos%=35-31+2*i%
if right$(t$,3)=":00" then ypos%=34-31+2*i%
2050 next i%
restore
if ypos%>47-31 then ypos%=ypos%-12
if val(left$(t$,2))<7 then xpos%=64-31
if val(left$(t$,2))>=7 then xpos%=39-31
gosub 15000
print a$
goto 2015
2060 return
2100 rem - post 2 subroutine *********************
for i%=1 to 12
read time0$
if t$=time0$ then 2120
if len(t$)=5 then 2110
if len(time0$)<5 and t$=left$(time0$,1)+":30" then 2120
goto 2130
2110 if t$=left$(time0$,2)+":30" then 2120
goto 2130
2120 if right$(t$,3)=":00" then ypos%=34-31+2*i%
if right$(t$,3)=":30" then ypos%=35-31+2*i%
i%=12
2130 next i%
restore
if ypos%>47-31 then let ypos%=ypos%-12
if val(left$(t$,2))<7 then xpos%=64-31
if val(left$(t$,2))>=7 then xpos%=39-31
gosub 15000
print a$
return
2200 rem - unpost 1 subroutine *******************
let a$="                   "
t$=t1$
gosub 2100
return
2300 rem - unpost 2 subroutine *******************
for i%=1 to 12
ypos%=35-31+i%
xpos%=39-31
gosub 15000
print "                   "
next i%
for i%=1 to 12
ypos%=35-31+i%
xpos%=64-31
gosub 15000
print "                 "
next i%
return
2400 rem - check exist subroutine ******************
e1=0
close 1
open "APPOINTS.DAT" as 1
2410 if end # 1 then 2430
read #1;d$,t1$,a$
if d$=date0$ then 2420
goto 2410
2420 if t$=t1$ then 2425
goto 2410
2425 gosub 1100 : rem - bell
gosub 1300 : rem - cursor 2
input "Overlaps another appointment; press - RETURN >";line q$
e1=1
2430 return
2500 rem - printout 2 subroutine *****************
gosub 1300 : rem - cursor 2
input "Ready printer and press - RETURN >";line q$
if q$=escape$ then 2570
lprinter
print
print
print tab(10);"APPOINTMENTS for ";day$;", ";month$;
print val(mid$(date0$,4,2));"- ";right$(date0$,4)
print
close 1
open "APPOINTS.DAT" as 1
for i%=1 to 12
read time0$
2505 print tab(15-len(time0$));time0$;
2510 if end #1 then 2520
goto 2530
2520 close 1
open "APPOINTS.DAT" as 1
if s5=1 then print
if s5=1 then 2555
s5=1
2530 read #1;d$,t$,a$
if d$=date0$ then 2540
goto 2510
2540 if t$=time0$ then 2550
goto 2510
2550 print tab(20);a$
2555 if right$(time0$,3)=":30" then 2560
if len(time0$)=4 then time0$=left$(time0$,1)+":30"
if len(time0$)=5 then time0$=left$(time0$,2)+":30"
s5=0
goto 2505
2560 s5=0
next i%
restore
console
2570 gosub 1300 : rem - cursor 2
s3=1
return
2600 rem - reschedule subroutine *****************
2610 gosub 1300 : rem - cursor 2
input "Enter time to be rescheduled >";line t1$
if t1$="" then print bell$;
if t1$="" then 2610
if t1$=escape$ then 2680
check$=t1$
gosub 1900 : rem - check time
if e1=0 then 2620
gosub 1100 : rem - bell
goto 2610
2620 close 1
open "APPOINTS.DAT" as 1
2630 if end #1 then 2650
read #1;d$,t$,a$
if d$=date0$ then 2640
goto 2630
2640 if t$=t1$ then 2660
goto 2630
2650 gosub 1100 : rem - bell
gosub 1300 : rem - cursor 2
input "Appointment does not exist; press - RETURN >";line q$
goto 2610
2660 gosub 920 : rem - delete
2665 gosub 1300 : rem - cursor 2
input "Enter reschedule date as MM/DD/YYYY >";line date0$
if date0$="" then print bell$;
if date0$="" then 2665
if date0$=escape$ then 2680
gosub 10000 : rem - date check
if e1=0 then 2670
gosub 1100:goto 2665
2670 gosub 1020 : rem - future
gosub 700 : rem - add
2680 return
2700 rem - search subroutine *********************
2710 gosub 1300 : rem - cursor 2
input "Enter key word for search >";line appoint$
if appoint$="" then print bell$;
if appoint$="" then 2710
if appoint$=escape$ then 2750
if len(appoint$)<19 then 2720
gosub 1100 : rem - bell
gosub 1300 : rem - cursor 2
input "Only 18 characters please; press - RETURN >";line q$
goto 2710
2720 close 1
search%=0 : rem - initialize search counter...
open "APPOINTS.DAT" as 1
2730 if end #1 then 2740
read #1;d$,t$,a$
if match(ucase$(appoint$),ucase$(a$),1)=0 then 2730
date0$=d$
gosub 1020
search%=search%+1
2735 gosub 1300 : rem - cursor 2
print "Continue search (y/n) > ";
while not constat%:wend:q2$=ucase$(chr$(conchar%))
if q2$="" then print bell$;
if q2$="" then 2735
if q2$=escape$ then 2750
q2$=ucase$(q2$)
if q2$<>"Y" and q2$<>"N" then gosub 1100
if q2$<>"Y" and q2$<>"N" then 2735
if q2$="N" then 2750
close 1
open "APPOINTS.DAT" as 1
for i%=1 to search%
2736 if end #1 then 2738
goto 2737
2738 i%=search%:goto 2739
2737 read #1;d$,t$,a$
if match(ucase$(appoint$),ucase$(a$),1)>0 then 2739
goto 2736
2739 next i%
goto 2730
2740 gosub 1100 : rem - bell
gosub 1300 : rem - cursor 2
input "Match not found; press - RETURN >";line q$
2750 gosub 1300 : rem - cursor 2
return
10000 rem - date check subroutine ******************
10010 rem
10020 rem - variables to check
10030 rem   date0$ = date being checked
10040 rem   e1    = error switch
10050 rem   i%    = for/next loop counter
10060 rem   p$    = substitute for date to be checked
10070 rem   p1$   = month
10080 rem   p2$   = day
10090 rem   p3$   = year
10100 rem   x     = numeric counter
10110 rem
10120 e1=0 
10130 p$=date0$ 
10140 if len(p$)>10 then 10340
10150 x=0
10160 for i%=1 to 10:x=x+match("#",p$,i%):next i%
10170 if x<>57 then 10340
10180 p1$=left$(p$,2):p2$=mid$(p$,4,2):p3$=right$(p$,4)
10190 if val(p1$)<1 then 10340
10200 if val(p1$)>12 then 10340
10210 if val(p2$)<1 then 10340
10215 if val(p2$)>31 then 10340
10220 if val(p3$)<1 then 10340
10230 if val(p1$)<>int(val(p1$)) then 10340
10240 if val(p2$)<>int(val(p2$)) then 10340
10250 if val(p3$)<>int(val(p3$)) then 10340
10260 if val(p1$)=9 and val(p2$)>30 then 10340
10270 if val(p1$)=4 and val(p2$)>30 then 10340
10280 if val(p1$)=6 and val(p2$)>30 then 10340
10290 if val(p1$)=11 and val(p2$)>30 then 10340
10300 if val(p1$)=2 and val(p2$)>29 then 10340
10310 if val(p3$)/4=int(val(p3$)/4) then 10350
10320 if val(p1$)=2 and val(p2$)>28 then 10340
10330 goto 10350
10340 let e1=1
10350 return
14000 rem - rubout subroutine ********************
14010 gosub 15000
14020 print clreol$;:gosub 15000
14030 return
15000 rem - cursor subroutine ********************
15020 rem - variables to check
15030 rem   xpos% = horizontal cursor position (1-52, L to R)
15040 rem   ypos% = vertical cursor position (1-24, T to B)
15060 if rowcol$=chr$(01) then 15090
15070 print poscmd$+chr$(xpos%+posofs%-1)+chr$(ypos%+posofs%-1);
15080 go to 15100
15090 print poscmd$+chr$(ypos%+posofs%-1)+chr$(xpos%+posofs%-1);
15100 return
16000 rem - tone on subroutine *******************
16020 return
18000 rem - tone off subroutine ******************
18020 return
data "7:00","8:00","9:00","10:00","11:00","12:00"
data "1:00","2:00","3:00","4:00","5:00","6:00","END"