100 'Appointment Calendar
110 ' by Jim Hunter 1/88
115 ' Feel free to change any part of this program except the statements telling who wrote the program.
120 'STOP KEY OFF
130 DEFINT A-Z
140 DIM RECORD(10)
150 ON ERROR GOTO 1420
160 OPEN "R",#1,"appts.dat",46
170 FIELD #1,2 AS MO$, 2 AS DY$, 2 AS YR$,40 AS MSG$
180 NORECS=LOF(1)
190 GOSUB 1330
200 SCREEN 0,0,0:WIDTH 80,40,8
210 CLS:PRINT TAB(29)"Appointment Calendar"
215 PRINT TAB(33)"by Jim Hunter"
220 PRINT:PRINT TAB(29)"(1)  Inquiry"
230 PRINT TAB(29)"(2)  Enter Data"
240 PRINT TAB(29)"(3)  Delete an Entry"
250 PRINT TAB(29)"(4)  Quit"
260 GOSUB 1440
270 A=VAL(A$):IF A<1 OR A>4 THEN 260
280 IF A=4 THEN CLOSE #1:PRINT"End.":STOP KEY ON:SYSTEM
290 ON A GOSUB 310,920,1120
300 GOTO 210
310 'Inquiry
320 CLS
330 PRINT TAB(35)"Inquiry"
340 PRINT:PRINT TAB(19)"<RETURN> = Display Today's Appointments"
350 PRINT TAB(26)"T = Display Tomorrow's Appointments"
360 PRINT TAB(26)"F = Display All Future Appointments"
370 PRINT TAB(26)"M = Return to Main Menu"
380 GOSUB 1440
390 IF A$=CHR$(13) THEN A=1
400 IF A$="T" THEN A=2
410 IF A$="F" THEN A=3
420 IF A$="M" THEN RETURN
430 ON A GOSUB 450,590,810
440 GOSUB 1490:GOTO 320
450 'Display today's appointments
460 TMO=VAL(LEFT$(DATE$,2))
470 TDY=VAL(MID$(DATE$,4,2))
480 TYR=VAL(RIGHT$(DATE$,2))
490 CLS:PRINT"Output to printer (Y/N)":GOSUB 1440:LP$=A$:CLS
500 FOR X=1 TO NORECS
510 GET #1,X
520 FMO=CVI(MO$)
530 FDY=CVI(DY$)
540 FYR=CVI(YR$)
550 GOSUB 1520
560 IF FMO=TMO AND FDY=TDY AND FYR=TYR THEN PRINT OTPT$:IF LP$="Y" THEN LPRINT OTPT$
570 NEXT X
580 RETURN
590 'Display tomorrow's appointments
600 TMO=VAL(LEFT$(DATE$,2))
610 TDY=VAL(MID$(DATE$,4,2))
620 TYR=VAL(RIGHT$(DATE$,2))
630 TDY=TDY+1
640 IF TDY=29 AND TMO=2 AND INT(TYR/4)*4<>TYR THEN TMO=3:TDY=1
650 IF TDY=30 AND TMO=2 THEN TMO=3:TDY=1
660 IF TDY=31 AND (TMO=4 OR TMO=6 OR TMO=9 OR TMO=11) THEN TMO=TMO+1:TDY=1
670 IF TDY=32 THEN TMO=TMO+1:TDY=1
680 IF TMO=13 THEN TMO=1:TYR=TYR+1
690 IF TYR=100 THEN TYR=0
700 CLS:PRINT"Output to printer (Y/N)"
710 GOSUB 1440-LP$=A$:CLS
720 FOR X=1 TO NORECS
730 GET #1,X
740 FMO=CVI(MO$)
750 FDY=CVI(DY$)
760 FYR=CVI(YR$)
770 GOSUB 1520
780 IF FMO=TMO AND FDY=TDY AND FYR=TYR THEN PRINT OTPT$:IF LP$="Y" THEN LPRINT OTPT$
790 NEXT X
800 RETURN
810 'Display all future appointments
820 CLS:PRINT"Output to printer (Y/N)":GOSUB 1440:LP$=A$:CLS
830 FOR X=1 TO NORECS
840 GET #1,X
850 FMO=CVI(MO$)
860 FDY=CVI(DY$)
870 FYR=CVI(YR$)
880 GOSUB 1520
890 IF FMO<>100 THEN PRINT OTPT$:IF LP$="Y" THEN LPRINT OTPT$
900 NEXT X
910 RETURN
920 'Enter data
930 CLS
940 PRINT TAB(34)"Enter Data"
950 PRINT:INPUT"Enter date of appointment or <RETURN> to return to menu";A$:IF A$="" THEN RETURN
960 GOSUB 1540
970 LINE INPUT"Enter message (up to 40 characters)   ";A$
980 IF LEN(A$)>40 THEN BEEP:BEEP:PRINT"Message too long":GOTO 970
990 IF A$="" THEN BEEP:BEEP:GOTO 970
1000 FOR X=1 TO NORECS
1010 GET #1,X
1020 FMO=CVI(MO$)
1030 FDY=CVI(DY$)
1040 FYR=CVI(YR$)
1050 IF FYR>TYR OR (FYR=TYR AND FMO>TMO) OR (FYR=TYR AND FMO=TMO AND FDY>TDY) THEN REC=X:GOSUB 1640:GOTO 1080
1060 NEXT X
1070 REC=NORECS+1:NORECS=NORECS+1
1080 LSET MO$=MKI$(TMO):LSET DY$=MKI$(TDY):LSET YR$=MKI$(TYR)
1090 LSET MSG$=A$
1100 PUT #1,REC
1110 GOTO 950
1120 'Delete an entry
1130 CLS:PRINT TAB(31)"Delete an Entry"
1140 PRINT:INPUT"Enter date of appointment to be deleted (MONTH/DAY/YEAR)";A$
1150 GOSUB 1540
1160 PRINT"Searching ... please wait":ARRPTR=0
1170 FOR X=1 TO NORECS
1180 GET #1,X
1190 IF TMO=CVI(MO$) AND TDY=CVI(DY$) AND TYR=CVI(YR$) THEN ARRPTR=ARRPTR+1:RECORD(ARRPTR)=X
1200 NEXT X:CLS:IF ARRPTR=0 THEN PRINT"No appointments on that date":BEEP:FOR X=1 TO 1000:NEXT X:RETURN
1210 FOR X=1 TO ARRPTR
1220 GET #1,RECORD(X):FMO=CVI(MO$):FDY=CVI(DY$):FYR=CVI(YR$):GOSUB 1520
1230 PRINT X;OTPT$:NEXT X
1240 INPUT"Enter number of entry to delete or 0 for no change and press <RETURN>";REC:IF REC=0 THEN RETURN
1250 GET #1,RECORD(REC):GOSUB 1520
1260 PRINT REC;OTPT$
1270 PRINT"Delete this entry (Y/N)"
1280 GOSUB 1440
1290 IF A$<>"Y" THEN RETURN
1300 PRINT"Deleting ..."
1310 GOSUB 1690
1320 RETURN
1330 CLS:PRINT"Deleting old appointments ..."
1340 TMO=VAL(LEFT$(DATE$,2))
1350 TDY=VAL(MID$(DATE$,4,2))
1360 TYR=VAL(RIGHT$(DATE$,2))
1370 FOR X=NORECS TO 1 STEP -1
1380 GET #1,X
1390 IF (CVI(YR$)<TYR OR (CVI(YR$)=TYR AND CVI(MO$)<TMO) OR (CVI(YR$)=TYR AND CVI(MO$)=TMO AND CVI(DY$)<TDY)) AND LEFT$(MSG$,1)<>"*" THEN REC=1:RECORD(REC)=X:GOSUB 1690
1400 NEXT X
1410 RETURN
1420 IF ERR=24 THEN PRINT"Printer not ready -- printout aborted":BEEP:BEEP:LP$="N":FOR QQ=1 TO 1000:NEXT QQ:RESUME
1430 ON ERROR GOTO 0
1440 'Input a character and convert to uppercase
1450 A$=INKEY$
1460 IF A$="" THEN 1450
1470 IF A$>="a" AND A$<="z" THEN A$=CHR$(ASC(A$)-32)
1480 RETURN
1490 PRINT"Press any key to continue"
1500 GOSUB 1440
1510 RETURN
1520 OTPT$=RIGHT$(STR$(FMO),2)+"/"+RIGHT$(STR$(FDY),2)+"/"+RIGHT$(STR$(FYR),2)+"  "+MSG$
1530 RETURN
1540 S1=INSTR(A$,"/")
1550 S2=INSTR(S1+1,A$,"/")
1560 IF S1=0 AND S2=0 THEN 1610
1570 TMO=VAL(LEFT$(A$,S1-1))
1580 IF S2=0 THEN TDY=VAL(RIGHT$(A$,LEN(A$)-S1)) ELSE TDY=VAL(MID$(A$,S1+1,S2-S1-1))
1590 IF S2=0 THEN TYR=VAL(RIGHT$(DATE$,2)) ELSE TYR=VAL(RIGHT$(A$,LEN(A$)-S2))
1600 RETURN
1610 TMO=VAL(LEFT$(A$,2)):TDY=VAL(MID$(A$,3,2))
1620 IF LEN(A$)=4 THEN TYR=VAL(RIGHT$(DATE$,2)) ELSE TYR=VAL(RIGHT$(A$,2))
1630 RETURN
1640 FOR X=NORECS TO REC STEP -1
1650 GET #1,X
1660 IF CVI(MO$)<>100 THEN PUT #1,X+1
1670 NEXT X
1680 RETURN
1690 'Delete record #REC
1700 FOR Y=RECORD(REC) TO NORECS-1
1710 GET #1,Y+1:PUT #1,Y
1720 NEXT Y
1730 LSET MO$=MKI$(100):LSET DY$=MKI$(100):LSET YR$=MKI$(100):LSET MSG$="Deleted"
1740 PUT #1,NORECS
1750 RETURN
20 NEXT Y
1730 LSET MO$=MKI$(100):LSET DY$=MKI$(100):LSET YR$=MKI$(100):LSET