90 WIDTH "scrn:", 80
95 SCREEN 0,1,0,0
100 TITLE$ = "Update the Ordinances 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 Ordinances File Program.
1010 REM By:  Melvin O. Duke.  Last Updated:  02 December 1983.
1020 OPEN "a:ordfile" AS #2 LEN = 256
1030 FIELD 2,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
1040 REM
1050 OPEN "a:persfile" AS #1 LEN = 256
1060 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$
1070 REM ask the user for input
1080 LOCATE 22,1
1090 PRINT SPACE$(79) : LOCATE 22,1
1100 INPUT "Enter Record Number of Person to Update (0 to quit)"; REC.NO
1110 IF REC.NO = 0 THEN 5070
1120 IF REC.NO < 1 OR REC.NO > 500 THEN T1 = REC.NO : GOTO 1161
1130 SEX$ = "U"
1140 GET #1, REC.NO
1150 GET #2, REC.NO
1160 GOSUB 1200  'Person Extract
1161 REM Test for empty person record
1162 IF T1 < 1 OR T1 > 500 THEN 1163 ELSE 1170
1163  CLS : LOCATE 22,1 : PRINT SPACE$(79);
1164  LOCATE 22,1 : PRINT "Person Record"; T1; "Undefined or Out-of-range"
1165  LOCATE 23,1 : PRINT SPACE$(79);
1166  LOCATE 23,1 : PRINT "Press any key to continue";
1167  A$ = INKEY$ : IF A$ = "" THEN 1167
1168  CLS : GOTO 1070  ' for next input
1170 GOSUB 1490  'Ordinance Extract
1180 SEX$ = LEFT$(T4$,1)
1190 GOTO 1750  'to Print
1200 REM Extract information from the file for use
1210 T1 = CVS(F1$)
1220 T2$ = F2$
1230 FOR J = 1 TO LEN(F2$)-1
1240  IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
1250 NEXT J
1260 T3$ = F3$
1270 FOR J = 1 TO LEN(F3$)-1
1280  IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
1290 NEXT J
1300 T4$ = F4$
1310 IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
1320 IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
1330 T5 = CVS(F5$)
1340 T6 = CVS(F6$)
1350 T7 = CVS(F7$)
1360 T8$ = F8$
1370 T9$ = F9$
1380 T10$ = F10$
1390 T11$ = F11$
1400 T12$ = F12$
1410 T13$ = F13$
1420 T14$ = F14$
1430 T15$ = F15$
1440 T16$ = F16$
1450 T17$ = F17$
1460 T18$ = F18$
1470 T19$ = F19$
1480 RETURN
1490 REM extract the Ordinances Information
1500 U1 = CVS(O1$)
1510 U2$ = O2$
1520 U3$ = O3$
1530 U4$ = O4$
1540 U5 = CVS(O5$)
1550 U6 = CVS(O6$)
1560 U7$ = O7$
1570 U8$ = O8$
1580 U9$ = O9$
1590 U10$ = O10$
1600 U11$ = O11$
1610 U12 = CVS(O12$)
1620 U13$ = O13$
1630 U14$ = O14$
1640 U15$ = O15$
1650 U16$ = O16$
1660 U17$ = O17$
1670 U18$ = O18$
1680 U19$ = O19$
1690 U20$ = O20$
1700 U21$ = O21$
1710 U22$ = O22$
1720 U23$ = O23$
1730 U24$ = O24$
1740 RETURN
1750 CLS
1760 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
1770 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2780  'Horizontal double
1780 R1 =19 : C1 = 1 : R2 =19 : C2 = 79 : GOSUB 2780  'Horizontal double
1790 LOCATE 2,3 : PRINT "Ordinance Information for:"
1800 LOCATE 4,7 : COLOR 1 : PRINT "Personal Record"; : COLOR 7
1810 LOCATE 5,3 : PRINT "Christening:";
1820 LOCATE 6,3 : PRINT "Blessing:";
1830 LOCATE 7,3 : PRINT "Sealed to Parents:";
1840 LOCATE 8,5 : PRINT "Father's Id:";
1850 LOCATE 9,6 : PRINT "Name:";
1860 LOCATE 10,5 : PRINT "Mother's ID:";
1870 LOCATE 11,6 : PRINT "Name:";
1880 LOCATE 12,3 : PRINT "Baptism:";
1890 LOCATE 13,3 : PRINT "Confirmation:";
1900 LOCATE 14,3 : PRINT "Patriarchical Blessing:";
1910 LOCATE 15,3 : PRINT "Endowment:";
1914 REM Test for male.  Skip if male
1915 IF SEX$ = "M" THEN 1950
1920 LOCATE 16,3 : PRINT "Sealed to Husband:";
1930 LOCATE 17,5 : PRINT "Husband's Id:";
1940 LOCATE 18,6 : PRINT "Name:";
1950 REM test for male.  Skip if not.
1960 IF SEX$ <> "M" THEN 2100
1970 R1 = 3 : R2 = 19 : C1 = 40 : C2 = 40 : GOSUB 2920 'Vertical Double
1980 LOCATE 4,46 : COLOR 1 : PRINT "Priesthood Record"; : COLOR 7
1990 LOCATE 5,42 : PRINT "Aaronic Priesthood:";
2000 LOCATE 6,44 : PRINT "Deacon:";
2010 LOCATE 7,44 : PRINT "Teacher:";
2020 LOCATE 8,44 : PRINT "Priest:";
2030 LOCATE 10,42 : PRINT "Melchizedek Priesthood:";
2040 LOCATE 11,44 : PRINT "Elder:";
2050 LOCATE 12,44 : PRINT "Seventy:";
2060 LOCATE 13,44 : PRINT "High Priest:";
2070 LOCATE 15,42 : PRINT "Bishop:";
2080 LOCATE 16,42 : PRINT "Patriarch:";
2090 LOCATE 17,42 : PRINT "Apostle:";
2100 LOCATE 20,3 : PRINT "Occupation:";
2110 GOSUB 2130  'Print current information
2120 GOTO 3060  'For user input
2130 REM Print the Information Currently Present
2140 LOCATE 2,30 : PRINT SPACE$(48);
2150 LOCATE 2,30 : PRINT T3$ + " " + T2$;
2160 LOCATE 2,66 : PRINT SPACE$(13);
2170 LOCATE 2,66 : PRINT "Person:"; T1;
2180 LOCATE 5,29 : PRINT SPACE$(11);
2190 LOCATE 5,29 : PRINT U2$;
2200 LOCATE 6,29 : PRINT SPACE$(11);
2210 LOCATE 6,29 : PRINT U3$;
2220 LOCATE 7,29 : PRINT SPACE$(11);
2230 LOCATE 7,29 : PRINT U4$;
2240 LOCATE 8,18 : PRINT SPACE$(5);
2250 LOCATE 8,18 : PRINT U5;
2260 IF U5 = 0 THEN T3$ = "" : T2$ = "" : GOTO 2280
2270 GET #1, U5 : GOSUB 1200
2280 LOCATE 9,12 : PRINT SPACE$(27);
2290 LOCATE 9,12 : PRINT T3$ + " " + T2$;
2300 LOCATE 10,18 : PRINT SPACE$(5);
2310 LOCATE 10,18 : PRINT U6;
2320 IF U6 = 0 THEN T3$ = "" : T2$ = "" : GOTO 2340
2330 GET #1, U6 : GOSUB 1200
2340 LOCATE 11,12 : PRINT SPACE$(27);
2350 LOCATE 11,12 : PRINT T3$ + " " + T2$;
2360 LOCATE 12,29 : PRINT SPACE$(11);
2370 LOCATE 12,29 : PRINT U7$;
2380 LOCATE 13,29 : PRINT SPACE$(11);
2390 LOCATE 13,29 : PRINT U8$;
2400 LOCATE 14,29 : PRINT SPACE$(11);
2410 LOCATE 14,29 : PRINT U9$;
2420 LOCATE 15,29 : PRINT SPACE$(11);
2430 LOCATE 15,29 : PRINT U10$;
2434 REM Test for Male.  Skip if Male.
2440 LOCATE 16,29 : PRINT SPACE$(11);
2445 IF SEX$ = "M" THEN 2510
2450 LOCATE 16,29 : PRINT U11$;
2460 LOCATE 17,18 : PRINT SPACE$(5);
2470 LOCATE 17,18 : PRINT U12;
2480 IF U12 = 0 THEN 2510
2490 GET #1, U12 : GOSUB 1200
2500 LOCATE 18,12 : PRINT T3$ + " " + T2$;
2510 REM test for male; bypass if not.
2520 IF SEX$ <> "M" THEN 2750
2530 LOCATE 5,68 : PRINT SPACE$(11);
2540 LOCATE 5,68 : PRINT U13$;
2550 LOCATE 6,68 : PRINT SPACE$(11);
2560 LOCATE 6,68 : PRINT U14$;
2570 LOCATE 7,68 : PRINT SPACE$(11);
2580 LOCATE 7,68 : PRINT U15$;
2590 LOCATE 8,68 : PRINT SPACE$(11);
2600 LOCATE 8,68 : PRINT U16$;
2610 LOCATE 10,68 : PRINT SPACE$(11);
2620 LOCATE 10,68 : PRINT U17$;
2630 LOCATE 11,68 : PRINT SPACE$(11);
2640 LOCATE 11,68 : PRINT U18$;
2650 LOCATE 12,68 : PRINT SPACE$(11);
2660 LOCATE 12,68 : PRINT U19$;
2670 LOCATE 13,68 : PRINT SPACE$(11);
2680 LOCATE 13,68 : PRINT U20$;
2690 LOCATE 15,68 : PRINT SPACE$(11);
2700 LOCATE 15,68 : PRINT U21$;
2710 LOCATE 16,68 : PRINT SPACE$(11);
2720 LOCATE 16,68 : PRINT U22$;
2730 LOCATE 17,68 : PRINT SPACE$(11);
2740 LOCATE 17,68 : PRINT U23$;
2750 LOCATE 20,15 : PRINT SPACE$(26);
2760 LOCATE 20,15 : PRINT U24$;
2770 RETURN
2780 REM Subroutine to draw a double horizontal line.  Attach to double.
2790 FOR J = C1 + 1 TO C2 - 1
2800  LOCATE R1,J : PRINT CHR$(205);
2810 NEXT J
2820 LOCATE R1,C1 : PRINT CHR$(204);
2830 LOCATE R1,C2 : PRINT CHR$(185);
2840 RETURN
2850 REM Subroutine to draw a single horizontal line.  Attach to double.
2860 FOR J = C1 + 1 TO C2 - 1
2870  LOCATE R1,J : PRINT CHR$(196);
2880 NEXT J
2890 LOCATE R1,C1 : PRINT CHR$(199);
2900 LOCATE R1,C2 : PRINT CHR$(182);
2910 RETURN
2920 REM Subroutine to draw a double vertical line.  Attach to double.
2930 FOR I = R1 + 1 TO R2 - 1
2940  LOCATE I,C1 : PRINT CHR$(186);
2950 NEXT I
2960 LOCATE R1,C1 : PRINT CHR$(203);
2970 LOCATE R2,C1 : PRINT CHR$(202);
2980 RETURN
2990 REM Subroutine to draw a single vertical line.  Attach to double.
3000 FOR I = R1 + 1 TO R2 - 1
3010  LOCATE I,C1 : PRINT CHR$(179);
3020 NEXT I
3030 LOCATE R1,C1 : PRINT CHR$(209);
3040 LOCATE R2,C1 : PRINT CHR$(207);
3050 RETURN
3060 REM Routines to Obtain information from the User
3070 LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
3080 LOCATE 23,1
3090 INPUT "Enter the Christening Date as: dd Mmm yyyy";REPLY$
3100 IF REPLY$ = "/" THEN 4690
3110 IF REPLY$ = "" THEN 3140
3120 U2$ = REPLY$
3130 GOSUB 2180
3140 LOCATE 23,1 : PRINT SPACE$(79);
3150 LOCATE 23,1
3160 INPUT "Enter the Blessing Date as: dd Mmm yyyy";REPLY$
3170 IF REPLY$ = "/" THEN 4690
3180 IF REPLY$ = "" THEN 3210
3190 U3$ = REPLY$
3200 GOSUB 2200
3210 LOCATE 23,1 : PRINT SPACE$(79);
3220 LOCATE 23,1
3230 INPUT "Enter the Date of Sealing to the Parents as: dd Mmm yyyy";REPLY$
3240 IF REPLY$ = "/" THEN 4690
3250 IF REPLY$ = "" THEN 3280
3260 U4$ = REPLY$
3270 GOSUB 2220
3280 LOCATE 23,1 : PRINT SPACE$(79);
3290 LOCATE 23,1
3300 INPUT "Enter the Father's Record Number";REPLY$
3310 IF REPLY$ = "/" THEN 4690
3320 IF REPLY$ = "" THEN 3350
3330 U5 = VAL(REPLY$)
3340 GOSUB 2240
3350 LOCATE 23,1 : PRINT SPACE$(79);
3360 LOCATE 23,1
3370 INPUT "Enter the Mother's Record Number";REPLY$
3380 IF REPLY$ = "/" THEN 4690
3390 IF REPLY$ = "" THEN 3420
3400 U6 = VAL(REPLY$)
3410 GOSUB 2300
3420 LOCATE 23,1 : PRINT SPACE$(79);
3430 LOCATE 23,1
3440 INPUT "Enter the Baptism Date as: dd Mmm yyyy";REPLY$
3450 IF REPLY$ = "/" THEN 4690
3460 IF REPLY$ = "" THEN 3490
3470 U7$= REPLY$
3480 GOSUB 2360
3490 LOCATE 23,1 : PRINT SPACE$(79);
3500 LOCATE 23,1
3510 INPUT "Enter the Confirmation Date as: dd Mmm yyyy";REPLY$
3520 IF REPLY$ = "/" THEN 4690
3530 IF REPLY$ = "" THEN 3560
3540 U8$ = REPLY$
3550 GOSUB 2380
3560 LOCATE 23,1 : PRINT SPACE$(79);
3570 LOCATE 23,1
3580 INPUT "Enter the Patriarchical Blessing Date as: dd Mmm yyyy";REPLY$
3590 IF REPLY$ = "/" THEN 4690
3600 IF REPLY$ = "" THEN 3630
3610 U9$ = REPLY$
3620 GOSUB 2400
3630 LOCATE 23,1 : PRINT SPACE$(79);
3640 LOCATE 23,1
3650 INPUT "Enter the Endowment Date as: dd Mmm yyyy";REPLY$
3660 IF REPLY$ = "/" THEN 4690
3670 IF REPLY$ = "" THEN 3694
3680 U10$ = REPLY$
3690 GOSUB 2420
3694 REM Test for male.  Skip if male
3695 IF SEX$ = "M" THEN 3840
3700 LOCATE 23,1 : PRINT SPACE$(79);
3710 LOCATE 23,1
3720 INPUT "Enter the Date of Sealing to Spouse as: dd Mmm yyyy";REPLY$
3730 IF REPLY$ = "/" THEN 4690
3740 IF REPLY$ = "" THEN 3770
3750 U11$ = REPLY$
3760 GOSUB 2440
3770 LOCATE 23,1 : PRINT SPACE$(79);
3780 LOCATE 23,1
3790 INPUT "Enter the Spouse's Record Number";REPLY$
3800 IF REPLY$ = "/" THEN 4690
3810 IF REPLY$ = "" THEN 3840
3820 U12 = VAL(REPLY$)
3830 GOSUB 2460
3835 REM Skip Priesthood if not male.
3840 IF SEX$ <> "M" THEN 4620
3850 LOCATE 23,1 : PRINT SPACE$(79);
3860 LOCATE 23,1
3870 INPUT "Enter the Aaronic Priesthood Date as: dd Mmm yyyy";REPLY$
3880 IF REPLY$ = "/" THEN 4690
3890 IF REPLY$ = "" THEN 3920
3900 U13$ = REPLY$
3910 GOSUB 2530
3920 LOCATE 23,1 : PRINT SPACE$(79);
3930 LOCATE 23,1
3940 INPUT "Enter the Deacon Date as: dd Mmm yyyy";REPLY$
3950 IF REPLY$ = "/" THEN 4690
3960 IF REPLY$ = "" THEN 3990
3970 U14$ = REPLY$
3980 GOSUB 2550
3990 LOCATE 23,1 : PRINT SPACE$(79);
4000 LOCATE 23,1
4010 INPUT "Enter the Teacher Date as: dd Mmm yyyy";REPLY$
4020 IF REPLY$ = "/" THEN 4690
4030 IF REPLY$ = "" THEN 4060
4040 U15$ = REPLY$
4050 GOSUB 2570
4060 LOCATE 23,1 : PRINT SPACE$(79);
4070 LOCATE 23,1
4080 INPUT "Enter the Priest Date as: dd Mmm yyyy";REPLY$
4090 IF REPLY$ = "/" THEN 4690
4100 IF REPLY$ = "" THEN 4130
4110 U16$ = REPLY$
4120 GOSUB 2590
4130 LOCATE 23,1 : PRINT SPACE$(79);
4140 LOCATE 23,1
4150 INPUT "Enter the Melchizedek Priesthood Date as: dd Mmm yyyy";REPLY$
4160 IF REPLY$ = "/" THEN 4690
4170 IF REPLY$ = "" THEN 4200
4180 U17$ = REPLY$
4190 GOSUB 2610
4200 LOCATE 23,1 : PRINT SPACE$(79);
4210 LOCATE 23,1
4220 INPUT "Enter the Elder Date as: dd Mmm yyyy";REPLY$
4230 IF REPLY$ = "/" THEN 4690
4240 IF REPLY$ = "" THEN 4270
4250 U18$ = REPLY$
4260 GOSUB 2630
4270 LOCATE 23,1 : PRINT SPACE$(79);
4280 LOCATE 23,1
4290 INPUT "Enter the Seventy Date as: dd Mmm yyyy";REPLY$
4300 IF REPLY$ = "/" THEN 4690
4310 IF REPLY$ = "" THEN 4340
4320 U19$ = REPLY$
4330 GOSUB 2650
4340 LOCATE 23,1 : PRINT SPACE$(79);
4350 LOCATE 23,1
4360 INPUT "Enter the High Priest Date as: dd Mmm yyyy";REPLY$
4370 IF REPLY$ = "/" THEN 4690
4380 IF REPLY$ = "" THEN 4410
4390 U20$ = REPLY$
4400 GOSUB 2670
4410 LOCATE 23,1 : PRINT SPACE$(79);
4420 LOCATE 23,1
4430 INPUT "Enter the Bishop Date as: dd Mmm yyyy";REPLY$
4440 IF REPLY$ = "/" THEN 4690
4450 IF REPLY$ = "" THEN 4480
4460 U21$ = REPLY$
4470 GOSUB 2690
4480 LOCATE 23,1 : PRINT SPACE$(79);
4490 LOCATE 23,1
4500 INPUT "Enter the Patriarch Date as: dd Mmm yyyy";REPLY$
4510 IF REPLY$ = "/" THEN 4690
4520 IF REPLY$ = "" THEN 4550
4530 U22$ = REPLY$
4540 GOSUB 2710
4550 LOCATE 23,1 : PRINT SPACE$(79);
4560 LOCATE 23,1
4570 INPUT "Enter the Apostle Date as: dd Mmm yyyy";REPLY$
4580 IF REPLY$ = "/" THEN 4690
4590 IF REPLY$ = "" THEN 4620
4600 U23$ = REPLY$
4610 GOSUB 2730
4620 LOCATE 23,1 : PRINT SPACE$(79);
4630 LOCATE 23,1
4640 INPUT "Enter the Person's Occupation";REPLY$
4650 IF REPLY$ = "/" THEN 4690
4660 IF REPLY$ = "" THEN 4690
4670 U24$ = REPLY$
4680 GOSUB 2750
4690 REM Input is complete, now see if user wants to save the data
4700 LOCATE 24,1 : PRINT SPACE$(79);
4710 LOCATE 23,1 : PRINT SPACE$(79);
4720 LOCATE 23,1
4730 INPUT "Type s (save), m (more), or f (forget)";REPLY$
4740 IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3060
4750 IF LEFT$(REPLY$,1) = "f" THEN CLS : GOTO 1070
4760 IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 4790
4770 LOCATE 22,1 : PRINT "Error in reply";
4780 GOTO 4710
4790 REM Routine to SAVE the newly updated record
4800 LSET O1$  = MKS$(U1)
4810 LSET O2$  = U2$
4820 LSET O3$  = U3$
4830 LSET O4$  = U4$
4840 LSET O5$  = MKS$(U5)
4850 LSET O6$  = MKS$(U6)
4860 LSET O7$  = U7$
4870 LSET O8$  = U8$
4880 LSET O9$  = U9$
4890 LSET O10$  = U10$
4900 LSET O11$  = U11$
4910 LSET O12$  = MKS$(U12)
4920 LSET O13$  = U13$
4930 LSET O14$  = U14$
4940 LSET O15$  = U15$
4950 LSET O16$  = U16$
4960 LSET O17$  = U17$
4970 LSET O18$  = U18$
4980 LSET O19$  = U19$
4990 LSET O20$ = U20$
5000 LSET O21$ = U21$
5010 LSET O22$ = U22$
5020 LSET O23$ = U23$
5030 LSET O24$ = U24$
5040 PUT #2, REC.NO
5050 CLS
5060 GOTO 1070
5070 CLOSE #1
5080 CLOSE #2
5090 CLS : LOCATE 21,1
5100 PRINT "End of Program"
5110 RUN "a:menu"