Compucolor.org – Virtual Media

Listing of file='DIARY.BAS;01' on disk='vmedia/chip_81-sector.ccvf'

0 REM KY 0 REM           S T A R T  O F  P R O G R A M
1 GOTO 4500
3 REM   GENERAL DATANAMES
5 REM  SN$ = SURNAME
10 REM AA$ = ADDRESS LINE 1
15 REM AB$ = ADDRESS LINE 2
20 REM AC$ = ADDRESS LINE 3
25 REM PC$ = POST CODE
30 REM TL$ = TELEPHONE NO.
40 REM MN$ = FAMILY MEMBER'S NAME (OCCURS 7)
50 REM MB$ = MEMBER'S BIRTHDAY (OCCURS 7)
60 REM LF  = LAST FAMILY RECORD NO. ON FILE
70 REM LP  = LAST PERSON RECORD NO. ON FILE
100 REM  SUBROUTINE  FIELD HANDLING SUBROUTINE
103
105 REM  X  = X CO-ORDINATE
110 REM  Y  = Y CO-ORDINATE
115 REM  ML = MAXIMUM INPUT LENGTH
120 REM  NA$= 'N' FOR NUMERIC OR 'A' FOR ALPHANUMERIC
125 REM  KB = KEYBOARD CHARACTER
130 REM  FI$=FINAL STRING
135 REM  SA = SCREEN ADDRESS OF FIELD
140
145 SA= 28672+ 128* Y+ X+ X:REM  SCREEN ADDRESS
150 ZZ= INT (SA/ 256):POKE 65524,SA- 256* ZZ:POKE 65525,ZZ
155 SA= SA- 2
160 POKE 65522,ASC (NA$):REM  ALPHANUMERIC OR NUMERIC
165 FI$= ""
170 PLOT 3,X,Y
175 KB= CALL (ML)
180 IF KB= 9OR PEEK (65521)= 0THEN RETURN
185 FOR I= 2TO PEEK (65521)* 2STEP 2
190 FI$= FI$+ CHR$ (PEEK (SA+ I)):NEXT I
195 RETURN
500
510 REM SUBROUTINE PUT UP MAIN SCREEN
520
530 PLOT 3,1,13:PRINT "ADDRESS  ";SPC( 29);"   POST"
540 PRINT SPC( 10);"";SPC( 29);"   CODE      TEL NUMBER"
550 PRINT SPC( 10);"";SPC( 29);"                        "
555 IF FU$= "M"THEN RETURN
560 PLOT 3,20,17:PRINT "CHRISTIAN NAME(S)        BIRTHDAY (DDMM)"
570 PLOT 3,0,19:PRINT  " FAMILY MEMBERS";
580 FOR I= 1TO 7
590 PRINT TAB( 15);"";I;" ";SPC( 21);"";TAB( 49);"";SPC( 4);""
600 PRINT
610 NEXT I
650 RETURN
700
710 REM CLEAR SCREEN SUBROUTINE
720 PLOT 3,0,10,6,1
730 FOR I= 1TO 22:PLOT 11,10:NEXT I
740 RETURN
750 REM SUBROUTINES TO PUT UP MONTH NAMES IN SPECIAL CHARACTERS
760 PRINT TAB( 22);"";J1$;" ";A1$;" ";N1$;" ";U1$;" ";A1$;" ";R1$;" ";Y1$;""
765 PRINT TAB( 22);"";J2$;" ";A2$;" ";N2$;" ";U2$;" ";A2$;" ";R2$;" ";Y2$;""
767 PLOT 6,CL,2,40,98,242,86,98,86,85,40,85,40,98,255
770 RETURN
780 PRINT TAB( 21);"";F1$;" ";E1$;" ";B1$;" ";R1$;" ";U1$;" ";A1$;" ";R1$;" ";Y1$;""
785 PRINT TAB( 21);"";F2$;" ";E2$;" ";B2$;" ";R2$;" ";U2$;" ";A2$;" ";R2$;" ";Y2$;""
790 PLOT 6,CL,2,38,98,242,90,98,90,85,38,85,38,98,255
795 RETURN
800 PRINT TAB( 25);"";M1$;" ";A1$;" ";R1$;" ";C1$;" ";H1$;""
805 PRINT TAB( 25);"";M2$;" ";A2$;" ";R2$;" ";C2$;" ";H2$;""
810 PLOT 6,CL,2,46,98,242,81,98,81,85,46,85,46,98,255
815 RETURN
820 PRINT TAB( 25);"";A1$;" ";P1$;" ";R1$;" ";I1$;" ";L1$;""
825 PRINT TAB( 25);"";A2$;" ";P2$;" ";R2$;" ";I2$;" ";L2$;""
830 PLOT 6,CL,2,46,98,242,81,98,81,85,46,85,46,98,255
835 RETURN
840 PRINT TAB( 28);"";M1$;" ";A1$;" ";Y1$;""
845 PRINT TAB( 28);"";M2$;" ";A2$;" ";Y2$;""
850 PLOT 6,CL,2,51,98,242,76,98,76,85,51,85,51,98,255
855 RETURN
860 PRINT TAB( 26);"";J1$;" ";U1$;" ";N1$;" ";E1$;""
865 PRINT TAB( 26);"";J2$;" ";U2$;" ";N2$;" ";E2$;""
870 PLOT 6,CL,2,48,98,242,77,98,77,85,48,85,48,98,255
875 RETURN
880 PRINT TAB( 26);"";J1$;" ";U1$;" ";L1$;" ";Y1$;""
885 PRINT TAB( 26);"";J2$;" ";U2$;" ";L2$;" ";Y2$;""
890 PLOT 6,CL,2,48,98,242,77,98,77,85,48,85,48,98,255
895 RETURN
900 PRINT TAB( 24);"";A1$;" ";U1$;" ";G1$;" ";U1$;" ";S1$;" ";T1$;""
905 PRINT TAB( 24);"";A2$;" ";U2$;" ";G2$;" ";U2$;" ";S2$;" ";T2$;""
907 PLOT 6,CL,2,43,98,242,85,98,85,85,43,85,43,98,255
910 RETURN
920 PRINT TAB( 19);"";S1$;" ";E1$;" ";P1$;" ";T1$;" ";E1$;" ";M1$;" ";B1$;" ";E1$;" ";R1$;""
925 PRINT TAB( 19);"";S2$;" ";E2$;" ";P2$;" ";T2$;" ";E2$;" ";M2$;" ";B2$;" ";E2$;" ";R2$;""
930 PLOT 6,CL,2,35,98,242,92,98,92,85,35,85,35,98,255
935 RETURN
940 PRINT TAB( 22);"";O1$;" ";C1$;" ";T1$;" ";O1$;" ";B1$;" ";E1$;" ";R1$;""
945 PRINT TAB( 22);"";O2$;" ";C2$;" ";T2$;" ";O2$;" "B2$;" ";E2$;" ";R2$;""
950 PLOT 6,CL,2,40,98,242,86,98,86,85,40,85,40,98,255
955 RETURN
960 PRINT TAB( 21);"";N1$;" ";O1$;" ";V1$;" ";E1$;" ";M1$;" ";B1$;" ";E1$;" ";R1$;""
965 PRINT TAB( 21);"";N2$;" ";O2$;" ";V2$;" ";E2$;" ";M2$;" ";B2$;" ";E2$;" ";R2$;""
970 PLOT 6,CL,2,38,98,242,90,98,90,85,38,85,38,98,255
975 RETURN
980 PRINT TAB( 21);"";D1$;" ";E1$;" ";C1$;" ";E1$;" ";M1$;" ";B1$;" ";E1$;" ";R1$;""
985 PRINT TAB( 21);"";D2$;" ";E2$;" ";C2$;" ";E2$;" ";M2$;" ";B2$;" ";E2$;" ";R2$;""
987 PLOT 6,CL,2,38,98,242,90,98,90,85,38,85,38,98,255
990 RETURN
1000
1010 REM FIND PERSON RECORD ON INDEX FILE SUBROUTINE
1020 REM BH$ CONTAINS BIRTHDAY (KEY)
1030 DV= 1:L2= LP
1040 REM START OF BINARY CHOP LOOP
1050 DV= DV* 2
1060 L1= L2- INT (L2/ DV)
1070 GET 3,L1;A$[4],N
1080 IF BH$= A$THEN FD$= "Y":RETURN :REM FOUND IT
1090 IF DV> L2THEN FD$= "N":RETURN :REM COULDN'T FIND IT
1100 IF BH$< A$THEN L2= L1:GOTO 1060:REM KEEP DIVISOR THE SAME,BUT HALVE L2
1105 GOTO 1050
1500
1510 REM FIND FAMILY RECORD ON INDEX FILE
1515 FI$= FI$+ "     "
1520 DV= 1:L2= LF:N6$= LEFT$ (FI$,6)
1530 REM START OF BINARY CHOP LOOP
1540 DV= DV* 2
1550 L1= L2- INT (L2/ DV)
1560 GET 1,L1;A$[6],N
1570 IF N6$= A$THEN FD$= "Y":RETURN :REM FOUND IT
1580 IF DV> L2THEN FD$= "N":RETURN :REM COULDN'T FIND IT
1590 IF N6$< A$THEN L2= L1:GOTO 1550:REM KEEP DIVISOR THE SAME,BUT HALVE L2
1600 GOTO 1540
4000
4001 REM  SUBROUTINE CLEAR SCREEN AND HEADING
4003 PLOT 6,1
4005 PLOT 12,14,3,23,1:PRINT " BIRTHDAY DIARY "
4010 RETURN
4025
4500
4510 REM  PROPER START OF PROGRAM
4520 POKE 32940,63:POKE 32941,254:REM PROTECT FIELDS ROUTINE
4530 POKE 33283,64:POKE 33284,254:REM SET START ADDRESS OF FIELDS
4540 CLEAR 500
4542 FILE "R",1,"FAMILY.INX",2:REM OPEN UP FILES
4544 FILE "R",2,"FAMILY.DAT",2
4545 FILE "R",3,"PERSON.INX",2
4546 FILE "R",4,"PERSON.DAT",2
4548 GET 1,1;LF:GET 3,1;LP
4550 PLOT 27,4:PRINT "LOA FIELDS.PRG":PLOT 27,27
4560 PLOT 27,24:REM PAGE MODE
4570 DIM MN$(7),MB$(7),MT$(12),SF$(31)
4575 FOR I= 1TO 12:READ MT$(I):NEXT I
4580 DATA "JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE"
4585 DATA "JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER",DECEMBER"
4590 FOR I= 1TO 31:READ SF$(I):NEXT I
4595 DATA "1ST","2ND","3RD","4TH","5TH","6TH","7TH","8TH","9TH"
4600 DATA "10TH","11TH","12TH","13TH","14TH","15TH","16TH","17TH"
4605 DATA "18TH","19TH","20TH","21ST","22ND","23RD","24TH","25TH"
4610 DATA "26TH","27TH","28TH","29TH","30TH","31ST"
4615 READ A1$,B1$,C1$,D1$,E1$,F1$,G1$,H1$,I1$,J1$
4617 READ A2$,B2$,C2$,D2$,E2$,F2$,G2$,H2$,I2$,J2$
4620 READ L1$,M1$,N1$,O1$,P1$,R1$,S1$,T1$,U1$,V1$
4630 READ L2$,M2$,N2$,O2$,P2$,R2$,S2$,T2$,U2$,V2$,Y1$,Y2$
4635 DATA "tu","{d","tf","nu","{e","{e","tf","ab","en"," b"
4640 DATA "no","ld","vi","lw","l","a ","vd","no","l","gw"
4641
4645 DATA "a ","pq","pb","tu","{d","{d","cf","en","ab","ab"
4650 DATA "l","ab","as","vw","a ","a|","gd"," a","vw","|~"
4651
4655 DATA "|~"
4660 DATA "b "
5033 GOSUB 4000
5035 PLOT 3,15,5,14:PRINT "THE WHAT DO YOU WANT TO DO SCREEN "
5040 PLOT 15,29,3,14,6:PRINT "fhfhfhfhfhfhfhfhfhfhfhfhfhfhfhfhfhfh"
5045 PLOT 3,15,10:PRINT "1 INSERT OR MODIFY FAMILY DETAILS"
5050 PLOT 3,15,11:PRINT "h"
5055 PLOT 3,15,13:PRINT "2 FIND A TELEPHONE NO. OR ADDRESS"
5060 PLOT 3,15,14:PRINT "h"
5065 PLOT 3,15,16:PRINT "3 WHAT BIRTHDAYS ARE COMING UP"
5070 PLOT 3,15,17:PRINT "h"
5140 PLOT 14,3,17,25:PRINT "WHICH ONE WOULD YOU LIKE "
5145 X= 42:Y= 25:ML= 1:NA$= "N":PLOT 6,1,14:GOSUB 100
5147 FI$= CHR$ (ASC (FI$)- 128)
5150 ON VAL (FI$)GOTO 5500,8000,9000
5160 GOTO 5140
5500
5510 GOSUB 4000:REM PUT UP HEADING
5520 PLOT 14,3,21,5
5530 PRINT "UPDATE FAMILY DETAILS"
5540 PLOT 15,3,20,6
5550 PRINT "hfhfhfhfhfhfhfhfhfhfhfh"
5560 PLOT 3,6,8:PRINT "ENTER FUNCTION";TAB( 30);"INSERT,MODIFY OR END"
5570 PRINT "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii"
5574 PLOT 6,1,3,22,8,32
5580 X= 22:Y= 8:ML= 1:NA$= "A":GOSUB 100
5590 FU$= FI$
5595 IF FU$= "I"GOTO 5700
5600 IF FU$= "M"GOTO 6500
5605 IF FU$= "E"GOTO 7800
5610 GOTO 5574
5700
5710 REM START OF INSERT FUNCTION
5720
5730 PLOT 3,36,8:PRINT "INSERT"
5740 PLOT 3,4,14:INPUT "DO YOU WISH TO INSERT A FAMILY OR A PERSON - 'F' OR 'P'    ";PF$
5744 IF PF$< > "F"AND PF$< > "P"GOTO 5740
5750 PLOT 28,11
5755 IF PF$= "P"GOTO 6192
5780 PLOT 3,1,11
5790 PRINT "SURNAME                        "
5800 GOSUB 500:REM PUT UP MAIN PART OF SCREEN
5803 PLOT 6,38
5805 X= 10:Y= 11:ML= 22:NA$= "A":GOSUB 100
5810 IF KB= 9THEN PLOT 3,36,8:PRINT "INSERT":GOSUB 700:GOTO 5574
5820 SN$= FI$
5830 X= 10:Y= 13:ML= 29:NA$= "A":GOSUB 100:REM ADDRESS LINE 1
5840 IF KB< > 9GOTO 5850
5845 IF FU$= "M"GOTO 5830
5847 GOTO 5805
5850 AA$= FI$
5860 X= 10:Y= 14:NA$= "A":ML= 29:GOSUB 100:REM ADDRESS LINE 2
5870 IF KB= 9GOTO 5830
5880 AB$= FI$
5890 X= 10:Y= 15:NA$= "A":ML= 29:GOSUB 100:REM ADDRESS LINE 3
5900 IF KB= 9GOTO 5860
5910 AC$= FI$
5920 X= 41:Y= 15:NA$= "A":ML= 7:GOSUB 100:REM POST CODE
5930 IF KB= 9GOTO 5890
5940 PC$= FI$
5950 X= 51:Y= 15:ML= 12:NA$= "A":GOSUB 100:REM TELEPHONE NO.
5960 IF KB= 9GOTO 5920
5970 TL$= FI$
5973 IF FU$= "M"THEN RETURN
5975 NP= 0
5980 FOR N= 1TO 7
5990   X= 18:Y= 17+ N* 2:NA$= "A":ML= 21:GOSUB 100:REM MEMBERS' NAME
5995  IF KB< > 9GOTO 6010
6005  IF N< > 1THEN N= N- 1:GOTO 6030
6007   GOTO 5950
6010  IF FI$= ""THEN NP= N- 1:N= 7:GOTO 6060
6020   MN$(N)= FI$
6030   X= 49:Y= 17+ N* 2:ML= 4:NA$= "N":GOSUB 100:REM MEMBERS' BIRTHDAY
6040  IF KB= 9GOTO 5990
6050   MB$(N)= RIGHT$ (FI$,2)+ LEFT$ (FI$,2)
6060 NEXT N
6063 IF NP= 0THEN NP= 7
6065
6070 REM NOW WRITE OUT FAMILY RECORDS
6080 L1= LF:N6$= LEFT$ (SN$,6)
6090 IF L1= 1GOTO 6160
6100 GET 1,L1;A$[6],N:  REM   SHIFT UP INDEX RECORDS
6110 IF N6$> A$GOTO 6160: REM   FIRST IF NECESSARY
6120 PUT 1,L1+ 1;A$[6],N
6130 L1= L1- 1
6140 GOTO 6090
6150
6160 REM PUT NEW FAMILY RECORDS
6170 L1= L1+ 1:LF= LF+ 1
6180 PUT 1,L1;N6$[6],LF
6190 PUT 2,LF;SN$[22],AA$[29],AB$[29],AC$[29],PC$[7],TL$[12]
6191 GOTO 6210:REM PERSON INPUT ONLY FROM HERE
6192 GOSUB 6540:N9= N:IF KB= 9GOTO 5810:REM GET SURNAME AND STORE REC NO
6193 PLOT 3,1,13,6,1:PRINT "CHRISTIAN NAME                       
6194 PRINT :PRINT " BIRTHDAY            
6196 X= 17:Y= 13:ML= 21:NA$= "A":PLOT 6,38:GOSUB 100
6198 IF KB= 9GOTO 6192
6200 MN$(1)= FI$
6202 X= 17:Y= 15:ML= 4:NA$= "N":GOSUB 100
6204 IF KB= 9GOTO 6196
6206 MB$(1)= RIGHT$ (FI$,2)+ LEFT$ (FI$,2)
6208 NP= 1
6210 REM  NOW WRITE OUT PERSON RECORDS
6230 FOR I= 1TO NP:REM DO IT ONCE FOR EACH PERSON ENTERED
6240 L1= LP
6250 IF L1= 1GOTO 6330
6260 GET 3,L1;A$[4],N:REM SHIFT UP IF NECESSARY
6270 IF MB$(I)> A$GOTO 6330
6280 PUT 3,L1+ 1;A$[4],N
6290 L1= L1- 1
6300 GOTO 6250
6315
6320 REM NOW ACTUALLY WRITE THEM
6330 L1= L1+ 1:LP= LP+ 1
6335 IF FU$= "M"GOTO 6360
6337 IF PF$= "F"THEN N9= LF
6340 PUT 3,L1;MB$(I)[4],LP
6350 PUT 4,LP;MN$(I)[21],N9
6360 NEXT I
6365 IF FU$= "M"THEN RETURN
6367 IF PF$= "P"THEN KB= 9:GOTO 5810
6370 GOTO 5780
6500
6510 REM START OF MODIFY FUNCTION
6520
6530 PLOT 3,43,8:PRINT "MODIFY"
6532 PLOT 3,4,14:INPUT "DO YOU WISH TO MODIFY A FAMILY OR A PERSON - 'F' OR 'P'    ";A$
6534 IF A$< > "F"AND A$< > "P"GOTO 6532
6535 PLOT 28,11
6536 IF A$= "P"GOTO 6850
6540 PLOT 3,1,11
6550 PRINT "SURNAME                        "
6560 PLOT 6,38
6570 X= 10:Y= 11:ML= 22:NA$= "A":GOSUB 100
6575 IF KB= 9AND FU$= "M"GOTO 7500
6577 IF KB= 9AND FU$= "I"THEN RETURN
6590 GOSUB 1500:REM FIND RECORD ON INDEX FILE
6600 IF FD$= "Y"GOTO 6679
6674 PLOT 3,20,14:PRINT "SORRY!,I'VE LOOKED EVERYWHERE BUT"
6676 PLOT 3,20,15:PRINT "I SIMPLY CAN'T FIND THIS FAMILY"
6678 GOTO 6560
6679 PLOT 3,0,13,6,1,11,10,11,10,11
6680 IF FU$= "I"THEN RETURN
6682 REM GET 1ST RECORD IF DUPLICATE KEYS
6684 L1= L1- 1:GET 1,L1;A$[6],M
6685 IF A$= N6$THEN N= M:GOTO 6684
6686 L1= L1+ 1
6687 REM O.K NOW BEGIN
6690 GET 2,N;SN$[22],AA$[29],AB$[29],AC$[29],PC$[7],TL$[12]
6700 GOSUB 500:REM PUT UPMAIN SCREEN
6710 PLOT 6,6
6720 PLOT 3,10,11:PRINT SN$:PLOT 6,38
6730 PLOT 3,10,13:PRINT AA$
6740 PLOT 3,10,14:PRINT AB$
6750 PLOT 3,10,15:PRINT AC$
6760 PLOT 3,41,15:PRINT PC$
6770 PLOT 3,51,15:PRINT TL$
6780 GOSUB 5830:REM GET DETAILS AS IN INSERT MODE
6790 PUT 2,N;SN$[22],AA$[29],AB$[29],AC$[29],PC$[7],TL$[12]
6792 REM CHECK TO SEE IF ANY MORE
6794 L1= L1+ 1:GET 1,L1;A$[6],N
6796 IF A$= N6$GOTO 6687
6800 GOTO 7500
6850 PLOT 3,1,11:PRINT  "BIRTHDAY (DDMM)       "
6855 PLOT 6,38
6860 X= 19:Y= 11:ML= 4:NA$= "N":GOSUB 100
6870 IF KB= 9GOTO 7500
6880 BH$= RIGHT$ (FI$,2)+ LEFT$ (FI$,2)
6890 GOSUB 1000:REM LOOK FOR RECORD WITH BIRTHDAY AS KEY
6900 IF FD$= "Y"GOTO 6940:REM GOT IT
6910 PLOT 3,15,14:PRINT "WELL,I'VE LOOKED HIGH AND LOW,BUT I"
6920 PLOT 3,15,15:PRINT "CAN'T FIND ANYBODY WITH THIS BIRTHDAY"
6930 GOTO 6855
6940 PLOT 3,15,13,6,1,11,10,11,10,11
6942 REM O.K. FOUND RECORD,NOW MAKE SURE IT'S THE FIRST ONE
6944 L1= L1- 1:GET 3,L1;B$[4],M
6946 IF B$= A$THEN N= M:GOTO 6944
6948 L3= L1+ 1
6950 IF N= 9999GOTO 7100
6952 REM  RIGHT,NOW BEGIN
6961 GET 4,N;MN$[21],N1
6963 PLOT 3,1,13:PRINT "CHRISTIAN NAME    ";MN$;""
6965 REM  ALLOW A CHANGE TO BIRTHDAY.IF IT DOES CHANGE
6967 REM  THEN DELETE OLD RECORD,AND RE-LOCATE NEW ONE
6969 PLOT 6,38
6980 X= 19:Y= 11:ML= 4:NA$= "N":GOSUB 100:REM  GET BIRTHDAY AGAIN
6990 MB$= RIGHT$ (FI$,2)+ LEFT$ (FI$,2)
7000 X= 19:Y= 13:ML= 21:NA$= "A":GOSUB 100:REM GET NAME
7010 MN$= FI$
7020 IF BH$= MB$THEN N0= N:GOTO 7090
7030 REM BIRTHDAY HAS CHANGED
7040 NP= 1:MB$(1)= MB$:REM SETUP FOR CALL TO SUBROUTINE
7060 PUT 3,L3;BH$[4],9999:REM 9999 SAYS IT'S DELETED
7065 N0= N
7070 GOSUB 6210:REM SHIFT UP INDEX RECORDS
7080 PUT 3,L1;MB$[4],N0
7090 PUT 4,N0;MN$[21],N1
7100 L3= L3+ 1:GET 3,L3;B$[4],N
7110 IF N= 9999GOTO 7100
7125 IF B$= BH$THEN PLOT 3,19,11,6,38:PRINT RIGHT$ (BH$,2);LEFT$ (BH$,2):GOTO 6961
7500 GOSUB 700:REM CLEAR BOTTOM HALF OF SCREEN
7510 PLOT 3,43,8:PRINT "MODIFY"
7520 GOTO 5574
7800
7810 REM  END FUNCTION
7820 PLOT 3,53,8:PRINT "END"
7825 PUT 1,1;LF:PUT 3,1;LP:REM UPDATE LAST RECORD NO'S
7830 FILE "D",1,2,3,4:REM DUMP BUFFERS
7840 GOTO 5033
8000
8010 REM  START OF FUNCTION 2 - FIND TEL.NO AND ADDRESS
8020
8030 GOSUB 4000:REM CLEAR SCREEN & PUT UP HEADING
8040 PLOT 14,3,18,5:PRINT "FIND AN ADDRESS/TELEPHONE NO."
8050 PLOT 15,3,17,6:PRINT "hfhfhfhfhfhfhfhfhfhfhfhfhfhfhf"
8060 PLOT 3,5,11:PRINT "FAMILY SURNAME  ";SPC( 22);""
8070 X= 21:Y= 11:ML= 22:NA$= "A":PLOT 6,38:GOSUB 100
8080 GOSUB 1500:REM FIND RECORD ON INDEX
8090 IF FD$= "Y"THEN PLOT 3,0,15,6,1,11,10,11:GOTO 8130
8100 PLOT 3,20,15:PRINT "TERRIBLY SORRY OLD BEAN"
8110 PRINT TAB( 20);"I CAN'T FIND THIS FAMILY"
8120 GOTO 8070
8130 REM FOUND IT
8140 REM GET 1ST RECORD IF DUPLICATE KEYS
8160 L1= L1- 1:GET 1,L1;A$[6],M
8170 IF A$= N6$THEN N= M:GOTO 8160
8180 L1= L1+ 1
8190 REM O.K NOW BEGIN
8200 GET 2,N;SN$[22],AA$[29],AB$[29],AC$[29],PC$[7],TL$[12]
8210 PLOT 3,22,13:PRINT "";AA$;""
8215 PRINT
8220 PRINT TAB( 23);"";AB$;""
8225 PRINT
8230 PRINT TAB( 24);"";AC$;""
8235 PRINT
8240 PRINT TAB( 25);"";PC$;SPC( 5);"TELEPHONE  ";TL$;""
8250 REM CHECK TO SEE IF ANY MORE
8260 L1= L1+ 1:GET 1,L1;A$[6],N
8265 PLOT 3,5,25
8270 IF A$= N6$THEN INPUT "M O R E  T O  F O L L O W ";Z$:GOTO 8200
8290 PLOT 3,5,25:INPUT "ANY MORE 'Y' OR 'N'        ";Z$
8300 IF Z$= "Y"THEN GOSUB 700:GOTO 8060
8310 GOTO 5033
9000
9010 REM  START OF FUNCTION 2 - FIND PEOPLE WITH BIRTHDAYS
9020
9030 GOSUB 4000:REM CLEAR SCREEN ETC..
9040 PLOT 14,3,20,5:PRINT "FIND THE BIRTHDAY PEOPLE
9050 PLOT 15,3,19,6:PRINT "hfhfhfhfhfhfhfhfhfhfhfhfhfh"
9060 PLOT 3,5,9:PRINT "WHICH MONTH       "
9070 X= 20:Y= 9:ML= 3:NA$= "A":PLOT 6,38:GOSUB 100
9075 SB= 0:PLOT 6,1
9080 FOR I= 1TO 12
9090 IF FI$= LEFT$ (MT$(I),3)THEN SB= I:I= 12
9100 NEXT I
9110 IF SB< > 0GOTO 9132
9120 PLOT 3,10,18,14:PRINT "THAT'S NO GOOD WHATSOEVER,TRY AGAIN"
9130 FOR  I= 1TO 500:NEXT I:PLOT 15,28,28,28,11,10,11:GOTO  9070
9132 PLOT 3,0,9,11,3,0,8:CL= INT (RND (1)* 7)+ 1
9133 ON SBGOSUB 760,780,800,820,840,860,880,900,920,940,960,980
9135 SB$= RIGHT$ (STR$ (SB),2):IF LEFT$ (SB$,1)= " "THEN SB$= "0"+ RIGHT$ (SB$,1)
9137 SA$= RIGHT$ (STR$ (SB- 1),2):IF LEFT$ (SA$,1)= " "THEN SA$= "0"+ RIGHT$ (SA$,1)
9140 BH$= SA$+ "31"
9150 GOSUB 1000:REM FIND END OF PREVIOUS MONTH
9160 FD$= "N"
9165 PLOT 3,0,11:PRINT
9170 IF SB$< LEFT$ (A$,2)GOTO 9212:REM FINITO
9180 IF SB$> LEFT$ (A$,2)GOTO 9205:REM NOT THERE YET
9182 FD$= "Y"
9185 GET 4,N;MN$[21],N1
9190 GET 2,N1;SN$[22],AA$[106]
9192 FOR I= 21TO 1STEP - 1
9194 IF MID$ (MN$,I,1)< > " "THEN LN= I:I= 1
9196 NEXT I
9200 PRINT TAB( 8);"";LEFT$ (MN$,LN)+ " ";SN$;"";TAB( 45);SF$(VAL (RIGHT$ (A$,2)))
9205 L1= L1+ 1:GET 3,L1;A$[4],N
9207 IF N= 9999GOTO 9205:REM IGNORE MODIFIED ONES
9210 GOTO 9170
9212 IF FD$= "Y"GOTO 9220
9215 PLOT 3,0,31:INPUT "NO BIRTHDAYS THIS MONTH I'M AFRAID,'Y' TO TRY AGAIN,OR 'RETURN'";B$:GOTO 9230
9220 PLOT 3,0,31:INPUT "THAT'S ALL,'Y' TO PICK ANOTHER MONTH OR 'RETURN' FOR THE MENU";B$
9230 IF B$= "Y"GOTO 9030
9240 GOTO 5033
20000 FOR I= 1TO LF
20005 IF I= 1THEN GET 1,1;N:A$= "":GOTO 20020
20010 GET 1,I;A$[6],N
20020 PRINT "REC ";I;"= ";A$;N
20030 NEXT I
20040 FOR I= 1TO LF
20045 IF I= 1THEN GET 2,1;N:A$= "":GOTO 20060
20050 GET 2,I;A$[128]
20060 PRINT "REC ";I;"= ";A$
20070 NEXT I
20100 FOR I= 1TO LP
20110 IF I= 1THEN GET 3,1;N:A$= "":GOTO 20130
20120 GET 3,I;A$[4],N
20130 PRINT "REC ";I;"= ";A$;N
20140 NEXT I
20150 FOR I= 1TO LP
20155 IF I= 1THEN GET 4,1;N:A$= "":GOTO 20170
20160 GET 4,I;A$[21],N
20170 PRINT "REC";I;"= ";A$,N
20180 NEXT I