90 WIDTH "scrn:", 80
95 SCREEN 0,1,0,0
100 TITLE$ = "Update the Marriages 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 Marriage File Program
1010 REM By:  Melvin O. Duke.  Last Updated:  02 December 1983.
1015 REM Open the Marriages File
1020 OPEN "a:marrfile" AS #2 LEN = 128
1025 REM Open the Persons File
1026 OPEN "a:persfile" AS #1 LEN = 256
1027 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$
1030 FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
1040 REM ask the user for input
1050 LOCATE 22,1
1060 PRINT SPACE$(79) : LOCATE 22,1
1070 INPUT "Enter Record Number of Marriage to Update (0 to quit)"; REC.NO
1080 IF REC.NO = 0 THEN 2790
1090 IF REC.NO < 1 OR REC.NO > 200 THEN 1040
1100 GET #2, REC.NO
1110 REM Extract information from the file for use
1120 TT1 = CVS(M1$)
1130 TT2 = CVS(M2$)
1140 TT3 = CVS(M3$)
1150 TT4 = CVS(M4$)
1160 TT5$ = M5$
1170 TT6$ = M6$
1180 TT7$ = M7$
1190 TT8$ = M8$
1200 TT9$ = M9$
1210 CLS
1220 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
1230 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 1620  'Horizontal double
1240 R1 = 19 : C1 = 1 : R2 = 19 : C2 = 79 : GOSUB 1620  'Horizontal double
1250 LOCATE  2,33 : PRINT "Marriage Record"
1270 LOCATE  5, 3 : PRINT "Marriage Record-number:";
1290 LOCATE  7, 3 : PRINT "Husband's Record-number:";
1300 LOCATE  8, 3 : PRINT "Husband's Name:";
1310 LOCATE 10, 3 : PRINT "Wife's Record-number:";
1320 LOCATE 11, 3 : PRINT "Wife's Name:";
1330 LOCATE 20, 3 : PRINT "Comments:";
1340 LOCATE  5,42 : PRINT "Marriage Code:";
1350 LOCATE 13, 3 : COLOR 1 : PRINT "Marriage Statistics:"; : COLOR 7
1360 LOCATE 14, 3 : PRINT "Marriage-date:";
1370 LOCATE 15, 3 : PRINT "Marriage-city:";
1380 LOCATE 16, 3 : PRINT "Marriage-county:";
1390 LOCATE 17, 3 : PRINT "State/Country:";
1400 GOSUB 1420 'To print the current information
1410 GOTO 1900 'For User Input
1420 REM Print the Information Currently Present
1430 LOCATE  5,28 : PRINT SPACE$(5);
1440 LOCATE  5,28 : PRINT TT1;
1450 LOCATE  7,28 : PRINT SPACE$(5);
1460 LOCATE  7,28 : PRINT TT2;
1462 LOCATE  8,28 : PRINT SPACE$(40);
1463 REM Obtain the Husband's Record
1464 IF TT2 = 0 THEN GOSUB 3740 ELSE GET #1, TT2 : GOSUB 3450
1466 LOCATE  8,28 : PRINT T3$ + " " + T2$;
1470 LOCATE 10,28 : PRINT SPACE$(5);
1480 LOCATE 10,28 : PRINT TT3;
1482 LOCATE 11,28 : PRINT SPACE$(40);
1484 REM Obtain the Wife's Record
1485 IF TT3 = 0 THEN GOSUB 3740 ELSE GET #1, TT3 : GOSUB 3450
1486 LOCATE 11,28 : PRINT T3$ + " " + T2$;
1490 LOCATE  5,57 : PRINT SPACE$(5);
1500 LOCATE  5,57 : PRINT TT4;
1510 LOCATE 14,28 : PRINT SPACE$(11);
1520 LOCATE 14,28 : PRINT TT5$;
1530 LOCATE 15,28 : PRINT SPACE$(18);
1540 LOCATE 15,28 : PRINT TT6$;
1550 LOCATE 16,28 : PRINT SPACE$(16);
1560 LOCATE 16,28 : PRINT TT7$;
1570 LOCATE 17,28 : PRINT SPACE$(16);
1580 LOCATE 17,28 : PRINT TT8$;
1590 LOCATE 20,20 : PRINT SPACE$(45);
1600 LOCATE 20,20 : PRINT TT9$;
1610 RETURN
1620 REM Subroutine to draw a double horizontal line.  Attach to double.
1630 FOR J = C1 + 1 TO C2 - 1
1640  LOCATE R1,J : PRINT CHR$(205);
1650 NEXT J
1660 LOCATE R1,C1 : PRINT CHR$(204);
1670 LOCATE R1,C2 : PRINT CHR$(185);
1680 RETURN
1690 REM Subroutine to draw a single horizontal line.  Attach to double.
1700 FOR J = C1 + 1 TO C2 - 1
1710  LOCATE R1,J : PRINT CHR$(196);
1720 NEXT J
1730 LOCATE R1,C1 : PRINT CHR$(199);
1740 LOCATE R1,C2 : PRINT CHR$(182);
1750 RETURN
1760 REM Subroutine to draw a double vertical line.  Attach to double.
1770 FOR I = R1 + 1 TO R2 - 1
1780  LOCATE I,C1 : PRINT CHR$(186);
1790 NEXT I
1800 LOCATE R1,C1 : PRINT CHR$(203);
1810 LOCATE R2,C1 : PRINT CHR$(202);
1820 RETURN
1830 REM Subroutine to draw a single vertical line.  Attach to double.
1840 FOR I = R1 + 1 TO R2 - 1
1850  LOCATE I,C1 : PRINT CHR$(179);
1860 NEXT I
1870 LOCATE R1,C1 : PRINT CHR$(209);
1880 LOCATE R2,C1 : PRINT CHR$(207);
1890 RETURN
1900 REM Routines to Obtain information from the User
1910 LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown)";
1920 LOCATE 23,1
1930 INPUT "Enter the Record Number";REPLY$
1940 IF REPLY$ = "/" THEN 2560
1950 IF REPLY$ = "" THEN 1990
1960 IF ABS(VAL(REPLY$)) = ABS(TT1) THEN 1970 ELSE 1980
1970 TT1 = VAL(REPLY$)
1975 IF TT1 < 1 THEN GOSUB 3000 : GOSUB 1420 : GOTO 2560  'Null Record
1980 GOSUB 1420
1990 LOCATE 23,1 : PRINT SPACE$(79);
2000 LOCATE 23,1
2010 INPUT "Enter the Husband's Persons Record-Number";REPLY$
2020 IF REPLY$ = "/" THEN 2560
2030 IF REPLY$ = "" THEN 2060
2040 TT2 = VAL(REPLY$)
2050 GOSUB 1450
2060 LOCATE 23,1 : PRINT SPACE$(79);
2070 LOCATE 23,1
2080 INPUT "Enter the Wife's Persons Record-Number";REPLY$
2090 IF REPLY$ = "/" THEN 2560
2100 IF REPLY$ = "" THEN 2130
2110 TT3 = VAL(REPLY$)
2120 GOSUB 1470
2130 LOCATE 23,1 : PRINT SPACE$(79);
2140 LOCATE 23,1
2150 INPUT "Enter the Marriage Code";REPLY$
2160 IF REPLY$ = "/" THEN 2560
2170 IF REPLY$ = "" THEN 2200
2180 TT4 = VAL(REPLY$)
2190 GOSUB 1490
2200 LOCATE 23,1 : PRINT SPACE$(79);
2210 LOCATE 23,1
2220 INPUT "Enter the Marriage-Date as: dd Mmm yyyy";REPLY$
2230 IF REPLY$ = "/" THEN 2560
2240 IF REPLY$ = "" THEN 2270
2250 TT5$ = REPLY$
2260 GOSUB 1510
2270 LOCATE 23,1 : PRINT SPACE$(79);
2280 LOCATE 23,1
2290 INPUT "Enter the Marriage-city";REPLY$
2300 IF REPLY$ = "/" THEN 2560
2310 IF REPLY$ = "" THEN 2340
2320 TT6$ = REPLY$
2330 GOSUB 1530
2340 LOCATE 23,1 : PRINT SPACE$(79);
2350 LOCATE 23,1
2360 INPUT "Enter the Marriage-county";REPLY$
2370 IF REPLY$ = "/" THEN 2560
2380 IF REPLY$ = "" THEN 2410
2390 TT7$ = REPLY$
2400 GOSUB 1550
2410 LOCATE 23,1 : PRINT SPACE$(79);
2420 LOCATE 23,1
2430 INPUT "Enter the Marriage-State or Country:";REPLY$
2440 IF REPLY$ = "/" THEN 2560
2450 IF REPLY$ = "" THEN 2480
2460 TT8$ = REPLY$
2470 GOSUB 1570
2480 LOCATE 23,1 : PRINT SPACE$(79);
2490 LOCATE 23,1
2500 INPUT "Enter any Comments";REPLY$
2510 IF REPLY$ = "/" THEN 2560
2520 IF REPLY$ = "" THEN 2550
2530 TT9$ = REPLY$
2540 GOSUB 1590
2550 REM
2560 REM Completed this Record
2570 LOCATE 24,1 : PRINT SPACE$(79);
2580 LOCATE 23,1 : PRINT SPACE$(79);
2590 LOCATE 23,1
2600 INPUT "Type s (save), m (more), or f (forget)";REPLY$
2610 IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 1900
2620 IF LEFT$(REPLY$,1) = "f" THEN CLS : GOTO 1040
2630 IF LEFT$(REPLY$,1) = "s" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 2660
2640 LOCATE 22,1 : PRINT "Error in reply";
2650 GOTO 2580
2660 REM Routine to SAVE the newly updated record
2670 LSET M1$  = MKS$(TT1)
2680 LSET M2$  = MKS$(TT2)
2690 LSET M3$  = MKS$(TT3)
2700 LSET M4$  = MKS$(TT4)
2710 LSET M5$  = TT5$
2720 LSET M6$  = TT6$
2730 LSET M7$  = TT7$
2740 LSET M8$  = TT8$
2750 LSET M9$  = TT9$
2760 PUT #2, REC.NO
2770 CLS
2780 GOTO 1040
2790 CLOSE #2
2795 CLOSE #1
2800 CLS : LOCATE 21,1
2810 PRINT "End of Program"
2820 RUN "a:menu"
3000 REM Blank a Negative Record
3020 TT2 = 0
3030 TT3 = 0
3040 TT4 = 0
3050 TT5$ = ""
3060 TT6$ = ""
3070 TT7$ = ""
3080 TT8$ = ""
3090 TT9$ = ""
3100 RETURN
3450 REM Routine to Extract Personal Information
3460 T1 = CVS(F1$)
3470 T2$ = F2$
3480 FOR J = 1 TO LEN(F2$) -1
3490  IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
3500 T3$ = F3$
3510 NEXT J
3520 FOR J = 1 TO LEN(F3$) -1
3530  IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
3540 NEXT J
3550 T4$ = F4$
3560 IF T4$ = "M" THEN T4$ = "Male"
3570 IF T4$ = "F" THEN T4$ = "Female"
3580 T5 = CVS(F5$)
3590 T6 = CVS(F6$)
3600 T7 = CVS(F7$)
3610 T8$ = F8$
3620 T9$ = F9$
3630 T10$ = F10$
3640 T11$ = F11$
3650 T12$ = F12$
3660 T13$ = F13$
3670 T14$ = F14$
3680 T15$ = F15$
3690 T16$ = F16$
3700 T17$ = F17$
3710 T18$ = F18$
3720 T19$ = F19$
3730 RETURN
3740 REM Blank out a Record
3750 T1 = 0
3760 T2$ = ""
3770 T3$ = ""
3780 T4$ = ""
3790 T5 = 0
3800 T6 = 0
3810 T7 = 0
3820 T8$ = ""
3830 T9$ = ""
3840 T10$ = ""
3850 T11$ = ""
3860 T12$ = ""
3870 T13$ = ""
3880 T14$ = ""
3890 T15$ = ""
3900 T16$ = ""
3910 T17$ = ""
3920 T18$ = ""
3930 T19$ = ""
3940 RETURN