90 WIDTH "scrn:", 80
95 SCREEN 0,1,0,0
100 TITLE$ = "Update the Persons File Program"
105 TITLE$ = TITLE$ + " ON DISPLAY"
110 VERSION$ = "Version 2.0"
115 COPY1$ = "Copyright (c) 1983, 1984, by:"
120 COPY2$ = "Melvin O. Duke"
125 PRICE$ = "$35"
130 ADDR1$ = "Melvin O. Duke"
135 ADDR2$ = "P. O. Box 20836"
140 ADDR3$ = "San Jose, CA  95160"
145 REM Dimension Statements go here
170 REM Produce the first screen
175 KEY OFF : CLS
180 REM Draw the outer double box
185 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
190 REM Find the title location
195 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
200 REM Draw the title box
205 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
210 REM Print the title
215 LOCATE 4,TITLE.POS : PRINT TITLE$
220 LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
225 REM Draw the Contribution box
230 R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
235 REM Request the Contribution
240 LOCATE 9,23 : PRINT "If you are using these programs, and"
245 LOCATE 10,21 : PRINT "finding them of value, your contribution"
250 LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
255 REM Draw the Mailing Label
260 R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
265 REM Print the Name and Address
270 LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
275 LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
280 LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
285 REM Draw the Copyright box
290 R1 = 19 : C1 = 24 : R2 = 22 : C2 = 56 : GOSUB 400
295 REM Print the Copyright
300 LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
305 LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
310 GOTO 740
400 REM subroutine to print a double box
410 FOR I = R1 + 1 TO R2 - 1
420  LOCATE I, C1 : PRINT CHR$(186);
430  LOCATE I, C2 : PRINT CHR$(186);
440 NEXT I
450 FOR J = C1 + 1 TO C2 - 1
460  LOCATE R1, J : PRINT CHR$(205);
470  LOCATE R2, J : PRINT CHR$(205);
480 NEXT J
490  LOCATE R1, C1 : PRINT CHR$(201);
500  LOCATE R1, C2 : PRINT CHR$(187);
510  LOCATE R2, C1 : PRINT CHR$(200);
520  LOCATE R2, C2 : PRINT CHR$(188);
530 RETURN
600 REM subroutine to print a single box
610 FOR I = R1 + 1 TO R2 - 1
620  LOCATE I, C1 : PRINT CHR$(179);
630  LOCATE I, C2 : PRINT CHR$(179);
640 NEXT I
650 FOR J = C1 + 1 TO C2 - 1
660  LOCATE R1, J : PRINT CHR$(196);
670  LOCATE R2, J : PRINT CHR$(196);
680 NEXT J
690  LOCATE R1, C1 : PRINT CHR$(218);
700  LOCATE R1, C2 : PRINT CHR$(191);
710  LOCATE R2, C1 : PRINT CHR$(192);
720  LOCATE R2, C2 : PRINT CHR$(217);
730 RETURN
740 REM ask user to press a key to continue
750 LOCATE 25,1
760 PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
770 K$ = INKEY$ : IF K$ = "" THEN 770
780 CLS
840 CLS
1000 REM Update the Persons File Program.
1010 REM By:  Melvin O. Duke.  Last Updated:  02 December 1983.
1020 OPEN "a:persfile" AS #1 LEN = 256
1030 FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
1040 REM ask the user for input
1050 LOCATE 22,1
1060 PRINT SPACE$(79) : LOCATE 22,1
1070 INPUT "Enter Record Number of Person to Update (0 to quit)"; REC.NO
1080 IF REC.NO = 0 THEN 4080
1090 IF REC.NO < 1 OR REC.NO > 500 THEN 1040
1100 GET #1, REC.NO
1110 REM Extract information from the file for use
1120 T1 = CVS(F1$)
1130 T2$ = F2$
1140 T3$ = F3$
1150 FOR J = 1 TO LEN(F3$)-1
1160  IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
1170 NEXT J
1180 T4$ = F4$
1190 IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
1200 IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
1210 T5 = CVS(F5$)
1220 T6 = CVS(F6$)
1230 T7 = CVS(F7$)
1240 T8$ = F8$
1250 T9$ = F9$
1260 T10$ = F10$
1270 T11$ = F11$
1280 T12$ = F12$
1290 T13$ = F13$
1300 T14$ = F14$
1310 T15$ = F15$
1320 T16$ = F16$
1330 T17$ = F17$
1340 T18$ = F18$
1350 T19$ = F19$
1360 CLS
1370 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
1380 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2100  'Horizontal double
1390 LOCATE 2,3 : PRINT "Personal Information for:"
1400 R1 = 3 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2240  'Vertical Double
1410 LOCATE 4,3 : COLOR 1 : PRINT "Person:"; : COLOR 7
1420 LOCATE 6,3 : PRINT "Record-Number:";
1430 LOCATE 8,3 : PRINT "Surname:";
1440 LOCATE 9,3 : PRINT "Given-names:";
1450 LOCATE 11,3 : PRINT "Sex:";
1460 LOCATE 12,3 : PRINT "Code:";
1470 R1 = 13 : C1 = 1 : R2 =13 : C2 = 40 : GOSUB 2100  'Horizontal Double
1480 LOCATE 14,3 : COLOR 1 : PRINT "Person's Father:"; : COLOR 7
1490 LOCATE 16,3 : PRINT "Father's Record-number:";
1500 R1 = 17 : C1 = 1 : R2 = 17 : C2 = 40 : GOSUB 2170  'Horizontal Single
1510 LOCATE 18,3 : COLOR 1 : PRINT "Person's Mother:"; : COLOR 7
1520 LOCATE 20,3 : PRINT "Mother's Record-number:";
1530 LOCATE 4,42 : COLOR 1 : PRINT "Person's Vital Statistics:"; : COLOR 7
1540 LOCATE 6,42 : PRINT "Birth-date:";
1550 LOCATE 7,42 : PRINT "Birth-city:";
1560 LOCATE 8,42 : PRINT "Birth-county:";
1570 LOCATE 9,42 : PRINT "State/Country:";
1580 LOCATE 11,42 : PRINT "Death-date:";
1590 LOCATE 12,42 : PRINT "Death-city:";
1600 LOCATE 13,42 : PRINT "Death-county:";
1610 LOCATE 14,42 : PRINT "State/Country:";
1620 LOCATE 16,42 : PRINT "Burial-date:";
1630 LOCATE 17,42 : PRINT "Burial-city:";
1640 LOCATE 18,42 : PRINT "Burial-county:";
1650 LOCATE 19,42 : PRINT "State/Country:";
1660 GOSUB 1680 'To print the current information
1670 GOTO 2380 'For User Input
1680 REM Print the Information Currently Present
1690 LOCATE 2,29 : PRINT SPACE$(50);
1700 LOCATE 2,29 : PRINT T3$ + " " + T2$;
1710 LOCATE 6,18 : PRINT SPACE$(5);
1720 LOCATE 6,18 : PRINT T1;
1730 LOCATE 8,18 : PRINT SPACE$(20);
1740 LOCATE 8,18 : PRINT T2$;
1750 LOCATE 9,18 : PRINT SPACE$(22);
1760 LOCATE 9,18 : PRINT T3$;
1770 LOCATE 11,18 : PRINT SPACE$(7);
1780 LOCATE 11,18 : PRINT T4$;
1790 LOCATE 12,9 : PRINT SPACE$(5);
1800 LOCATE 12,9 : PRINT T5;
1810 LOCATE 16,27 : PRINT SPACE$(5);
1820 LOCATE 16,27 : PRINT T6;
1830 LOCATE 20,27 : PRINT SPACE$(5);
1840 LOCATE 20,27 : PRINT T7;
1850 LOCATE 6,57 : PRINT SPACE$(11);
1860 LOCATE 6,57 : PRINT T8$;
1870 LOCATE 7,57 : PRINT SPACE$(18);
1880 LOCATE 7,57 : PRINT T9$;
1890 LOCATE 8,57 : PRINT SPACE$(16);
1900 LOCATE 8,57 : PRINT T10$;
1910 LOCATE 9,57 : PRINT SPACE$(16);
1920 LOCATE 9,57 : PRINT T11$;
1930 LOCATE 11,57 : PRINT SPACE$(11);
1940 LOCATE 11,57 : PRINT T12$;
1950 LOCATE 12,57 : PRINT SPACE$(18);
1960 LOCATE 12,57 : PRINT T13$;
1970 LOCATE 13,57 : PRINT SPACE$(16);
1980 LOCATE 13,57 : PRINT T14$;
1990 LOCATE 14,57 : PRINT SPACE$(16);
2000 LOCATE 14,57 : PRINT T15$;
2010 LOCATE 16,57 : PRINT SPACE$(11);
2020 LOCATE 16,57 : PRINT T16$;
2030 LOCATE 17,57 : PRINT SPACE$(18);
2040 LOCATE 17,57 : PRINT T17$;
2050 LOCATE 18,57 : PRINT SPACE$(16);
2060 LOCATE 18,57 : PRINT T18$;
2070 LOCATE 19,57 : PRINT SPACE$(16);
2080 LOCATE 19,57 : PRINT T19$;
2090 RETURN
2100 REM Subroutine to draw a double horizontal line.  Attach to double.
2110 FOR J = C1 + 1 TO C2 - 1
2120  LOCATE R1,J : PRINT CHR$(205);
2130 NEXT J
2140 LOCATE R1,C1 : PRINT CHR$(204);
2150 LOCATE R1,C2 : PRINT CHR$(185);
2160 RETURN
2170 REM Subroutine to draw a single horizontal line.  Attach to double.
2180 FOR J = C1 + 1 TO C2 - 1
2190  LOCATE R1,J : PRINT CHR$(196);
2200 NEXT J
2210 LOCATE R1,C1 : PRINT CHR$(199);
2220 LOCATE R1,C2 : PRINT CHR$(182);
2230 RETURN
2240 REM Subroutine to draw a double vertical line.  Attach to double.
2250 FOR I = R1 + 1 TO R2 - 1
2260  LOCATE I,C1 : PRINT CHR$(186);
2270 NEXT I
2280 LOCATE R1,C1 : PRINT CHR$(203);
2290 LOCATE R2,C1 : PRINT CHR$(202);
2300 RETURN
2310 REM Subroutine to draw a single vertical line.  Attach to double.
2320 FOR I = R1 + 1 TO R2 - 1
2330  LOCATE I,C1 : PRINT CHR$(179);
2340 NEXT I
2350 LOCATE R1,C1 : PRINT CHR$(209);
2360 LOCATE R2,C1 : PRINT CHR$(207);
2370 RETURN
2380 REM Routines to Obtain information from the User
2390 LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
2400 LOCATE 23,1
2410 INPUT "Enter the Record Number";REPLY$
2420 IF REPLY$ = "/" THEN 3750
2430 IF REPLY$ = "" THEN 2470
2440 IF ABS(VAL(REPLY$)) = ABS(T1) THEN 2450 ELSE 2460
2450 T1 = VAL(REPLY$)
2452 IF T1 < 1 THEN GOSUB 5000 : GOSUB 1680 : GOTO 3750  'Negative
2460 GOSUB 1680
2470 LOCATE 23,1 : PRINT SPACE$(79);
2480 LOCATE 23,1
2490 INPUT "Enter the Person's Surname (all capital letters)";REPLY$
2500 IF REPLY$ = "/" THEN 3750
2510 IF REPLY$ = "" THEN 2540
2520 T2$ = REPLY$
2530 GOSUB 1680
2540 LOCATE 23,1 : PRINT SPACE$(79);
2550 LOCATE 23,1
2560 INPUT "Enter the Person's Given Names";REPLY$
2570 IF REPLY$ = "/" THEN 3750
2580 IF REPLY$ = "" THEN 2610
2590 T3$ = REPLY$
2600 GOSUB 1680
2610 LOCATE 23,1 : PRINT SPACE$(79);
2620 LOCATE 23,1
2630 INPUT "Enter the Person's Sex";REPLY$
2640 IF REPLY$ = "/" THEN 3750
2650 IF REPLY$ = "" THEN 2700
2660 T4$ = REPLY$
2670 IF LEFT$(REPLY$,1) = "m" OR LEFT$(REPLY$,1) = "M" THEN T4$ = "Male"
2680 IF LEFT$(REPLY$,1) = "f" OR LEFT$(REPLY$,1) = "F" THEN T4$ = "Female"
2690 GOSUB 1680
2700 LOCATE 23,1 : PRINT SPACE$(79);
2710 LOCATE 23,1
2720 INPUT "Enter the Person's Code";REPLY$
2730 IF REPLY$ = "/" THEN 3750
2740 IF REPLY$ = "" THEN 2770
2750 T5 = VAL(REPLY$)
2760 GOSUB 1680
2770 LOCATE 23,1 : PRINT SPACE$(79);
2780 LOCATE 23,1
2790 INPUT "Enter the Father's Record Number";REPLY$
2800 IF REPLY$ = "/" THEN 3750
2810 IF REPLY$ = "" THEN 2840
2820 T6 = VAL(REPLY$)
2830 GOSUB 1680
2840 LOCATE 23,1 : PRINT SPACE$(79);
2850 LOCATE 23,1
2860 INPUT "Enter the Mother's Record Number";REPLY$
2870 IF REPLY$ = "/" THEN 3750
2880 IF REPLY$ = "" THEN 2910
2890 T7 = VAL(REPLY$)
2900 GOSUB 1680
2910 LOCATE 23,1 : PRINT SPACE$(79);
2920 LOCATE 23,1
2930 INPUT "Enter the Person's Birth-date as: dd Mmm yyyy";REPLY$
2940 IF REPLY$ = "/" THEN 3750
2950 IF REPLY$ = "" THEN 2980
2960 T8$ = REPLY$
2970 GOSUB 1680
2980 LOCATE 23,1 : PRINT SPACE$(79);
2990 LOCATE 23,1
3000 INPUT "Enter the Person's Birth-city";REPLY$
3010 IF REPLY$ = "/" THEN 3750
3020 IF REPLY$ = "" THEN 3050
3030 T9$ = REPLY$
3040 GOSUB 1680
3050 LOCATE 23,1 : PRINT SPACE$(79);
3060 LOCATE 23,1
3070 INPUT "Enter the Person's Birth-county";REPLY$
3080 IF REPLY$ = "/" THEN 3750
3090 IF REPLY$ = "" THEN 3120
3100 T10$ = REPLY$
3110 GOSUB 1680
3120 LOCATE 23,1 : PRINT SPACE$(79);
3130 LOCATE 23,1
3140 INPUT "Enter the Person's Birth-state or Country";REPLY$
3150 IF REPLY$ = "/" THEN 3750
3160 IF REPLY$ = "" THEN 3190
3170 T11$ = REPLY$
3180 GOSUB 1680
3190 LOCATE 23,1 : PRINT SPACE$(79);
3200 LOCATE 23,1
3210 INPUT "Enter the Person's Death-date as: dd Mmm yyyy";REPLY$
3220 IF REPLY$ = "/" THEN 3750
3230 IF REPLY$ = "" THEN 3260
3240 T12$ = REPLY$
3250 GOSUB 1680
3260 LOCATE 23,1 : PRINT SPACE$(79);
3270 LOCATE 23,1
3280 INPUT "Enter the Person's Death-city";REPLY$
3290 IF REPLY$ = "/" THEN 3750
3300 IF REPLY$ = "" THEN 3330
3310 T13$ = REPLY$
3320 GOSUB 1680
3330 LOCATE 23,1 : PRINT SPACE$(79);
3340 LOCATE 23,1
3350 INPUT "Enter the Person's Death-county";REPLY$
3360 IF REPLY$ = "/" THEN 3750
3370 IF REPLY$ = "" THEN 3400
3380 T14$ = REPLY$
3390 GOSUB 1680
3400 LOCATE 23,1 : PRINT SPACE$(79);
3410 LOCATE 23,1
3420 INPUT "Enter the Person's Death-state or Country";REPLY$
3430 IF REPLY$ = "/" THEN 3750
3440 IF REPLY$ = "" THEN 3470
3450 T15$ = REPLY$
3460 GOSUB 1680
3470 LOCATE 23,1 : PRINT SPACE$(79);
3480 LOCATE 23,1
3490 INPUT "Enter the Person's Burial-date as: dd Mmm yyyy";REPLY$
3500 IF REPLY$ = "/" THEN 3750
3510 IF REPLY$ = "" THEN 3540
3520 T16$ = REPLY$
3530 GOSUB 1680
3540 LOCATE 23,1 : PRINT SPACE$(79);
3550 LOCATE 23,1
3560 INPUT "Enter the Person's Burial-city";REPLY$
3570 IF REPLY$ = "/" THEN 3750
3580 IF REPLY$ = "" THEN 3610
3590 T17$ = REPLY$
3600 GOSUB 1680
3610 LOCATE 23,1 : PRINT SPACE$(79);
3620 LOCATE 23,1
3630 INPUT "Enter the Person's Burial-county";REPLY$
3640 IF REPLY$ = "/" THEN 3750
3650 IF REPLY$ = "" THEN 3680
3660 T18$ = REPLY$
3670 GOSUB 1680
3680 LOCATE 23,1 : PRINT SPACE$(79);
3690 LOCATE 23,1
3700 INPUT "Enter the Person's Burial-state or Country";REPLY$
3710 IF REPLY$ = "/" THEN 3750
3720 IF REPLY$ = "" THEN 3750
3730 T19$ = REPLY$
3740 GOSUB 1680
3750 REM Input is complete, now see if user wants to save the data
3760 LOCATE 24,1 : PRINT SPACE$(79);
3770 LOCATE 23,1 : PRINT SPACE$(79);
3780 LOCATE 23,1
3790 INPUT "Type s (save), m (more), or f (forget)";REPLY$
3800 IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 2380
3810 IF LEFT$(REPLY$,1) = "f" THEN CLS : GOTO 1040
3820 IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 3850
3830 LOCATE 22,1 : PRINT "Error in reply";
3840 GOTO 3770
3850 REM Routine to SAVE the newly updated record
3860 LSET F1$  = MKS$(T1)
3870 LSET F2$  = T2$
3880 LSET F3$  = T3$
3890 LSET F4$  = LEFT$(T4$,1)
3900 LSET F5$  = MKS$(T5)
3910 LSET F6$  = MKS$(T6)
3920 LSET F7$  = MKS$(T7)
3930 LSET F8$  = T8$
3940 LSET F9$  = T9$
3950 LSET F10$  = T10$
3960 LSET F11$  = T11$
3970 LSET F12$  = T12$
3980 LSET F13$  = T13$
3990 LSET F14$  = T14$
4000 LSET F15$  = T15$
4010 LSET F16$  = T16$
4020 LSET F17$  = T17$
4030 LSET F18$  = T18$
4040 LSET F19$  = T19$
4050 PUT #1, REC.NO
4060 CLS
4070 GOTO 1040
4080 CLOSE #1
4090 CLS : LOCATE 21,1
4100 PRINT "End of Program"
4110 RUN "a:menu"
5000 REM Blank out a negative record
5020 T2$ = ""
5030 T3$ = ""
5040 T4$ = ""
5050 T5 = 0
5060 T6 = 0
5070 T7 = 0
5080 T8$ = ""
5090 T9$ = ""
5100 T10$ = ""
5110 T11$ = ""
5120 T12$ = ""
5130 T13$ = ""
5140 T14$ = ""
5150 T15$ = ""
5160 T16$ = ""
5170 T17$ = ""
5180 T18$ = ""
5190 T19$ = ""
5200 RETURN