PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #90)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “GENEALOGY ON DISPLAY”
Genealogy On Display is an integrated, menu-driven group
of 20 unprotected BASIC programs for IBM PCs (including the IBM-PCjr).
The programs will help you organize, record, and report your own
genealogical data.
As shipped, GENEALOGY ON DISPLAY provides for 500 persons and 200
marriages within its database, with no specific generation limit. These
numbers can be increased to over 3000 persons and over 1000
marriages with sufficient storage space; i.e., a hard drive.
Output available for printing or displaying on the screen includes:
~ Charts of ancestors (pedigree or family tree charts)
~ Charts of families (family group charts)
~ Charts of descendants (30 generations default)
~ Detailed personal information
~ Detailed marriage information
~ Lists of persons (by number or alphabetized)
~ Lists of marriages (by number or alphabetized)
~ Lists of parent/child relationships
Note: A companion disk (PC-SIG disk number 594) is not necessary to run
this disk, but it offers additional functions and smooths out the
operation.
ALPHAMAR.BAS
100 REM ALPHAMAR Program.
110 REM Prints an Alphabetic List of Marriages
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Alphabetic List of Marriages"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
910 DIM PERS.ID(2*MAX.MAR), MARR.ID(2*MAX.MAR), IDX$(2*MAX.MAR)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM ALPHAMAR Program Starts Here.
2010 OPEN CC.PERSFILE$ AS #1 LEN = 256
2020 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$
2030 IF WHERE.LIST = 1 THEN OPEN "lpt1:" FOR OUTPUT AS #3 ELSE OPEN "scrn:" FOR OUTPUT AS #3
2040 REM Read the Marriage Index and then the Person File
2050 KEY ON : CLS : KEY OFF
2060 LOCATE 7,1 : PRINT "Open the Marriage Index"
2070 OPEN CC.MINDEX$ FOR INPUT AS #2
2080 INPUT #2, CX
2090 IF CX <> 0 THEN 2140
2100 PRINT "Marriage Index has no Index Records"
2110 PRINT "Press any key to return to the Menu"
2120 A$ = INKEY$ : IF A$ = "" THEN 2120
2130 GOTO 3220
2140 LOCATE 19,1 : PRINT "There are:";CX;"Marriage Index Records"
2150 C = 0
2160 FOR I = 1 TO CX
2170 C = C + 1
2180 INPUT #2, PERS.ID(I), MARR.ID(I)
2190 LOCATE 23,1 : PRINT "Processing Marriage Index Record:";I,"Freespace";FRE(0)
2200 REM get the personal information
2210 GET #1, PERS.ID(I)
2220 REM Extract information from the file for use
2230 T2$ = F2$
2240 REM Convert to Upper Case
2250 ONE$ = LEFT$(T2$,1)
2260 ONE = ASC(ONE$)
2270 IF ONE >= 97 AND ONE <= 122 THEN ONE = ONE - 32
2280 ONE$ = CHR$(ONE)
2290 REM Test if out of range
2300 IF ONE$ < BEGIN.LTR$ OR ONE$ > END.LTR$ THEN 2430
2310 REM Right-trim t2$
2320 FOR J = 1 TO LEN(F2$) -1
2330 IF RIGHT$(T2$,1)=" " THEN T2$=LEFT$(T2$,LEN(T2$)-1) ELSE J=LEN(F2$)-1
2340 NEXT J
2350 T3$ = F3$
2360 FOR J = 1 TO LEN(F3$) -1
2370 IF RIGHT$(T3$,1)=" " THEN T3$=LEFT$(T3$,LEN(T3$)-1) ELSE J=LEN(F3$)-1
2380 NEXT J
2390 PERS.ID(C) = PERS.ID(I)
2400 MARR.ID(C) = MARR.ID(I)
2410 IDX$(C) = T2$+" "+T3$+STR$(I)
2420 C = C + 1
2430 C = C - 1
2440 NEXT I
2450 LOCATE 23,1 : PRINT SPACE$(79)
2460 REM Sort the index into ascending sequence
2470 LOCATE 19,1 : PRINT SPACE$(79);
2480 LOCATE 19,1 : PRINT "Sorting";C;"Records";
2490 FOR I = 1 TO 6
2500 B(I) = B(I-1)*4+1
2510 IF B(I) <= C/2 THEN K1 = I
2520 NEXT I
2530 B(K1) = INT(C/5)+1
2540 B(1) = 1
2550 FOR I = K1 TO 1 STEP -1
2560 LOCATE 23,1 : PRINT "Sorting Group:";I
2570 K1 = B(I)
2580 K2$ = SPACE$(1)
2590 TEMP1 = 0
2600 TEMP2 = 0
2610 FOR J = K1 TO C
2620 LOCATE 23,20 : PRINT "J:";J;
2630 SWAP K2$, IDX$(J)
2640 SWAP TEMP1, PERS.ID(J)
2650 SWAP TEMP2, MARR.ID(J)
2660 FOR K4 = J-K1 TO 0 STEP -K1
2670 'LOCATE 23,30 : PRINT "Freespace:";FRE(0)
2680 IF K2$ > IDX$(K4) THEN 2730
2690 SWAP IDX$(K4+K1), IDX$(K4)
2700 SWAP PERS.ID(K4+K1), PERS.ID(K4)
2710 SWAP MARR.ID(K4+K1), MARR.ID(K4)
2720 NEXT K4
2730 SWAP IDX$(K4+K1), K2$
2740 SWAP PERS.ID(K4+K1), TEMP1
2750 SWAP MARR.ID(K4+K1), TEMP2
2760 NEXT J
2770 NEXT I
2780 LOCATE 21,1
2790 IF WHERE.LIST <> 1 THEN KEY ON : CLS : KEY OFF : GOTO 2820
2800 COLOR W,K
2810 PRINT "Printing the Alphabetical List"
2820 GOSUB 2840
2830 GOTO 2920
2840 COLOR O,K
2850 PRINT #3, " Alphabetic Listing of the Marriages File ";DATE$;" ";TIME$
2860 PRINT #3, " "
2870 PRINT #3, " REC SURNAME GIVEN-NAMES";TAB(62);"BIRTHDATE"
2880 COLOR P,K
2890 PRINT #3, " ---- ------------------- -----------------------------";
2900 PRINT #3, TAB(62);"-----------"
2910 RETURN
2920 REM Read all records, and print the actual ones
2930 FF = 0
2940 IF WHERE.LIST <> 1 THEN 2970
2950 LOCATE 24,1 : PRINT SPACE$(79);
2960 LOCATE 23,1 : PRINT SPACE$(79);
2970 FOR I = 1 TO C
2980 GET #1, ABS(PERS.ID(I))
2990 IF WHERE.LIST <> 1 THEN 3020
3000 COLOR W,K
3010 LOCATE 23,1 : PRINT "Printing Record:"; I, "Freespace:";FRE(0)
3020 REM Print the information in Alphabetical Order.
3030 T1! = CVS(F1$) : T1 = T1!
3040 IF T1 < 1 THEN 3150
3050 FF = FF + 1
3060 T2$ = F2$
3070 T3$ = F3$
3080 T8$ = F8$
3090 COLOR W,K
3100 PRINT #3, USING "#####";MARR.ID(I);
3110 COLOR G,K
3120 PRINT #3, TAB(10); T2$; " "; T3$; TAB(62); T8$
3130 IF WHERE.LIST <> 1 THEN 3150
3140 IF FF MOD 55 = 0 THEN PRINT #3, FORM.FEED$;: GOSUB 2840
3150 NEXT I
3160 IF WHERE.LIST <> 1 THEN PRINT #3, " ": PRINT #3, " ": GOTO 3190
3170 PRINT #3, FORM.FEED$;
3180 KEY ON : CLS : KEY OFF
3190 COLOR W,K : LOCATE 24,1 : PRINT "y (yes) or n (no)";
3200 LOCATE 23,1 : INPUT "Would you like another copy"; REPLY$
3210 IF LEFT$(REPLY$,1) = "y" OR LEFT$(REPLY$,1) = "Y" THEN 2780
3220 CLOSE
3230 KEY ON : CLS : KEY OFF : LOCATE 21,1
3240 PRINT "End of Program
3250 RUN CC.MENU$
ALPHAPER.BAS
100 REM ALPHAPER Program.
110 REM Prints an Alphabetic List of Persons
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Alphabetic Person Name Listing"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
910 DIM IDX$(MAX.PER), WHERE(MAX.PER)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM ALPHAPER Program Starts Here.
2010 OPEN CC.PERSFILE$ AS #1 LEN = 256
2020 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$
2030 IF WHERE.LIST = 1 THEN OPEN "lpt1:" FOR OUTPUT AS #3 ELSE OPEN "scrn:" FOR OUTPUT AS #3
2040 KEY ON : CLS : KEY OFF
2050 REM Read all records, and print the actual ones
2060 N.ACT = 1
2070 FOR I = 1 TO MAX.PER
2080 GET #1, I
2090 LOCATE 23,1 : PRINT "Processing Record:";I,"Freespace:";FRE(0)
2100 REM Extract Information from the File
2110 TEMP! = CVS(F1$) : WHERE(N.ACT) = TEMP!
2120 IF WHERE(N.ACT) < 1 THEN 2480
2130 T2$ = F2$ 'Surname
2140 REM Convert to Upper Case
2150 ONE$ = LEFT$(T2$,1)
2160 ONE = ASC(ONE$)
2170 IF ONE >= 97 AND ONE <= 122 THEN ONE = ONE - 32
2180 ONE$ = CHR$(ONE)
2190 REM Test if out of range
2200 IF ONE$ < BEGIN.LTR$ OR ONE$ > END.LTR$ THEN 2480
2210 REM Right-trim t2$
2220 FOR J = 1 TO LEN(F2$)-1
2230 IF RIGHT$(T2$,1)=" "THEN T2$=LEFT$(T2$,LEN(T2$)-1) ELSE J=LEN(F2$)-1
2240 NEXT J
2250 T3$ = F3$ 'Given Names
2260 REM Right-trim t3$
2270 FOR J = 1 TO LEN(F3$)-1
2280 IF RIGHT$(T3$,1)=" "THEN T3$=LEFT$(T3$,LEN(T3$)-1) ELSE J=LEN(F3$)-1
2290 NEXT J
2300 T8$ = F8$ 'Birthdate
2310 REM convert to yyyymmdd
2320 TEMP$ = RIGHT$(T8$,4)
2330 IF MID$(T8$,4,3)="Jan" THEN TEMP$=TEMP$+"01"
2340 IF MID$(T8$,4,3)="Feb" THEN TEMP$=TEMP$+"02"
2350 IF MID$(T8$,4,3)="Mar" THEN TEMP$=TEMP$+"03"
2360 IF MID$(T8$,4,3)="Apr" THEN TEMP$=TEMP$+"04"
2370 IF MID$(T8$,4,3)="May" THEN TEMP$=TEMP$+"05"
2380 IF MID$(T8$,4,3)="Jun" THEN TEMP$=TEMP$+"06"
2390 IF MID$(T8$,4,3)="Jul" THEN TEMP$=TEMP$+"07"
2400 IF MID$(T8$,4,3)="Aug" THEN TEMP$=TEMP$+"08"
2410 IF MID$(T8$,4,3)="Sep" THEN TEMP$=TEMP$+"09"
2420 IF MID$(T8$,4,3)="Oct" THEN TEMP$=TEMP$+"10"
2430 IF MID$(T8$,4,3)="Nov" THEN TEMP$=TEMP$+"11"
2440 IF MID$(T8$,4,3)="Dec" THEN TEMP$=TEMP$+"12"
2450 TEMP$=TEMP$+LEFT$(T8$,2) 'add day
2460 IDX$(N.ACT) = T2$+" "+T3$+TEMP$
2470 N.ACT = N.ACT + 1
2480 NEXT I
2490 N.ACT = N.ACT - 1
2500 LOCATE 23,1 : PRINT SPACE$(79)
2510 REM Sort the index into ascending sequence
2520 KEY ON : CLS : KEY OFF
2530 FOR I = 1 TO 6
2540 B(I) = B(I-1)*4+1
2550 IF B(I) <= N.ACT/2 THEN K1 = I
2560 NEXT I
2570 B(K1) = INT(N.ACT/5) +1
2580 B(1) = 1
2590 LOCATE 21,1 : PRINT "Total Records:";N.ACT;
2600 FOR I = K1 TO 1 STEP -1
2610 LOCATE 23,1 : PRINT "Sorting Group:";I
2620 K1 = B(I)
2630 K2$ = SPACE$(1)
2640 K3 = 0
2650 FOR J = K1 TO N.ACT
2660 LOCATE 23,20 : PRINT "J:";J;
2670 SWAP K2$, IDX$(J)
2680 SWAP K3, WHERE(J)
2690 FOR K4 = J-K1 TO 0 STEP -K1
2700 'LOCATE 23,30 : PRINT "Freespace:";FRE(0)
2710 IF K2$ >= IDX$(K4) THEN 2750
2720 SWAP IDX$(K4+K1), IDX$(K4)
2730 SWAP WHERE(K4+K1), WHERE(K4)
2740 NEXT K4
2750 SWAP IDX$(K4+K1), K2$
2760 SWAP WHERE(K4+K1), K3
2770 NEXT J
2780 NEXT I
2790 LOCATE 24,1 : PRINT SPACE$(79);
2800 LOCATE 23,1 : PRINT SPACE$(79);
2810 LOCATE 23,1
2820 IF WHERE.LIST <> 1 THEN KEY ON : CLS : KEY OFF : GOTO 2850
2830 COLOR W,K
2840 PRINT "Printing the Alphabetical List"
2850 GOSUB 2870
2860 GOTO 2950
2870 COLOR O,K
2880 PRINT #3, " Alphabetic Listing of the Persons File ";DATE$;" ";TIME$
2890 PRINT #3, " "
2900 PRINT #3, " REC SURNAME GIVEN-NAMES";TAB(62);"BIRTHDATE"
2910 COLOR P,K
2920 PRINT #3, " ---- ------------------- -----------------------------";
2930 PRINT #3, TAB(62);"-----------"
2940 RETURN
2950 REM Read all records, and print the actual ones
2960 FF = 0
2970 IF WHERE.LIST <> 1 THEN 3010
2980 KEY ON : CLS : KEY OFF
2990 COLOR W,K
3000 LOCATE 21,1 : PRINT "There are";N.ACT;"records."
3010 FOR I = 1 TO N.ACT
3020 GET #1, ABS(WHERE(I))
3030 IF WHERE.LIST <> 1 THEN 3060
3040 COLOR W,K
3050 LOCATE 23,1 : PRINT "Printing Record:"; I, "Freespace:";FRE(0)
3060 REM Print the information in Alphabetical Order.
3070 T1 = CVS(F1$)
3080 IF T1 < 1 THEN 3190
3090 FF = FF + 1
3100 T2$ = F2$
3110 T3$ = F3$
3120 T8$ = F8$
3130 IF WHERE.LIST <> 1 THEN 3150
3140 IF FF MOD 55 = 0 THEN PRINT #3, FORM.FEED$;: GOSUB 2870
3150 COLOR W,K
3160 PRINT #3, USING "#####";T1,
3170 COLOR G,K
3180 PRINT #3, TAB(10); T2$; " "; T3$; TAB(62); T8$
3190 NEXT I
3200 IF WHERE.LIST <> 1 THEN PRINT #3, " ": PRINT #3, " ": GOTO 3230
3210 PRINT #3, FORM.FEED$;
3220 KEY ON : CLS : KEY OFF
3230 COLOR W,K : LOCATE 24,1 : PRINT "y (yes) or n (no)";
3240 LOCATE 23,1 : INPUT "Would you like another copy"; REPLY$
3250 IF LEFT$(REPLY$,1) = "y" OR LEFT$(REPLY$,1) = "Y" THEN 2790
3260 CLOSE
3270 KEY ON : CLS : KEY OFF : LOCATE 21,1
3280 PRINT "End of Program"
3290 RUN CC.MENU$
ANCESTOR.BAS
100 REM ANCESTOR Program.
110 REM Prints Charts of Ancestors
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Charts of Ancestors"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
940 DIM PERS(31), FORM$(49)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1020 REM Find the title location
1030 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1040 REM Print the title
1050 LOCATE 4,TITLE.POS : PRINT TITLE$
1060 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1070 REM Print the Copyright
1080 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1090 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM ANCESTOR Program Starts Here.
2010 REM Prevent Common User Errors
2020 IF PP.FORMS = 1 THEN GENS = 5
2030 IF GENS <> 5 THEN GENS = 4
2040 REM Routine to obtain Printer Information
2050 LOCATE 21,1 : PRINT "Make sure that the Printer is on and Ready"
2060 LOCATE 22,1 : PRINT "Make sure that the correct Diskette(s) are in place."
2070 LOCATE 23,1 : PRINT "Then press any key"
2080 A$ = INKEY$ : IF A$ = "" THEN 2080
2090 KEY ON : CLS : KEY OFF
2100 REM Set for Wide Printing
2110 WIDTH "lpt1:", 132 'For printing Genealogy Forms
2120 REM Read the Marriage Index
2130 LOCATE 7,1 : PRINT "Open the Marriage Index"
2140 OPEN CC.MINDEX$ FOR INPUT AS #2
2150 INPUT #2, M.COUNT
2160 IF M.COUNT <> 0 THEN 2210
2170 PRINT "Marriage Index has no Index Records"
2180 PRINT "Press any key to return to the Menu"
2190 A$ = INKEY$ : IF A$ = "" THEN 2190
2200 GOTO 7680
2210 DIM PERS.NO(M.COUNT), M.NO(M.COUNT)
2220 FOR I = 1 TO M.COUNT
2230 LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
2240 INPUT #2,PERS.NO(I), M.NO(I)
2250 NEXT I
2260 CLOSE #2
2270 REM Open the Persons File
2280 LOCATE 10,1 : PRINT "Open the Persons File"
2290 OPEN CC.PERSFILE$ AS #1 LEN = 256
2300 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$
2310 REM open the Marriages File
2320 LOCATE 12,1 : PRINT "Open the Marriage File"
2330 OPEN CC.MARRFILE$ AS #2 LEN = 128
2340 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$
2350 REM Obtain a Person Record from the User
2360 LOCATE 20,1 : INPUT "Enter the Record-number of a Person (0 to quit)";REPLY$
2370 IF REPLY$ = "0" THEN 7680
2380 PERS(1) = VAL(REPLY$)
2390 IF PERS(1) < 1 OR PERS(1) > MAX.PER THEN KEY ON : CLS : LOCATE 19,1 : PRINT "Number is out of range"; : KEY OFF : GOTO 2350
2400 REM Reset the Printer characteristics for next page if required.
2410 IF FORMS = 1 THEN 2450 'Don't stop if forms are continuous
2420 REM process single sheets
2430 PRINT "Press any key when next form is ready"
2440 A$ = INKEY$ : IF A$ = "" THEN 2440
2450 REM Reset paper sensing if required
2460 IF FORMS = 2 THEN LPRINT PAP.SEN.OFF$;
2470 REM Reset paper length if required
2480 IF LENGTH = 1 THEN LPRINT PAP.SHORT$;
2490 REM Reset Condensed printing if required
2500 IF WIDE = 1 THEN LPRINT COMPR.ON$;
2510 KEY ON : CLS : KEY OFF
2520 GOTO 3160
2530 REM Routine to Extract Personal Information
2540 T1! = CVS(F1$) : T1 = T1!
2550 TEMP1$ = F2$ : TEMP2$ = F2$ : GOSUB 2720 'Rtrim
2560 T2$ = TEMP2$
2570 TEMP1$ = F3$ : TEMP2$ = F3$ : GOSUB 2720 'Rtrim
2580 T3$ = TEMP2$
2590 T6! = CVS(F6$) : T6 = T6!
2600 T7! = CVS(F7$) : T7 = T7!
2610 T8$ = F8$
2620 TEMP1$ = F9$ : TEMP2$ = F9$ : GOSUB 2720 'Rtrim
2630 T9$ = TEMP2$
2640 TEMP1$ = F11$ : TEMP2$ = F11$ : GOSUB 2720 'Rtrim
2650 T11$ = TEMP2$
2660 T12$ = F12$
2670 TEMP1$ = F13$ : TEMP2$ = F13$ : GOSUB 2720 'Rtrim
2680 T13$ = TEMP2$
2690 TEMP1$ = F15$ : TEMP2$ = F15$ : GOSUB 2720 'Rtrim
2700 T15$ = TEMP2$
2710 RETURN
2720 REM General RTRIM$ Routine
2730 FOR J = 1 TO LEN(TEMP1$)-1
2740 IF RIGHT$(TEMP2$,1) = " " THEN TEMP2$ = LEFT$(TEMP2$,LEN(TEMP2$)-1) ELSE J = LEN(TEMP1$)-1
2750 NEXT J
2760 RETURN
2770 REM Blank out a Person Record
2780 T1 = 0
2790 T2$ = ""
2800 T3$ = ""
2810 T4$ = ""
2820 T5 = 0
2830 T6 = 0
2840 T7 = 0
2850 T8$ = ""
2860 T9$ = ""
2870 T10$ = ""
2880 T11$ = ""
2890 T12$ = ""
2900 T13$ = ""
2910 T14$ = ""
2920 T15$ = ""
2930 T16$ = ""
2940 T17$ = ""
2950 T18$ = ""
2960 T19$ = ""
2970 RETURN
2980 REM Routine to extract a name
2990 NM$ = T2$+", "+T3$
3000 IF COL = 24 THEN NM$ = LEFT$(NM$,48)
3010 IF COL > 24 THEN NM$ = LEFT$(NM$,23)
3020 MID$(FORM$(ROW),COL,LEN(NM$))=NM$
3030 RETURN
3040 REM Routine to extract a birth-location
3050 BL$=T9$+", "+T11$
3060 IF COL = 27 THEN BL$ = LEFT$(BL$,46)
3070 IF COL > 27 THEN BL$ = LEFT$(BL$,20)
3080 MID$(FORM$(ROW),COL,LEN(BL$))=BL$
3090 RETURN
3100 REM Routine to extract a death-location
3110 DL$ = T13$+", "+T15$
3120 IF COL = 27 THEN DL$ = LEFT$(DL$,46)
3130 IF COL > 27 THEN DL$ = LEFT$(DL$,20)
3140 MID$(FORM$(ROW),COL,LEN(DL$))=DL$
3150 RETURN
3160 REM Routine to Produce a Chart of Ancestors
3170 REM Test if already formed
3180 IF PERS(1) = LAST.PERS THEN 7570
3190 REM Start with all Spaces
3200 FOR I = 1 TO 49
3210 FORM$(I) = SPACE$(131)
3220 NEXT I
3230 IF PP.FORMS = 1 THEN 3240 ELSE GOSUB 7770
3240 REM get 1
3250 LOCATE 20,1 : PRINT "Processing Person # 1 on the Chart"
3260 IF PERS(1) = 0 THEN GOSUB 2770 : GOTO 3530
3270 GET #1, PERS(1) : GOSUB 2530 'Extract 1
3280 ROW = 22: COL = 1: GOSUB 9660 'for Person Number
3290 MID$(FORM$(22),1,PLEN) = PNUM$
3300 IF T2$ = " " AND T3$ = " " THEN 3470
3310 ROW=23: COL=1: GOSUB 2980
3320 REM Insert Preparer's Name and Address
3330 IF PP.FORMS = 1 THEN 3340 ELSE 3460
3340 MID$(FORM$(3),1,LEN(PREP1$)) = PREP1$
3350 MID$(FORM$(5),1,LEN(PREP2$)) = PREP2$
3360 MID$(FORM$(7),1,LEN(PREP3$)) = PREP3$
3370 MID$(FORM$(9),1,LEN(PREP4$)) = PREP4$
3380 MID$(FORM$(42),1,15) = "Person Record: "
3390 P.NO$ = STR$(PERS(1))
3400 P.NO$ = RIGHT$(P.NO$,LEN(P.NO$)-1)
3410 MID$(FORM$(42),16,LEN(P.NO$)) = P.NO$
3420 MID$(FORM$(43),1,23) = "Prepared on "+DATE$
3430 MID$(FORM$(43),23,12) = " at "+TIME$
3440 MID$(FORM$(44),1,42) = "Using Version 6.0 of Genealogy ON DISPLAY."
3450 GOTO 3470
3460 MID$(FORM$(1),23,LEN(T2$+T3$)+1) = T3$+" "+T2$
3470 MID$(FORM$(24),3,11) = T8$
3480 IF T9$ = " " AND T11$ = " " THEN 3500
3490 ROW=25: COL=3: GOSUB 3040
3500 MID$(FORM$(27),3,11) = T12$
3510 IF T13$ = " " AND T15$ = " " THEN 3530
3520 ROW=28: COL=3: GOSUB 3100
3530 PERS(2) = T6
3540 PERS(3) = T7
3550 REM get 11
3560 LOCATE 20,20: PRINT " 2";
3570 IF PERS(2) = 0 THEN GOSUB 2770 : GOTO 3680
3580 GET #1, PERS(2) : GOSUB 2530 'Extract 11
3590 ROW=12: COL=24: GOSUB 9660 'for Person Number
3600 IF T2$ = " " AND T3$ = " " THEN 3620
3610 GOSUB 2980
3620 MID$(FORM$(13),27,11) = T8$
3630 IF T9$ = " " AND T11$ = " " THEN 3650
3640 ROW=14: COL=27: GOSUB 3040
3650 MID$(FORM$(16),27,11) = T12$
3660 IF T13$ = " " AND T15$ = " " THEN 3680
3670 ROW=17: COL=27: GOSUB 3100
3680 PERS(4) = T6
3690 PERS(5) = T7
3700 REM get 10
3710 LOCATE 20,20: PRINT " 3";
3720 IF PERS(3) = 0 THEN GOSUB 2770 : GOTO 3830
3730 GET #1, PERS(3) : GOSUB 2530 'Extract 10
3740 ROW=36: COL=24: GOSUB 9660 'for Person Number
3750 IF T2$ = " " AND T3$ = " " THEN 3770
3760 GOSUB 2980
3770 MID$(FORM$(37),27,11) = T8$
3780 IF T9$ = " " AND T11$ = " " THEN 3800
3790 ROW=38: COL=27: GOSUB 3040
3800 MID$(FORM$(39),27,11) = T12$
3810 IF T13$ = " " AND T15$ = " " THEN 3830
3820 ROW=40: COL=27: GOSUB 3100
3830 PERS(6) = T6
3840 PERS(7) = T7
3850 REM get 111
3860 LOCATE 20,20: PRINT " 4";
3870 IF PERS(4) = 0 THEN GOSUB 2770 : GOTO 3980
3880 GET #1, PERS(4) : GOSUB 2530 'Extract 111
3890 ROW=6: COL=49: GOSUB 9660 'for Person Number
3900 IF T2$ = " " AND T3$ = " " THEN 3920
3910 GOSUB 2980
3920 MID$(FORM$(7),52,11) = T8$
3930 IF T9$ = " " AND T11$ = " " THEN 3950
3940 ROW=8: COL=52: GOSUB 3040
3950 MID$(FORM$(10),52,11) = T12$
3960 IF T13$ = " " AND T15$ = " " THEN 3980
3970 ROW=11: COL=52: GOSUB 3100
3980 PERS(8) = T6
3990 PERS(9) = T7
4000 REM get 110
4010 LOCATE 20,20: PRINT " 5";
4020 IF PERS(5) = 0 THEN GOSUB 2770 : GOTO 4130
4030 GET #1, PERS(5) : GOSUB 2530 'Extract 110
4040 ROW=18: COL=49: GOSUB 9660 'for Person Number
4050 IF T2$ = " " AND T3$ = " " THEN 4070
4060 GOSUB 2980
4070 MID$(FORM$(19),52,11) = T8$
4080 IF T9$ = " " AND T11$ = " " THEN 4100
4090 ROW=20: COL=52: GOSUB 3040
4100 MID$(FORM$(21),52,11) = T12$
4110 IF T13$ = " " AND T15$ = " " THEN 4130
4120 ROW=22: COL=52: GOSUB 3100
4130 PERS(10) = T6
4140 PERS(11) = T7
4150 REM get 101
4160 LOCATE 20,20: PRINT " 6";
4170 IF PERS(6) = 0 THEN GOSUB 2770 : GOTO 4280
4180 GET #1, PERS(6) : GOSUB 2530 'Extract 101
4190 ROW=30: COL=49: GOSUB 9660 'for Person Number
4200 IF T2$ = " " AND T3$ = " " THEN 4220
4210 GOSUB 2980
4220 MID$(FORM$(31),52,11) = T8$
4230 IF T9$ = " " AND T11$ = " " THEN 4250
4240 ROW=32: COL=52: GOSUB 3040
4250 MID$(FORM$(34),52,11) = T12$
4260 IF T13$ = " " AND T15$ = " " THEN 4280
4270 ROW=35: COL=52: GOSUB 3100
4280 PERS(12) = T6
4290 PERS(13) = T7
4300 REM get 100
4310 LOCATE 20,20: PRINT " 7";
4320 IF PERS(7) = 0 THEN GOSUB 2770 : GOTO 4430
4330 GET #1, PERS(7) : GOSUB 2530 'Extract 100
4340 ROW=42: COL=49: GOSUB 9660 'for Person Number
4350 IF T2$ = " " AND T3$ = " " THEN 4370
4360 GOSUB 2980
4370 MID$(FORM$(43),52,11) = T8$
4380 IF T9$ = " " AND T11$ = " " THEN 4400
4390 ROW=44: COL=52: GOSUB 3040
4400 MID$(FORM$(45),52,11) = T12$
4410 IF T13$ = " " AND T15$ = " " THEN 4430
4420 ROW=46: COL=52: GOSUB 3100
4430 PERS(14) = T6
4440 PERS(15) = T7
4450 REM get 1111
4460 LOCATE 20,20: PRINT " 8";
4470 IF PERS(8) = 0 THEN GOSUB 2770 : GOTO 4580
4480 GET #1, PERS(8) : GOSUB 2530 'Extract 1111
4490 ROW=3: COL=74: GOSUB 9660 'for Person Number
4500 IF T2$ = " " AND T3$ = " " THEN 4520
4510 GOSUB 2980
4520 MID$(FORM$(4),77,11) = T8$
4530 IF T9$ = " " AND T11$ = " " THEN 4550
4540 ROW=5: COL=77: GOSUB 3040
4550 MID$(FORM$(7),77,11) = T12$
4560 IF T13$ = " " AND T15$ = " " THEN 4580
4570 ROW=8: COL=77: GOSUB 3100
4580 PERS(16) = T6
4590 PERS(17) = T7
4600 REM get 1110
4610 LOCATE 20,20: PRINT " 9";
4620 IF PERS(9) = 0 THEN GOSUB 2770 : GOTO 4730
4630 GET #1, PERS(9) : GOSUB 2530 'Extract 1110
4640 ROW=9: COL=74: GOSUB 9660 'for Person Number
4650 IF T2$ = " " AND T3$ = " " THEN 4670
4660 GOSUB 2980
4670 MID$(FORM$(10),77,11) = T8$
4680 IF T9$ = " " AND T11$ = " " THEN 4700
4690 ROW=11: COL=77: GOSUB 3040
4700 MID$(FORM$(12),77,11) = T12$
4710 IF T13$ = " " AND T15$ = " " THEN 4730
4720 ROW=13: COL=77: GOSUB 3100
4730 PERS(18) = T6
4740 PERS(19) = T7
4750 REM get 1101
4760 LOCATE 20,20: PRINT "10";
4770 IF PERS(10) = 0 THEN GOSUB 2770 : GOTO 4880
4780 GET #1, PERS(10) : GOSUB 2530 'Extract 1101
4790 ROW=15: COL=74: GOSUB 9660 'for Person Number
4800 IF T2$ = " " AND T3$ = " " THEN 4820
4810 GOSUB 2980
4820 MID$(FORM$(16),77,11) = T8$
4830 IF T9$ = " " AND T11$ = " " THEN 4850
4840 ROW=17: COL=77: GOSUB 3040
4850 MID$(FORM$(19),77,11) = T12$
4860 IF T13$ = " " AND T15$ = " " THEN 4880
4870 ROW=20: COL=77: GOSUB 3100
4880 PERS(20) = T6
4890 PERS(21) = T7
4900 REM get 1100
4910 LOCATE 20,20: PRINT "11";
4920 IF PERS(11) = 0 THEN GOSUB 2770 : GOTO 5030
4930 GET #1, PERS(11) : GOSUB 2530 'Extract 1100
4940 ROW=21: COL=74: GOSUB 9660 'for Person Number
4950 IF T2$ = " " AND T3$ = " " THEN 4970
4960 GOSUB 2980
4970 MID$(FORM$(22),77,11) = T8$
4980 IF T9$ = " " AND T11$ = " " THEN 5000
4990 ROW=23: COL=77: GOSUB 3040
5000 MID$(FORM$(24),77,11) = T12$
5010 IF T13$ = " " AND T15$ = " " THEN 5030
5020 ROW=25: COL=77: GOSUB 3100
5030 PERS(22) = T6
5040 PERS(23) = T7
5050 REM get 1011
5060 LOCATE 20,20: PRINT "12";
5070 IF PERS(12) = 0 THEN GOSUB 2770 : GOTO 5180
5080 GET #1, PERS(12) : GOSUB 2530 'Extract 1010
5090 ROW=27: COL=74: GOSUB 9660 'for Person Number
5100 IF T2$ = " " AND T3$ = " " THEN 5120
5110 GOSUB 2980
5120 MID$(FORM$(28),77,11) = T8$
5130 IF T9$ = " " AND T11$ = " " THEN 5150
5140 ROW=29: COL=77: GOSUB 3040
5150 MID$(FORM$(31),77,11) = T12$
5160 IF T13$ = " " AND T15$ = " " THEN 5180
5170 ROW=32: COL=77: GOSUB 3100
5180 PERS(24) = T6
5190 PERS(25) = T7
5200 REM get 1010
5210 LOCATE 20,20: PRINT "13";
5220 IF PERS(13) = 0 THEN GOSUB 2770 : GOTO 5330
5230 GET #1, PERS(13) : GOSUB 2530 'Extract 1010
5240 ROW=33: COL=74: GOSUB 9660 'for Person Number
5250 IF T2$ = " " AND T3$ = " " THEN 5270
5260 GOSUB 2980
5270 MID$(FORM$(34),77,11) = T8$
5280 IF T9$ = " " AND T11$ = " " THEN 5300
5290 ROW=35: COL=77: GOSUB 3040
5300 MID$(FORM$(36),77,11) = T12$
5310 IF T13$ = " " AND T15$ = " " THEN 5330
5320 ROW=37: COL=77: GOSUB 3100
5330 PERS(26) = T6
5340 PERS(27) = T7
5350 REM get 1001
5360 LOCATE 20,20: PRINT "14";
5370 IF PERS(14) = 0 THEN GOSUB 2770 : GOTO 5480
5380 GET #1, PERS(14) : GOSUB 2530 'Extract 1001
5390 ROW=39: COL=74: GOSUB 9660 'for Person Number
5400 IF T2$ = " " AND T3$ = " " THEN 5420
5410 GOSUB 2980
5420 MID$(FORM$(40),77,11) = T8$
5430 IF T9$ = " " AND T11$ = " " THEN 5450
5440 ROW=41: COL=77: GOSUB 3040
5450 MID$(FORM$(43),77,11) = T12$
5460 IF T13$ = " " AND T15$ = " " THEN 5480
5470 ROW=44: COL=77: GOSUB 3100
5480 PERS(28) = T6
5490 PERS(29) = T7
5500 REM get 1001
5510 LOCATE 20,20: PRINT "15";
5520 IF PERS(15) = 0 THEN GOSUB 2770 : GOTO 5630
5530 GET #1, PERS(15) : GOSUB 2530 'Extract 1000
5540 ROW=45: COL=74: GOSUB 9660 'for Person Number
5550 IF T2$ = " " AND T3$ = " " THEN 5570
5560 GOSUB 2980
5570 MID$(FORM$(46),77,11) = T8$
5580 IF T9$ = " " AND T11$ = " " THEN 5600
5590 ROW=47: COL=77: GOSUB 3040
5600 MID$(FORM$(48),77,11) = T12$
5610 IF T13$ = " " AND T15$ = " " THEN 5630
5620 ROW=49: COL=77: GOSUB 3100
5630 PERS(30) = T6
5640 PERS(31) = T7
5650 IF GENS <> 5 THEN 6730
5660 REM get 11111
5670 LOCATE 20,20: PRINT "16";
5680 IF PERS(16) = 0 THEN GOSUB 2770 : GOTO 5720
5690 GET #1, PERS(16) : GOSUB 2530 'Extract 11111
5700 ROW=1: COL=98: GOSUB 9660 'for Person Number
5710 GOSUB 2980
5720 REM get 11110
5730 LOCATE 20,20: PRINT "17";
5740 IF PERS(17) = 0 THEN GOSUB 2770 : GOTO 5780
5750 GET #1, PERS(17) : GOSUB 2530 'Extract 11110
5760 ROW=4: COL=98: GOSUB 9660 'for Person Number
5770 GOSUB 2980
5780 REM get 11101
5790 LOCATE 20,20: PRINT "18";
5800 IF PERS(18) = 0 THEN GOSUB 2770 : GOTO 5840
5810 GET #1, PERS(18) : GOSUB 2530 'Extract 11101
5820 ROW=7: COL=98: GOSUB 9660 'for Person Number
5830 GOSUB 2980
5840 REM get 11100
5850 LOCATE 20,20: PRINT "19";
5860 IF PERS(19) = 0 THEN GOSUB 2770 : GOTO 5900
5870 GET #1, PERS(19) : GOSUB 2530 'Extract 11100
5880 ROW=10: COL=98: GOSUB 9660 'for Person Number
5890 GOSUB 2980
5900 REM get 11011
5910 LOCATE 20,20: PRINT "20";
5920 IF PERS(20) = 0 THEN GOSUB 2770 : GOTO 5970
5930 GET #1, PERS(20) : GOSUB 2530 'Extract 11011
5940 IF PP.FORMS = 1 THEN ROW=13 ELSE ROW=14
5950 COL=98: GOSUB 9660 'for Person Number
5960 GOSUB 2980
5970 REM get 11010
5980 LOCATE 20,20: PRINT "21";
5990 IF PERS(21) = 0 THEN GOSUB 2770 : GOTO 6030
6000 GET #1, PERS(21) : GOSUB 2530 'Extract 11010
6010 ROW=16: COL=98: GOSUB 9660 'for Person Number
6020 GOSUB 2980
6030 REM get 11001
6040 LOCATE 20,20: PRINT "22";
6050 IF PERS(22) = 0 THEN GOSUB 2770 : GOTO 6090
6060 GET #1, PERS(22) : GOSUB 2530 'Extract 11001
6070 ROW=19: COL=98: GOSUB 9660 'for Person Number
6080 GOSUB 2980
6090 REM get 11000
6100 LOCATE 20,20: PRINT "23";
6110 IF PERS(23) = 0 THEN GOSUB 2770 : GOTO 6150
6120 GET #1, PERS(23) : GOSUB 2530 'Extract 11000
6130 ROW=22: COL=98: GOSUB 9660 'for Person Number
6140 GOSUB 2980
6150 REM get 10111
6160 LOCATE 20,20: PRINT "24";
6170 IF PERS(24) = 0 THEN GOSUB 2770 : GOTO 6220
6180 GET #1, PERS(24) : GOSUB 2530 'Extract 10111
6190 IF PP.FORMS = 1 THEN ROW=25 ELSE ROW=26
6200 COL=98: GOSUB 9660 'for Person Number
6210 GOSUB 2980
6220 REM get 10110
6230 LOCATE 20,20: PRINT "25";
6240 IF PERS(25) = 0 THEN GOSUB 2770 : GOTO 6280
6250 GET #1, PERS(25) : GOSUB 2530 'Extract 10110
6260 ROW=28: COL=98: GOSUB 9660 'for Person Number
6270 GOSUB 2980
6280 REM get 10101
6290 LOCATE 20,20: PRINT "26";
6300 IF PERS(26) = 0 THEN GOSUB 2770 : GOTO 6340
6310 GET #1, PERS(26) : GOSUB 2530 'Extract 10101
6320 ROW=31: COL=98: GOSUB 9660 'for Person Number
6330 GOSUB 2980
6340 REM get 10100
6350 LOCATE 20,20: PRINT "27";
6360 IF PERS(27) = 0 THEN GOSUB 2770 : GOTO 6400
6370 GET #1, PERS(27) : GOSUB 2530 'Extract 10100
6380 ROW=34: COL=98: GOSUB 9660 'for Person Number
6390 GOSUB 2980
6400 REM get 10011
6410 LOCATE 20,20: PRINT "28";
6420 IF PERS(28) = 0 THEN GOSUB 2770 : GOTO 6470
6430 GET #1, PERS(28) : GOSUB 2530 'Extract 10011
6440 IF PP.FORMS = 1 THEN ROW=37 ELSE ROW=38
6450 COL=98: GOSUB 9660 'for Person Number
6460 GOSUB 2980
6470 REM get 10010
6480 LOCATE 20,20: PRINT "29";
6490 IF PERS(29) = 0 THEN GOSUB 2770 : GOTO 6530
6500 GET #1, PERS(29) : GOSUB 2530 'Extract 10010
6510 ROW=40: COL=98: GOSUB 9660 'for Person Number
6520 GOSUB 2980
6530 REM get 10001
6540 LOCATE 20,20: PRINT "30";
6550 IF PERS(30) = 0 THEN GOSUB 2770 : GOTO 6590
6560 GET #1, PERS(30) : GOSUB 2530 'Extract 10001
6570 ROW=43: COL=98: GOSUB 9660 'for Person Number
6580 GOSUB 2980
6590 REM get 10000
6600 LOCATE 20,20: PRINT "31";
6610 IF PERS(31) = 0 THEN GOSUB 2770 : GOTO 6650
6620 GET #1, PERS(31) : GOSUB 2530 'Extract 10000
6630 ROW=46: COL=98: GOSUB 9660 'for Person Number
6640 GOSUB 2980
6650 GOTO 6730
6660 REM Extract Marriage Information
6670 TT2! = CVS(M2$) : TT2 = TT2! 'Husband
6680 TT3! = CVS(M3$) : TT3 = TT3! 'Wife
6690 REM Position based upon forms
6700 TT5$ = SPACE$(13)
6710 IF PP.FORMS = 1 THEN RSET TT5$ = M5$ ELSE LSET TT5$ = M5$
6720 RETURN
6730 REM Find Marriage of Person (1)
6740 KEY ON : CLS : KEY OFF
6750 LOCATE 20,1 : PRINT "Processing Marriage of # 1 on Chart"
6760 FOUND = 0
6770 FOR L = 1 TO M.COUNT
6780 IF PERS(1) > PERS.NO(L) THEN 6840
6790 IF PERS(1) < PERS.NO(L) THEN L = M.COUNT : GOTO 6840
6800 REM found the marriage
6810 FOUND = 1
6820 GET #2, M.NO(L)
6830 L = M.COUNT
6840 NEXT L
6850 IF FOUND = 0 THEN 6980
6860 REM extract marriage information
6870 GOSUB 6660 'extract
6880 MID$(FORM$(26),10,13) = TT5$
6890 REM identify the spouse
6900 IF TT2 = PERS(1) THEN SPOUSE = TT3
6910 IF TT3 = PERS(1) THEN SPOUSE = TT2
6920 GET #1, SPOUSE
6930 GOSUB 2530 'Extract Person Info
6940 MID$(FORM$(29),1,LEN(T2$+T3$)+2) = T2$ + ", " + T3$
6950 COL = 1
6960 GOSUB 9660 'Obtain Spouse's Record No.
6970 MID$(FORM$(30),1,PLEN) = PNUM$
6980 GOTO 7210
6990 REM find a marriage
7000 FOUND = 0
7010 IF HUSB = 0 THEN 7200 'return
7020 REM Establish Skip-ahead Start-value and Delta
7030 START.AT = 1 : DELTA = INT(M.COUNT/10) : IF DELTA = 0 THEN 7080
7040 REM Add delta and test if too far
7050 START.AT = START.AT + DELTA
7060 IF START.AT > 9 * DELTA THEN 7080
7070 IF HUSB > PERS.NO(START.AT) THEN 7050
7080 START.AT = START.AT - DELTA
7090 REM Search Routine
7100 FOR L = START.AT TO M.COUNT
7110 IF HUSB > PERS.NO(L) THEN 7190 'next l
7120 IF HUSB < PERS.NO(L) THEN L = M.COUNT : GOTO 7190 'next l
7130 REM found one marriage
7140 GET #2, M.NO(L)
7150 GOSUB 6660 'Extract marriage info
7160 IF TT3 <> WIFE THEN 7190 'next l
7170 FOUND = 1
7180 L = M.COUNT
7190 NEXT L
7200 RETURN
7210 LOCATE 20,25: PRINT " 2";
7220 HUSB = PERS(2) : WIFE = PERS(3)
7230 GOSUB 6990 'Look for marriage
7240 IF FOUND = 0 THEN 7260
7250 MID$(FORM$(15),30,13) = TT5$
7260 LOCATE 20,25: PRINT " 4";
7270 HUSB = PERS(4) : WIFE = PERS(5)
7280 GOSUB 6990 'Look for marriage
7290 IF FOUND = 0 THEN 7310
7300 MID$(FORM$(9),55,13) = TT5$
7310 LOCATE 20,25: PRINT " 6";
7320 HUSB = PERS(6) : WIFE = PERS(7)
7330 GOSUB 6990 'Look for marriage
7340 IF FOUND = 0 THEN 7360
7350 MID$(FORM$(33),55,13) = TT5$
7360 LOCATE 20,25: PRINT " 8";
7370 HUSB = PERS(8) : WIFE = PERS(9)
7380 GOSUB 6990 'Look for marriage
7390 IF FOUND = 0 THEN 7410
7400 MID$(FORM$(6),80,13) = TT5$
7410 LOCATE 20,25: PRINT "10";
7420 HUSB = PERS(10) : WIFE = PERS(11)
7430 GOSUB 6990 'Look for marriage
7440 IF FOUND = 0 THEN 7460
7450 MID$(FORM$(18),80,13) = TT5$
7460 LOCATE 20,25: PRINT "12";
7470 HUSB = PERS(12) : WIFE = PERS(13)
7480 GOSUB 6990 'Look for marriage
7490 IF FOUND = 0 THEN 7510
7500 MID$(FORM$(30),80,13) = TT5$
7510 LOCATE 20,25: PRINT "14";
7520 HUSB = PERS(14) : WIFE = PERS(15)
7530 GOSUB 6990 'Look for marriage
7540 IF FOUND = 0 THEN 7560
7550 MID$(FORM$(42),80,13) = TT5$
7560 REM All Marriages found
7570 PRINT : PRINT "Ready to Print"
7580 LPRINT
7590 REM Print the Chart of Ancestors
7600 FOR I = 1 TO 49
7610 PRINT "Printing Line: ";I
7620 IF GENS <> 5 THEN LPRINT TAB(18); LEFT$(FORM$(I),97) ELSE LPRINT FORM$(I)
7630 NEXT I
7640 LAST.PERS = PERS(1)
7650 KEY ON : CLS : KEY OFF
7660 LPRINT FORM.FEED$;
7670 GOTO 2350 'for next chart
7680 REM Wrapup
7690 LPRINT COMPR.OFF$; 'Normal Printing
7700 LPRINT PAP.SEN.ON$; 'Paper Sensing ON
7710 LPRINT PAP.LONG$; 'Normal Page of 66 Lines
7720 CLOSE
7730 WIDTH "lpt1:",80 'Reset for narrow paper
7740 KEY ON : CLS : KEY OFF : LOCATE 21,1
7750 PRINT "End of Program"
7760 RUN CC.MENU$
7770 REM Create the Form
7780 REM Draw the Vertical Lines
7790 LOCATE 15,1 : PRINT "Drawing the Vertical Lines"
7800 FOR II = 13 TO 36
7810 MID$(FORM$(II),23,1) = CHR$(124)
7820 NEXT II
7830 FOR II = 7 TO 18
7840 MID$(FORM$(II),48,1) = CHR$(124)
7850 MID$(FORM$(II+24),48,1) = CHR$(124)
7860 NEXT II
7870 FOR II = 4 TO 9
7880 MID$(FORM$(II),73,1) = CHR$(124)
7890 MID$(FORM$(II+12),73,1) = CHR$(124)
7900 MID$(FORM$(II+24),73,1) = CHR$(124)
7910 MID$(FORM$(II+36),73,1) = CHR$(124)
7920 NEXT II
7930 IF GENS <> 5 THEN 8070
7940 FOR II = 2 TO 4
7950 MID$(FORM$(II),97,1) = CHR$(124)
7960 MID$(FORM$(II+6),97,1) = CHR$(124)
7970 IF II = 2 THEN 7990
7980 MID$(FORM$(II+12),97,1) = CHR$(124)
7990 MID$(FORM$(II+18),97,1) = CHR$(124)
8000 IF II = 2 THEN 8020
8010 MID$(FORM$(II+24),97,1) = CHR$(124)
8020 MID$(FORM$(II+30),97,1) = CHR$(124)
8030 IF II = 2 THEN 8050
8040 MID$(FORM$(II+36),97,1) = CHR$(124)
8050 MID$(FORM$(II+42),97,1) = CHR$(124)
8060 NEXT II
8070 REM Draw the Horizontal Lines
8080 PRINT "Drawing the Horizontal Lines"
8090 FOR JJ = 1 TO 22
8100 MID$(FORM$(23),JJ,1) = CHR$(95)
8110 MID$(FORM$(29),JJ,1) = CHR$(95)
8120 NEXT JJ
8130 PRINT "Drawing Lines for Parents"
8140 FOR II = 12 TO 36 STEP 24
8150 MID$(FORM$(II),24) = STRING$(24,95)
8160 NEXT II
8170 PRINT "Drawing Lines for Grandparents"
8180 FOR II = 6 TO 42 STEP 12
8190 MID$(FORM$(II),49) = STRING$(24,95)
8200 NEXT II
8210 PRINT "Drawing Lines for Great-grandparents"
8220 FOR II = 3 TO 45 STEP 6
8230 MID$(FORM$(II),74) = STRING$(23,95)
8240 NEXT II
8250 IF GENS <> 5 THEN 8330
8260 PRINT "Drawing Lines for Great-great-grandparents"
8270 FOR II = 1 TO 46 STEP 3
8280 IF II = 13 OR II = 25 OR II = 37 THEN 8310
8290 MID$(FORM$(II),98,23) = STRING$(23,95)
8300 GOTO 8320
8310 MID$(FORM$(II+1),98,23) = STRING$(23,95)
8320 NEXT II
8330 REM Prepare the Title Information
8340 PRINT "Preparing Titles and Numbers"
8350 PRINT : PRINT : PRINT : PRINT : PRINT
8360 MID$(FORM$( 1),1,22) = "Chart of Ancestors of "
8370 MID$(FORM$( 2),1,15) = "Person Record: "
8380 P.NO$ = STR$(PERS(1))
8390 P.NO$ = RIGHT$(P.NO$,LEN(P.NO$)-1)
8400 MID$(FORM$( 2),16,LEN(P.NO$)) = P.NO$
8410 MID$(FORM$( 3),1,23) = "Prepared on "+DATE$
8420 MID$(FORM$( 3),23,12) = " at "+TIME$
8430 MID$(FORM$( 4),1,42) = "Using Version 6.0 of Genealogy ON DISPLAY."
8440 IF PREP1$ = "" THEN 8460
8450 MID$(FORM$( 5),1, 3) = "By:"
8460 MID$(FORM$( 5),5, LEN(PREP1$)) = PREP1$
8470 MID$(FORM$( 6),5, LEN(PREP2$)) = PREP2$
8480 MID$(FORM$( 7),5, LEN(PREP3$)) = PREP3$
8490 MID$(FORM$( 8),5, LEN(PREP4$)) = PREP4$
8500 IF CHART.NOS$ = "n" THEN 8520
8510 MID$(FORM$(22),1,1) = "1"
8520 MID$(FORM$(24),1,1) = "B"
8530 MID$(FORM$(25),1,1) = "W"
8540 MID$(FORM$(26),1,8) = "Married:"
8550 MID$(FORM$(27),1,1) = "D"
8560 MID$(FORM$(28),1,1) = "W"
8570 IF CHART.NOS$ = "n" THEN 8590
8580 MID$(FORM$(12),21,2) = " 2"
8590 MID$(FORM$(13),24,2) = "B:"
8600 MID$(FORM$(14),24,2) = "W:"
8610 MID$(FORM$(15),24,5) = "Marr:"
8620 MID$(FORM$(16),24,2) = "D:"
8630 MID$(FORM$(17),24,2) = "W:"
8640 IF CHART.NOS$ = "n" THEN 8660
8650 MID$(FORM$(36),21,2) = " 3"
8660 MID$(FORM$(37),24,2) = "B:"
8670 MID$(FORM$(38),24,2) = "W:"
8680 MID$(FORM$(39),24,2) = "D:"
8690 MID$(FORM$(40),24,2) = "W:"
8700 IF CHART.NOS$ = "n" THEN 8720
8710 MID$(FORM$( 6),46,2) = " 4"
8720 MID$(FORM$( 7),49,2) = "B:"
8730 MID$(FORM$( 8),49,2) = "W:"
8740 MID$(FORM$( 9),49,5) = "Marr:"
8750 MID$(FORM$(10),49,2) = "D:"
8760 MID$(FORM$(11),49,2) = "W:"
8770 IF CHART.NOS$ = "n" THEN 8790
8780 MID$(FORM$(18),46,2) = " 5"
8790 MID$(FORM$(19),49,2) = "B:"
8800 MID$(FORM$(20),49,2) = "W:"
8810 MID$(FORM$(21),49,2) = "D:"
8820 MID$(FORM$(22),49,2) = "W:"
8830 IF CHART.NOS$ = "n" THEN 8850
8840 MID$(FORM$(30),46,2) = " 6"
8850 MID$(FORM$(31),49,2) = "B:"
8860 MID$(FORM$(32),49,2) = "W:"
8870 MID$(FORM$(33),49,5) = "Marr:"
8880 MID$(FORM$(34),49,2) = "D:"
8890 MID$(FORM$(35),49,2) = "W:"
8900 IF CHART.NOS$ = "n" THEN 8920
8910 MID$(FORM$(42),46,2) = " 7"
8920 MID$(FORM$(43),49,2) = "B:"
8930 MID$(FORM$(44),49,2) = "W:"
8940 MID$(FORM$(45),49,2) = "D:"
8950 MID$(FORM$(46),49,2) = "W:"
8960 IF CHART.NOS$ = "n" THEN 8980
8970 MID$(FORM$( 3),71,2) = " 8"
8980 MID$(FORM$( 4),74,2) = "B:"
8990 MID$(FORM$( 5),74,2) = "W:"
9000 MID$(FORM$( 6),74,5) = "Marr:"
9010 MID$(FORM$( 7),74,2) = "D:"
9020 MID$(FORM$( 8),74,2) = "W:"
9030 IF CHART.NOS$ = "n" THEN 9050
9040 MID$(FORM$( 9),71,2) = " 9"
9050 MID$(FORM$(10),74,2) = "B:"
9060 MID$(FORM$(11),74,2) = "W:"
9070 MID$(FORM$(12),74,2) = "D:"
9080 MID$(FORM$(13),74,2) = "W:"
9090 IF CHART.NOS$ = "n" THEN 9110
9100 MID$(FORM$(15),71,2) = "10"
9110 MID$(FORM$(16),74,2) = "B:"
9120 MID$(FORM$(17),74,2) = "W:"
9130 MID$(FORM$(18),74,5) = "Marr:"
9140 MID$(FORM$(19),74,2) = "D:"
9150 MID$(FORM$(20),74,2) = "W:"
9160 IF CHART.NOS$ = "n" THEN 9180
9170 MID$(FORM$(21),71,2) = "11"
9180 MID$(FORM$(22),74,2) = "B:"
9190 MID$(FORM$(23),74,2) = "W:"
9200 MID$(FORM$(24),74,2) = "D:"
9210 MID$(FORM$(25),74,2) = "W:"
9220 IF CHART.NOS$ = "n" THEN 9240
9230 MID$(FORM$(27),71,2) = "12"
9240 MID$(FORM$(28),74,2) = "B:"
9250 MID$(FORM$(29),74,2) = "W:"
9260 MID$(FORM$(30),74,5) = "Marr:"
9270 MID$(FORM$(31),74,2) = "D:"
9280 MID$(FORM$(32),74,2) = "W:"
9290 IF CHART.NOS$ = "n" THEN 9310
9300 MID$(FORM$(33),71,2) = "13"
9310 MID$(FORM$(34),74,2) = "B:"
9320 MID$(FORM$(35),74,2) = "W:"
9330 MID$(FORM$(36),74,2) = "D:"
9340 MID$(FORM$(37),74,2) = "W:"
9350 IF CHART.NOS$ = "n" THEN 9370
9360 MID$(FORM$(39),71,2) = "14"
9370 MID$(FORM$(40),74,2) = "B:"
9380 MID$(FORM$(41),74,2) = "W:"
9390 MID$(FORM$(42),74,5) = "Marr:"
9400 MID$(FORM$(43),74,2) = "D:"
9410 MID$(FORM$(44),74,2) = "W:"
9420 IF CHART.NOS$ = "n" THEN 9440
9430 MID$(FORM$(45),71,2) = "15"
9440 MID$(FORM$(46),74,2) = "B:"
9450 MID$(FORM$(47),74,2) = "W:"
9460 MID$(FORM$(48),74,2) = "D:"
9470 MID$(FORM$(49),74,2) = "W:"
9480 IF CHART.NOS$ = "n" OR GENS <> 5 THEN 9650
9490 MID$(FORM$( 1),95,2) = "16"
9500 MID$(FORM$( 4),95,2) = "17"
9510 MID$(FORM$( 7),95,2) = "18"
9520 MID$(FORM$(10),95,2) = "19"
9530 MID$(FORM$(14),95,2) = "20"
9540 MID$(FORM$(16),95,2) = "21"
9550 MID$(FORM$(19),95,2) = "22"
9560 MID$(FORM$(22),95,2) = "23"
9570 MID$(FORM$(26),95,2) = "24"
9580 MID$(FORM$(28),95,2) = "25"
9590 MID$(FORM$(31),95,2) = "26"
9600 MID$(FORM$(34),95,2) = "27"
9610 MID$(FORM$(38),95,2) = "28"
9620 MID$(FORM$(40),95,2) = "29"
9630 MID$(FORM$(43),95,2) = "30"
9640 MID$(FORM$(46),95,2) = "31"
9650 RETURN
9660 REM Routine to Obtain a Usable Person Number for the Chart
9670 REM Skip if LDS Wide, Single Sheet Forms
9680 IF PP.FORMS = 1 THEN 9810 'return
9690 IF CHART.NOS$ <> "n" THEN 9810
9700 REM Convert the Person Number to a String
9710 PNUM$ = STR$(T1)
9720 REM Find its Length
9730 PLEN = LEN(PNUM$)
9740 REM Get rid of the leading space for algebraic sign
9750 PNUM$ = RIGHT$(PNUM$,PLEN-1)
9760 REM Append a Trailing Space
9770 PNUM$ = PNUM$ + " "
9780 REM bypass if column is 1 (person or spouse)
9790 IF COL = 1 THEN 9810
9800 MID$(FORM$(ROW),COL-PLEN,PLEN) = PNUM$
9810 RETURN
9820 REM Clean User Input Area
9830 LOCATE 19,1 : PRINT SPACE$(79);
9840 LOCATE 20,1 : PRINT SPACE$(79);
9850 LOCATE 21,1 : PRINT SPACE$(79);
9860 LOCATE 22,1 : PRINT SPACE$(79);
9870 LOCATE 23,1 : PRINT SPACE$(79);
9880 RETURN
APPENDIX.BAS
100 REM APPENDIX Program.
110 REM Documentation. Appendices.
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 DATA Genealogy
140 DATA User's Manual
150 DATA -5
160 DATA 1
170 INDENT = 0
180 REM Printer Definitions
190 FORM.FEED$ = CHR$(12)
200 COMPR.OFF$ = CHR$(18) : COMPR.ON$ = CHR$(15)
210 BOLD.OFF$ = CHR$(27)+"F" : BOLD.ON$ = CHR$(27)+"E"
220 EXPAND.OFF$ = CHR$(18) : EXPAND.ON$ = CHR$(14)
230 DASHES$ = "+"+STRING$(54,45)+"+"
240 TRIM.LINE$ = "(Trim-line)"
300 REM Program begins here
310 READ TITLE$, DOC.NAME$, PAGE.NO, LINE.NO
320 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
330 GOSUB 920 'For trim line and heading space
340 FOR I = 1 TO 6 : LPRINT : NEXT I
350 LPRINT BOLD.ON$; 'Set Emphasized mode
360 LPRINT EXPAND.ON$; 'Set Expanded Print
370 LPRINT TAB(TAB.POS-1);TITLE$
380 LPRINT EXPAND.OFF$; 'Return to normal
390 LPRINT BOLD.OFF$; 'Return to normal
400 FOR I = 1 TO 3 : LPRINT : NEXT I
410 LPRINT BOLD.ON$; 'Set Emphasized mode
420 LPRINT TAB(TAB.POS+12);"ON DISPLAY"
430 LPRINT BOLD.OFF$; 'Return to normal
440 LPRINT : LPRINT : LPRINT
450 LPRINT TAB(TAB.POS+11);"Version 6.0"
460 FOR I = 1 TO 11 : LPRINT : NEXT I
470 LPRINT TAB(TAB.POS+10); DOC.NAME$
480 LINE.NO = LINE.NO + 27
490 '
500 READ REPLY$
510 REM First, change tildes to quotes
520 FOR Q = 1 TO LEN(REPLY$)
530 IF MID$(REPLY$,Q,1)="~"THEN MID$(REPLY$,Q,1)=CHR$(34)
540 NEXT Q
550 IF LEFT$(REPLY$,1) = "." THEN GOSUB 1270: GOTO 500
560 IF LINE.NO > 44 THEN GOSUB 1030
570 REM Print the line if not a command
580 LPRINT TAB(TAB.POS);REPLY$
590 LINE.NO = LINE.NO + 1
600 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
610 GOTO 500
620 REM Data for the Copyright Page
630 DATA ".pa"
640 DATA " "
750 DATA ".vt 31"
870 DATA "Copyright (c) 1982 ... 1989, by:"
880 DATA "Melvin O. Duke."
890 DATA ".sp"
900 DATA "All rights reserved."
910 '
920 REM Top of each page routine
930 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
940 LPRINT
950 LPRINT TAB(30); TRIM.LINE$
960 LPRINT DASHES$ 'Dashes
970 FOR I = 1 TO 6
980 LPRINT
990 NEXT I
1000 LINE.NO = LINE.NO + 6
1010 RETURN
1020 '
1030 REM Bottom of each page Routine
1040 IF PAGE.NO < 1 THEN LPRINT : LPRINT : LPRINT : GOTO 1160
1050 LPRINT TAB(TAB.POS); STRING$(40,45) 'on line 46
1060 LPRINT TAB(TAB.POS+2); TITLE$+" ON DISPLAY. Version 6.0" 'on line 47
1070 IF PAGE.NO MOD 2 = 1 THEN 1110
1080 LPRINT TAB(TAB.POS);"Page";PAGE.NO;
1090 LPRINT TAB(TAB.POS+27);"User's Manual"
1100 GOTO 1160
1110 LPRINT TAB(TAB.POS); "User's Manual";
1120 IF PAGE.NO < 10 THEN DELTA = 34
1130 IF PAGE.NO > 9 THEN DELTA = 33
1140 IF PAGE.NO > 99 THEN DELTA = 32
1150 LPRINT TAB(TAB.POS+DELTA); "Page"; PAGE.NO 'on line 48
1160 LPRINT : LPRINT : LPRINT
1170 LPRINT DASHES$ 'dashes after 51
1180 LPRINT TAB(30); TRIM.LINE$
1190 LPRINT FORM.FEED$;
1200 PAGE.NO = PAGE.NO + 1
1210 LINE.NO = 1
1220 IF REPLY$ = ".eof" THEN 1240 'Bypass after last page
1230 GOSUB 920 'For top of next page
1240 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1250 RETURN
1260 '
1270 REM Command Processor
1280 IF LEFT$(REPLY$,3) = ".h1" THEN 1390
1290 IF LEFT$(REPLY$,3) = ".h2" THEN 1550
1300 IF LEFT$(REPLY$,3) = ".h3" THEN 1660
1310 IF LEFT$(REPLY$,3) = ".sp" THEN 1770
1320 IF LEFT$(REPLY$,4) = ".eof" THEN 1820
1330 IF LEFT$(REPLY$,3) = ".pa" THEN 1860
1340 IF LEFT$(REPLY$,3) = ".pn" THEN PAGE.NO = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3)) : RETURN
1350 IF LEFT$(REPLY$,3) = ".vt" THEN 1930
1360 IF LEFT$(REPLY$,3) = ".pk" THEN 2040
1370 IF LEFT$(REPLY$,3) = ".in" THEN 2170
1380 STOP
1390 REM Head 1 Processor
1400 FOR I = LINE.NO TO 44
1410 LPRINT
1420 NEXT I
1430 GOSUB 1030 'Bottom of page Routine
1440 IF PAGE.NO MOD 2 = 0 THEN GOSUB 1860 'For h1 on Odd pages
1450 LPRINT BOLD.ON$; 'Set emphasized print
1460 LPRINT EXPAND.ON$; 'Set expanded print
1470 IF PAGE.NO MOD 2 = 0 THEN ADJUST = -2 ELSE ADJUST = -5
1480 LPRINT TAB(TAB.POS+ADJUST); RIGHT$(REPLY$,LEN(REPLY$)-4)
1490 LPRINT EXPAND.OFF$; 'Return to normal
1500 LPRINT BOLD.OFF$; 'Return to non-bold
1510 LINE.NO = LINE.NO+1
1520 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1530 RETURN
1540 '
1550 REM Head 2 Processor
1560 IF LINE.NO = 7 THEN 1580 'skip spacing if at top of page
1570 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1580 LPRINT BOLD.ON$; 'Set emphasized print
1590 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1600 LPRINT BOLD.OFF$; 'Return to normal
1610 LPRINT
1620 LINE.NO = LINE.NO + 2
1630 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1640 RETURN
1650 '
1660 REM Head 3 Processor
1670 IF LINE.NO = 7 THEN 1690 'skip spacing if at top of page
1680 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1690 LPRINT BOLD.ON$; 'Set emphasized print
1700 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1710 LPRINT BOLD.OFF$; 'Return to normal
1720 LPRINT
1730 LINE.NO = LINE.NO + 2
1740 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1750 RETURN
1760 '
1770 REM Single Space Processor
1780 IF LINE.NO = 7 THEN 1800
1790 IF LINE.NO > 44 THEN GOSUB 1860 ELSE LPRINT : LINE.NO = LINE.NO + 1
1800 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1810 RETURN
1820 REM End of File Processor
1830 GOSUB 1860 'Bottom of Page
1850 GOTO 9230
1860 REM Page Eject Processor
1870 FOR I = LINE.NO TO 44
1880 LPRINT
1890 LINE.NO = LINE.NO + 1
1900 NEXT I
1910 GOSUB 1030 'Bottom of Page Processing
1920 RETURN
1930 REM Vertical Tab Processor
1940 IF LINE.NO = 7 THEN 2030
1950 IF LINE.NO > 44 THEN GOSUB 1030 'End of page
1960 QTY = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
1970 FOR I = 1 TO QTY
1980 LPRINT
1990 LINE.NO = LINE.NO + 1
2000 IF LINE.NO > 44 THEN I = QTY
2010 NEXT I
2020 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2030 RETURN
2040 REM Pack Processor
2050 IF LINE.NO > 44 THEN GOSUB 1030
2060 IF TAB.POS = 8 THEN ADJUST = 4
2070 IF TAB.POS = 13 THEN ADJUST = 7
2080 TAB.POS = TAB.POS + ADJUST + INDENT
2090 WIDTH "lpt1:", 132 'set condensed width
2100 LPRINT COMPR.ON$; 'Packed printing
2110 LPRINT TAB(TAB.POS); RIGHT$(REPLY$,LEN(REPLY$)-3)
2120 LPRINT COMPR.OFF$; 'Return to normal
2130 WIDTH "lpt1:", 80 'return to normal
2140 LINE.NO = LINE.NO + 1
2150 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2160 RETURN
2170 REM Indent Processor
2180 INDENT = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
2190 RETURN
3000 REM APPENDIX
3010 DATA ".h1 A. MESSAGES"
3020 DATA ".pn 63"
3030 DATA ".h2 START-UP MESSAGES"
3040 DATA "The initial System Message, when the"
3050 DATA "system is turned on, is:"
3060 DATA ".sp"
3070 DATA ".pk Current date is Tue 1-01-1980"
3080 DATA ".pk Enter new date:"
3090 DATA ".sp"
3100 DATA "The user is expected to respond with an"
3110 DATA "appropriate date."
3120 DATA ".sp"
3130 DATA "The next system message is:"
3140 DATA ".sp"
3150 DATA ".pk Current time is 0:00:52.17"
3160 DATA ".pk Enter new time:"
3170 DATA ".sp"
3180 DATA "The user is expected to respond with a"
3190 DATA "correct time."
3200 DATA ".sp"
3210 DATA "The System then responds:"
3220 DATA ".sp"
3230 DATA ".pk The IBM Personal Computer DOS"
3240 DATA ".pk Version 2.10 (C) Copyright IBM Corp 1981, 1982, 1983"
3250 DATA ".sp"
3260 DATA "When Starting BASIC, the message"
3270 DATA "in response to"
3280 DATA ".sp"
3290 DATA ".pk basic/s:256"
3300 DATA ".sp"
3310 DATA "is similar to:"
3320 DATA ".sp"
3330 DATA ".pk IBM Personal Computer Basic"
3340 DATA ".pk Version D2.00 Copyright IBM Corp. 1981, 1982, 1983"
3350 DATA ".pk 61118 Bytes Free"
3360 DATA ".pa"
3370 DATA ".h1 B. Summary"
3380 DATA ".h2 General Programs"
3390 DATA ".pk Function Performed Filename"
3400 DATA ".pk ----------------------------------- --------"
3410 DATA ".pk Initial File Formatting"
3420 DATA ".pk Persons File CREATPER"
3430 DATA ".pk Marriages File CREATMAR"
3440 DATA ".pk Ordinances File CREATORD"
3450 DATA ".sp"
3460 DATA ".pk Entry of Data"
3470 DATA ".pk Persons File UPDATPER"
3480 DATA ".pk Marriages File UPDATMAR"
3490 DATA ".pk Ordinances File UPDATORD"
3500 DATA ".sp"
3510 DATA ".pk Print Detailed Information"
3520 DATA ".pk Detailed Personal Information PRINTPER"
3530 DATA ".pk Detailed Marriage Information PRINTMAR"
3540 DATA ".sp"
3550 DATA ".pk Numerical Lists"
3560 DATA ".pk Persons LISTPER"
3570 DATA ".pk Marriages LISTMAR"
3580 DATA ".pk Parent/Child Index LISTPCI"
3590 DATA ".sp"
3600 DATA ".pk Alphabetical Lists"
3610 DATA ".pk Persons ALPHAPER"
3620 DATA ".pk Marriages ALPHAMAR"
3630 DATA ".sp"
3640 DATA ".pk Prepare an Index"
3650 DATA ".pk Parent/Child Index INDEXPC"
3660 DATA ".pk Marriages Index INDEXMAR"
3670 DATA ".pa"
3680 DATA ".h2 General Programs, Cont."
3690 DATA ".pk Function Performed Filename"
3700 DATA ".pk ----------------------------------- --------"
3710 DATA ".pk Display the Information DISPLAY"
3720 DATA ".pk Personal Information"
3730 DATA ".pk Ancestor Information"
3740 DATA ".pk Family Information"
3750 DATA ".pk Ordinances Information"
3760 DATA ".sp"
3770 DATA ".pk Print the Genealogical Forms"
3780 DATA ".pk Print Charts of Ancestors ANCESTOR"
3790 DATA ".pk Print Charts of Families FAMILY"
3800 DATA ".sp"
3810 DATA ".pk Produce Charts of Descendants DESCEND"
3820 DATA ".pk Display on the Screen"
3830 DATA ".pk Print the Charts"
3840 DATA ".sp"
3850 DATA ".pk Display a Menu"
3860 DATA ".pk Displays Available Programs MENU"
3870 DATA ".h2 Data Files"
3880 DATA ".pk File Usage Filename"
3890 DATA ".pk ------------------------------------ --------"
3900 DATA ".pk Personal Vital Statistics PERSFILE"
3910 DATA ".pk Marriage Vital Statistics MARRFILE"
3920 DATA ".pk Life Events (LDS Ordinances) ORDFILE"
3930 DATA ".pk Verify BASIC has 256 byte buffer VERIFILE"
3940 DATA ".pa"
3950 DATA ".h2 Indexes"
3960 DATA ".pk Function Performed Filename"
3970 DATA ".pk ------------------------------------ --------"
3980 DATA ".pk Relates Parents and Children PCINDEX"
3990 DATA ".pk Relates Spouses by Marriage MINDEX"
4000 DATA ".h2 Documentation"
4010 DATA ".pk Purpose of Documentation Filename"
4020 DATA ".pk ------------------------------------ --------"
4030 DATA ".pk Getting Started Information READ.ME"
4040 DATA ".sp"
4050 DATA ".pk Change Printers for Documentation PRINTERS"
4060 DATA ".sp"
4070 DATA ".pk Print a Program Directory DIRECTOR"
4080 DATA ".sp"
4090 DATA ".pk Print a User's Manual"
4100 DATA ".pk Table of Contents TABLEOFC"
4110 DATA ".pk Introduction INTRODUC"
4120 DATA ".pk General Information GENERAL"
4130 DATA ".pk Using the Programs USINGTHE"
4140 DATA ".pk Reference Material REFERENC"
4150 DATA ".pk Appendexes APPENDIX"
4160 DATA ".h2 Overview Information"
4170 DATA ".pk Function Perfomed Filename"
4180 DATA ".pk ------------------------------------ --------"
4190 DATA ".pk Overview on the Display Screen OVERVIEW"
4200 DATA ".h1 C. HINTS"
4210 DATA ".h2 NAMES"
4220 DATA "It is best to enter surnames with all"
4230 DATA "capitals, such as: ABLE"
4240 DATA ".sp"
4250 DATA "(Note: It is common practice to use the"
4260 DATA "Maiden name of a woman, and the surname"
4270 DATA "given at birth for a child.)"
4280 DATA ".h2 DATES"
4290 DATA "All of the programs expect dates in the"
4300 DATA "form dd Mmm yyyy, such as: 16 Jun 1928."
4310 DATA "However, partial dates, or approximate"
4320 DATA "dates, may be entered. They will be"
4330 DATA "moved as far to the right as possible."
4340 DATA ".h2 Replacing Information"
4350 DATA "When using one of the update-programs,"
4360 DATA "information (with the exception of the"
4370 DATA "record-number) can be replaced by"
4380 DATA "entering the new information. The new"
4390 DATA "information simply replaces the old."
4400 DATA ".sp"
4410 DATA "In the event that a user wishes to re-"
4420 DATA "place a current value with blanks (the"
4430 DATA "data was not correct), one or more"
4440 DATA "blanks may be entered by enclosing them"
4450 DATA "within quotes."
4460 DATA ".pa"
4470 DATA ".h2 Removing a Record."
4480 DATA "In the rare event that a user wishes"
4490 DATA "to remove a record from the Persons"
4500 DATA "File, the Marriages File, or the Ord-"
4510 DATA "inances File, he may do so by chang-"
4520 DATA "ing the record-number to the same num-"
4530 DATA "ber preceded by a minus-sign. This"
4540 DATA "will cause the record to be cleared,"
4550 DATA "and it may then be 'saved'."
4560 DATA ".sp"
4570 DATA "(Note: Remove an Ordinance Record be-"
4580 DATA "fore removing its Corresponding Person"
4590 DATA "Record, because an Ordinance Record"
4600 DATA "cannot be accessed if its Person Record"
4610 DATA "does not exist.)"
4620 DATA ".sp"
4630 DATA "After a record is removed, it may be"
4640 DATA "necessary to change any references to"
4650 DATA "the removed record (in persons and"
4660 DATA "marriage records), and you may have"
4670 DATA "to prepare the indexes again."
4680 DATA ".h1 D. MODIFICATIONS"
4690 DATA ".h2 Making Changes"
4700 DATA "In all of the following examples, the"
4710 DATA "MENU Program has to be loaded and"
4720 DATA "edited. If you desire the changes to"
4730 DATA "be permanent, you must then save the"
4740 DATA "MENU again. Unless you save the MENU,"
4750 DATA "the changes will be only temporary"
4760 DATA "(gone the next time that the MENU is"
4770 DATA "loaded)."
4780 DATA ".sp"
4790 DATA "Since the MENU Program is a BASIC"
4800 DATA "program, you will need to use the"
4810 DATA "BASIC Editor (see the BASIC Manual"
4820 DATA "for details) to make the changes."
4830 DATA ".sp"
4840 DATA "Note: If you are using a one-drive"
4850 DATA "system, make sure that both copies"
4860 DATA "are modified in the same way."
4870 DATA ".h2 Color Considerations"
4880 DATA "Line 260 in the MENU Program establish-"
4890 DATA "es color, through the use of a SCREEN"
4900 DATA "Statement, which is:"
4910 DATA ".sp"
4920 DATA " SCREEN S1,S2,S3
4930 DATA ".sp"
4940 DATA "For many display screens, color can be"
4950 DATA "disabled by editing the definition of"
4960 DATA "S2 in Line 220 of the MENU Program."
4970 DATA "It can be changed from S2 = 1, to"
4980 DATA "S2 = 0."
4990 DATA ".pa"
5000 DATA ".h2 Color Definitions"
5010 DATA "Lines 300 through 380 of the MENU Pro-"
5020 DATA "gram establishe color for a number of"
5030 DATA "variables, which are then used by all"
5040 DATA "of the programs."
5050 DATA ".sp"
5060 DATA "Color can be disabled, or it can be"
5070 DATA "changed, by changing the numbers for"
5080 DATA "the variables. For example, color"
5090 DATA "can be disabled by changing each of"
5100 DATA "the numbers which is not a zero (0)"
5110 DATA "to a seven (7)."
5120 DATA ".h2 Changing the Number of Persons"
5130 DATA "The programs, as distributed, provide"
5140 DATA "for 500 persons, and 500 ordinances."
5150 DATA ".sp"
5160 DATA "In order to change the number of"
5170 DATA "persons and ordinances, it is then"
5180 DATA "necessary to change the 500 to some"
5190 DATA "other, more desirable, number."
5200 DATA ".sp"
5210 DATA "This can be done in the following way:"
5220 DATA ".sp"
5230 DATA "In the MENU Program:"
5240 DATA ".sp"
5250 DATA "Line-number: 610"
5260 DATA "Old-value: MAX.PER = 500"
5270 DATA "New-value: you decide."
5280 DATA ".pa"
5290 DATA ".h2 Extending Existing Files"
5300 DATA "Before extending any existing file,"
5310 DATA "it is always wise to make a back-up"
5320 DATA "copy of that file, in case you make"
5330 DATA "any mistakes."
5340 DATA ".sp"
5350 DATA "A current file can be extended by"
5360 DATA "changing the old maximum and setting"
5370 DATA "a new upper limit. Once set, the"
5380 DATA "CREATPER and CREATORD Programs must"
5390 DATA "then be ~run~."
5400 DATA ".sp"
5410 DATA "For example, expanding from 500 to 600"
5420 DATA "persons would require a change in the"
5430 DATA "the MENU Program in line 610 and line"
5440 DATA "630."
5450 DATA ".sp"
5460 DATA "Line-number: 610"
5470 DATA "Old-value: MAX.PER = 500"
5480 DATA "New-value: MAX.PER = 600"
5490 DATA ".sp"
5500 DATA "Line-number: 630"
5510 DATA "Old-value: OLD.MAX.PER = 0"
5520 DATA "New-value: OLD.MAX.PER = 500"
5530 DATA ".pa"
5540 DATA ".h2 Printing A Partial Alphabetic List"
5550 DATA "The beginning and ending letters, to"
5560 DATA "be used when printing an alphabetic"
5570 DATA "list of persons, are set in lines 720"
5580 DATA "and 730 of the MENU Program. These"
5590 DATA "may be changed, in order to print a"
5600 DATA "partial list (e.g. F through M)."
5610 DATA ".h2 Changing the Number of Marriages"
5620 DATA "The programs, as designed, provide"
5630 DATA "for 200 marriages."
5640 DATA ".sp"
5650 DATA "In order to change the number of"
5660 DATA "marriages, it is then necessary to"
5670 DATA "change the 200 to some other, more"
5680 DATA "desirable, number."
5690 DATA ".sp"
5700 DATA "In the MENU Program:"
5710 DATA ".sp"
5720 DATA "Line-number: 620"
5730 DATA "Old-value: MAX.MAR = 200"
5740 DATA "New-value: you decide."
5750 DATA ".pa"
5760 DATA ".h2 Extending an Existing File"
5770 DATA "Before extending any existing file,"
5780 DATA "it is always wise to make a back-up"
5790 DATA "copy of that file, in case you make"
5800 DATA "any mistakes."
5810 DATA ".sp"
5820 DATA "A current file of marriages can be ex-"
5830 DATA "tended by changing the old maximum and"
5840 DATA "establishing a new upper limit. Then"
5850 DATA "the CREATMAR Program must be ~run~."
5860 DATA ".sp"
5870 DATA "For example, expanding from 200 to 300"
5880 DATA "marriages would require a change in"
5890 DATA "the MENU Program in line 620 and line"
5900 DATA "640."
5910 DATA ".sp"
5920 DATA "Line-number: 620"
5930 DATA "Old-value: MAX.MAR = 200"
5940 DATA "New-value: MAX.MAR = 300"
5950 DATA ".sp"
5960 DATA "Line-number: 640"
5970 DATA "Old-value: OLD.MAX.MAR = 0"
5980 DATA "New-value: OLD.MAX.MAR = 200"
5990 DATA ".pa"
6000 DATA ".h2 Including Numeric Codes"
6010 DATA "Line 940 in the MENU Program specifies"
6020 DATA "that ~no~ numeric codes are to be in-"
6030 DATA "cluded within the user's data. Deleting"
6040 DATA "line 940 causes codes to be included."
6050 DATA ".h2 Printing Partial Files"
6060 DATA "As your files grow in size, you may want"
6070 DATA "printouts of just the new information,"
6080 DATA "rather than of entire files."
6090 DATA ".h2 Partial Printout of Persons"
6100 DATA "Line 680 in the MENU Program defines"
6110 DATA "the beginning Person Number for use by"
6120 DATA "the PRINTPER and LISTPER Programs. It"
6130 DATA "is 1. If you change this number to a"
6140 DATA "higher number (such as 201), the print-"
6150 DATA "outs will begin at the higher number,"
6160 DATA "rather than at 1."
6170 DATA ".h2 Partial Printout of Marriages"
6180 DATA "Line 690 in the MENU Program defines"
6190 DATA "the beginning Marriage Number for use by"
6200 DATA "the PRINTMAR and LISTMAR Programs. It"
6210 DATA "is 1. If you change this number to a"
6220 DATA "higher number (such as 101), the print-"
6230 DATA "outs will begin at the higher number,"
6240 DATA "rather than at 1."
6250 DATA ".pa"
6260 DATA ".h2 Repositioning the Files"
6270 DATA "As released, all files are associated"
6280 DATA "with the current directory. In order"
6290 DATA "to reposition any file onto a different"
6300 DATA "drive, the path must be changed."
6310 DATA ".sp"
6320 DATA "In the MENU Program, the default paths"
6330 DATA "are located in line numbers 410-480."
6340 DATA "They are:"
6350 DATA ".sp"
6360 DATA "Name Reference"
6370 DATA "----------------- -------------------"
6380 DATA "DD.PROG$ = ~~ The Programs"
6390 DATA "DD.VERI$ = ~~ Verify s/256: file"
6400 DATA "DD.MENU$ = ~~ Menu"
6410 DATA "DD.PERS$ = ~~ Persons File"
6420 DATA "DD.MARR$ = ~~ Marriages File"
6430 DATA "DD.ORD$ = ~no~ Ordinances File"
6440 DATA "DD.PCIDX$ = ~~ Parent/Child Index"
6450 DATA "DD.MARIDX$ = ~~ Marriages Index"
6460 DATA ".sp"
6470 DATA "The Path to any of the above programs"
6480 DATA "and files may be changed, by inserting"
6490 DATA "a path between the quotes (e.g. b:\)"
6500 DATA "for any specific file."
6510 DATA ".sp"
6520 DATA "If the current directory is not where"
6530 DATA "you have placed the Genealogy ON DISPLAY"
6540 DATA "Programs and Data Files, then each path"
6550 DATA "must be defined. For example:"
6560 DATA ".sp"
6570 DATA "DD.PROG$ = ~c:\GENONDIS\~"
6580 DATA ".sp"
6590 DATA "Where: GENONDIS is a Sub-Directory Name."
6600 DATA ".pa"
6610 DATA ".h2 Removing Person and Marriage Numbers"
6620 DATA "As distributed, numbers for both the"
6630 DATA "Person and Marriage are shown. These"
6640 DATA "numbers may be removed by changing line"
6650 DATA "670 in the MENU Program,"
6660 DATA ".sp"
6670 DATA " from: 670 CHART.NOS$ = ~n~"
6680 DATA " to: 670 CHART.NOS$ = ~y~"
6690 DATA ".sp"
6700 DATA "One other effect is that after this"
6710 DATA "change, Ancestral Numbers (e.g. 1,2,4,"
6720 DATA "8,16) will be shown in Pedigree Charts"
6730 DATA "instead of Person Numbers."
6740 DATA ".h2 Changing the Chart of Descendants"
6750 DATA "As distributed, the Chart of Descendants"
6760 DATA "prints in pages. It also prints a max-"
6770 DATA "imum of 30 generations. Both of these"
6780 DATA "may be changed by the user."
6790 DATA ".h2 Continuous Charts of Descendants"
6800 DATA "Line 660 of the MENU Program contains"
6810 DATA "a definition of the number of lines on"
6820 DATA "a page, which is 55. By changing this"
6830 DATA "to a very large number (e.g. 9999),"
6840 DATA "continuous charts may be produced."
6850 DATA ".pa"
6860 DATA ".h2 Changing the Generations Shown"
6870 DATA "Line number 650 of the MENU Program"
6880 DATA "contains a definition of the maximum"
6890 DATA "number of generations of descendants"
6900 DATA "to be shown, which is 30. This number"
6910 DATA "may be reduced to as few as 1. Making"
6920 DATA "the number more than 30 may cause in-"
6930 DATA "terference between names and dates."
6940 DATA "Making the number greater than 50 may"
6950 DATA "exceed the printer width definition."
6960 DATA ".h2 Charts of Families Binding Space"
6970 DATA "When Charts of Families are printed"
6980 DATA "without the LDS Ordinances, the part of"
6990 DATA "each sheet which contain those LDS"
7000 DATA "Ordinances is removed, and the form is"
7010 DATA "shifted to the right to provide space"
7020 DATA "for binding (3-hole punching)."
7030 DATA ".sp"
7040 DATA "Line 710 in the MENU Program contains"
7050 DATA "the definition of the number of char-"
7060 DATA "acters removed on each side of the"
7070 DATA "chart (10). If this number is redu-"
7080 DATA "ced (1 minimum), less binding space"
7090 DATA "will result, and more information will"
7100 DATA "be shown."
7110 DATA ".sp"
7120 DATA "If this number is increased (18 maxi-"
7130 DATA "mum), more binding space will result,"
7140 DATA "and less information will be shown."
7150 DATA ".pa"
7160 DATA ".h2 Adding an LDS Ordinances File"
7170 DATA "An LDS Ordinances File may be added by"
7180 DATA "changing line 460 in the MENU Program.
7190 DATA ".sp"
7200 DATA "Line 460 currently defines the absence"
7210 DATA "of an Ordinances file. Its content is:"
7220 DATA ".sp"
7230 DATA " DD.ORD$ = ~no~"
7240 DATA ".sp"
7250 DATA "By changing this to:"
7260 DATA ".sp"
7270 DATA " DD.ORD$ = ~~"
7280 DATA ".sp"
7290 DATA "an LDS Ordinance File is added, together"
7300 DATA "with the ability to Create (format) it,"
7310 DATA "update it, print its content as part of"
7320 DATA "the output of the PRINTPER Program, and"
7330 DATA "display it in the DISPLAY Program."
7340 DATA ".h2 Changing Number of Ancestor Generations"
7350 DATA "Line 700 of the MENU Program contains"
7360 DATA "the definition of the number of Genera-"
7370 DATA "tions to be shown, when a Chart of An-"
7380 DATA "cestors is prepared. It is set at 5."
7390 DATA ".sp"
7400 DATA "If additional binding space (for 3-hole"
7410 DATA "punching) is desired, changing the num-"
7420 DATA "ber from 5 to 4 will reduce the number"
7430 DATA "of generations shown, and cause the"
7440 DATA "remaining generations to be centered"
7450 DATA "on the page."
7460 DATA ".pa"
7470 DATA ".h2 Changing Sex Designations"
7480 DATA "Lines 740 and 750 in the MENU Program"
7490 DATA "contain one-letter abbreviations, and"
7500 DATA "full-word designations for male and"
7510 DATA "female sexes. These designations may"
7520 DATA "be changed for other uses, such as for"
7530 DATA "animal and bird genealogies. (Note:"
7540 DATA "The same abbreviation cannot be used"
7550 DATA "for both the male and female sex.)"
7560 DATA ".h2 Utilizing other Printers"
7570 DATA "As designed, an IBM Matrix Printer,"
7580 DATA "an IBM ProPrinter, or some equivalent"
7590 DATA "printer is assumed."
7600 DATA ".sp"
7610 DATA "Control for Compressed Printing, for"
7620 DATA "Page Length, for Paper Sensing, and"
7630 DATA "for Form Feeding is provided in the"
7640 DATA "ANCESTOR Program, in the FAMILY Pro-"
7650 DATA "gram, and in the DESCEND Program."
7660 DATA ".sp"
7670 DATA "Form Feeding is also provided in the"
7680 DATA "PRINTPER, PRINTMAR, LISTPER, LISTMAR,"
7690 DATA "LISTPCI, ALPHAPER, ALPHAMAR, and DIS-"
7700 DATA "PLAY Programs."
7710 DATA ".sp"
7720 DATA "Emphasized (bold) printing is used in"
7730 DATA "the PRINTPER Program."
7740 DATA ".sp"
7750 DATA "In order to provide the same facility"
7760 DATA "for another printer, these controls"
7770 DATA "may need to be changed. They are"
7780 DATA "found in lines 510-590 of the MENU"
7790 DATA "Program."
7800 DATA ".pa"
7810 DATA "The variable names, and their purposes,"
7820 DATA "are as follows:"
7830 DATA ".sp"
7840 DATA "Name: Purpose"
7850 DATA "------------- -----------------------"
7860 DATA "FORM.FEED$ To Top of the Next Page"
7870 DATA "PAP.SEN.ON$ Paper Sensing ON"
7880 DATA "PAP.SEN.OFF$ Paper Sensing OFF"
7890 DATA "PAP.LONG$ Long (11 inch) Paper"
7900 DATA "PAP.SHORT$ Short (8-1/2 in.) Paper"
7910 DATA "COMPR.ON$ Compressed Print ON"
7920 DATA "COMPR.OFF$ Compressed Print OFF"
7930 DATA "BOLD.ON$ Emphasized Print ON"
7940 DATA "BOLD.OFF$ Emphasized Print OFF"
7950 DATA ".sp"
7960 DATA "For each of the above, change the"
7970 DATA "definition to that of your printer."
7980 DATA ".h2 Paper Considerations"
7990 DATA "The definition of the paper being used"
8000 DATA "is continuous, 8-1/2 x 11 inch paper."
8010 DATA "This is the normal printer paper for"
8020 DATA "most printers in use. However, when-"
8030 DATA "ever a printer has the capabilities of"
8040 DATA "using wider paper, paper with another"
8050 DATA "length, and single sheets, changes can"
8060 DATA "be made to the MENU Program to use"
8070 DATA "these features in the DESCEND, FAMILY,"
8080 DATA "and ANCESTOR Programs."
8090 DATA ".sp"
8100 DATA "Lines 760 through 780 of the MENU Pro-"
8110 DATA "gram contain coded definitions for"
8120 DATA "different paper characteristics."
8130 DATA ".pa"
8140 DATA ".h2 Use of Wide Paper"
8150 DATA "Line 760 defines compressed printing"
8160 DATA "for narrow (e.g. 8-1/2 inch) paper. By"
8170 DATA "changing the 1 to a 2, compressed print-"
8180 DATA "ing will not occur, and wide (e.g. 14"
8190 DATA "inch) paper may be used."
8200 DATA ".h2 Use of Short Paper"
8210 DATA "Line 770 specifies long (i.e. 11 inch)"
8220 DATA "paper. By changing the 2 to a 1, the"
8230 DATA "alternate (short) paper length will be"
8240 DATA "used (i.e. 51 lines per page, for an"
8250 DATA "8-1/2 inch paper length). Note: Line"
8260 DATA "550 may be changed to a different page"
8270 DATA "length (e.g. 72 lines per page, for a"
8280 DATA "12 inch paper length)."
8290 DATA ".h2 Use of Single Sheets"
8300 DATA "Line 780 defines continuous paper. By"
8310 DATA "changing the 1 to a 2, the paper will"
8320 DATA "then be defined as existing in single"
8330 DATA "sheets (e.g. some Acid-free papers)."
8340 DATA ".h2 Defining Function Keys"
8350 DATA "Lines 810-900 of the MENU Program con-"
8360 DATA "tain definitions of the content of the"
8370 DATA "ten function keys, and are empty. These"
8380 DATA "definitions may be changed to contain"
8390 DATA "the names and places which are used the"
8400 DATA "most (e.g. TAYLOR, Wichita, Kansas)."
8410 DATA ".pa"
8420 DATA ".h2 Displaying Lists"
8430 DATA "The five listing programs (LISTPER"
8440 DATA "LISTMAR, LISTPCI, ALPHAPER, ALPHAMAR)"
8450 DATA "normally produce lists on the printer."
8460 DATA ".sp"
8470 DATA "By changing line 790 in the MENU Program"
8480 DATA "(from a 1 to a 0), these lists will be"
8490 DATA "be displayed on the screen instead of"
8500 DATA "being printed on the printer."
8510 DATA ".h2 Including Your Name and Address"
8520 DATA "You may include your name and address"
8530 DATA "(up to four lines), in the charts pro-"
8540 DATA "duced by the ANCESTOR, FAMILY and"
8550 DATA "DESCEND Programs by changing lines"
8560 DATA "960-990 of the MENU Program."
8570 DATA ".sp"
8580 DATA "Information inserted between the two"
8590 DATA "parentheses in each of these four"
8600 DATA "lines of the MENU Program will appear"
8610 DATA "in the appropriate places within the"
8620 DATA "body of the three major charts."
8630 DATA ".h2 Using LDS Pre-printed Forms"
8640 DATA "Line 920 in the MENU Program specifies"
8650 DATA "that LDS Forms will not be used. By"
8660 DATA "changing the 0 to a 1, LDS Forms, Stock"
8670 DATA "Numbers #GA-054 and #GA-032 may be used."
8680 DATA ".h1 E. TERMS & CONDITIONS"
8690 DATA ".h2 Terms"
8700 DATA "If you are using these programs, you are"
8710 DATA "expected to become a Registered User,"
8720 DATA "by making a contribution to the Author"
8730 DATA "of the programs ($49.00 suggested)."
8740 DATA ".sp"
8750 DATA " Melvin O. Duke"
8760 DATA " P. O. Box 2048"
8770 DATA " Morgan Hill, CA 95038-2048"
8780 DATA ".sp"
8790 DATA "Registration is by individual, not by"
8800 DATA "company or group."
8810 DATA ".sp"
8820 DATA "An individual may request a copy of these"
8830 DATA "programs, for trial, by sending an unfor-"
8840 DATA "matted, double-sided, double-density,"
8850 DATA "5-1/4 inch diskette to the Author. (No"
8860 DATA "SS, HD or 3-1/2 inch diskettes, please.)"
8870 DATA ".sp"
8880 DATA "A self-addressed, postage-paid return"
8890 DATA "diskette-mailer must accompany the"
8900 DATA "diskette (no exceptions, please)."
8910 DATA ".sp"
8920 DATA "The programs and documentation will be"
8930 DATA "copied to the requestor's diskette and"
8940 DATA "returned in the requestor's mailer."
8950 DATA ".pa"
8960 DATA ".h2 Conditions"
8970 DATA "A limited license is granted to Users"
8980 DATA "of these programs, to make copies of"
8990 DATA "them, and distribute them to other indi-"
9000 DATA "viduals, under the following conditions:"
9010 DATA ".sp"
9020 DATA "1. The Genealogy ON DISPLAY Programs"
9030 DATA " are not to be distributed to others"
9040 DATA " in a modified form."
9050 DATA ".sp"
9060 DATA "2. No fee is to be charged for the Gene-"
9070 DATA " alogy ON DISPLAY Programs themselves."
9080 DATA ".sp"
9090 DATA "3. The notices displayed at program"
9100 DATA " start-up are not to be bypassed,"
9110 DATA " altered, or removed."
9120 DATA ".h2 Disclaimer"
9130 DATA "In no event will the Author be liable to"
9140 DATA "you for any damages, including any lost"
9150 DATA "profits, lost savings or other inciden-"
9160 DATA "tal or consequential damages arising out"
9170 DATA "of the use of or inability to use these"
9180 DATA "programs, even if the Author has been"
9190 DATA "advised of the possibility of such"
9200 DATA "damages, or for any claim by any other"
9210 DATA "party."
9220 DATA ".eof"
9230 END
CREATMAR.BAS
100 REM CREATMAR Program
110 REM Creates (Formats) a Marriages File
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Create a Marriages File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
1760 REM Give the User one more chance to protect himself.
1770 LOCATE 10,1
1780 PRINT "This program FORMATS a Marriages-file by writing new, empty records."
1790 PRINT "It will destroy any data which exists with the same record-numbers."
1800 PRINT
1810 PRINT "If this is REALLY what you want to do,"
1820 PRINT "type y to continue, and press the 'enter' key."
1830 PRINT "Otherwise, type anything else, and press the 'enter' key."
1840 PRINT
1850 LINE INPUT "Enter your desired action: ",REPLY$
1860 IF LEFT$(REPLY$,1) = "y" THEN 2000
1870 IF LEFT$(REPLY$,1) = "Y" THEN 2000
1880 PRINT
1890 PRINT "File was NOT Created."
1900 PRINT
1910 PRINT "Press any key to continue"
1920 A$ = INKEY$ : IF A$ = "" THEN 1920
1930 GOTO 2220 'to end the program
2000 REM CREATMAR Program Starts Here
2010 OPEN CC.MARRFILE$ AS #2 LEN = 128
2020 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$
2030 '
2040 REM Write the Marriage Records
2050 FOR I = OLD.MAX.MAR + 1 TO MAX.MAR
2060 LOCATE 22,1 : PRINT "Writing Record:"; I
2070 TEMP! = -I
2080 LSET M1$ = MKS$(TEMP!) 'Record Number
2090 TEMP! = 0
2100 LSET M2$ = MKS$(TEMP!) 'Husband
2110 LSET M3$ = MKS$(TEMP!) 'Wife
2120 LSET M4$ = MKS$(TEMP!) 'Code
2130 TEMP$ = " "
2140 LSET M5$ = TEMP$ 'Marriage Date
2150 LSET M6$ = TEMP$ 'Marriage City
2160 LSET M7$ = TEMP$ 'Marriage County
2170 LSET M8$ = TEMP$ 'Marriage State
2180 LSET M9$ = TEMP$ 'Comments
2190 PUT #2, I
2200 NEXT I
2210 CLOSE #2
2220 KEY ON : CLS : KEY OFF : LOCATE 21,1
2230 PRINT "End of Program"
2240 RUN CC.MENU$
CREATORD.BAS
100 REM CREATORD Program
110 REM Creates (Formats) an (LDS) Ordinances File
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Create an Ordinances File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
1760 REM Give the User one more chance to protect himself.
1770 LOCATE 10,1
1780 PRINT "This program FORMATS an Ordinances-file by writing new, empty records."
1790 PRINT "It will destroy any data which exists with the same record-numbers."
1800 PRINT
1810 PRINT "If this is REALLY what you want to do,"
1820 PRINT "type y to continue, and press the 'enter' key."
1830 PRINT "Otherwise, type anything else, and press the 'enter' key."
1840 PRINT
1850 LINE INPUT "Enter your desired action: ",REPLY$
1860 IF LEFT$(REPLY$,1) = "y" THEN 2000
1870 IF LEFT$(REPLY$,1) = "Y" THEN 2000
1880 PRINT
1890 PRINT "File was NOT Created."
1900 PRINT
1910 PRINT "Press any key to continue"
1920 A$ = INKEY$ : IF A$ = "" THEN 1920
1930 GOTO 2370 'to end the program
2000 REM CREATORD Program Starts Here
2010 OPEN CC.ORDFILE$ AS #2 LEN = 256
2020 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$
2030 '
2040 REM Write the Ordinances Records
2050 FOR I = OLD.MAX.PER + 1 TO MAX.PER
2060 TEMP! = I
2070 LSET O1$ = MKS$(TEMP!) 'Record Number
2080 TEMP! = 0
2090 TEMP$ = " "
2100 LSET O2$ = TEMP$ 'Christening
2110 LSET O3$ = TEMP$ 'Blessing
2120 LSET O4$ = TEMP$ 'Sealed to Parents
2130 LSET O5$ = MKS$(TEMP!) 'Sealed to Father
2140 LSET O6$ = MKS$(TEMP!) 'Sealed to Mother
2150 LSET O7$ = TEMP$ 'Baptism
2160 LSET O8$ = TEMP$ 'Confirmation
2170 LSET O9$ = TEMP$ 'Patriarchal Blessing
2180 LSET O10$ = TEMP$ 'Endowment
2190 LSET O11$ = TEMP$ 'Sealed to Spouse
2200 LSET O12$ = MKS$(TEMP!) 'Spouse
2210 LSET O13$ = TEMP$ 'Aaronic Priesthood
2220 LSET O14$ = TEMP$ 'Deacon
2230 LSET O15$ = TEMP$ 'Teacher
2240 LSET O16$ = TEMP$ 'Priest
2250 LSET O17$ = TEMP$ 'Melchizedek Priesthood
2260 LSET O18$ = TEMP$ 'Elder
2270 LSET O19$ = TEMP$ 'Seventy
2280 LSET O20$ = TEMP$ 'High Priest
2290 LSET O21$ = TEMP$ 'Bishop
2300 LSET O22$ = TEMP$ 'Patriarch
2310 LSET O23$ = TEMP$ 'Apostle
2320 LSET O24$ = TEMP$ 'Occupation
2330 LOCATE 23,1 : PRINT "Writing Record Number:";I
2340 PUT #2,I
2350 NEXT I
2360 CLOSE #2
2370 KEY ON : CLS : KEY OFF : LOCATE 21,1
2380 PRINT "End of Program"
2390 RUN CC.MENU$
CREATPER.BAS
100 REM CREATPER Program
110 REM Creates (Formats) a Persons File
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Create a Persons File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
1760 REM Give the User one more chance to protect himself.
1770 LOCATE 10,1
1780 PRINT "This program FORMATS a Persons-file by writing new, empty records."
1790 PRINT "It will destroy any data which exists with the same record-numbers."
1800 PRINT
1810 PRINT "If this is REALLY what you want to do,"
1820 PRINT "type y to continue, and press the 'enter' key."
1830 PRINT "Otherwise, type anything else, and press the 'enter' key."
1840 PRINT
1850 LINE INPUT "Enter your desired action: ",REPLY$
1860 IF LEFT$(REPLY$,1) = "y" THEN 2000
1870 IF LEFT$(REPLY$,1) = "Y" THEN 2000
1880 PRINT
1890 PRINT "File was NOT Created."
1900 PRINT
1910 PRINT "Press any key to continue"
1920 A$ = INKEY$ : IF A$ = "" THEN 1920
1930 GOTO 2330 'to end the program
2000 REM CREATPER Program Starts Here
2010 OPEN CC.PERSFILE$ AS #1 LEN = 256
2020 FIELD 1,5ASF1$,20ASF2$,30ASF3$,2ASF4$,5ASF5$,5ASF6$,5ASF7$,11ASF8$,18ASF9$,16ASF10$,16ASF11$,11ASF12$,18ASF13$,16ASF14$,16ASF15$,11ASF16$,18ASF17$,16ASF18$,16ASF19$
2030 REM Write the Persons Records
2040 FOR I = OLD.MAX.PER + 1 TO MAX.PER
2050 TEMP! = -I
2060 TEMP$ = MKS$(TEMP!)
2070 LSET F1$ = TEMP$ 'Record Number
2080 TEMP$ = " "
2090 TEMP! = 0
2100 LSET F2$ = TEMP$ 'Surname
2110 LSET F3$ = TEMP$ 'Given Names
2120 LSET F4$ = TEMP$ 'Sex
2130 LSET F5$ = MKS$(TEMP!) 'Code
2140 LSET F6$ = MKS$(TEMP!) 'Father
2150 LSET F7$ = MKS$(TEMP!) 'Mother
2160 REM all the rest are string
2170 LSET F8$ = TEMP$ 'Birth Date
2180 LSET F9$ = TEMP$ 'Birth City
2190 LSET F10$ = TEMP$ 'Birth County
2200 LSET F11$ = TEMP$ 'Birth State
2210 LSET F12$ = TEMP$ 'Death Date
2220 LSET F13$ = TEMP$ 'Death City
2230 LSET F14$ = TEMP$ 'Death County
2240 LSET F15$ = TEMP$ 'Death State
2250 LSET F16$ = TEMP$ 'Burial Date
2260 LSET F17$ = TEMP$ 'Burial City
2270 LSET F18$ = TEMP$ 'Burial County
2280 LSET F19$ = TEMP$ 'Burial State
2290 LOCATE 23,1 : PRINT "Writing Record Number:";I
2300 PUT #1,I
2310 NEXT I
2320 CLOSE #1
2330 KEY ON : CLS : KEY OFF : LOCATE 21,1
2340 PRINT "End of Program"
2350 RUN CC.MENU$
DESCEND.BAS
100 REM DESCEND Program.
110 REM Prints (and Displays) Charts of Descendants
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Charts of Descendants"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
940 DIM PERSATLVL(MAX.GEN+1), SEXATLVL$(MAX.GEN+1)
950 DIM MARRATLVL(MAX.GEN+1), SPOUSATLVL(MAX.GEN+1)
960 DIM TEMPMAR(MAX.GEN+1), TEMPCHILD(MAX.GEN+1)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1020 REM Find the title location
1030 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1040 REM Print the title
1050 LOCATE 4,TITLE.POS : PRINT TITLE$
1060 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1070 REM Print the Copyright
1080 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1090 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM DESCEND Program Starts Here.
2010 REM Prevent Common User Errors
2020 IF MAX.GEN < 1 THEN MAX.GEN = 1
2030 IF MAX.LINES < 20 THEN MAX.LINES = 20
2040 REM set initial color
2050 COLOR W,K
2060 REM Ask about whether to print
2070 PRT.SW = 0
2080 LOCATE 19,1
2090 PRINT "Charts of Descendants will be Displayed."
2100 INPUT "Do you want to Print as well as to Display";REPLY$
2110 IF LEFT$(REPLY$,1)="y" OR LEFT$(REPLY$,1) ="Y"THEN PRT.SW = 1
2120 ON PRT.SW+1 GOTO 2230, 2140
2130 STOP
2140 LOCATE 1,1 : PRINT "Charts will be Printed"
2150 GOSUB 6110 'Clean
2160 REM Routine to obtain Printer Information
2170 LOCATE 21,1 : PRINT "Make sure that the Printer is on and Ready"
2180 LOCATE 22,1 : PRINT "Make sure that the correct Diskette(s) are in place."
2190 LOCATE 23,1 : PRINT "Then press any key"
2200 A$ = INKEY$ : IF A$ = "" THEN 2200
2210 REM reset all Printer Defaults
2220 WIDTH "lpt1:", 132 'For printing Genealogy Forms
2230 KEY ON : CLS : KEY OFF
2240 REM Read the Parent/Child Index
2250 OPEN CC.PCINDEX$ FOR INPUT AS #1
2260 LOCATE 4,1 : PRINT "Open the Parent/Child Index"
2270 INPUT #1, PC.COUNT
2280 IF PC.COUNT <> 0 THEN 2330
2290 PRINT "Parent/Child Index has no Index Records"
2300 PRINT "Press any key to return to the Menu"
2310 A$ = INKEY$ : IF A$ = "" THEN 2310
2320 GOTO 5680
2330 DIM PA.ID(PC.COUNT), CH.ID(PC.COUNT)
2340 FOR I = 1 TO PC.COUNT
2350 LOCATE 5,1 : PRINT "Reading Index Record #:";I;
2360 INPUT #1, PA.ID(I), CH.ID(I)
2370 NEXT I
2380 CLOSE #1
2390 REM Read the Marriage Index
2400 LOCATE 7,1 : PRINT "Open the Marriage Index"
2410 OPEN CC.MINDEX$ FOR INPUT AS #2
2420 INPUT #2, M.COUNT
2430 IF M.COUNT <> 0 THEN 2480
2440 PRINT "Marriage Index has no Index Records"
2450 PRINT "Press any key to return to the Menu"
2460 A$ = INKEY$ : IF A$ = "" THEN 2460
2470 GOTO 5680
2480 DIM PERS.NO(M.COUNT), M.NO(M.COUNT)
2490 FOR I = 1 TO M.COUNT
2500 LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I;
2510 INPUT #2,PERS.NO(I), M.NO(I)
2520 NEXT I
2530 CLOSE #2
2540 REM Open the Persons File
2550 LOCATE 10,1 : PRINT "Open the Persons File"
2560 OPEN CC.PERSFILE$ AS #1 LEN = 256
2570 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$
2580 REM open the Marriages File
2590 LOCATE 12,1 : PRINT "Open the Marriage File"
2600 OPEN CC.MARRFILE$ AS #2 LEN = 128
2610 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$
2620 REM Obtain a Person Record from the User
2630 LOCATE 20,1
2640 INPUT "Enter the Record-number of a Person (0 to quit)"; REPLY$
2650 IF REPLY$ = "0" THEN 5680
2660 PERSON = VAL(REPLY$)
2670 IF PERSON < 1 OR PERSON > MAX.PER THEN KEY ON : CLS : LOCATE 19,1 : PRINT "Number is out of range"; : KEY OFF : GOTO 2620
2680 ON PRT.SW + 1 GOTO 3120, 2690
2690 GOSUB 2700 : GOTO 3120
2700 REM Reset the Printer Characteristics for next page if required.
2710 IF FORMS = 1 THEN 2750 'Don't stop if forms are continuous
2720 REM Process Single Sheets
2730 PRINT "Press any key when next form is ready"
2740 A$ = INKEY$ : IF A$ = "" THEN 2740
2750 REM Reset paper sensing if required
2760 IF FORMS = 2 THEN LPRINT PAP.SEN.OFF$;
2770 REM Reset paper length if required
2780 IF LENGTH = 1 THEN LPRINT PAP.SHORT$;
2790 IF LENGTH = 1 AND MAX.LINES = 55 THEN MAX.LINES = 43
2800 REM Reset Condensed Printing if required
2810 IF WIDE = 1 THEN LPRINT COMPR.ON$;
2820 RETURN
2830 REM Routine to do a Right-trim
2840 TEMP2$ = ""
2850 FOR J = LEN(TEMP1$) TO 1 STEP -1
2860 IF MID$(TEMP1$,J,1) = " " THEN 2880
2870 TEMP2$ = LEFT$(TEMP1$,J) : J = 1
2880 NEXT J
2890 RETURN
2900 REM Routine to Extract Personal Information
2910 T1! = CVS(F1$) : T1 = T1!
2920 TEMP1$ = F2$ : TEMP2$ = F2$ : GOSUB 2830
2930 T2$ = TEMP2$
2940 IF CHART.NOS$ = "n" THEN GOSUB 5870
2950 TEMP1$ = F3$ : TEMP2$ = F3$ : GOSUB 2830
2960 T3$ = TEMP2$
2970 T4$ = " "
2980 IF LEFT$(F4$,1) = MALE.LTR$ THEN T4$ = MALE.LTR$
2990 IF LEFT$(F4$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.LTR$
3000 T6! = CVS(F6$) : T6 = T6! 'Father
3010 T7! = CVS(F7$) : T7 = T7! 'Mother
3020 T8$ = F8$
3030 T12$ = F12$
3040 RETURN
3050 RETURN
3060 REM Extraction of Marriage Information
3070 TT1! = CVS(M1$) : TT1 = TT1! 'Rec.no
3080 TT2! = CVS(M2$) : TT2 = TT2! 'Husband
3090 TT3! = CVS(M3$) : TT3 = TT3! 'Wife
3100 TT5$ = M5$ 'Marriage Date
3110 RETURN
3120 REM Routine to Produce a Chart of Descendants
3130 REM First of all, set all numbers to 0 and letters to -
3140 FOR ATLVL = 1 TO MAX.GEN
3150 PERSATLVL(ATLVL) = 0
3160 SEXATLVL$(ATLVL) = "-"
3170 MARRATLVL(ATLVL) = 0
3180 SPOUSATLVL(ATLVL) = 0
3190 NEXT ATLVL
3200 REM Establish a starting-point for level 1
3210 LEVEL = 1
3220 PERSATLVL(LEVEL) = PERSON
3230 GET #1, PERSATLVL(LEVEL)
3240 GOSUB 2900 'for Person's Information
3250 REM Test if Empty
3260 IF T1 > 0 THEN 3290
3270 KEY ON : CLS : KEY OFF : LOCATE 20,1 : PRINT "Record";PERSON;"is Empty"
3280 GOTO 4010
3290 SEXATLVL$(LEVEL) = T4$
3300 PERSON$ = T3$+" "+T2$
3310 PAGE.NO = 1 : PAGE.LEN = 0
3320 ON PRT.SW+1 GOTO 3720, 3330
3330 REM Print the Title on the First Page, Date, Time, and Person Indicated
3340 GOSUB 3350 : GOSUB 3390 : GOTO 3670
3350 LPRINT
3360 LPRINT TAB(11);"Chart of Descendants of ";PERSON$;
3370 LPRINT TAB(112); "Page"; PAGE.NO
3380 RETURN
3390 LPRINT TAB(11);"Person Record"; T1
3400 LPRINT TAB(11);"Prepared on ";DATE$;" at ";TIME$
3410 LPRINT TAB(11);"Using Version 6.0 of Genealogy ON DISPLAY"
3420 IF PREP1$ = "" THEN 3460
3430 LPRINT TAB(11);"By: ";
3440 LPRINT PREP1$
3450 PAGE.LEN = PAGE.LEN + 1
3460 IF PREP2$ = "" THEN 3490
3470 LPRINT TAB(15); PREP2$
3480 PAGE.LEN = PAGE.LEN + 1
3490 IF PREP3$ = "" THEN 3520
3500 LPRINT TAB(15); PREP3$
3510 PAGE.LEN = PAGE.LEN + 1
3520 IF PREP4$ = "" THEN 3550
3530 LPRINT TAB(15); PREP4$
3540 PAGE.LEN = PAGE.LEN + 1
3550 LPRINT
3560 LPRINT TAB(11);" d-Descendant Generation Name";
3570 LPRINT TAB( 83);"Date of";
3580 LPRINT TAB( 96);"Date of";
3590 LPRINT TAB(109);"Date of"
3600 LPRINT TAB(11);" s-Spouse Generation Name";
3610 LPRINT TAB( 83);"Birth";
3620 LPRINT TAB( 96);"Marriage";
3630 LPRINT TAB(109);"Death"
3640 LPRINT TAB(11);
3650 FOR VERT = 1 TO 109 : LPRINT "-";: NEXT VERT : LPRINT
3660 RETURN
3670 LPRINT TAB(11);
3680 LPRINT " -1 "+LEFT$(T3$+" "+T2$,69);
3690 LPRINT TAB( 83);T8$;
3700 LPRINT TAB(109);T12$
3710 PAGE.LEN = PAGE.LEN + 10
3720 KEY ON : CLS : KEY OFF : COLOR O,K
3730 PRINT "Chart of Descendants for "; T3$;" ";T2$
3740 PRINT
3750 PRINT "Prepared on ";DATE$;" at ";TIME$
3760 PRINT "Using Version 6.0 of Genealogy ON DISPLAY"
3770 PRINT
3780 IF PREP1$ = "" THEN 3820
3790 PRINT "By: ";
3800 PRINT PREP1$
3810 '
3820 IF PREP2$ = "" THEN 3850
3830 PRINT TAB(5); PREP2$
3840 '
3850 IF PREP3$ = "" THEN 3880
3860 PRINT TAB(5); PREP3$
3870 '
3880 IF PREP4$ = "" THEN 3910
3890 PRINT TAB(5); PREP4$
3900 '
3910 PRINT : COLOR O,K
3920 PRINT " d-Descendant Generation Name"
3930 PRINT " s-Spouse Generation Name"
3940 COLOR P,K : FOR VERT = 1 TO 79 : PRINT "-";: NEXT VERT : PRINT
3950 COLOR G,K : PRINT " -1 "+LEFT$(T3$+" "+T2$,76)
3960 COLOR W,K
3970 MLEVEL=0
3980 GOTO 4060 'look for marriage
3990 ON PRT.SW+1 GOTO 4010,4000
4000 LPRINT FORM.FEED$;
4010 PRINT
4020 PRINT "Press any key to continue"
4030 A$ = INKEY$ : IF A$ = "" THEN 4030
4040 KEY ON : CLS : KEY OFF
4050 GOTO 2620
4060 REM Locate an unreported marriage, if present
4070 MLEVEL = MLEVEL + 1
4080 REM Establish Skip-ahead Start-value and Delta
4090 MRECATLVL = 1 : DELTA = INT(M.COUNT/10) : IF DELTA = 0 THEN 4140
4100 REM Add delta and test if too far
4110 MRECATLVL = MRECATLVL + DELTA
4120 IF MRECATLVL > 9 * DELTA THEN 4140
4130 IF PERS.NO(MRECATLVL) < PERSATLVL(LEVEL) THEN 4110 'Not there yet
4140 MRECATLVL = MRECATLVL - DELTA -1
4150 REM Search Routine
4160 MRECATLVL = MRECATLVL + 1
4170 IF PERS.NO(MRECATLVL) < PERSATLVL(LEVEL) THEN 4880 'Not there yet
4180 IF PERS.NO(MRECATLVL) > PERSATLVL(LEVEL) THEN MRECATLVL = M.COUNT : GOTO 4880
4190 REM found a marriage. Try to accept it.
4200 IF MARRATLVL(LEVEL) <> 0 AND MARRATLVL(LEVEL) = M.NO(MRECATLVL) THEN 4880
4210 IF MARRATLVL(LEVEL) = 0 THEN MARRATLVL(LEVEL) = M.NO(MRECATLVL)
4220 REM get the marriage record, and the spouse
4230 GET #2, M.NO(MRECATLVL)
4240 GOSUB 3060 'to Extract Marriage Information
4250 IF SEXATLVL$(LEVEL) = MALE.LTR$ THEN SELF = TT2 : SPOUSE = TT3
4260 IF SEXATLVL$(LEVEL) = FEMALE.LTR$ THEN SELF = TT3 : SPOUSE = TT2
4270 SPOUSATLVL(LEVEL) = SPOUSE
4280 PERSATLVL(LEVEL) = SELF
4290 GET #1, SPOUSE
4300 GOSUB 2900 'to Extract Personal Information
4310 IF CHART.NOS$ = "n" THEN GOSUB 5990
4320 ON PRT.SW+1 GOTO 4490, 4330
4330 REM Now print the Spouse
4340 LPRINT TAB(11);
4350 FOR VERT = 2 TO LEVEL
4360 LPRINT "| ";
4370 NEXT VERT
4380 LPRINT " ";
4390 LPRINT "s"+LEFT$(STR$(-VERT+1)+" "+T3$+" "+T2$,119-(2*VERT));
4400 IF T8$ = SPACE$(11) THEN 4420
4410 LPRINT TAB( 83);T8$;
4420 IF TT5$ = SPACE$(11) THEN 4440
4430 LPRINT TAB( 96);TT5$;
4440 IF T12$ = SPACE$(11) THEN 4460
4450 LPRINT TAB(109);T12$;
4460 LPRINT
4470 PAGE.LEN = PAGE.LEN + 1
4480 GOSUB 5780 'test page-break
4490 COLOR P,K
4500 FOR VERT = 2 TO LEVEL
4510 PRINT "| ";
4520 NEXT VERT
4530 PRINT " ";
4540 COLOR G,K : PRINT "s"+STR$(-VERT+1)+" "+T3$+" "+T2$
4550 COLOR W,K
4560 REM Line After the Spouse
4570 ON PRT.SW+1 GOTO 4690, 4580
4580 LPRINT TAB(11);
4590 FOR VERT = 2 TO LEVEL
4600 LPRINT "| ";
4610 NEXT VERT
4620 LPRINT "+";
4630 FOR VERT = LEVEL*2 TO 109
4640 LPRINT "-";
4650 NEXT VERT
4660 LPRINT
4670 PAGE.LEN = PAGE.LEN + 1
4680 GOSUB 5780 'test page-break
4690 COLOR P,K : FOR VERT = 2 TO LEVEL
4700 PRINT "| ";
4710 NEXT VERT
4720 PRINT "+";
4730 FOR VERT = LEVEL*2 TO 79
4740 PRINT "-";
4750 NEXT VERT
4760 PRINT : COLOR W,K
4770 TEMPMAR(LEVEL) = MRECATLVL 'Save the Index
4780 REM now look for children
4790 LEVEL = LEVEL + 1
4800 GOTO 4910 'Look for Children of this Marriage
4810 REM blank prior level
4820 PERSATLVL(LEVEL) = 0
4830 SEXATLVL$(LEVEL) = "-"
4840 MARRATLVL(LEVEL) = 0
4850 SPOUSATLVL(LEVEL) = 0
4860 LEVEL = LEVEL -1
4870 MRECATLVL = TEMPMAR(LEVEL) 'Restore the Index
4880 IF MRECATLVL < M.COUNT THEN 4160
4890 MLEVEL = MLEVEL - 1
4900 IF MLEVEL = 0 THEN 3990 ELSE 5430
4910 REM Search for Children of the Marriage
4920 IF LEVEL > MAX.GEN THEN 5670 'return
4930 REM Establish Skip-ahead Start-value and Delta
4940 LL = 1 : DELTA = INT(PC.COUNT/10) : IF DELTA = 0 THEN 4990
4950 REM Add delta and test if too far
4960 LL = LL + DELTA
4970 IF LL > 9 * DELTA THEN 4990
4980 IF PERSATLVL(LEVEL-1) > PA.ID(LL) THEN 4960
4990 LL = LL -DELTA -1
5000 REM Search Routine
5010 LL = LL + 1
5020 IF PERSATLVL(LEVEL-1) > PA.ID(LL) THEN 5440
5030 IF PERSATLVL(LEVEL-1) < PA.ID(LL) THEN LL = PC.COUNT : GOTO 5440
5040 REM found a child. Try to accept.
5050 PERSATLVL(LEVEL) = CH.ID(LL)
5060 GET #1, CH.ID(LL)
5070 GOSUB 2900 'To extract personal information
5080 REM identify that both parents match
5090 IF SEXATLVL$(LEVEL-1) = MALE.LTR$ THEN 5120
5100 IF SEXATLVL$(LEVEL-1) = FEMALE.LTR$ THEN 5160
5110 STOP
5120 REM Male Parent in Direct Line
5130 IF PERSATLVL(LEVEL-1) <> T6 THEN 5440
5140 IF SPOUSATLVL(LEVEL-1) <> T7 THEN 5440
5150 GOTO 5190
5160 REM Female Parent in Direct Line
5170 IF PERSATLVL(LEVEL-1) <> T7 THEN 5440
5180 IF SPOUSATLVL(LEVEL-1) <> T6 THEN 5440
5190 REM Passed All Tests, so print this child
5200 ON PRT.SW+1 GOTO 5330, 5210
5210 LPRINT TAB(11);
5220 FOR VERT = 2 TO LEVEL
5230 LPRINT "| ";
5240 NEXT VERT
5250 LPRINT "d"+LEFT$(STR$(-VERT+1)+" "+T3$+" "+T2$,120-(2*VERT));
5260 IF T8$ = SPACE$(11) THEN 5280
5270 LPRINT TAB( 83);T8$;
5280 IF T12$ = SPACE$(11) THEN 5300
5290 LPRINT TAB(109);T12$;
5300 LPRINT
5310 PAGE.LEN = PAGE.LEN + 1
5320 GOSUB 5780 'test page-break
5330 COLOR P,K : FOR VERT = 2 TO LEVEL
5340 PRINT "| ";
5350 NEXT VERT
5360 COLOR G,K : PRINT "d"+STR$(-VERT+1)+" "+T3$+" "+T2$
5370 COLOR W,K
5380 REM save information at this level
5390 SEXATLVL$(LEVEL) = T4$
5400 REM Search for Spouse
5410 TEMPCHILD(LEVEL) = LL 'Save the Index
5420 GOTO 4060 'for Marriage Search
5430 LL = TEMPCHILD(LEVEL) 'Restore the Index
5440 IF LL < PC.COUNT THEN 5010
5450 REM Print a line after last child
5460 ON PRT.SW+1 GOTO 5580, 5470
5470 LPRINT TAB(11);
5480 FOR VERT = 1 TO 2*LEVEL-4 STEP 2
5490 LPRINT "| ";
5500 NEXT VERT
5510 LPRINT "+";
5520 FOR VERT = 2*LEVEL-2 TO 109
5530 LPRINT "-";
5540 NEXT VERT
5550 LPRINT
5560 PAGE.LEN = PAGE.LEN + 1
5570 GOSUB 5780 'test page-break
5580 COLOR P
5590 FOR VERT = 1 TO 2*LEVEL-4 STEP 2
5600 PRINT "| ";
5610 NEXT VERT
5620 PRINT "+";
5630 FOR VERT = 2*LEVEL-2 TO 79
5640 PRINT "-";
5650 NEXT VERT
5660 PRINT : COLOR W,K
5670 GOTO 4810 'return
5680 REM Wrapup
5690 ON PRT.SW+1 GOTO 5740, 5700
5700 LPRINT PAP.SENS.OFF$;
5710 LPRINT PAP.LONG$;
5720 LPRINT COMPR.OFF$;
5730 WIDTH "lpt1:",80
5740 CLOSE
5750 KEY ON : CLS : KEY OFF : LOCATE 21,1
5760 PRINT "End of Program"
5770 RUN CC.MENU$
5780 REM Page-break Test
5790 IF PAGE.LEN < MAX.LINES THEN 5850
5800 REM Page eject,and reset parms
5810 LPRINT FORM.FEED$;
5820 GOSUB 2700 'Reset Printer
5830 PAGE.NO = PAGE.NO + 1 : PAGE.LEN = 6
5840 GOSUB 3350 : GOSUB 3550 'top of next page
5850 RETURN
5860 END
5870 REM Routine to Obtain a Usable Person Number for the Chart
5880 REM Convert the Person Number to a String
5890 PNUM$ = STR$(T1)
5900 REM Find the Length of the String
5910 PLEN = LEN(PNUM$)
5920 REM Get rid of the leading space for algebraic sign
5930 PNUM$ = RIGHT$(PNUM$,PLEN-1)
5940 REM Surround with Quotes and add a Leading Space
5950 PNUM$ = " (P-" + PNUM$ + ")"
5960 REM Suffix Person Number to Surname
5970 T2$ = T2$ + PNUM$
5980 RETURN
5990 REM Routine to Obtain a Usable Marriage Number for the Chart
6000 REM Convert the Marriage Number to a String
6010 PNUM$ = STR$(TT1)
6020 REM Find the Length of the String
6030 PLEN = LEN(PNUM$)
6040 REM Get rid of the leading space for algebraic sign
6050 PNUM$ = RIGHT$(PNUM$,PLEN-1)
6060 REM Surround with Quotes and add a Leading Space
6070 PNUM$ = " (M-" + PNUM$ + ")"
6080 REM Suffix Person Number to Surname
6090 T2$ = T2$ + PNUM$
6100 RETURN
6110 REM Clean User Input Area
6120 LOCATE 19,1 : PRINT SPACE$(79);
6130 LOCATE 20,1 : PRINT SPACE$(79);
6140 LOCATE 21,1 : PRINT SPACE$(79);
6150 LOCATE 22,1 : PRINT SPACE$(79);
6160 LOCATE 23,1 : PRINT SPACE$(79);
6170 RETURN
DIRECTOR.BAS
100 REM DIRECTOR Program.
110 REM Program Directory for the Genealogy ON DISPLAY Programs
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 DATA Genealogy
140 DATA Program Directory
150 DATA -1
160 DATA 1
170 INDENT = 0
180 REM Printer Definitions
190 FORM.FEED$ = CHR$(12)
200 COMPR.OFF$ = CHR$(18) : COMPR.ON$ = CHR$(15)
210 BOLD.OFF$ = CHR$(27)+"F" : BOLD.ON$ = CHR$(27)+"E"
220 EXPAND.OFF$ = CHR$(18) : EXPAND.ON$ = CHR$(14)
300 REM Program begins here
310 READ TITLE$, DOC.NAME$, PAGE.NO, LINE.NO
320 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
330 GOSUB 920 'For trim line and heading space
340 FOR I = 1 TO 6 : LPRINT : NEXT I
350 LPRINT BOLD.ON$; 'Set Emphasized Print
360 LPRINT EXPAND.ON$; 'Set Expanded Print
370 LPRINT TAB(TAB.POS-1);TITLE$
380 LPRINT EXPAND.OFF$; 'Return to normal
390 LPRINT BOLD.OFF$; 'Return to normal
400 FOR I = 1 TO 3 : LPRINT : NEXT I
410 LPRINT BOLD.ON$; 'Set Emphasized mode
420 LPRINT TAB(TAB.POS+12);"ON DISPLAY"
430 LPRINT BOLD.OFF$; 'Return to normal
440 LPRINT : LPRINT : LPRINT
450 LPRINT TAB(TAB.POS+11);"Version 6.0"
460 FOR I = 1 TO 11 : LPRINT : NEXT I
470 LPRINT TAB(TAB.POS+8); DOC.NAME$
480 LINE.NO = LINE.NO + 27
490 '
500 READ REPLY$
510 REM First, change tildes to quotes
520 FOR Q = 1 TO LEN(REPLY$)
530 IF MID$(REPLY$,Q,1)="~"THEN MID$(REPLY$,Q,1)=CHR$(34)
540 NEXT Q
550 IF LEFT$(REPLY$,1) = "." THEN GOSUB 1270: GOTO 500
560 IF LINE.NO > 44 THEN GOSUB 1030
570 REM Print the line if not a command
580 LPRINT TAB(TAB.POS);REPLY$
590 LINE.NO = LINE.NO + 1
600 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
610 GOTO 500
620 REM Data for the Copyright Page
630 DATA ".pa"
640 DATA " "
750 DATA ".vt 2"
754 DATA "If you are using these programs, you are"
758 DATA "expected to become a Registered User,"
762 DATA "by making a contribution to the Author"
766 DATA "of the programs ($49.00 suggested)."
770 DATA "Registration is by each individual,"
774 DATA "and not by any company or group."
778 DATA ".vt 2"
782 DATA "Users are encouraged to copy and to"
786 DATA "share the programs with others."
820 DATA ".vt 13"
830 DATA "Melvin O. Duke"
840 DATA "P. O. Box 2048"
850 DATA "Morgan Hill, CA 95038-2048"
860 DATA ".vt 3"
870 DATA "Copyright (c) 1982 ... 1989, by:"
880 DATA "Melvin O. Duke."
890 DATA ".sp"
900 DATA "All rights reserved."
910 '
920 REM Top of each page routine
930 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
940 LPRINT
950 LPRINT TAB(30); "(Trim-line)"
960 LPRINT "+"+STRING$(54,45)+"+" 'Dashes
970 FOR I = 1 TO 6
980 LPRINT
990 NEXT I
1000 LINE.NO = LINE.NO + 6
1010 RETURN
1020 '
1030 REM Bottom of each page Routine
1040 IF PAGE.NO < 1 THEN LPRINT : LPRINT : LPRINT : GOTO 1160
1050 LPRINT TAB(TAB.POS); STRING$(40,45) 'on line 46
1060 LPRINT TAB(TAB.POS+2); TITLE$+" ON DISPLAY. Version 6.0" 'on line 47
1070 IF PAGE.NO MOD 2 = 1 THEN 1110
1080 LPRINT TAB(TAB.POS);"Page";PAGE.NO;
1090 LPRINT TAB(TAB.POS+23);"Program Directory"
1100 GOTO 1160
1110 LPRINT TAB(TAB.POS); "Program Directory";
1120 IF PAGE.NO < 10 THEN DELTA = 34
1130 IF PAGE.NO > 9 THEN DELTA = 33
1140 IF PAGE.NO > 99 THEN DELTA = 32
1150 LPRINT TAB(TAB.POS+DELTA); "Page"; PAGE.NO 'on line 48
1160 LPRINT : LPRINT : LPRINT
1170 LPRINT "+"+STRING$(54,45)+"+" 'dashes after 51
1180 LPRINT TAB(30); "(Trim-line)"
1190 LPRINT FORM.FEED$;
1200 PAGE.NO = PAGE.NO + 1
1210 LINE.NO = 1
1220 IF REPLY$ = ".eof" THEN 1240 'Bypass after last page
1230 GOSUB 920 'For top of next page
1240 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1250 RETURN
1260 '
1270 REM Command Processor
1280 IF LEFT$(REPLY$,3) = ".h1" THEN 1380
1290 IF LEFT$(REPLY$,3) = ".h2" THEN 1540
1300 IF LEFT$(REPLY$,3) = ".h3" THEN 1650
1310 IF LEFT$(REPLY$,3) = ".sp" THEN 1760
1320 IF LEFT$(REPLY$,4) = ".eof" THEN 1810
1330 IF LEFT$(REPLY$,3) = ".pa" THEN 1850
1340 IF LEFT$(REPLY$,3) = ".vt" THEN 1920
1350 IF LEFT$(REPLY$,3) = ".pk" THEN 2020
1360 IF LEFT$(REPLY$,3) = ".in" THEN 2150
1370 STOP
1380 REM Head 1 Processor
1390 FOR I = LINE.NO TO 44
1400 LPRINT
1410 NEXT I
1420 GOSUB 1030 'Bottom of page Routine
1430 IF PAGE.NO MOD 2 = 0 THEN GOSUB 1850 'For h1 on Odd pages
1440 LPRINT BOLD.ON$; 'Set Emphasized Printing
1450 LPRINT EXPAND.ON$; 'Set expanded print
1460 IF PAGE.NO MOD 2 = 0 THEN ADJUST = -2 ELSE ADJUST = -5
1470 LPRINT TAB(TAB.POS+ADJUST); RIGHT$(REPLY$,LEN(REPLY$)-4)
1480 LPRINT EXPAND.OFF$; 'Return to normal
1490 LPRINT BOLD.OFF$; 'Return to non-bold
1500 LINE.NO = LINE.NO+1
1510 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1520 RETURN
1530 '
1540 REM Head 2 Processor
1550 IF LINE.NO = 7 THEN 1570 'skip spacing if at top of page
1560 IF LINE.NO > 43 THEN GOSUB 1850 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1570 LPRINT BOLD.ON$; 'Set emphasized print
1580 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1590 LPRINT BOLD.OFF$; 'Return to normal
1600 LPRINT
1610 LINE.NO = LINE.NO + 2
1620 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1630 RETURN
1640 '
1650 REM Head 3 Processor
1660 IF LINE.NO = 7 THEN 1680 'skip spacing if at top of page
1670 IF LINE.NO > 43 THEN GOSUB 1850 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1680 LPRINT BOLD.ON$; 'Set emphasized print
1690 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1700 LPRINT BOLD.OFF$; 'Return to normal
1710 LPRINT
1720 LINE.NO = LINE.NO + 2
1730 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1740 RETURN
1750 '
1760 REM Single Space Processor
1770 IF LINE.NO = 7 THEN 1790
1780 IF LINE.NO > 44 THEN GOSUB 1850 ELSE LPRINT : LINE.NO = LINE.NO + 1
1790 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1800 RETURN
1810 REM End of File Processor
1820 GOSUB 1850 'Bottom of Page
1840 GOTO 6100
1850 REM Page Eject Processor
1860 FOR I = LINE.NO TO 44
1870 LPRINT
1880 LINE.NO = LINE.NO + 1
1890 NEXT I
1900 GOSUB 1030 'Bottom of Page Processing
1910 RETURN
1920 REM Vertical Tab Processor
1930 IF LINE.NO = 7 THEN 2010
1940 QTY = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
1950 FOR I = 1 TO QTY
1960 LPRINT
1970 LINE.NO = LINE.NO + 1
1980 IF LINE.NO > 44 THEN I = QTY
1990 NEXT I
2000 IF LINE.NO > 44 THEN GOSUB 1030 'End of page
2010 RETURN
2020 REM Pack Processor
2030 IF LINE.NO > 44 THEN GOSUB 1030
2040 IF TAB.POS = 8 THEN ADJUST = 4
2050 IF TAB.POS = 13 THEN ADJUST = 7
2060 TAB.POS = TAB.POS + ADJUST + INDENT
2070 WIDTH "lpt1:", 132 'set condensed width
2080 LPRINT COMPR.ON$; 'Packed printing
2090 LPRINT TAB(TAB.POS); RIGHT$(REPLY$,LEN(REPLY$)-3)
2100 LPRINT COMPR.OFF$; 'Return to normal
2110 WIDTH "lpt1:", 80 'return to normal
2120 LINE.NO = LINE.NO + 1
2130 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2140 RETURN
2150 REM Indent Processor
2160 INDENT = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
2170 RETURN
3000 REM DIRECTOR
3010 DATA ".h1 INTRODUCTION"
3020 DATA ".h2 OVERVIEW"
3030 DATA "This Program Directory contains the"
3040 DATA "information about the contents of the"
3050 DATA "Distribution Diskette for the Genealogy"
3060 DATA "ON DISPLAY programs and documentation."
3070 DATA ".h2 CONTENT"
3080 DATA "The Distribution Diskette contains the"
3090 DATA "following Documentation Programs:"
3100 DATA ".sp"
3110 DATA " Program Program Program"
3120 DATA " Name Language Size"
3130 DATA " -------- -------- ---------"
3140 DATA " READ ME 1,082"
3150 DATA " PRINTERS BASIC 1,352"
3160 DATA " DIRECTOR BASIC 16,085"
3170 DATA " TABLEOFC BASIC 13,343"
3180 DATA " INTRODUC BASIC 12,583"
3190 DATA " GENERAL BASIC 18,845"
3200 DATA " USINGTHE BASIC 29,379"
3210 DATA " REFERENC BASIC 17,893"
3220 DATA " APPENDIX BASIC 28,960"
3230 DATA ".vt 2"
3240 DATA "The Distribution Diskette contains the"
3250 DATA "following Overview program:"
3260 DATA ".sp"
3270 DATA " Program Program Program"
3280 DATA " Name Language Size"
3290 DATA " -------- -------- ---------"
3300 DATA " OVERVIEW BASIC 13,113"
3310 DATA ".pa"
3320 DATA "The Distribution Diskette contains the"
3330 DATA "following Genealogy programs:"
3340 DATA ".sp"
3350 DATA " Program Program Program"
3360 DATA " Name Language Size"
3370 DATA " -------- -------- ---------"
3380 DATA " MENU BASIC 13,006"
3390 DATA " CREATPER BASIC 2,864"
3400 DATA " CREATMAR BASIC 2,333"
3410 DATA " CREATORD BASIC 3,128"
3420 DATA " UPDATPER BASIC 14,442"
3430 DATA " UPDATMAR BASIC 11,292"
3440 DATA " UPDATORD BASIC 16,226"
3450 DATA " INDEXPC BASIC 5,321"
3460 DATA " INDEXMAR BASIC 5,229"
3470 DATA " PRINTPER BASIC 6,499"
3480 DATA " PRINTMAR BASIC 3,811"
3490 DATA " LISTPER BASIC 2,835"
3500 DATA " LISTMAR BASIC 3,494"
3510 DATA " LISTPCI BASIC 3,267"
3520 DATA " ALPHAPER BASIC 4,926"
3530 DATA " ALPHAMAR BASIC 4,680"
3540 DATA " DISPLAY BASIC 24,489"
3550 DATA " ANCESTOR BASIC 24,262"
3560 DATA " FAMILY BASIC 22,630"
3570 DATA " DESCEND BASIC 13,432"
3580 DATA ".vt 3"
3590 DATA "The Distribution Diskette contains the"
3600 DATA "following Data File:"
3610 DATA ".sp"
3620 DATA " Data File Data File"
3630 DATA " Name Size"
3640 DATA " -------- ---------"
3650 DATA " VERIFILE 256"
3660 DATA ".pa"
3670 DATA ".h2 REQUIREMENTS"
3680 DATA ".h3 Hardware Requirements"
3690 DATA "Any member of the IBM PC Family of"
3700 DATA "computers, from the PCjr upward (in-"
3710 DATA "cluding 'Truly-Compatibles'), with at"
3720 DATA "least the following:"
3730 DATA ".sp"
3740 DATA " One double-sided Diskette Drive."
3750 DATA ".sp"
3760 DATA " 60K of Main Memory available to the"
3770 DATA " Genealogy ON DISPLAY Programs, after"
3780 DATA " the Operating System and the BASIC"
3790 DATA " Processor have been loaded."
3800 DATA ".sp"
3810 DATA " A printer, such as the IBM Matrix"
3820 DATA " printer, which has the capability"
3830 DATA " of controlling the appearance of the"
3840 DATA " output, including the following:"
3850 DATA ".sp"
3860 DATA " 120 Print Positions"
3870 DATA " For full-sized printouts of the"
3880 DATA " Charts of Ancestors and Charts"
3890 DATA " of Families, a 132 character"
3900 DATA " (10 char/in) printer is required."
3910 DATA " Normal Printing"
3920 DATA " Compressed Printing"
3930 DATA " Emphasized Printing"
3940 DATA " Form Feed (Page Eject)"
3950 DATA ".sp"
3960 DATA " A Display, either Monochrome or"
3970 DATA " Color, with at least 80 display"
3980 DATA " positions, in each of 25 lines."
3990 DATA ".pa"
4000 DATA ".h2 Software Requirements."
4010 DATA "IBM PC DOS (Version 2.1 or later), or"
4020 DATA "a compatible equivalent."
4030 DATA ".sp"
4040 DATA "IBM PC BASIC (PCjr Level or higher), or"
4050 DATA "a compatible equivalent."
4060 DATA ".h1 GENERAL INFORMATION"
4070 DATA ".h2 DOCUMENTATION PROGRAMS"
4080 DATA "Nine documentation programs are included"
4090 DATA "on the Distribution Diskette. Except"
4100 DATA "for the READ.ME Program, these are BASIC"
4110 DATA "programs, which can be 'run'."
4120 DATA ".sp"
4130 DATA "The documentation programs contain their"
4140 DATA "own formatting capability, as well as"
4150 DATA "the content of the documents which they"
4160 DATA "will produce."
4170 DATA ".sp"
4180 DATA "By 'running' each of the documentation"
4190 DATA "programs, the user is able to obtain one"
4200 DATA "or more copies of each chapter of the"
4210 DATA "documentation as he desires."
4220 DATA ".vt 2"
4230 DATA "These documentation programs are:"
4240 DATA ".sp
4250 DATA " 1. READ.ME (causes a display of the"
4260 DATA " cover letter, showing how to get"
4270 DATA " started.)"
4280 DATA ".sp"
4290 DATA " 2. PRINTERS (shows the changes to"
4300 DATA " the documentation programs for"
4310 DATA " printing on other printers.)"
4320 DATA ".pa"
4330 DATA " 3. DIRECTOR (documentation of the"
4340 DATA " content of the Distribution"
4350 DATA " Diskette)."
4360 DATA ".sp"
4370 DATA " Produces this document."
4380 DATA ".vt 2"
4390 DATA " 4 through 9. Documentation for the"
4400 DATA " Genealogy ON DISPLAY Programs."
4410 DATA ".sp"
4420 DATA " Produces an 86 Page User's Manual"
4430 DATA " for use with the Genealogy ON"
4440 DATA " DISPLAY, Version 6.0 programs."
4450 DATA ".sp"
4460 DATA " 4. TABLEOFC (Table of Contents for"
4470 DATA " the User's Manual)."
4480 DATA ".sp"
4490 DATA " 5. INTRODUC (Introduction for the"
4500 DATA " User's Manual)."
4510 DATA ".sp"
4520 DATA " 6. GENERAL (General Information for"
4530 DATA " the User's Manual)."
4540 DATA ".sp"
4550 DATA " 7. USINGTHE (Using the Programs, for"
4560 DATA " the User's Manual)."
4570 DATA ".sp"
4580 DATA " 8. REFERENC (Reference Material for"
4590 DATA " the User's Manual)."
4600 DATA ".sp"
4610 DATA " 9. APPENDIX (Appendixes for the"
4620 DATA " User's Manual)."
4630 DATA ".pa"
4640 DATA ".h2 GENEALOGY PROGRAMS"
4650 DATA "Twenty Genealogy programs are"
4660 DATA "included on the Distribution"
4670 DATA "Diskette. They are:"
4680 DATA ".sp"
4690 DATA " 1. CREATPER"
4700 DATA " Formats a Persons File."
4710 DATA ".vt 2"
4720 DATA " 2. CREATMAR"
4730 DATA " Formats a Marriages File."
4740 DATA ".vt 2"
4750 DATA " 3. CREATORD"
4760 DATA " Formats an Ordinances File."
4770 DATA ".vt 2"
4780 DATA " 4. UPDATPER"
4790 DATA " Updates the Persons File."
4800 DATA ".vt 2"
4810 DATA " 5. UPDATMAR"
4820 DATA " Updates the Marriages File."
4830 DATA ".vt 2"
4840 DATA " 6. UPDATORD"
4850 DATA " Updates the Ordinances File."
4860 DATA ".vt 2"
4870 DATA " 7. INDEXPC"
4880 DATA " Prepares a Parent/Child Index."
4890 DATA ".pa"
4900 DATA " 8. INDEXMAR"
4910 DATA " Prepares a Marriages Index."
4920 DATA ".vt 2"
4930 DATA " 9. PRINTPER"
4940 DATA " Prints the combined contents of the"
4950 DATA " Persons and Ordinances Files."
4960 DATA ".vt 2"
4970 DATA " 10. PRINTMAR"
4980 DATA " Prints the contents of the"
4990 DATA " Marriages File."
5000 DATA ".vt 2"
5010 DATA " 11. LISTPER"
5020 DATA " List of persons, in numerical"
5030 DATA " order."
5040 DATA ".vt 2"
5050 DATA " 12. LISTMAR"
5060 DATA " List of marriages, in numerical"
5070 DATA " order."
5080 DATA ".vt 2"
5090 DATA " 13. LISTPCI"
5100 DATA " Lists the Parent/Child Index."
5110 DATA ".vt 2"
5120 DATA " 14. ALPHAPER"
5130 DATA " List of persons, in alphabetical"
5140 DATA " order."
5150 DATA ".pa"
5160 DATA " 15. ALPHAMAR"
5170 DATA " List of marriages, in alphabetical"
5180 DATA " order."
5190 DATA ".vt 2"
5200 DATA " 16. DISPLAY"
5210 DATA " Provides for displaying all of the"
5220 DATA " information in all of the files,"
5230 DATA " in the form of personal, family,"
5240 DATA " ancestors, and ordinance informa-"
5250 DATA " tion."
5260 DATA ".vt 2"
5270 DATA " 17. ANCESTOR"
5280 DATA " Provides a printout of a Chart of"
5290 DATA " the Ancestors of any person."
5300 DATA ".vt 2"
5310 DATA " 18. FAMILY"
5320 DATA " Provides a printout of a Chart of"
5330 DATA " the Family of any marriage."
5340 DATA ".vt 2"
5350 DATA " 19. DESCEND"
5360 DATA " Provides a display (and an option-"
5370 DATA " al printout) of a Chart of the"
5380 DATA " Descendants of any person."
5390 DATA ".vt 2"
5400 DATA " 20. MENU"
5410 DATA " Provides for user selection of"
5420 DATA " any of the other programs to be"
5430 DATA " run."
5440 DATA ".pa"
5450 DATA ".h2 DATA FILE"
5460 DATA "One data file is included on the Distri-"
5470 DATA "bution Diskette. It is:"
5480 DATA ".sp"
5490 DATA " 1. VERIFILE"
5500 DATA ".sp"
5510 DATA "Its purpose is to verify that BASIC was"
5520 DATA "brought up with the /s:256 parameter."
5530 DATA ".h2 OVERVIEW PROGRAM"
5540 DATA "One overview program is provided, which"
5550 DATA "may be used to show your friends just"
5560 DATA "what 'Genealogy ON DISPLAY' is all"
5570 DATA "about. The overview program may also"
5580 DATA "be used for presentations, such as at"
5590 DATA "Association or Club Meetings."
5600 DATA ".sp"
5610 DATA "While the overview program makes a"
5620 DATA "better presentation in color, it is"
5630 DATA "also suitable for use on a Monochrome"
5640 DATA "Monitor."
5650 DATA ".sp"
5660 DATA "In order to use this program, type:"
5670 DATA ".sp"
5680 DATA " run ~overview~"
5690 DATA ".sp"
5700 DATA "and press the 'enter' key."
5710 DATA ".h1 USING THE PROGRAMS"
5720 DATA ".h2 FIRST TIME USAGE"
5730 DATA "If your system does not have a hard-"
5740 DATA "disk, you will need to set up a Pro-"
5750 DATA "gram Diskette (by making a copy of"
5760 DATA "the Distribution Diskette of Genealogy"
5770 DATA "ON DISPLAY), and a Data Diskette for"
5780 DATA "your genealogical information."
5790 DATA ".sp"
5800 DATA "If your system has a hard-disk, you"
5810 DATA "will need to define a Sub-directory"
5820 DATA "for Genealogy ON DISPLAY, and copy the"
5830 DATA "contents of the Distribution Diskette"
5840 DATA "of Genealogy ON DISPLAY into it."
5850 DATA ".sp"
5860 DATA "Whatever hardware you have, you will"
5870 DATA "also need to format (create) the"
5880 DATA "Genealogy ON DISPLAY records with the"
5890 DATA "formatting programs provided."
5900 DATA ".sp"
5910 DATA "(Formatting puts numbers where numbers"
5920 DATA "should be and letters where letters"
5930 DATA "should be, in each record in each data"
5940 DATA "file.)"
5950 DATA ".sp"
5960 DATA "Details are contained within the User's"
5970 DATA "Manual."
5980 DATA ".pa"
5990 DATA ".h2 GETTING STARTED"
6000 DATA "Getting started consists of bringing up"
6010 DATA "the BASIC Processor (with the size of"
6020 DATA "of the BASIC Records defined to be"
6030 DATA "256, which is the size of the records"
6040 DATA "in the Persons File), and then running"
6050 DATA "the MENU Program."
6060 DATA ".sp"
6070 DATA "Details are contained within the User's"
6080 DATA "Manual."
6090 DATA ".eof"
6100 END
DISPLAY.BAS
100 REM DISPLAY Program.
110 REM Displays Genealogical Information
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Display Program"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
940 DIM PERS(15), CH(MAX.PER)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1020 REM Find the title location
1030 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1040 REM Print the title
1050 LOCATE 4,TITLE.POS : PRINT TITLE$
1060 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1070 REM Print the Copyright
1080 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1090 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1100 GOTO 1700
1110 REM subroutine to print a double box
1120 COLOR P
1130 FOR I = R1 + 1 TO R2 - 1
1140 LOCATE I, C1 : PRINT CHR$(186);
1150 LOCATE I, C2 : PRINT CHR$(186);
1160 NEXT I
1170 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
1180 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
1190 LOCATE R1, C1 : PRINT CHR$(201);
1200 LOCATE R1, C2 : PRINT CHR$(187);
1210 LOCATE R2, C1 : PRINT CHR$(200);
1220 LOCATE R2, C2 : PRINT CHR$(188);
1230 COLOR W
1240 RETURN
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 REM DISPLAY Program Starts Here.
1760 KEY ON : CLS
1770 GOTO 3530
2000 REM Routine to Draw a Chart of Ancestors
2010 REM Draw the form on the display
2020 R1= 1 : C1= 1 : R2=21 : C2=79: GOSUB 1110 'Double box
2030 R1= 3 : C1= 1 : R2= 3 : C2=79: GOSUB 3210 'Horizontal Double
2040 LOCATE 2,3 : PRINT "Ancestors of:"
2050 LOCATE 4,68 : COLOR N : PRINT "Birthdate:" : COLOR W
2060 LOCATE 12, 3 : I = 1 : GOSUB 2470
2070 LOCATE 8,11 : COLOR B : PRINT CHR$(218)+CHR$(196);
2080 LOCATE 9,11 : PRINT CHR$(179);
2090 LOCATE 10,11 : PRINT CHR$(179);
2100 LOCATE 11,11 : PRINT CHR$(179);
2110 LOCATE 8,13 : I = 2 : GOSUB 2510
2120 LOCATE 16,11 : COLOR B : PRINT CHR$(192)+CHR$(196);
2130 LOCATE 13,11 : PRINT CHR$(179);
2140 LOCATE 14,11 : PRINT CHR$(179);
2150 LOCATE 15,11 : PRINT CHR$(179);
2160 LOCATE 16,13 : I = 3 : GOSUB 2510
2170 LOCATE 6,21 : COLOR B : PRINT CHR$(218)+CHR$(196);
2180 LOCATE 7,21 : PRINT CHR$(179);
2190 LOCATE 6,23 : I = 4 : GOSUB 2540
2200 LOCATE 10,21 : COLOR B : PRINT CHR$(192)+CHR$(196);
2210 LOCATE 9,21 : PRINT CHR$(179);
2220 LOCATE 10,23 : I = 5 : GOSUB 2540
2230 LOCATE 14,21 : COLOR B : PRINT CHR$(218)+CHR$(196);
2240 LOCATE 15,21 : PRINT CHR$(179);
2250 LOCATE 14,23 : I = 6 : GOSUB 2540
2260 LOCATE 18,21 : COLOR B : PRINT CHR$(192)+CHR$(196);
2270 LOCATE 17,21 : PRINT CHR$(179);
2280 LOCATE 18,23 : I = 7 : GOSUB 2540
2290 LOCATE 5,31 : COLOR B : PRINT CHR$(218)+CHR$(196);
2300 LOCATE 5,33 : I = 8 : GOSUB 2570
2310 LOCATE 7,31 : COLOR B : PRINT CHR$(192)+CHR$(196);
2320 LOCATE 7,33 : I = 9 : GOSUB 2570
2330 LOCATE 9,31 : COLOR B : PRINT CHR$(218)+CHR$(196);
2340 LOCATE 9,33 : I = 10 : GOSUB 2570
2350 LOCATE 11,31 : COLOR B : PRINT CHR$(192)+CHR$(196);
2360 LOCATE 11,33 : I = 11 : GOSUB 2570
2370 LOCATE 13,31 : COLOR B : PRINT CHR$(218)+CHR$(196);
2380 LOCATE 13,33 : I = 12 : GOSUB 2570
2390 LOCATE 15,31 : COLOR B : PRINT CHR$(192)+CHR$(196);
2400 LOCATE 15,33 : I = 13 : GOSUB 2570
2410 LOCATE 17,31 : COLOR B : PRINT CHR$(218)+CHR$(196);
2420 LOCATE 17,33 : I = 14 : GOSUB 2570
2430 LOCATE 19,31 : COLOR B : PRINT CHR$(192)+CHR$(196);
2440 LOCATE 19,33 : I = 15 : GOSUB 2570
2450 COLOR W,K
2460 RETURN
2470 REM Routine to print the lines
2480 COLOR K,W : PRINT RIGHT$(STR$(I),2);
2490 COLOR B,K : PRINT STRING$(62,95);
2500 RETURN
2510 COLOR K,W : PRINT RIGHT$(STR$(I),2);
2520 COLOR B,K : PRINT STRING$(52,95);
2530 RETURN
2540 COLOR K,W : PRINT RIGHT$(STR$(I),2);
2550 COLOR B,K : PRINT STRING$(42,95);
2560 RETURN
2570 COLOR K,W : PRINT RIGHT$(STR$(I),2);
2580 COLOR B,K : PRINT STRING$(32,95); : COLOR W,K
2590 RETURN
2600 REM Draw the Personal Information Chart
2610 KEY OFF
2620 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1110 'Double box
2630 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3210 'Horizontal double
2640 LOCATE 2,3 : PRINT "Personal Information for:"
2650 R1 = 3 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 3350 'Vertical Double
2660 LOCATE 4,3 : COLOR N : PRINT "Person:";
2670 LOCATE 5,3 : COLOR O : PRINT "Record-no.:";
2680 LOCATE 6,3 : PRINT "Surname:";
2690 LOCATE 7,3 : PRINT "Given-names:";
2700 LOCATE 8,3 : PRINT "Sex:";
2710 R1 = 9 : C1 = 1 : R2 =11 : C2 = 40 : GOSUB 3210 'Horizontal Double
2720 LOCATE 10,3 : COLOR N : PRINT "Male Parent:";
2730 LOCATE 11,3 : COLOR O : PRINT "Record-no.:";
2740 LOCATE 12,3 : PRINT "Surname:";
2750 LOCATE 13,3 : PRINT "Given-names:";
2760 LOCATE 14,3 : PRINT "Birth-date:";
2770 R1 = 15 : C1 = 1 : R2 = 15 : C2 = 40 : GOSUB 3280 'Horizontal Single
2780 LOCATE 16,3 : COLOR N : PRINT "Female Parent:";
2790 LOCATE 17,3 : COLOR O : PRINT "Record-no.:";
2800 LOCATE 18,3 : PRINT "Surname:";
2810 LOCATE 19,3 : PRINT "Given-names:";
2820 LOCATE 20,3 : PRINT "Birth-date:";
2830 LOCATE 4,42 : COLOR N : PRINT "Person's Vital Statistics:";
2840 LOCATE 6,42 : COLOR O : PRINT "Birth-date:";
2850 LOCATE 7,42 : PRINT "Birth-city:";
2860 LOCATE 8,42 : PRINT "Birth-county:";
2870 LOCATE 9,42 : PRINT "Birth-state:";
2880 LOCATE 11,42 : PRINT "Death-date:";
2890 LOCATE 12,42 : PRINT "Death-city:";
2900 LOCATE 13,42 : PRINT "Death-county:";
2910 LOCATE 14,42 : PRINT "Death-state:";
2920 LOCATE 16,42 : PRINT "Burial-date:";
2930 LOCATE 17,42 : PRINT "Burial-city:";
2940 LOCATE 18,42 : PRINT "Burial-county:";
2950 LOCATE 19,42 : PRINT "Burial-state:"; : COLOR W,K
2960 RETURN
2970 REM Draw a Family Group
2980 KEY OFF
2990 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1110 'Double box
3000 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3210 'Double Horizontal
3010 LOCATE 2,3 : PRINT "Family Group";
3020 LOCATE 2,64 : PRINT "Marriage:";
3030 LOCATE 4,3 : COLOR O : PRINT "Father:";
3040 LOCATE 4,56 : PRINT "Birthdate:";
3050 LOCATE 5,3 : PRINT "Mother:";
3060 LOCATE 5,56 : PRINT "Birthdate:";
3070 R1 = 6 : C1 = 1 : R2 = 6 : C2 = 79 : GOSUB 3280 'Single Horizontal
3080 LOCATE 7,3 : COLOR O : PRINT "Marriage Date:";
3090 LOCATE 7,35 : PRINT "Location:";
3100 R1 = 8 : C1 = 1 : R2 = 8 : C2 = 79 : GOSUB 3210 'Double Horizontal
3110 R1 = 8 : C1 = 5 : R2 = 21 : C2 = 5 : GOSUB 3440 'Single Vertical
3120 R1 = 8 : C1 = 7 : R2 = 21 : C2 = 7 : GOSUB 3440 'Single Vertical
3130 R1 = 8 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 3440 'Single Vertical
3140 LOCATE 9,2 : COLOR N : PRINT "No.";
3150 LOCATE 9,6 : PRINT "S";
3160 LOCATE 9,8 : PRINT "Children:";
3170 LOCATE 9,41 : PRINT "Birthdate:";
3180 R1 = 8 : C1 = 52 : R2 = 21 : C2 = 52 : GOSUB 3440 'Single Vertical
3190 LOCATE 9,53 : COLOR N : PRINT "Birth Location:"; : COLOR W
3200 RETURN
3210 REM Subroutine to draw a double horizontal line. Attach to double.
3220 COLOR P
3230 LOCATE R1,C1+1 : PRINT STRING$(C2-C1-1,205)
3240 LOCATE R1,C1 : PRINT CHR$(204);
3250 LOCATE R1,C2 : PRINT CHR$(185);
3260 COLOR W
3270 RETURN
3280 REM Subroutine to draw a single horizontal line. Attach to double.
3290 COLOR P
3300 LOCATE R1,C1+1 : PRINT STRING$(C2-C1-1,196)
3310 LOCATE R1,C1 : PRINT CHR$(199);
3320 LOCATE R1,C2 : PRINT CHR$(182);
3330 COLOR W
3340 RETURN
3350 REM Subroutine to draw a double vertical line. Attach to double.
3360 COLOR P
3370 FOR I = R1 + 1 TO R2 - 1
3380 LOCATE I,C1 : PRINT CHR$(186);
3390 NEXT I
3400 LOCATE R1,C1 : PRINT CHR$(203);
3410 LOCATE R2,C1 : PRINT CHR$(202);
3420 COLOR W
3430 RETURN
3440 REM Subroutine to draw a single vertical line. Attach to double.
3450 COLOR P
3460 FOR I = R1 + 1 TO R2 - 1
3470 LOCATE I,C1 : PRINT CHR$(179);
3480 NEXT I
3490 LOCATE R1,C1 : PRINT CHR$(209);
3500 LOCATE R2,C1 : PRINT CHR$(207);
3510 COLOR W
3520 RETURN
3530 REM Program begins here
3540 REM By: Melvin O. Duke.
3550 REM Read the Parent/Child Index
3560 KEY OFF
3570 LOCATE 4,1 : PRINT "Open the Parent/Child Index"
3580 OPEN CC.PCINDEX$ FOR INPUT AS #1
3590 INPUT #1, PC.COUNT
3600 IF PC.COUNT <> 0 THEN 3650
3610 PRINT "Parent/Child Index has no Index Records"
3620 PRINT "Press any key to return to the Menu"
3630 A$ = INKEY$ : IF A$ = "" THEN 3630
3640 GOTO 9530
3650 DIM PA.ID(PC.COUNT), CH.ID(PC.COUNT)
3660 FOR I = 1 TO PC.COUNT
3670 LOCATE 5,1 : PRINT "Reading Index Record #:";I;
3680 INPUT #1, PA.ID(I), CH.ID(I)
3690 NEXT I
3700 CLOSE #1
3710 REM Read the Marriage Index
3720 LOCATE 7,1 : PRINT "Open the Marriage Index"
3730 OPEN CC.MINDEX$ FOR INPUT AS #2
3740 INPUT #2, M.COUNT
3750 IF M.COUNT <> 0 THEN 3800
3760 PRINT "Marriage Index has no Index Records"
3770 PRINT "Press any key to return to the Menu"
3780 A$ = INKEY$ : IF A$ = "" THEN 3780
3790 GOTO 9530
3800 DIM PERS.NO(M.COUNT), M.NO(M.COUNT)
3810 FOR I = 1 TO M.COUNT
3820 LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
3830 INPUT #2,PERS.NO(I), M.NO(I)
3840 NEXT I
3850 CLOSE #2
3860 REM Open the Persons File
3870 LOCATE 10,1 : PRINT "Open the Persons File"
3880 OPEN CC.PERSFILE$ AS #1 LEN = 256
3890 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$
3900 REM open the Marriages File
3910 LOCATE 12,1 : PRINT "Open the Marriage File"
3920 OPEN CC.MARRFILE$ AS #2 LEN = 128
3930 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$
3940 REM Open the Ordinance File
3950 IF DD.ORD$ = "no" THEN 3990
3960 LOCATE 14,1 : PRINT "Open the Ordinances File";
3970 OPEN CC.ORDFILE$ AS #3 LEN = 256
3980 FIELD 3,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
3990 REM Obtain a Person Record from the User
4000 LOCATE 20,1 : PRINT SPACE$(79);: LOCATE 20,1
4010 LINE INPUT "Enter the Record-number of a Person (0 to quit): ";REPLY$
4020 IF REPLY$ = "0" THEN 9530
4030 PERS(1) = VAL(REPLY$)
4040 IF PERS(1) < 1 OR PERS(1) > MAX.PER THEN KEY ON : CLS : KEY OFF : LOCATE 19,1 : PRINT "Person Number is out of range"; : GOTO 3990
4050 REM Obtain the information about a person
4060 GET #1, PERS(1)
4070 KEY ON : CLS
4080 GOSUB 4660 'Extract Personal Information
4090 GOSUB 2600 'Draw the form
4100 LOCATE 2,30 : COLOR W : PRINT LEFT$(T3$ + " " + T2$,35);
4110 LOCATE 2,66 : PRINT "Person:";T1
4120 LOCATE 5,16 : COLOR G : PRINT T1
4130 LOCATE 6,16 : PRINT T2$;
4140 LOCATE 7,16 : PRINT LEFT$(T3$,24);
4150 LOCATE 8,16 : PRINT T4$;
4160 LOCATE 6,57 : PRINT T8$;
4170 LOCATE 7,57 : PRINT T9$;
4180 LOCATE 8,57 : PRINT T10$;
4190 LOCATE 9,57 : PRINT T11$;
4200 LOCATE 11,57 : PRINT T12$;
4210 LOCATE 12,57 : PRINT T13$;
4220 LOCATE 13,57 : PRINT T14$;
4230 LOCATE 14,57 : PRINT T15$;
4240 LOCATE 16,57 : PRINT T16$;
4250 LOCATE 17,57 : PRINT T17$;
4260 LOCATE 18,57 : PRINT T18$;
4270 LOCATE 19,57 : PRINT T19$;
4280 PERS(2) = T6
4290 PERS(3) = T7
4300 COLOR W
4310 REM Check if Male Parent is known
4320 IF PERS(2) = 0 THEN GOSUB 5000 : GOTO 4350
4330 GET #1, PERS(2)
4340 GOSUB 4660 'Extract
4350 LOCATE 11,16 : COLOR G : PRINT T1;
4360 LOCATE 12,16 : PRINT T2$;
4370 LOCATE 13,16 : PRINT LEFT$(T3$,24);
4380 LOCATE 14,16 : PRINT T8$;
4390 COLOR W
4400 REM Check if Female Parent is known
4410 IF PERS(3) = 0 THEN GOSUB 5000 : GOTO 4440
4420 GET #1, PERS(3)
4430 GOSUB 4660 'Extract
4440 LOCATE 17,16 : COLOR G : PRINT T1;
4450 LOCATE 18,16 : PRINT T2$;
4460 LOCATE 19,16 : PRINT LEFT$(T3$,24);
4470 LOCATE 20,16 : PRINT T8$;
4480 COLOR W,K : LOCATE 23,1 : PRINT SPACE$(79);
4490 LOCATE 24,1 : PRINT SPACE$(79);
4500 LOCATE 24,1 : PRINT "(Possible Requests: ps, an, fg, ";
4510 IF DD.ORD$ = "no" THEN 4530
4520 PRINT "o, ";
4530 PRINT "p1...pn, m1...mn, q)";
4540 LOCATE 23,1
4550 LINE INPUT "Type a Request. Then press the 'enter' key.: "; REPLY$
4560 IF REPLY$ = "ps" OR REPLY$ = "PS" THEN GOSUB 8130 : GOTO 4480
4570 IF REPLY$ = "an" OR REPLY$ = "AN" THEN 5200 'Ancestors
4580 IF REPLY$ = "pc" OR REPLY$ = "PC" THEN 5200 'Ancestors
4590 IF REPLY$ = "fg" OR REPLY$ = "FG" THEN 6770 'Family Group
4600 IF DD.ORD$ = "no" THEN 4620
4610 IF REPLY$ = "o" OR REPLY$ = "O" THEN 8270 'Ordinances
4620 IF LEFT$(REPLY$,1) = "p" OR LEFT$(REPLY$,1) = "P" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : KEY ON : CLS : KEY OFF : GOTO 4040
4630 IF LEFT$(REPLY$,1) = "m" OR LEFT$(REPLY$,1) = "M" THEN 9400
4640 IF LEFT$(REPLY$,1) = "q" OR LEFT$(REPLY$,1) = "Q" THEN 9530
4650 LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 4480
4660 REM Routine to Extract Personal Information
4670 T1! = CVS(F1$) : T1 = T1!
4680 T2$ = F2$
4690 FOR J = 1 TO LEN(F2$) -1
4700 IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
4710 NEXT J
4720 T3$ = F3$
4730 FOR J = 1 TO LEN(F3$) -1
4740 IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
4750 NEXT J
4760 T4$ = F4$
4770 IF LEFT$(T4$,1) = MALE.LTR$ THEN T4$ = MALE.SEX$
4780 IF LEFT$(T4$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.SEX$
4790 T6! = CVS(F6$) : T6 = T6!
4800 T7! = CVS(F7$) : T7 = T7!
4810 T8$ = F8$
4820 T9$ = F9$
4830 FOR J = 1 TO LEN(F9$) -1
4840 IF RIGHT$(T9$,1)=" " THEN T9$ = LEFT$(T9$,LEN(T9$)-1) ELSE J = LEN(F9$)-1
4850 NEXT J
4860 T10$ = F10$
4870 T11$ = F11$
4880 FOR J = 1 TO LEN(F11$) -1
4890 IF RIGHT$(T11$,1)=" " THEN T11$ = LEFT$(T11$,LEN(T11$)-1) ELSE J = LEN(F11$)-1
4900 NEXT J
4910 T12$ = F12$
4920 T13$ = F13$
4930 T14$ = F14$
4940 T15$ = F15$
4950 T16$ = F16$
4960 T17$ = F17$
4970 T18$ = F18$
4980 T19$ = F19$
4990 RETURN
5000 REM Blank out a Record
5010 T1 = 0
5020 T2$ = ""
5030 T3$ = ""
5040 T4$ = ""
5050 T6 = 0
5060 T7 = 0
5070 T8$ = ""
5080 T9$ = ""
5090 T10$ = ""
5100 T11$ = ""
5110 T12$ = ""
5120 T13$ = ""
5130 T14$ = ""
5140 T15$ = ""
5150 T16$ = ""
5160 T17$ = ""
5170 T18$ = ""
5180 T19$ = ""
5190 RETURN
5200 REM Routine to Produce a Chart of Ancestors
5210 KEY ON : CLS : KEY OFF
5220 GOSUB 2000 'Draw the Chart
5230 GET #1, PERS(1)
5240 GOSUB 4660 'Extract the Person
5250 LOCATE 2,17 : COLOR W : PRINT LEFT$(T3$ + " " + T2$,48);
5260 LOCATE 2,66 : PRINT "Person:"; PERS(1);
5270 THIS.PERS = PERS(1) : GOSUB 9580
5280 LOCATE 12,6 : COLOR G : PRINT LEFT$(VALUE$,61);
5290 LOCATE 12,68 : PRINT T8$;
5300 PERS(2) = T6
5310 PERS(3) = T7
5320 REM Get 11
5330 IF PERS(2) = 0 THEN GOSUB 5000 : GOTO 5390
5340 GET #1, PERS(2)
5350 GOSUB 4660 'Extract
5360 THIS.PERS = PERS(2) : GOSUB 9580
5370 LOCATE 8,16 : PRINT LEFT$(VALUE$,51);
5380 LOCATE 8,68 : PRINT T8$;
5390 PERS(4) = T6
5400 PERS(5) = T7
5410 REM Get 10
5420 IF PERS(3) = 0 THEN GOSUB 5000 : GOTO 5480
5430 GET #1, PERS(3)
5440 GOSUB 4660 'Extract
5450 THIS.PERS = PERS(3): GOSUB 9580
5460 LOCATE 16,16 : PRINT LEFT$(VALUE$,51);
5470 LOCATE 16,68 : PRINT T8$;
5480 PERS(6) = T6
5490 PERS(7) = T7
5500 REM Get 111
5510 IF PERS(4) = 0 THEN GOSUB 5000 : GOTO 5570
5520 GET #1, PERS(4)
5530 GOSUB 4660 'Extract
5540 THIS.PERS = PERS(4): GOSUB 9580
5550 LOCATE 6,26 : PRINT LEFT$(VALUE$,41);
5560 LOCATE 6,68 : PRINT T8$;
5570 PERS(8) = T6
5580 PERS(9) = T7
5590 REM Get 110
5600 IF PERS(5) = 0 THEN GOSUB 5000 : GOTO 5660
5610 GET #1, PERS(5)
5620 GOSUB 4660 'Extract
5630 THIS.PERS = PERS(5): GOSUB 9580
5640 LOCATE 10,26 : PRINT LEFT$(VALUE$,41);
5650 LOCATE 10,68 : PRINT T8$;
5660 PERS(10) = T6
5670 PERS(11) = T7
5680 REM Get 101
5690 IF PERS(6) = 0 THEN GOSUB 5000 : GOTO 5750
5700 GET #1, PERS(6)
5710 GOSUB 4660 'Extract
5720 THIS.PERS = PERS(6): GOSUB 9580
5730 LOCATE 14,26 : PRINT LEFT$(VALUE$,41);
5740 LOCATE 14,68 : PRINT T8$;
5750 PERS(12) = T6
5760 PERS(13) = T7
5770 REM Get 100
5780 IF PERS(7) = 0 THEN GOSUB 5000 : GOTO 5840
5790 GET #1, PERS(7)
5800 GOSUB 4660 'Extract
5810 THIS.PERS = PERS(7): GOSUB 9580
5820 LOCATE 18,26 : PRINT LEFT$(VALUE$,41);
5830 LOCATE 18,68 : PRINT T8$;
5840 PERS(14) = T6
5850 PERS(15) = T7
5860 REM Get 1111
5870 IF PERS(8) = 0 THEN GOSUB 5000 : GOTO 5930
5880 GET #1, PERS(8)
5890 GOSUB 4660 'Extract
5900 THIS.PERS = PERS(8): GOSUB 9580
5910 LOCATE 5,36 : PRINT LEFT$(VALUE$,31);
5920 LOCATE 5,68 : PRINT T8$;
5930 REM
5940 REM Get 1110
5950 IF PERS(9) = 0 THEN GOSUB 5000 : GOTO 6010
5960 GET #1, PERS(9)
5970 GOSUB 4660 'Extract
5980 THIS.PERS = PERS(9): GOSUB 9580
5990 LOCATE 7,36 : PRINT LEFT$(VALUE$,31);
6000 LOCATE 7,68 : PRINT T8$;
6010 REM
6020 REM Get 1101
6030 IF PERS(10) = 0 THEN GOSUB 5000 : GOTO 6090
6040 GET #1, PERS(10)
6050 GOSUB 4660 'Extract
6060 THIS.PERS = PERS(10): GOSUB 9580
6070 LOCATE 9,36 : PRINT LEFT$(VALUE$,31);
6080 LOCATE 9,68 : PRINT T8$;
6090 REM
6100 REM Get 1100
6110 IF PERS(11) = 0 THEN GOSUB 5000 : GOTO 6170
6120 GET #1, PERS(11)
6130 GOSUB 4660 'Extract
6140 THIS.PERS = PERS(11): GOSUB 9580
6150 LOCATE 11,36 : PRINT LEFT$(VALUE$,31);
6160 LOCATE 11,68 : PRINT T8$;
6170 REM
6180 REM Get 1011
6190 IF PERS(12) = 0 THEN GOSUB 5000 : GOTO 6250
6200 GET #1, PERS(12)
6210 GOSUB 4660 'Extract
6220 THIS.PERS = PERS(12): GOSUB 9580
6230 LOCATE 13,36 : PRINT LEFT$(VALUE$,31);
6240 LOCATE 13,68 : PRINT T8$;
6250 REM
6260 REM Get 1010
6270 IF PERS(13) = 0 THEN GOSUB 5000 : GOTO 6330
6280 GET #1, PERS(13)
6290 GOSUB 4660 'Extract
6300 THIS.PERS = PERS(13): GOSUB 9580
6310 LOCATE 15,36 : PRINT LEFT$(VALUE$,31);
6320 LOCATE 15,68 : PRINT T8$;
6330 REM
6340 REM Get 1001
6350 IF PERS(14) = 0 THEN GOSUB 5000 : GOTO 6410
6360 GET #1, PERS(14)
6370 GOSUB 4660 'Extract
6380 THIS.PERS = PERS(14): GOSUB 9580
6390 LOCATE 17,36 : PRINT LEFT$(VALUE$,31);
6400 LOCATE 17,68 : PRINT T8$;
6410 REM
6420 REM Get 1000
6430 IF PERS(15) = 0 THEN GOSUB 5000 : GOTO 6490
6440 GET #1, PERS(15)
6450 GOSUB 4660 'Extract
6460 THIS.PERS = PERS(15): GOSUB 9580
6470 LOCATE 19,36 : PRINT LEFT$(VALUE$,31);
6480 LOCATE 19,68 : PRINT T8$;
6490 COLOR W
6500 LOCATE 23,1 : PRINT SPACE$(79);
6510 LOCATE 24,1 : PRINT SPACE$(79);
6520 LOCATE 24,1 : PRINT "(Possible Requests: ps, an, fg,";
6530 IF DD.ORD$ = "no" THEN 6550
6540 PRINT " o,";
6550 PRINT " l1...ln, p1...pn, m1...mn, q)";
6560 LOCATE 23,1
6570 LINE INPUT "Type a Request. Then press the 'enter' key.: "; REPLY$
6580 IF REPLY$ = "ps" OR REPLY$ = "PS" THEN GOSUB 8130 : GOTO 6500
6590 IF REPLY$ = "an" OR REPLY$ = "AN" THEN 5200
6600 IF REPLY$ = "pc" OR REPLY$ = "PC" THEN 5200
6610 IF REPLY$ = "fg" OR REPLY$ = "FG" THEN 6770
6620 IF DD.ORD$ = "no" THEN 6640
6630 IF REPLY$ = "o" OR REPLY$ = "O" THEN 8270
6640 IF LEFT$(REPLY$,1) = "l" OR LEFT$(REPLY$,1) = "L" THEN 6650 ELSE 6730
6650 WHO = (VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)))
6660 IF WHO < 1 OR WHO > 15 THEN 6670 ELSE 6720
6670 KEY ON : CLS : KEY OFF
6680 LOCATE 20,1 : PRINT "Line-number is out of range"
6690 LOCATE 22,1 : PRINT "Press any key to continue"
6700 A$ = INKEY$ : IF A$ = "" THEN 6700
6710 GOTO 4040
6720 PERS(1) = PERS(WHO) : GOTO 4040
6730 IF LEFT$(REPLY$,1) = "p" OR LEFT$(REPLY$,1) = "P" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 4040
6740 IF LEFT$(REPLY$,1) = "m" OR LEFT$(REPLY$,1) = "M" THEN 9400
6750 IF LEFT$(REPLY$,1) = "q" OR LEFT$(REPLY$,1) = "Q" THEN 9530
6760 LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 6500
6770 REM Routine to Produce a Family Group
6780 KEY ON : CLS
6790 GOSUB 2970 'Draw the form
6800 REM search the marriage index for the Person's Marriage
6810 FOUND = 0
6820 REM Establish Skip-ahead Start-value and Delta
6830 START.AT = 1 : DELTA = INT(M.COUNT/10) : IF DELTA = 0 THEN 6880
6840 REM Add delta and test if too far
6850 START.AT = START.AT + DELTA
6860 IF START.AT > 9 * DELTA THEN 6880
6870 IF PERS(1) > PERS.NO(START.AT) THEN 6850
6880 START.AT = START.AT - DELTA
6890 REM Search Routine
6900 FOR L = START.AT TO M.COUNT
6910 IF PERS(1) > PERS.NO(L) THEN 6970
6920 IF PERS(1) < PERS.NO(L) THEN L = M.COUNT : GOTO 6970
6930 REM found a Marriage
6940 FOUND = 1
6950 GET #2, M.NO(L)
6960 L = M.COUNT
6970 NEXT L
6980 IF FOUND = 1 THEN 7040
6990 REM No marriage found
7000 LOCATE 22,1 : COLOR W,K : PRINT "No Marriage Found";
7010 LOCATE 23,1 : PRINT "Press any key to continue";
7020 A$ = INKEY$ : IF A$ = "" THEN 7020
7030 KEY ON : CLS : KEY OFF : GOTO 4050
7040 REM extract Information from the Marriage Record
7050 TT1! = CVS(M1$) : TT1 = TT1!
7060 IF TT1 < 1 THEN 6990
7070 TT2! = CVS(M2$) : TT2 = TT2!
7080 TT3! = CVS(M3$) : TT3 = TT3!
7090 TT5$ = M5$
7100 TT6$ = M6$
7110 REM Right-trim
7120 FOR J = 1 TO LEN(M6$) -1
7130 IF RIGHT$(TT6$,1)=" " THEN TT6$ = LEFT$(TT6$,LEN(TT6$)-1) ELSE J = LEN(M6$)-1
7140 NEXT J
7150 TT7$ = M7$
7160 TT8$ = M8$
7170 REM Right-trim
7180 FOR J = 1 TO LEN(M8$) -1
7190 IF RIGHT$(TT8$,1)=" " THEN TT8$ = LEFT$(TT8$,LEN(TT8$)-1) ELSE J = LEN(M8$)-1
7200 NEXT J
7210 TT9$ = M9$
7220 REM print the Marriage Information
7230 LOCATE 2,73 : COLOR W : PRINT TT1
7240 LOCATE 7,18 : COLOR G : PRINT TT5$
7250 IF TT6$ = " " AND TT8$ = " " THEN 7270
7260 LOCATE 7,45 : PRINT LEFT$(TT6$+", "+TT8$,34)
7270 REM get the Husband's Record
7280 GET #1, TT2
7290 GOSUB 4660 'Extract
7300 THIS.PERS = TT2 : GOSUB 9580
7310 LOCATE 4,11 : COLOR G : PRINT LEFT$(VALUE$,44);
7320 LOCATE 4,67 : PRINT T8$;
7330 REM get the Wife's Record
7340 GET #1, TT3
7350 GOSUB 4660 'Extract
7360 THIS.PERS = TT3 : GOSUB 9580
7370 LOCATE 5,11 : COLOR G : PRINT LEFT$(VALUE$,44);
7380 LOCATE 5,67 : PRINT T8$;
7390 REM Blank previous children and find new ones
7400 FOR IC = 1 TO CHILD.COUNT
7410 CH(IC) = 0
7420 NEXT IC
7430 CHILD.COUNT = 0
7440 REM search the parent/child index
7450 REM Establish Skip-ahead Start-value and Delta
7460 START.AT = 1 : DELTA = INT(PC.COUNT/10) : IF DELTA = 0 THEN 7510
7470 REM Add delta and test if too far
7480 START.AT = START.AT + DELTA
7490 IF START.AT > 9 * DELTA THEN 7510
7500 IF HUSB > PA.ID(START.AT) THEN 7480
7510 START.AT = START.AT - DELTA
7520 REM Search Routine
7530 FOR LL = START.AT TO PC.COUNT
7540 IF TT2 > PA.ID(LL) THEN 7930
7550 IF TT2 < PA.ID(LL) THEN LL = PC.COUNT : GOTO 7930
7560 REM found a child
7570 GET #1, CH.ID(LL)
7580 GOSUB 4660 'Extract
7590 REM verify that Mother is the same
7600 IF TT3 <> T7 THEN 7930
7610 REM Found a valid child
7620 CHILD.COUNT = CHILD.COUNT + 1
7630 SHOW.COUNT = CHILD.COUNT
7640 IF CHILD.COUNT = 1 THEN 7810
7650 X11 = 0
7660 X11 = X11 + 11
7670 IF CHILD.COUNT > X11 THEN SHOW.COUNT = CHILD.COUNT - X11 : GOTO 7660
7680 IF (CHILD.COUNT-1) MOD 11 = 0 THEN 7690 ELSE 7810
7690 LOCATE 23,1 : PRINT SPACE$(79);
7700 LOCATE 23,1
7710 PRINT "Press p to Print Screen, or any other key to continue"
7720 A$ = INKEY$ : IF A$ = "" THEN 7720
7730 IF A$ = "P" OR A$ = "p" THEN GOSUB 8130 : GOTO 7720
7740 REM blank the previous children
7750 FOR ROW = 9 TO 20
7760 LOCATE ROW,2 : PRINT SPACE$(77);
7770 NEXT ROW
7780 REM restore the rest of the display
7790 GOSUB 3110
7800 LOCATE 23,1 : PRINT SPACE$(79)
7810 CH(CHILD.COUNT) = CH.ID(LL)
7820 LOCATE 9+SHOW.COUNT,2 : COLOR K,W
7830 CC.STR$ = " "+STR$(CHILD.COUNT)
7840 PRINT RIGHT$(CC.STR$,3); : COLOR G,K
7850 LOCATE 9+SHOW.COUNT,6 : PRINT LEFT$(F4$,1); 'Sex
7860 NM$ = T2$+", "+T3$
7870 IF T2$ = " " OR T3$ = " " THEN NM$ = T2$+T3$
7880 LOCATE 9+SHOW.COUNT,8 : PRINT LEFT$(NM$,32);
7890 LOCATE 9+SHOW.COUNT,41 : PRINT T8$;
7900 IF T9$ = " " AND T11$ = " " THEN 7920
7910 LOCATE 9+SHOW.COUNT,53 : PRINT LEFT$(T9$+", "+T11$,26);
7920 COLOR W,K
7930 NEXT LL
7940 LOCATE 23,1 : PRINT SPACE$(79);
7950 LOCATE 24,1 : PRINT SPACE$(79);
7960 LOCATE 24,1 : PRINT "(Possible Requests: ps, f, m, p1...pn, c1...cn, m1...mn, q)";
7970 LOCATE 23,1
7980 LINE INPUT "Type a Request. Then press the 'enter' key.: "; REPLY$
7990 IF REPLY$ = "ps" OR REPLY$ = "PS" THEN GOSUB 8130 : GOTO 7940
8000 IF REPLY$ = "an" OR REPLY$ = "AN" THEN LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 7940
8010 IF REPLY$ = "pc" OR REPLY$ = "PC" THEN LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 7940
8020 IF REPLY$ = "f" OR REPLY$ = "F" THEN PERS(1) = TT2 : GOTO 4050
8030 IF REPLY$ = "m" OR REPLY$ = "M" THEN PERS(1) = TT3 : GOTO 4050
8040 IF LEFT$(REPLY$,1) = "p" OR LEFT$(REPLY$,1) = "P" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 4040
8050 IF LEFT$(REPLY$,1) = "c" OR LEFT$(REPLY$,1) = "C" THEN 8060 ELSE 8100
8060 CHLD = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
8070 IF CHLD < 1 OR CHLD > CHILD.COUNT THEN 8120
8080 PERS(1) = CH(CHLD)
8090 GOTO 4050 'for personal
8100 IF LEFT$(REPLY$,1) = "m" OR LEFT$(REPLY$,1) = "M" THEN 9400 'marriage
8110 IF LEFT$(REPLY$,1) = "q" OR LEFT$(REPLY$,1) = "Q" THEN 9530
8120 LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 7940
8130 REM Routine to Print the Screen
8140 REM Accessed by users 'ps' reply
8150 LPRINT : LPRINT : LPRINT : LPRINT
8160 FOR ROW = 1 TO 21
8170 FOR COL = 1 TO 79
8180 X = SCREEN(ROW,COL)
8190 IF PTR.SCRN <> 0 THEN 8210
8200 IF X < 32 OR X > 125 THEN X = 32
8210 LPRINT CHR$(X);
8220 NEXT COL
8230 LPRINT
8240 NEXT ROW
8250 LPRINT FORM.FEED$;
8260 RETURN
8270 REM Routine to Display the Ordinances
8280 KEY ON : CLS
8290 GET #1, PERS(1) : GOSUB 4660
8300 GET #3, PERS(1)
8310 SEX$ = " "
8320 IF T4$ = MALE.SEX$ THEN SEX$ = MALE.LTR$
8330 IF T4$ = FEMALE.SEX$ THEN SEX$ = FEMALE.LTR$
8340 REM Extract the Ordinance Information
8350 U1! = CVS(O1$) : U1 = U1!
8360 REM Blank Ordinances of no Ordinance Record Present
8370 IF U1 = 0 THEN GOSUB 9690 : GOTO 8610
8380 U2$ = O2$
8390 U3$ = O3$
8400 U4$ = O4$
8410 U5! = CVS(O5$) : U5 = U5!
8420 U6! = CVS(O6$) : U6 = U6!
8430 U7$ = O7$
8440 U8$ = O8$
8450 U9$ = O9$
8460 U10$ = O10$
8470 U11$ = O11$
8480 U12! = CVS(O12$) : U12 = U12!
8490 U13$ = O13$
8500 U14$ = O14$
8510 U15$ = O15$
8520 U16$ = O16$
8530 U17$ = O17$
8540 U18$ = O18$
8550 U19$ = O19$
8560 U20$ = O20$
8570 U21$ = O21$
8580 U22$ = O22$
8590 U23$ = O23$
8600 U24$ = O24$
8610 KEY OFF
8620 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1110 'Double Box
8630 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3210 'Horizontal Double
8640 R1 = 19 : C1 = 1 : R2 = 19 : C2 = 79 : GOSUB 3210 'Horizontal Double
8650 LOCATE 2,3 : PRINT "Ordinances of:";
8660 LOCATE 4,7 : COLOR N : PRINT "Personal Record"; : COLOR O
8670 LOCATE 5,3 : PRINT "Christening:";
8680 LOCATE 6,3 : PRINT "Blessing:";
8690 LOCATE 7,3 : PRINT "Sealed to Parents:";
8700 LOCATE 8,5 : PRINT "Father's Rec.no:";
8710 LOCATE 9,6 : PRINT "Name:";
8720 LOCATE 10,5 : PRINT "Mother's Rec.no:";
8730 LOCATE 11,6 : PRINT "Name:";
8740 LOCATE 12,3 : PRINT "Baptism:";
8750 LOCATE 13,3 : PRINT "Confirmation:";
8760 LOCATE 14,3 : PRINT "Patriarchal Blessing:";
8770 LOCATE 15,3 : PRINT "Endowment:";
8780 REM Test for male. Skip if male.
8790 IF SEX$ = MALE.LTR$ THEN 8830
8800 LOCATE 16,3 : PRINT "Sealed to Husband:";
8810 LOCATE 17,5 : PRINT "Husband's Rec.no:";
8820 LOCATE 18,6 : PRINT "Name:";
8830 REM Test for Male. Skip if not
8840 IF SEX$ <> MALE.LTR$ THEN 8980
8850 R1 = 3 : R2 = 19 : C1 = 51 : C2 = 51 : GOSUB 3350 'Vertical Double
8860 LOCATE 4,57 : COLOR N : PRINT "Priesthood Record"; : COLOR O
8870 LOCATE 5,53 : PRINT "Aaronic:";
8880 LOCATE 6,55 : PRINT "Deacon:";
8890 LOCATE 7,55 : PRINT "Teacher:";
8900 LOCATE 8,55 : PRINT "Priest:";
8910 LOCATE 10,53 : PRINT "Melchizedek:";
8920 LOCATE 11,55 : PRINT "Elder:";
8930 LOCATE 12,55 : PRINT "Seventy:";
8940 LOCATE 13,55 : PRINT "High Priest:";
8950 LOCATE 15,53 : PRINT "Bishop:";
8960 LOCATE 16,53 : PRINT "Patriarch:";
8970 LOCATE 17,53 : PRINT "Apostle:";
8980 LOCATE 20,3 : PRINT "Occupation:";
8990 REM Print the Information Currently Present
9000 LOCATE 2,18 : COLOR W : PRINT LEFT$(T3$ + " " + T2$,47);
9010 LOCATE 2,66 : PRINT "Rec.no:";T1;
9020 LOCATE 5,28 : COLOR G : PRINT U2$;
9030 LOCATE 6,28 : PRINT U3$;
9040 LOCATE 7,28 : PRINT U4$;
9050 IF SEX$ = MALE.LTR$ THEN NO.SP = 38 ELSE NO.SP = 51
9060 LOCATE 8,27 : PRINT U5;
9070 IF U5 = 0 THEN 9100
9080 GET #1, U5 : GOSUB 4660 'Extract Father Information
9090 LOCATE 9,12 : PRINT LEFT$(T3$ + " " + T2$,NO.SP);
9100 LOCATE 10,27 : PRINT U6;
9110 IF U6 = 0 THEN 9140
9120 GET #1, U6 : GOSUB 4660 'Extract Mother Information
9130 LOCATE 11,12 : PRINT LEFT$(T3$ + " " + T2$,NO.SP);
9140 LOCATE 12,28 : PRINT U7$;
9150 LOCATE 13,28 : PRINT U8$;
9160 LOCATE 14,28 : PRINT U9$;
9170 LOCATE 15,28 : PRINT U10$;
9180 REM Test for male. Skip if male.
9190 IF SEX$ = MALE.LTR$ THEN 9250
9200 LOCATE 16,28 : PRINT U11$;
9210 LOCATE 17,27 : PRINT U12;
9220 IF U12 = 0 THEN 9250
9230 GET #1, U12 : GOSUB 4660 'Extract Spouse Information
9240 LOCATE 18,12 : PRINT T3$ + " " + T2$;
9250 REM Test for Male. Bypass if not.
9260 IF SEX$ <> MALE.LTR$ THEN 9380
9270 LOCATE 5,67 : PRINT U13$;
9280 LOCATE 6,67 : PRINT U14$;
9290 LOCATE 7,67 : PRINT U15$;
9300 LOCATE 8,67 : PRINT U16$;
9310 LOCATE 10,67 : PRINT U17$;
9320 LOCATE 11,67 : PRINT U18$;
9330 LOCATE 12,67 : PRINT U19$;
9340 LOCATE 13,67 : PRINT U20$;
9350 LOCATE 15,67 : PRINT U21$;
9360 LOCATE 16,67 : PRINT U22$;
9370 LOCATE 17,67 : PRINT U23$;
9380 LOCATE 20,15 : PRINT U24$;
9390 GOTO 4480 'For User Action
9400 REM Marriage was requested by Number
9410 MARRIAGE = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
9420 KEY ON : CLS : KEY OFF
9430 IF MARRIAGE > 0 AND MARRIAGE <= MAX.MAR THEN 9500
9440 LOCATE 22,1 : PRINT SPACE$(79);
9450 LOCATE 22,1 : PRINT "Marriage Number is out of range";
9460 LOCATE 23,1 : PRINT SPACE$(79);
9470 LOCATE 23,1 : PRINT "Press any key to continue."
9480 A$ = INKEY$ : IF A$ = "" THEN 9480
9490 GOTO 4050
9500 GOSUB 2970 'Print the form
9510 GET #2, MARRIAGE
9520 GOTO 7040
9530 REM Wrapup
9540 CLOSE
9550 KEY ON : CLS : KEY OFF : LOCATE 21,1 : COLOR W,K
9560 PRINT "End of Program"
9570 RUN CC.MENU$
9580 REM Routine to Convert a number to a string. This.pers is input
9590 REM value$ is output, with record number and persons name.
9600 VALUE$ = STR$(THIS.PERS)
9610 PLEN = LEN(VALUE$)
9620 VALUE$ = RIGHT$(VALUE$,PLEN-1)
9630 NM$ = T2$+", "+T3$
9640 IF T2$ = " " OR T3$ = " " THEN NM$ = T2$+T3$
9650 IF T2$ = " " AND T3$ = " " THEN NM$ = ""
9660 IF CHART.NOS$ <> "n" THEN VALUE$ = NM$ : GOTO 9680
9670 VALUE$ = "("+VALUE$+") "+NM$
9680 RETURN
9690 REM Blank Ordinances if No Ord Record
9700 U2$ = "" : U3$ = "" : U4$ = ""
9710 U5 = 0 : U6 = 0 : U12 = 0
9720 U7$ = "" : U8$ = "" : U9$ = "" : U10$ = ""
9730 U11$ = "" : U13$ = "" : U14$ = "" : U15$ = ""
9740 U16$ = "" : U17$ = "" : U18$ = "" : U19$ = ""
9750 U20$ = "" : U21$ = "" : U22$ = "" : U23$ = ""
9760 U24$ = ""
9770 RETURN
FAMILY.BAS
100 REM FAMILY Program.
110 REM Prints Charts of Families
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Charts of Families"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
940 DIM PERS(2), FORM$(49)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1020 REM Find the title location
1030 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1040 REM Print the title
1050 LOCATE 4,TITLE.POS : PRINT TITLE$
1060 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1070 REM Print the Copyright
1080 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1090 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM FAMILY Program Starts Here.
2010 REM Prevent Common User Errors
2020 IF LEFT.SPACE < 1 THEN LEFT.SPACE = 1
2030 IF LEFT.SPACE > 18 THEN LEFT.SPACE = 18
2040 REM Routine to obtain Printer Information
2050 LOCATE 21,1 : PRINT "Make sure that the Printer is On and Ready"
2060 LOCATE 22,1 : PRINT "Make sure that the correct Diskette(s) are in place."
2070 LOCATE 23,1 : PRINT "Then press any key"
2080 A$ = INKEY$ : IF A$ = "" THEN 2080
2090 KEY ON : CLS : KEY OFF
2100 REM Set for Wide Printing.
2110 WIDTH "lpt1:",132 'For printing Genealogy Forms
2120 REM Read the Parent/Child Index
2130 OPEN CC.PCINDEX$ FOR INPUT AS #1
2140 LOCATE 4,1 : PRINT "Open the Parent/Child Index"
2150 INPUT #1, PC.COUNT
2160 IF PC.COUNT <> 0 THEN 2210
2170 PRINT "Parent/Child Index has no Index Records"
2180 PRINT "Press any key to return to the Menu"
2190 A$ = INKEY$ : IF A$ = "" THEN 2190
2200 GOTO 6790
2210 DIM PA.ID(PC.COUNT), CH.ID(PC.COUNT)
2220 FOR I = 1 TO PC.COUNT
2230 LOCATE 5,1 : PRINT "Reading Index Record #:";I;
2240 INPUT #1, PA.ID(I), CH.ID(I)
2250 NEXT I
2260 CLOSE #1
2270 REM Read the Marriage Index
2280 LOCATE 7,1 : PRINT "Open the Marriage Index"
2290 OPEN CC.MINDEX$ FOR INPUT AS #2
2300 INPUT #2, M.COUNT
2310 IF M.COUNT <> 0 THEN 2360
2320 PRINT "Marriage Index has no Index Records"
2330 PRINT "Press any key to return to the Menu"
2340 A$ = INKEY$ : IF A$ = "" THEN 2340
2350 GOTO 6790
2360 DIM PERS.NO(M.COUNT), M.NO(M.COUNT)
2370 FOR I = 1 TO M.COUNT
2380 LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
2390 INPUT #2,PERS.NO(I), M.NO(I)
2400 NEXT I
2410 CLOSE #2
2420 REM Open the Persons File
2430 LOCATE 10,1 : PRINT "Open the Persons File"
2440 OPEN CC.PERSFILE$ AS #1 LEN = 256
2450 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$
2460 REM open the Marriages File
2470 LOCATE 12,1 : PRINT "Open the Marriage File"
2480 OPEN CC.MARRFILE$ AS #2 LEN = 128
2490 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$
2500 REM Open the Ordinance File
2510 IF DD.ORD$ = "no" THEN 2550
2520 LOCATE 14,1 : PRINT "Open the Ordinances File";
2530 OPEN CC.ORDFILE$ AS #3 LEN = 256
2540 FIELD 3,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
2550 REM Obtain a Person Record from the User
2560 LOCATE 20,1
2570 INPUT "Enter the Record-number of a Marriage (0 to quit)";REPLY$
2580 IF REPLY$ = "0" THEN 6790
2590 MARRIAGE = VAL(REPLY$)
2600 IF MARRIAGE < 1 OR MARRIAGE > MAX.MAR THEN KEY ON : CLS : LOCATE 19,1 : PRINT "Number is out of range;" : KEY OFF : GOTO 2570
2610 GOSUB 2620 : GOTO 3500
2620 REM Reset the Printer Characterisitcs for next page if required.
2630 IF FORMS = 1 THEN 2670 'Don't stop if forms are continuous
2640 REM Process Single Sheets
2650 PRINT "Press any key when next form is ready"
2660 A$ = INKEY$ : IF A$ = "" THEN 2660
2670 REM Reset paper sensing if required
2680 IF FORMS = 2 THEN LPRINT PAP.SEN.OFF$;
2690 REM Reset paper length if required
2700 IF LENGTH = 1 THEN LPRINT PAP.SHORT$;
2710 REM Reset Condensed Printing if required
2720 IF WIDE = 1 THEN LPRINT COMPR.ON$;
2730 RETURN
2740 REM Routine to do a Right-trim
2750 FOR J = 1 TO LEN(TEMP1$)
2760 IF RIGHT$(TEMP2$,1) = " " THEN TEMP2$ = LEFT$(TEMP2$,LEN(TEMP2$)-1) ELSE J = LEN(TEMP1$)
2770 NEXT J
2780 RETURN
2790 REM Routine to Extract Personal Information
2800 T1! = CVS(F1$) : T1 = T1!
2810 TEMP1$ = F2$ : TEMP2$ = F2$ : GOSUB 2740
2820 T2$ = TEMP2$
2830 REM Prefix the Record Number to the Surname
2840 GOSUB 8250
2850 TEMP1$ = F3$ : TEMP2$ = F3$ : GOSUB 2740
2860 T3$ = TEMP2$
2870 T4$ = " "
2880 IF LEFT$(F4$,1) = MALE.LTR$ THEN T4$ = MALE.LTR$
2890 IF LEFT$(F4$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.LTR$
2900 T6! = CVS(F6$) : T6 = T6!
2910 T7! = CVS(F7$) : T7 = T7!
2920 RETURN
2930 TEMP1$ = F8$ : TEMP2$ = F8$ : GOSUB 2740
2940 T8$ = TEMP2$ 'Birthdate
2950 TEMP1$ = F9$ : TEMP2$ = F9$ : GOSUB 2740
2960 T9$ = TEMP2$
2970 TEMP1$ = F10$ : TEMP2$ = F10$ : GOSUB 2740
2980 T10$ = TEMP2$
2990 TEMP1$ = F11$ : TEMP2$ = F11$ : GOSUB 2740
3000 T11$ = TEMP2$
3010 TEMP1$ = F12$ : TEMP2$ = F12$ : GOSUB 2740
3020 T12$ = TEMP2$ 'Death Date
3030 RETURN
3040 TEMP1$ = F13$ : TEMP2$ = F13$ : GOSUB 2740
3050 T13$ = TEMP2$
3060 TEMP1$ = F14$ : TEMP2$ = F14$ : GOSUB 2740
3070 T14$ = TEMP2$
3080 TEMP1$ = F15$ : TEMP2$ = F15$ : GOSUB 2740
3090 T15$ = TEMP2$
3100 TEMP1$ = F16$ : TEMP2$ = F16$ : GOSUB 2740
3110 T16$ = TEMP2$
3120 TEMP1$ = F17$ : TEMP2$ = F17$ : GOSUB 2740
3130 T17$ = TEMP2$
3140 TEMP1$ = F18$ : TEMP2$ = F18$ : GOSUB 2740
3150 T18$ = TEMP2$
3160 TEMP1$ = F19$ : TEMP2$ = F19$ : GOSUB 2740
3170 T19$ = TEMP2$
3180 RETURN
3190 REM Routine to Extract Ordinance Information
3200 U1! = CVS(O1$) : U1 = U1!
3210 IF U1 = 0 THEN GOSUB 8160 : GOTO 3350
3220 TEMP1$ = O2$ : TEMP2$ = O2$ : GOSUB 2740
3230 U2$ = TEMP2$ 'Christening Date
3240 TEMP1$ = O4$ : TEMP2$ = O4$ : GOSUB 2740
3250 U4$ = TEMP2$ 'Sealed to Parents
3260 TEMP1$ = O7$ : TEMP2$ = O7$ : GOSUB 2740
3270 U7$ = TEMP2$ 'Baptism
3280 TEMP1$ = O10$ : TEMP2$ = O10$ : GOSUB 2740
3290 U10$ = TEMP2$ 'Endowment
3300 TEMP1$ = O11$ : TEMP2$ = O11$ : GOSUB 2740
3310 U11$ = TEMP2$ 'Sealed to Spouse
3320 U12 = CVS(O12$)
3330 TEMP1$ = O24$ : TEMP2$ = O24$ : GOSUB 2740
3340 U24$ = TEMP2$ 'Occupation
3350 RETURN
3360 REM Extraction of Marriage Information
3370 TT1! = CVS(M1$) : TT1 = TT1! 'Rec.no
3380 TT2! = CVS(M2$) : TT2 = TT2! 'Husband
3390 TT3! = CVS(M3$) : TT3 = TT3! 'Wife
3400 TEMP1$ = M5$ : TEMP2$ = M5$ : GOSUB 2740
3410 TT5$ = TEMP2$ 'Marriage Date
3420 RETURN
3430 TEMP1$ = M6$ : TEMP2$ = M6$ : GOSUB 2740
3440 TT6$ = TEMP2$ 'City
3450 TEMP1$ = M7$ : TEMP2$ = M7$ : GOSUB 2740
3460 TT7$ = TEMP2$ 'County
3470 TEMP1$ = M8$ : TEMP2$ = M8$ : GOSUB 2740
3480 TT8$ = TEMP2$ 'State
3490 RETURN
3500 REM Routine to Fill with Spaces
3510 IF X.CHILD$ = "no" AND LAST.MARR = MARRIAGE THEN 3560
3520 FOR I = 1 TO 49
3530 FORM$(I) = SPACE$(132)
3540 NEXT I
3550 IF DD.ORD$ = "no" THEN FA.COL = 10 : GOTO 3570
3560 IF PP.FORMS = 1 THEN FA.COL = 12 ELSE FA.COL = 10
3570 IF X.CHILD$ = "no" AND LAST.MARR = MARRIAGE THEN GOSUB 6670 : GOTO 2550
3580 X.CHILD$ = "no"
3590 IF DD.ORD$ = "no" THEN GOSUB 6880 : GOTO 3610
3600 IF PP.FORMS = 1 THEN 3610 ELSE GOSUB 6880
3610 REM Routine to Produce a Chart of Family
3620 REM get the marriage record
3630 GET #2, MARRIAGE
3640 PRINT "Obtaining Marriage Record"
3650 GOSUB 3360 : GOSUB 3430 'Extract Marriage Information
3660 HUSB = TT2 : WIFE = TT3
3670 REM Verify that record contains information
3680 IF HUSB = 0 OR WIFE = 0 THEN 6450
3690 REM
3700 REM Marriage Information onto line 4
3710 PRINT "Locate Marriage Information"
3720 MID$(FORM$(4),7,LEN(TT5$)) = TT5$
3730 IF TT6$ = "" AND TT7$ = "" AND TT8$ = "" THEN 3750
3740 MID$(FORM$(4),28,LEN(TT6$+TT7$+TT8$)+4) = TT6$+", "+TT7$+", "+TT8$
3750 REM
3760 GET #1, HUSB
3770 PRINT "Obtaining Husband's Information"
3780 GOSUB 2790 : GOSUB 2930 : GOSUB 3040 'Extract Husband's Information
3790 REM Move the Husband's Information
3800 IF T2$ = "" AND T3$ = "" THEN 3840
3810 MID$(FORM$(1),FA.COL-2,LEN(T2$+T3$)+2) = T2$ + ", " + T3$
3820 IF DD.ORD$ = "no" THEN 3840
3830 MID$(FORM$(1),84,LEN(T2$+T3$)+9) = T2$+", "+T3$+" ("+RIGHT$(T8$,4)+")"
3840 MID$(FORM$(2),7,LEN(T8$)) = T8$
3850 IF T9$ = "" AND T10$ = "" AND T11$ = "" THEN 3870
3860 MID$(FORM$(2),28,LEN(T9$+T10$+T11$)+4) = T9$+", "+T10$+", "+T11$
3870 MID$(FORM$(5),7,LEN(T12$)) = T12$
3880 IF T13$ = "" AND T14$ = "" AND T15$ = "" THEN 3900
3890 MID$(FORM$(5),28,LEN(T13$+T14$+T15$)+4) = T13$+", "+T14$+", "+T15$
3900 MID$(FORM$(6),7,LEN(T16$)) = T16$
3910 IF T17$ = "" AND T18$ = "" AND T19$ = "" THEN 3930
3920 MID$(FORM$(6),28,LEN(T17$+T18$+T19$)+4) = T17$+", "+T18$+", "+T19$
3930 FATHER = T6 : MOTHER = T7
3940 IF FATHER = 0 THEN 4000
3950 GET #1, FATHER
3960 PRINT "Obtaining Husband's Father"
3970 GOSUB 2790 'Extract Father's Information
3980 IF T2$ = "" AND T3$ = "" THEN 4000
3990 MID$(FORM$(7),FA.COL,LEN(T2$+T3$)+2) = LEFT$(T2$+", "+T3$,38)
4000 IF MOTHER = 0 THEN 4060
4010 GET #1, MOTHER
4020 PRINT "Obtaining Husband's Mother"
4030 GOSUB 2790 'Extract Mother's Information
4040 IF T2$ = "" AND T3$ = "" THEN 4060
4050 MID$(FORM$(7),58,LEN(T2$+T3$)+2) = LEFT$(T2$ + ", " + T3$,38)
4060 REM
4070 REM Look for Husband's Other Wives
4080 PRINT "Look for Other Wives"
4090 XWIFE.COL = 0
4100 REM Establish Skip-ahead Start-value and Delta
4110 START.AT = 1 : DELTA = INT(M.COUNT/10) : IF DELTA = 0 THEN 4160
4120 REM Add delta and test if too far
4130 START.AT = START.AT + DELTA
4140 IF START.AT > 9 * DELTA THEN 4160
4150 IF HUSB > PERS.NO(START.AT) THEN 4130
4160 START.AT = START.AT - DELTA
4170 REM Search Routine
4180 FOR WW = START.AT TO M.COUNT
4190 IF HUSB > PERS.NO(WW) THEN 4330 'next ww
4200 IF HUSB < PERS.NO(WW) THEN WW = M.COUNT : GOTO 4330
4210 REM found a wife, skip if wife of this marriage
4220 IF M.NO(WW) = 0 THEN 4330
4230 GET #2, M.NO(WW)
4240 GOSUB 3360 'extract marriage info
4250 IF WIFE = TT3 THEN 4330 'skip if same
4260 REM found another wife
4270 IF TT3 = 0 THEN 4330
4280 GET #1, TT3 'get wife's information
4290 GOSUB 2790 'extract personal info.
4300 IF T2$ = "" AND T3$ = "" THEN 4330 'skip if empty
4310 MID$(FORM$(8),FA.COL-1+XWIFE.COL,LEN(T2$+T3$)+2) = T2$+", "+T3$
4320 XWIFE.COL = XWIFE.COL + LEN(T2$+T3$)+4
4330 NEXT WW
4340 REM
4350 GET #1, WIFE
4360 PRINT "Obtaining Wife's Information"
4370 GOSUB 2790 : GOSUB 2930 : GOSUB 3040 'Extract Wife's Information
4380 REM Move the Wife's Information
4390 IF T2$ = "" AND T3$ = "" THEN 4430
4400 MID$(FORM$(10),FA.COL-2,LEN(T2$+T3$)+2) = T2$ + ", " + T3$
4410 IF DD.ORD$ = "no" THEN 4430
4420 MID$(FORM$(2),84,LEN(T2$+T3$)+9) = T2$+", "+T3$+" ("+RIGHT$(T8$,4)+")"
4430 MID$(FORM$(11),7,LEN(T8$)) = T8$
4440 IF T9$ = "" AND T10$ = "" AND T11$ = "" THEN 4460
4450 MID$(FORM$(11),28,LEN(T9$+T10$+T11$)+4) = T9$+", "+T10$+", "+T11$
4460 MID$(FORM$(13),7,LEN(T12$)) = T12$
4470 IF T13$ = "" AND T14$ = "" AND T15$ = "" THEN 4490
4480 MID$(FORM$(13),28,LEN(T13$+T14$+T15$)+4) = T13$+", "+T14$+", "+T15$
4490 MID$(FORM$(14),7,LEN(T16$)) = T16$
4500 IF T17$ = "" AND T18$ = "" AND T19$ = "" THEN 4520
4510 MID$(FORM$(14),28,LEN(T17$+T18$+T19$)+4) = T17$+", "+T18$+", "+T19$
4520 FATHER = T6 : MOTHER = T7
4530 IF FATHER = 0 THEN 4590
4540 GET #1, FATHER
4550 PRINT "Obtaining Wife's Father"
4560 GOSUB 2790 'Extract Father's Information
4570 IF T2$ = "" AND T3$ = "" THEN 4590
4580 MID$(FORM$(15),FA.COL,LEN(T2$+T3$)+2) = LEFT$(T2$+", "+T3$,38)
4590 IF MOTHER = 0 THEN 4650
4600 GET #1, MOTHER
4610 PRINT "Obtaining Wife's Mother"
4620 GOSUB 2790 'Extract Mother's Information
4630 IF T2$ = "" AND T3$ = "" THEN 4650
4640 MID$(FORM$(15),58,LEN(T2$+T3$)+2) = LEFT$(T2$ + ", " + T3$,38)
4650 REM
4660 REM
4670 REM Look for Wife's Other Husbands
4680 PRINT "Look for Other Husbands"
4690 XHUSB.COL = 0
4700 REM Establish Skip-ahead Start-value and Delta
4710 START.AT = 1 : DELTA = INT(M.COUNT/10) : IF DELTA = 0 THEN 4760
4720 REM Add delta and test if too far
4730 START.AT = START.AT + DELTA
4740 IF START.AT > 9 * DELTA THEN 4760
4750 IF WIFE > PERS.NO(START.AT) THEN 4730
4760 START.AT = START.AT - DELTA
4770 REM Search Routine
4780 FOR H = START.AT TO M.COUNT
4790 IF WIFE > PERS.NO(H) THEN 4930 'next h
4800 IF WIFE < PERS.NO(H) THEN H = M.COUNT : GOTO 4930
4810 REM found a husband. Skip if husband of this marriage
4820 IF M.NO(H) = 0 THEN 4930
4830 GET #2, M.NO(H)
4840 GOSUB 3360 'extract marriage info
4850 IF HUSB = TT2 THEN 4930 'skip if same
4860 REM found another husband
4870 IF TT2 = 0 THEN 4930
4880 GET #1, TT2 'get husband's information
4890 GOSUB 2790 'extract personal info.
4900 IF T2$ = "" AND T3$ = "" THEN 4930 'skip if empty
4910 MID$(FORM$(16),12+XHUSB.COL,LEN(T2$+T3$)+2) = T2$+", "+T3$
4920 XHUSB.COL = XHUSB.COL + LEN(T2$+T3$)+4
4930 NEXT H
4940 REM Obtain Husband's Ordinances
4950 IF DD.ORD$ = "no" THEN 5230
4960 PRINT "Obtaining Husband's Ordinances"
4970 IF HUSB = 0 THEN 5090
4980 GET #3, HUSB
4990 GOSUB 3190 'Extract Ordinances
5000 MID$(FORM$(3),7,LEN(U2$)) = U2$
5010 REM Location of Baptism & Endowment
5020 IF PP.FORMS = 1 THEN WH1 = 100 : WH2 = 111 ELSE WH1 = 98 : WH2 = 110
5030 MID$(FORM$(17),WH1,LEN(U7$)) = U7$
5040 MID$(FORM$(17),WH2,LEN(U10$)) = U10$
5050 REM get Husband's Occupation
5060 PRINT "Obtaining Husband's Occupation"
5070 IF U24$ = "" THEN 5110
5080 MID$(FORM$(1),55,LEN(U24$)+2) = "("+U24$+")"
5090 REM Obtain Wife's Ordinances
5100 IF WIFE = 0 THEN 5230
5110 GET #3, WIFE
5120 PRINT "Obtaining Wife's Ordinances"
5130 GOSUB 3190 'Extract Ordinances
5140 MID$(FORM$(12),7,LEN(U2$)) = U2$
5150 MID$(FORM$(19),WH1,LEN(U7$)) = U7$
5160 MID$(FORM$(19),WH2,LEN(U10$)) = U10$
5170 IF U12 <> HUSB THEN 5190 'Sealed to another
5180 MID$(FORM$(17),122,LEN(U11$)) = U11$
5190 REM get Wife's Occupation
5200 PRINT "Obtaining Wife's Occupation"
5210 IF U24$ = "" THEN 5230
5220 MID$(FORM$(10),55,LEN(U24$)+2) = "("+U24$+")"
5230 REM Now obtain the information about the Children
5240 CHILD.COUNT = 0
5250 REM Search the Parent/Child Index
5260 PRINT "Look for Children"
5270 XMARRCT = 0
5280 REM Establish Skip-ahead Start-value and Delta
5290 START.AT = 1 : DELTA = INT(PC.COUNT/10) : IF DELTA = 0 THEN 5340
5300 REM Add delta and test if too far
5310 START.AT = START.AT + DELTA
5320 IF START.AT > 9 * DELTA THEN 5340
5330 IF HUSB > PA.ID(START.AT) THEN 5310
5340 START.AT = START.AT - DELTA
5350 REM Search Routine
5360 FOR LL = START.AT TO PC.COUNT
5370 IF HUSB > PA.ID(LL) THEN 6440
5380 IF HUSB < PA.ID(LL) THEN LL = PC.COUNT : GOTO 6440
5390 REM found a child
5400 IF CH.ID(LL) = 0 THEN 6420
5410 GET #1, CH.ID(LL)
5420 GOSUB 2790 : GOSUB 2930 'Extract Child's Info.
5430 REM verify that Mother is the same
5440 IF WIFE <> T7 THEN 6440
5450 REM Found a valid child
5460 CHILD.COUNT = CHILD.COUNT + 1
5470 SHOW.COUNT = CHILD.COUNT
5480 X11 = 0
5490 X11 = X11 + 11
5500 IF CHILD.COUNT > X11 THEN SHOW.COUNT = CHILD.COUNT - X11 : GOTO 5490
5510 REM test for more than 11 children
5520 IF CHILD.COUNT = 1 THEN 5690
5530 IF (CHILD.COUNT-1) MOD 11 = 0 THEN 5540 ELSE 5690
5540 GOSUB 6460 'print the current form, then blank out children
5550 FOR II = 20 TO 49
5560 FORM$(II) = SPACE$(132)
5570 NEXT II
5580 X.CHILD$ = "yes"
5590 GOSUB 2620 'Next form
5600 SHOW.COUNT = 1
5610 XMARRCT = 0
5620 IF DD.ORD$ = "no" THEN 5640
5630 IF PP.FORMS = 1 THEN 5690
5640 REM Redraw Partial Form
5650 FOR II = 21 TO 41 STEP 2
5660 FORM$(II) = STRING$(132,95)
5670 NEXT II
5680 GOSUB 7130 'Redraw vertical separators
5690 SEX$ = T4$
5700 PRINT "Processing Child #";CHILD.COUNT
5710 MID$(FORM$(19+(2*SHOW.COUNT)),2,1) = T4$
5720 CH.FM = 1
5730 IF DD.ORD$ = "no" THEN 5750
5740 IF PP.FORMS = 1 THEN 5790
5750 FORM.NO$ = STR$(CHILD.COUNT)
5760 CH.FM = LEN(FORM.NO$)-1
5770 FORM.NO$ = RIGHT$(FORM.NO$,CH.FM)
5780 MID$(FORM$(18+(2*SHOW.COUNT)),2,CH.FM) = FORM.NO$
5790 MID$(FORM$(18+(2*SHOW.COUNT)),3+CH.FM,LEN(T2$)+1) = LEFT$(T2$+",",25-CH.FM)
5800 MID$(FORM$(19+(2*SHOW.COUNT)),5,LEN(T3$)) = T3$
5810 '
5820 REM Position Birthdate if Drawing the Form
5830 IF DD.ORD$ = "no" THEN VV = 29 : GOTO 5850
5840 IF PP.FORMS = 1 THEN VV = 28 ELSE VV = 29
5850 MID$(FORM$(18+(2*SHOW.COUNT)),VV,LEN(T8$)) = T8$
5860 MID$(FORM$(18+(2*SHOW.COUNT)),41,LEN(T9$)) = T9$
5870 '
5880 REM Set Width of County and State
5890 IF DD.ORD$ = "no" THEN V = 5 : GOTO 5910
5900 IF PP.FORMS = 1 THEN V = 4 ELSE V = 5
5910 MID$(FORM$(18+(2*SHOW.COUNT)),60,V) = LEFT$(T10$,V)
5920 MID$(FORM$(18+(2*SHOW.COUNT)),66,V) = LEFT$(T11$,V)
5930 MID$(FORM$(18+(2*SHOW.COUNT)),85,LEN(T12$)) = T12$
5940 REM Now get Child's Ordinances
5950 IF DD.ORD$ = "no" THEN 6020
5960 GET #3, CH.ID(LL)
5970 PRINT "Obtain Child's Ordinances"
5980 GOSUB 3190 'Extract Ordinances
5990 MID$(FORM$(18+(2*SHOW.COUNT)),WH1,LEN(U7$)) = U7$
6000 MID$(FORM$(18+(2*SHOW.COUNT)),WH2,LEN(U10$)) = U10$
6010 MID$(FORM$(18+(2*SHOW.COUNT)),122,LEN(U4$)) = U4$
6020 REM Now look for Child's Marriage
6030 PRINT "Look for Child's Marriage"
6040 FOUND = 0
6050 REM Establish Skip-ahead Start-value and Delta
6060 START.AT = 1 : DELTA = INT(M.COUNT/10) : IF DELTA = 0 THEN 6110
6070 REM Add delta and test if too far
6080 START.AT = START.AT + DELTA
6090 IF START.AT > 9 * DELTA THEN 6110
6100 IF CH.ID(LL) > PERS.NO(START.AT) THEN 6080
6110 START.AT = START.AT - DELTA
6120 REM Search Routine
6130 FOR L = START.AT TO M.COUNT
6140 IF CH.ID(LL) > PERS.NO(L) THEN 6430
6150 IF CH.ID(LL) < PERS.NO(L) THEN L = M.COUNT : GOTO 6430
6160 REM Found a Marriage
6170 IF M.NO(L) = 0 THEN 6420
6180 FOUND = FOUND + 1
6190 GET #2, M.NO(L)
6200 GOSUB 3360 'Extract Marriage Information
6210 IF FOUND <> 1 THEN 6230
6220 MID$(FORM$(19+(2*SHOW.COUNT)-1),72,LEN(TT5$)) = TT5$
6230 REM get spouse
6240 SPOUSE = 0
6250 IF SEX$ = MALE.LTR$ THEN SPOUSE = TT3
6260 IF SEX$ = FEMALE.LTR$ THEN SPOUSE = TT2
6270 IF SPOUSE = 0 THEN 6420
6280 GET #1, SPOUSE
6290 GOSUB 2790 'Extract Spouse's Information
6300 IF FOUND = 1 THEN 6400
6310 XMARRCT = XMARRCT + 1
6320 IF XMARRCT > 7 THEN 6420
6330 CH$ = SPACE$(2)
6340 RSET CH$ = RIGHT$((STR$(CHILD.COUNT)),2)
6350 MID$(FORM$(42+XMARRCT),60,4) = CH$+" -"
6360 IF T2$ = " " AND T3$ = " " THEN 6390
6370 MID$(FORM$(42+XMARRCT),77,LEN(T2$+T3$)+2) = T2$+", "+T3$
6380 MID$(FORM$(42+XMARRCT),65,LEN(TT5$)) = TT5$
6390 GOTO 6420
6400 IF T2$ = " " AND T3$ = " " THEN 6420
6410 MID$(FORM$(19+(2*SHOW.COUNT)),72,LEN(T2$+T3$)+2) = T2$+", "+T3$
6420 REM finished with this child
6430 NEXT L
6440 NEXT LL
6450 GOSUB 6460 : GOTO 6780
6460 REM enter sources
6470 IF PP.FORMS = 1 THEN 6480 ELSE 6520
6480 MID$(FORM$(4),WH1,LEN(PREP1$)) = PREP1$
6490 MID$(FORM$(5),WH1,LEN(PREP2$)) = PREP2$
6500 MID$(FORM$(6),WH1,LEN(PREP3$)) = PREP3$
6510 MID$(FORM$(7),WH1,LEN(PREP4$)) = PREP4$
6520 MAR.NUM$ = STR$(MARRIAGE)
6530 MAR.NUM$ = RIGHT$(MAR.NUM$,LEN(MAR.NUM$)-1)
6540 MAR.DATA$ = "Marriage Record: " + MAR.NUM$
6550 MID$(FORM$(43),2,LEN(MAR.DATA$)) = MAR.DATA$
6560 MID$(FORM$(44),2,22) = "Prepared on " + DATE$
6570 MID$(FORM$(44),24,12) = " at " + TIME$
6580 COMM$ = "Using Version 6.0 of Genealogy ON DISPLAY"
6590 MID$(FORM$(45),2,LEN(COMM$)) = COMM$
6600 IF PP.FORMS = 1 THEN 6670
6610 IF PREP1$ = "" THEN 6630
6620 MID$(FORM$(46),2,3) = "By:"
6630 MID$(FORM$(46),6,LEN(PREP1$)) = PREP1$
6640 MID$(FORM$(47),6,LEN(PREP2$)) = PREP2$
6650 MID$(FORM$(48),6,LEN(PREP3$)) = PREP3$
6660 MID$(FORM$(49),6,LEN(PREP4$)) = PREP4$
6670 PRINT "Ready to Print"
6680 LPRINT
6690 REM Print the Chart of Family
6700 FOR I = 1 TO 49
6710 PRINT "Printing line: ";I
6720 IF DD.ORD$ = "no" THEN LPRINT TAB(LEFT.SPACE); LEFT$(FORM$(I),133-2*LEFT.SPACE) ELSE LPRINT FORM$(I);
6730 NEXT I
6740 LAST.MARR = MARRIAGE
6750 KEY ON : CLS : KEY OFF
6760 LPRINT FORM.FEED$;
6770 RETURN
6780 GOTO 2550 'for Next Group Sheet
6790 REM Wrapup
6800 LPRINT COMPR.OFF$; 'Normal Printing
6810 LPRINT PAP.SEN.ON$; 'Paper Sensing ON
6820 LPRINT PAP.LONG$; 'Normal Page of 66 Lines
6830 CLOSE
6840 WIDTH "lpt1:",80 'Reset for narrow paper
6850 KEY ON : CLS : KEY OFF : LOCATE 21,1
6860 PRINT "End of Program"
6870 RUN CC.MENU$
6880 REM Draw the Form Itself
6890 PRINT "Preparing the Form."
6900 '
6910 PRINT "Drawing the Horizontal Lines in Rows:"
6920 FOR II = 1 TO 8
6930 PRINT II;
6940 FORM$(II) = STRING$(132,95)
6950 NEXT II
6960 PRINT
6970 IF DD.ORD$ = "no" THEN 7000
6980 MID$(FORM$(1),83,1) = CHR$(124)
6990 MID$(FORM$(2),83,1) = CHR$(124)
7000 FOR II = 10 TO 16
7010 PRINT II;
7020 FORM$(II) = STRING$(132,95)
7030 NEXT II
7040 IF DD.ORD$ = "no" THEN 7070
7050 MID$(FORM$(9),98,35) = STRING$(35,95)
7060 MID$(FORM$(16),98,35) = SPACE$(35)
7070 PRINT
7080 FOR II = 17 TO 41 STEP 2
7090 PRINT II;
7100 FORM$(II) = STRING$(132,95)
7110 NEXT II
7120 PRINT
7130 '
7140 PRINT "Drawing the Vertical Lines in Rows:"
7150 FOR II = 18 TO 41
7160 PRINT II;
7170 MID$(FORM$(II),1,1) = CHR$(124)
7180 MID$(FORM$(II),3,1) = CHR$(124)
7190 MID$(FORM$(II),28,1) = CHR$(124)
7200 MID$(FORM$(II),40,1) = CHR$(124)
7210 MID$(FORM$(II),59,1) = CHR$(124)
7220 MID$(FORM$(II),65,1) = CHR$(124)
7230 MID$(FORM$(II),71,1) = CHR$(124)
7240 IF II MOD 2 = 1 THEN 7260
7250 MID$(FORM$(II),97,1) = CHR$(124)
7260 IF DD.ORD$ <> "no" THEN 7280
7270 MID$(FORM$(II),133-2*LEFT.SPACE,1) = CHR$(124)
7280 NEXT II
7290 PRINT
7300 FOR II = 42 TO 49
7310 PRINT II;
7320 MID$(FORM$(II),1,1) = CHR$(124)
7330 MID$(FORM$(II),59,1) = CHR$(124)
7340 IF DD.ORD$ <> "no" THEN 7360
7350 MID$(FORM$(II),133-2*LEFT.SPACE,1) = CHR$(124)
7360 NEXT II
7370 PRINT
7380 PRINT "Drawing Boxes in Rows:"
7390 FOR II = 18 TO 40 STEP 2
7400 PRINT II;
7410 MID$(FORM$(II),72,25) = STRING$(25,95)
7420 NEXT II
7430 PRINT
7440 FOR II = 18 TO 40 STEP 2
7450 PRINT II;
7460 MID$(FORM$(II),84,1) = CHR$(124)
7470 NEXT II
7480 PRINT
7490 REM Put the titles in place
7500 PRINT "Preparing Titles and Numbers"
7510 MID$(FORM$(18),11,8) = "CHILDREN"
7520 MID$(FORM$(18),30,9) = "WHEN BORN"
7530 MID$(FORM$(18),56,10) = "WHERE BORN"
7540 MID$(FORM$(18),72,11) = "1st MARRIED"
7550 MID$(FORM$(18),86,9) = "WHEN DIED"
7560 MID$(FORM$(19),4,20) = "SURNAME, Given Names"
7570 MID$(FORM$(19),29,11) = "DA MON YEAR"
7580 MID$(FORM$(19),45,5) = "TOWN"
7590 MID$(FORM$(19),60,4) = "CNTY"
7600 MID$(FORM$(19),66,4) = "STA."
7610 MID$(FORM$(19),72,15) = "TO WHOM MARRIED"
7620 MID$(FORM$(42),2,16) = "Chart of Family."
7630 MID$(FORM$(42),60,15) = "OTHER MARRIAGES"
7640 MID$(FORM$( 1),1,5) = "HUSB:"
7650 MID$(FORM$(2), 1,5) = "Born:"
7660 MID$(FORM$(2),20,6) = "Place:"
7670 MID$(FORM$(3), 1,4) = "Chr:"
7680 MID$(FORM$(3),20,6) = "Place:"
7690 MID$(FORM$(4), 1,5) = "Marr:"
7700 MID$(FORM$(4),20,6) = "Place:"
7710 MID$(FORM$(5), 1,5) = "Died:"
7720 MID$(FORM$(5),20,6) = "Place:"
7730 MID$(FORM$(6), 1,4) = "Bur:"
7740 MID$(FORM$(6),20,6) = "Place:"
7750 MID$(FORM$(7), 1,7) = "Father:"
7760 MID$(FORM$(7),49,7) = "Mother:"
7770 MID$(FORM$(8), 1,6) = "Wives:"
7780 MID$(FORM$(10),1,5) = "WIFE:"
7790 MID$(FORM$(11),1,5) = "Born:"
7800 MID$(FORM$(11),20,6) = "Place:"
7810 MID$(FORM$(12), 1,4) = "Chr:"
7820 MID$(FORM$(12),20,6) = "Place:"
7830 MID$(FORM$(13), 1,5) = "Died:"
7840 MID$(FORM$(13),20,6) = "Place:"
7850 MID$(FORM$(14), 1,4) = "Bur:"
7860 MID$(FORM$(14),20,6) = "Place:"
7870 MID$(FORM$(15), 1,7) = "Father:"
7880 MID$(FORM$(15),49,7) = "Mother:"
7890 MID$(FORM$(16), 1,9) = "Husbands:"
7900 FOR II = 3 TO 17
7910 IF DD.ORD$ <> "no" THEN 7940
7920 MID$(FORM$(II),133-2*LEFT.SPACE,1) = CHR$(124)
7930 GOTO 7950
7940 MID$(FORM$(II),97,1) = CHR$(124)
7950 NEXT II
7960 IF DD.ORD$ <> "no" THEN 7990
7970 MID$(FORM$(1),133-2*LEFT.SPACE,1) = CHR$(124)
7980 MID$(FORM$(2),133-2*LEFT.SPACE,1) = CHR$(124)
7990 REM Put in the Descriptions
8000 IF DD.ORD$ = "no" THEN 8150
8010 MID$(FORM$(14),106,19) = "LDS ORDINANCE DATA"
8020 REM Draw Ordinance Separators
8030 FOR II = 15 TO 41
8040 MID$(FORM$(II),109,1) = CHR$(124)
8050 MID$(FORM$(II),121,1) = CHR$(124)
8060 NEXT II
8070 MID$(FORM$(15), 99,8) = "BAPTIZED"
8080 MID$(FORM$(15),111,7) = "ENDOWED"
8090 MID$(FORM$(15),123,6) = "SEALED"
8100 MID$(FORM$(16),106,7) = "HUSBAND"
8110 MID$(FORM$(16),123,10) = "WIFE/HUSB."
8120 MID$(FORM$(18),107,4) = "WIFE"
8130 MID$(FORM$(18),123,8) = "CHILDREN"
8140 MID$(FORM$(19),123,6) = "SEALED"
8150 RETURN
8160 REM Blank Ordinances if No Ord Record
8170 U2$ = "" : U3$ = "" : U4$ = ""
8180 U5 = 0 : U6 = 0 : U12 = 0
8190 U7$ = "" : U8$ = "" : U9$ = "" : U10$ = ""
8200 U11$ = "" : U13$ = "" : U14$ = "" : U15$ = ""
8210 U16$ = "" : U17$ = "" : U18$ = "" : U19$ = ""
8220 U20$ = "" : U21$ = "" : U22$ = "" : U23$ = ""
8230 U24$ = ""
8240 RETURN
8250 REM Routine to Obtain a Usable Person Number for the Chart
8260 REM Skip if LDS Wide, Single Sheet Forms
8270 IF PP.FORMS = 1 THEN 8390 'return
8280 IF CHART.NOS$ <> "n" THEN 8390
8290 REM Convert the Person Number to a String
8300 PNUM$ = STR$(T1)
8310 REM Find the Length of the String
8320 PLEN = LEN(PNUM$)
8330 REM Get rid of the leading space for algebraic sign
8340 PNUM$ = RIGHT$(PNUM$,PLEN-1)
8350 REM Surround with Quotes and add a Trailing Space
8360 PNUM$ = "(" + PNUM$ + ") "
8370 REM Prefix Person Number to Surname
8380 T2$ = PNUM$ + T2$
8390 RETURN
8400 REM Clean User Input Area
8410 LOCATE 19,1 : PRINT SPACE$(79);
8420 LOCATE 20,1 : PRINT SPACE$(79);
8430 LOCATE 21,1 : PRINT SPACE$(79);
8440 LOCATE 22,1 : PRINT SPACE$(79);
8450 LOCATE 23,1 : PRINT SPACE$(79);
8460 RETURN
FILES90.TXT
Disk No: 90
Program Title: GENEALOGY ON DISPLAY version 6.0
PC-SIG version: 3.3
Genealogy ON DISPLAY, Version 6.0, is an integrated, menu-driven group
of thirty BASIC programs for PCs (including the PCjr), which assist
users in organizing, entering, and reporting their own genealogical
data. It provides for 500 persons and 200 marriages within its data
base, with no specific generation limit.
Information can be displayed and printed. Output available for printing
or displaying includes:
1. Pedigree (Family Tree) Charts.
2. Family Group Charts.
3. Descendants Charts (30 generation default)
4. Detailed Personal Information.
5. Detailed Marriage Information.
NOTE: A companion disk with more functions is available on Disk 594 -
Notes On Display.
Usage: Genealogical research and family fun.
Special Requirements: A version of BASIC.
How to Start: Type, TYPE READ.ME (press enter).
Suggested Registration: $35.00
File Descriptions:
ALPHAMAR BAS Prints alphanumeric marriage list.
ALPHAPER BAS Prints alphanumeric persons list.
ANCESTOR BAS Prints ancestor list.
APPENDIX BAS Program to print Appendices (6).
CREATMAR BAS Creates marriage file.
CREATORD BAS Creates ordinances file.
CREATPER BAS Creates persons file.
DESCEND BAS Prints descendants.
DIRECTOR BAS Prints program directory.
DISPLAY BAS Displays file information.
FAMILY BAS Prints family group sheets.
GENERAL BAS Program to print general information (3).
INDEXMAR BAS Creates marriage index.
INDEXPC BAS Creates persons index.
INTRODUC BAS Program to print manual introduction (2).
LISTMAR BAS Lists marriages.
LISTPCI BAS Lists parent/child index.
LISTPER BAS Lists persons file.
MENU BAS Program to run first.
OVERVIEW BAS Tells a bit about genealogy.
PRINTERS BAS Program to print documentation on other printers.
PRINTMAR BAS Prints marriage file.
PRINTPER BAS Prints persons and ordinance file.
READ ME Introductory text file.
REFERENC BAS Program to print reference material (5).
TABLEOFC BAS Program to print table of contents (1).
UPDATMAR BAS Updates marriage file.
UPDATORD BAS Updates ordinance file.
UPDATPER BAS Updates persons file.
USINGTHE BAS Program to print "Using the programs" (4).
VERIFILE Verification file used by main program.
PC-SIG
1030D E Duane Avenue
Sunnyvale Ca. 94086
(408) 730-9291
(c) Copyright 1984,85,86,87,88,89 PC-SIG, Inc.
GENERAL.BAS
100 REM GENERAL Program.
110 REM Documentation. General Information.
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 DATA Genealogy
140 DATA User's Manual
150 DATA -5
160 DATA 1
170 INDENT = 0
180 REM Printer Definitions
190 FORM.FEED$ = CHR$(12)
200 COMPR.OFF$ = CHR$(18) : COMPR.ON$ = CHR$(15)
210 BOLD.OFF$ = CHR$(27)+"F" : BOLD.ON$ = CHR$(27)+"E"
220 EXPAND.OFF$ = CHR$(18) : EXPAND.ON$ = CHR$(14)
230 DASHES$ = "+"+STRING$(54,45)+"+"
240 TRIM.LINE$ = "(Trim-line)"
300 REM Program begins here
310 READ TITLE$, DOC.NAME$, PAGE.NO, LINE.NO
320 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
330 GOSUB 920 'For trim line and heading space
340 FOR I = 1 TO 6 : LPRINT : NEXT I
350 LPRINT BOLD.ON$; 'Set Emphasized mode
360 LPRINT EXPAND.ON$; 'Set Expanded Print
370 LPRINT TAB(TAB.POS-1);TITLE$
380 LPRINT EXPAND.OFF$; 'Return to normal
390 LPRINT BOLD.OFF$; 'Return to normal
400 FOR I = 1 TO 3 : LPRINT : NEXT I
410 LPRINT BOLD.ON$; 'Set Emphasized mode
420 LPRINT TAB(TAB.POS+12);"ON DISPLAY"
430 LPRINT BOLD.OFF$; 'Return to normal
440 LPRINT : LPRINT : LPRINT
450 LPRINT TAB(TAB.POS+11);"Version 6.0"
460 FOR I = 1 TO 11 : LPRINT : NEXT I
470 LPRINT TAB(TAB.POS+10); DOC.NAME$
480 LINE.NO = LINE.NO + 27
490 '
500 READ REPLY$
510 REM First, change tildes to quotes
520 FOR Q = 1 TO LEN(REPLY$)
530 IF MID$(REPLY$,Q,1)="~"THEN MID$(REPLY$,Q,1)=CHR$(34)
540 NEXT Q
550 IF LEFT$(REPLY$,1) = "." THEN GOSUB 1270: GOTO 500
560 IF LINE.NO > 44 THEN GOSUB 1030
570 REM Print the line if not a command
580 LPRINT TAB(TAB.POS);REPLY$
590 LINE.NO = LINE.NO + 1
600 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
610 GOTO 500
620 REM Data for the Copyright Page
630 DATA ".pa"
640 DATA " "
750 DATA ".vt 31"
870 DATA "Copyright (c) 1983 ... 1989, by:"
880 DATA "Melvin O. Duke."
890 DATA ".sp"
900 DATA "All rights reserved."
910 '
920 REM Top of each page routine
930 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
940 LPRINT
950 LPRINT TAB(30); TRIM.LINE$
960 LPRINT DASHES$ 'Dashes
970 FOR I = 1 TO 6
980 LPRINT
990 NEXT I
1000 LINE.NO = LINE.NO + 6
1010 RETURN
1020 '
1030 REM Bottom of each page Routine
1040 IF PAGE.NO < 1 THEN LPRINT : LPRINT : LPRINT : GOTO 1160
1050 LPRINT TAB(TAB.POS); STRING$(40,45) 'on line 46
1060 LPRINT TAB(TAB.POS+3); TITLE$+" ON DISPLAY. Version 6.0" 'on line 47
1070 IF PAGE.NO MOD 2 = 1 THEN 1110
1080 LPRINT TAB(TAB.POS);"Page";PAGE.NO;
1090 LPRINT TAB(TAB.POS+27);"User's Manual"
1100 GOTO 1160
1110 LPRINT TAB(TAB.POS); "User's Manual";
1120 IF PAGE.NO < 10 THEN DELTA = 34
1130 IF PAGE.NO > 9 THEN DELTA = 33
1140 IF PAGE.NO > 99 THEN DELTA = 32
1150 LPRINT TAB(TAB.POS+DELTA); "Page"; PAGE.NO 'on line 48
1160 LPRINT : LPRINT : LPRINT
1170 LPRINT DASHES$ 'dashes after 51
1180 LPRINT TAB(30); TRIM.LINE$
1190 LPRINT FORM.FEED$;
1200 PAGE.NO = PAGE.NO + 1
1210 LINE.NO = 1
1220 IF REPLY$ = ".eof" THEN 1240 'Bypass after last page
1230 GOSUB 920 'For top of next page
1240 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1250 RETURN
1260 '
1270 REM Command Processor
1280 IF LEFT$(REPLY$,3) = ".h1" THEN 1390
1290 IF LEFT$(REPLY$,3) = ".h2" THEN 1550
1300 IF LEFT$(REPLY$,3) = ".h3" THEN 1660
1310 IF LEFT$(REPLY$,3) = ".sp" THEN 1770
1320 IF LEFT$(REPLY$,4) = ".eof" THEN 1820
1330 IF LEFT$(REPLY$,3) = ".pa" THEN 1860
1340 IF LEFT$(REPLY$,3) = ".pn" THEN PAGE.NO = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3)) : RETURN
1350 IF LEFT$(REPLY$,3) = ".vt" THEN 1930
1360 IF LEFT$(REPLY$,3) = ".pk" THEN 2040
1370 IF LEFT$(REPLY$,3) = ".in" THEN 2170
1380 STOP
1390 REM Head 1 Processor
1400 FOR I = LINE.NO TO 44
1410 LPRINT
1420 NEXT I
1430 GOSUB 1030 'Bottom of page Routine
1440 IF PAGE.NO MOD 2 = 0 THEN GOSUB 1860 'For h1 on Odd pages
1450 LPRINT BOLD.ON$; 'Set emphasized print
1460 LPRINT EXPAND.ON$; 'Set expanded print
1470 IF PAGE.NO MOD 2 = 0 THEN ADJUST = -2 ELSE ADJUST = -5
1480 LPRINT TAB(TAB.POS+ADJUST); RIGHT$(REPLY$,LEN(REPLY$)-4)
1490 LPRINT EXPAND.OFF$; 'Return to normal
1500 LPRINT BOLD.OFF$; 'Return to non-bold
1510 LINE.NO = LINE.NO+1
1520 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1530 RETURN
1540 '
1550 REM Head 2 Processor
1560 IF LINE.NO = 7 THEN 1580 'skip spacing if at top of page
1570 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1580 LPRINT BOLD.ON$; 'Set emphasized print
1590 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1600 LPRINT BOLD.OFF$; 'Return to normal
1610 LPRINT
1620 LINE.NO = LINE.NO + 2
1630 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1640 RETURN
1650 '
1660 REM Head 3 Processor
1670 IF LINE.NO = 7 THEN 1690 'skip spacing if at top of page
1680 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1690 LPRINT BOLD.ON$; 'Set emphasized print
1700 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1710 LPRINT BOLD.OFF$; 'Return to normal
1720 LPRINT
1730 LINE.NO = LINE.NO + 2
1740 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1750 RETURN
1760 '
1770 REM Single Space Processor
1780 IF LINE.NO = 7 THEN 1800
1790 IF LINE.NO > 44 THEN GOSUB 1860 ELSE LPRINT : LINE.NO = LINE.NO + 1
1800 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1810 RETURN
1820 REM End of File Processor
1830 GOSUB 1860 'Bottom of Page
1850 GOTO 6600
1860 REM Page Eject Processor
1870 FOR I = LINE.NO TO 44
1880 LPRINT
1890 LINE.NO = LINE.NO + 1
1900 NEXT I
1910 GOSUB 1030 'Bottom of Page Processing
1920 RETURN
1930 REM Vertical Tab Processor
1940 IF LINE.NO = 7 THEN 2030
1950 IF LINE.NO > 44 THEN GOSUB 1030 'End of page
1960 QTY = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
1970 FOR I = 1 TO QTY
1980 LPRINT
1990 LINE.NO = LINE.NO + 1
2000 IF LINE.NO > 44 THEN I = QTY
2010 NEXT I
2020 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2030 RETURN
2040 REM Pack Processor
2050 IF LINE.NO > 44 THEN GOSUB 1030
2060 IF TAB.POS = 8 THEN ADJUST = 4
2070 IF TAB.POS = 13 THEN ADJUST = 7
2080 TAB.POS = TAB.POS + ADJUST + INDENT
2090 WIDTH "lpt1:", 132 'set condensed width
2100 LPRINT COMPR.ON$; 'Packed printing
2110 LPRINT TAB(TAB.POS); RIGHT$(REPLY$,LEN(REPLY$)-3)
2120 LPRINT COMPR.OFF$; 'Return to normal
2130 WIDTH "lpt1:", 80 'return to normal
2140 LINE.NO = LINE.NO + 1
2150 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2160 RETURN
2170 REM Indent Processor
2180 INDENT = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
2190 RETURN
3000 DATA ".h1 GENERAL INFORMATION"
3010 DATA ".pn 9"
3020 DATA ".h2 DATA ACCESS REQUIREMENT"
3030 DATA "All of the data files and indexes used"
3040 DATA "by Genealogy ON DISPLAY are expected to"
3050 DATA "be available to any of the programs at"
3060 DATA "the same time. Also, no data-file or"
3070 DATA "index can be split across drives."
3080 DATA ".h2 DESCRIPTION OF FUNCTIONS"
3090 DATA ".h3 File Formatting."
3100 DATA "Programs are provided to permit the user"
3110 DATA "to format one data file which contains"
3120 DATA "information about persons, another data"
3130 DATA "file which contains information about"
3140 DATA "marriages, and a third data file which"
3150 DATA "contains information about ordinances."
3160 DATA ".h3 File Maintenance."
3170 DATA "Programs are provided for the maintenance"
3180 DATA "of the three data files. The user is free"
3190 DATA "to change any information, or to add new"
3200 DATA "information at any time."
3210 DATA ".h3 File Indexes."
3220 DATA "Programs are provided for the formatting"
3230 DATA "of two indexes, one of which relates"
3240 DATA "parents and their children, and the other"
3250 DATA "which relates persons by marriage."
3260 DATA ".h3 Summary Lists."
3270 DATA "Programs are provided which will produce"
3280 DATA "summary lists of the records in the file"
3290 DATA "which contain the personal information,"
3300 DATA "or of the records in the file which con-"
3310 DATA "tain the marriages information."
3320 DATA ".h3 Detailed Data."
3330 DATA "One program is provided which will print"
3340 DATA "either individual records or the entire"
3350 DATA "contents of the Persons File, together"
3360 DATA "with the Ordinances File. A second"
3370 DATA "program is provided which will print"
3380 DATA "either individual records or the entire"
3390 DATA "contents of the Marriages File."
3400 DATA ".h3 Displaying the Genealogy"
3410 DATA "Once the data files are as complete as"
3420 DATA "possible, and the indexes have been"
3430 DATA "prepared, then the DISPLAY Program can be"
3440 DATA "used to display the information about a"
3450 DATA "person (including personal information"
3460 DATA "and church-related information), the"
3470 DATA "information about ancestors, and the"
3480 DATA "information about families."
3490 DATA ".pa
3500 DATA ".h3 Printing Charts of Ancestors"
3510 DATA "Once the data files are as complete as"
3520 DATA "possible, and the indexes have been"
3530 DATA "prepared, then the ANCESTOR Program"
3540 DATA "can be used to print a chart of the"
3550 DATA "ancestors of any person who is iden-"
3560 DATA "tified by the user."
3570 DATA ".h3 Printing Charts of Families"
3580 DATA "Once the data files are as complete as"
3590 DATA "possible, and the indexes have been"
3600 DATA "prepared, then the FAMILY Program can"
3610 DATA "be used to print a chart of the family"
3620 DATA "for any marriage which is identified"
3630 DATA "by the user."
3640 DATA ".h3 Producing Charts of Descendants"
3650 DATA "Once the data files are as complete as"
3660 DATA "possible, and the indexes have been"
3670 DATA "prepared, then the DESCEND Program can"
3680 DATA "be used to display (and optionally"
3690 DATA "print) a chart of the descendants of"
3700 DATA "any person who is identified by the"
3710 DATA "user."
3720 DATA ".pa"
3730 DATA ".h2 DEFINITION OF TERMS"
3740 DATA ".h3 Information About Persons."
3750 DATA "Personal information is that information"
3760 DATA "that is unique to a person. It includes"
3770 DATA "the person's name, his date of birth, the"
3780 DATA "location of his birth, and his parents."
3790 DATA "It also contains (if appropriate) the"
3800 DATA "same type of information about a person's"
3810 DATA "death and burial."
3820 DATA ".h3 Information About Ancestors."
3830 DATA "Ancestor information is that information"
3840 DATA "which shows the parents, grandparents,"
3850 DATA "etc., about a person. It encompases the"
3860 DATA "direct ancestry of the person."
3870 DATA ".h3 Information About Families."
3880 DATA "Family information is that information"
3890 DATA "about a marriage, and the children of the"
3900 DATA "marriage. It includes the location and"
3910 DATA "date of the marriage, as well as birth-"
3920 DATA "dates, birth-places, and other informa-"
3930 DATA "tion about the children, such as marriage"
3940 DATA "dates, and names of the spouse of each"
3950 DATA "child."
3960 DATA ".pa"
3970 DATA ".h3 Information About Descendants."
3980 DATA "Descendants information is that infor-"
3990 DATA "mation about a person, that person's"
4000 DATA "marriages, that person's children, the"
4010 DATA "marriages of those children, the child-"
4020 DATA "ren of those children, etc., etc."
4030 DATA ".sp"
4040 DATA "It includes references to each person's"
4050 DATA "birthdate and deathdate, each marriage,"
4060 DATA "and the date of that marriage."
4070 DATA ".h2 Information About Ordinances."
4080 DATA "Ordinance information is information"
4090 DATA "about (LDS) church-related events in a"
4100 DATA "person's life."
4110 DATA ".pa"
4120 DATA ".h2 EXPLANATION OF GENERAL CONCEPTS"
4130 DATA "Genealogy is concerned with information"
4140 DATA "about any number of direct ancestors,"
4150 DATA "reaching backward as many generations"
4160 DATA "as possible. It is also concerned with"
4170 DATA "family groups, with spouses, and with"
4180 DATA "children within the family groups."
4190 DATA ".sp"
4200 DATA "Keeping track of the broad and varied"
4210 DATA "relationships is a tedious manual task."
4220 DATA ".sp"
4230 DATA "Genealogy ON DISPLAY provides the basis"
4240 DATA "for recording and relating these varied"
4250 DATA "relationships by utilizing two data"
4260 DATA "files and two indexes. The first data"
4270 DATA "file contains information about persons."
4280 DATA "The second data file contains informa-"
4290 DATA "tion about marriages. The first index"
4300 DATA "relates parents and their children."
4310 DATA "The second index relates people with"
4320 DATA "marriages."
4330 DATA ".sp"
4340 DATA "With these two files, and two indexes,"
4350 DATA "Genealogy ON DISPLAY is able to"
4360 DATA "associate every person with every other"
4370 DATA "person, both with parent/child rela-"
4380 DATA "tionships, and with husband/wife"
4390 DATA "relationships."
4400 DATA ".sp"
4410 DATA "A third data file contains additional"
4420 DATA "personal information which is church-"
4430 DATA "related. It contains all of the LDS"
4440 DATA "ordinance information about a person."
4450 DATA ".pa"
4460 DATA ".h3 Persfile"
4470 DATA "The first data file, named PERSFILE,"
4480 DATA "contains all of the personal information"
4490 DATA "about an individual. It also contains a"
4500 DATA "reference to that person's father and"
4510 DATA "mother. Its format and content are:"
4520 DATA ".sp"
4530 DATA "Size Content"
4540 DATA "---- --------------------------"
4550 DATA " 5 Record Number for a Person"
4560 DATA " 20 Surname of person"
4570 DATA " 30 Given names of person"
4580 DATA " 2 Sex"
4590 DATA " 5 Code"
4600 DATA " 5 Father's Record Number"
4610 DATA " 5 Mother's Record Number"
4620 DATA " 11 Birth-date of person"
4630 DATA " 18 Birth-city"
4640 DATA " 16 Birth-county"
4650 DATA " 16 Birth-state or country"
4660 DATA " 11 Death-date"
4670 DATA " 18 Death-city"
4680 DATA " 16 Death-county"
4690 DATA " 16 Death-state or country"
4700 DATA " 11 Burial-date"
4710 DATA " 18 Burial-city"
4720 DATA " 16 Burial-county"
4730 DATA " 16 Burial-state or country"
4740 DATA ".sp"
4750 DATA "Note: Code is available to the user"
4760 DATA "for any special user identification,"
4770 DATA "such as differentiating between"
4780 DATA "natural parents and adoptive parents."
4790 DATA "It is unused by the programs."
4800 DATA ".pa"
4810 DATA ".h3 Marrfile"
4820 DATA "The second data file, named MARRFILE,"
4830 DATA "contains all of the records of marr-"
4840 DATA "iages.Its contents are as follows:"
4850 DATA ".sp"
4860 DATA "Size Content"
4870 DATA "---- --------------------------"
4880 DATA " 5 Record Number of the Marriage"
4890 DATA " 5 Husband's Record-number"
4900 DATA " 5 Wife's Record-number"
4910 DATA " 5 Code"
4920 DATA " 11 Marriage-date"
4930 DATA " 18 Marriage-city"
4940 DATA " 16 Marriage-county"
4950 DATA " 16 Marriage-state or country"
4960 DATA " 45 Comments"
4970 DATA ".sp"
4980 DATA "Note: Code is available to the user"
4990 DATA "for any special user identification,"
5000 DATA "such as differentiating between"
5010 DATA "first and second marriage of spouses."
5020 DATA "It is unused by the programs."
5030 DATA ".pa
5040 DATA ".h3 Pcindex"
5050 DATA "The first index, named PCINDEX,"
5060 DATA "provides the relationships between"
5070 DATA "parents and children. It contains:"
5080 DATA ".sp"
5090 DATA "The Number of Records in the Index."
5100 DATA ".sp"
5110 DATA "For each index record:"
5120 DATA "Parent's Record-number, and Child's"
5130 DATA "Record-number."
5140 DATA ".sp"
5150 DATA "Note: Index records are in sequence"
5160 DATA "by Child's Birthdate within Parent's"
5170 DATA "Record-number."
5180 DATA ".h3 Mindex"
5190 DATA "The second index, named MINDEX,"
5200 DATA "provides the relationships between"
5210 DATA "husbands and wives. It contains:"
5220 DATA ".sp"
5230 DATA "The Number of Records in the Index."
5240 DATA ".sp"
5250 DATA "For each index record:"
5260 DATA "Person's Record-number in the Person's"
5270 DATA "File, followed by the Marriage-number"
5280 DATA "within the Marriage-file."
5290 DATA ".sp"
5300 DATA "Note: Index records are in sequence"
5310 DATA "by Marriage-date within the Person's"
5320 DATA "Record-number."
5330 DATA ".pa"
5340 DATA ".h3 Ordfile"
5350 DATA "The third data file, named ORDFILE"
5360 DATA "contains all (LDS) church-related"
5370 DATA "information about an individual,"
5380 DATA "including all of the ordinance infor-"
5390 DATA "mation. Its contents are as follows:"
5400 DATA "Size Content"
5410 DATA "---- --------------------------"
5420 DATA " 5 Record Number for a Person"
5430 DATA " 11 Christening Date"
5440 DATA " 11 Blessing Date"
5450 DATA " 11 Sealed to Parents Date"
5460 DATA " 5 Father's Record Number"
5470 DATA " 5 Mother's Record Number"
5480 DATA " 11 Baptism Date"
5490 DATA " 11 Confirmation Date"
5500 DATA " 11 Patriarchal Blessing Date"
5510 DATA " 11 Endowment Date"
5520 DATA " 11 Sealed to Spouse Date"
5530 DATA " 5 Spouse's Record Number"
5540 DATA " 11 Aaronic Priesthood Date"
5550 DATA " 11 Deacon Date"
5560 DATA " 11 Teacher Date"
5570 DATA " 11 Priest Date"
5580 DATA " 11 Melchizedek Priesthood Date"
5590 DATA " 11 Elder Date"
5600 DATA " 11 Seventy Date"
5610 DATA " 11 High Priest Date"
5620 DATA " 11 Bishop Date"
5630 DATA " 11 Patriarch Date"
5640 DATA " 11 Apostle Date"
5650 DATA " 26 Occupation"
5660 DATA ".pa"
5670 DATA ".h3 Relationships."
5680 DATA "Because of the relationships carried"
5690 DATA "within the Persons File, ancestor"
5700 DATA "information may be associated backward"
5710 DATA "for any number of generations. There"
5720 DATA "is no specific limit to the number of"
5730 DATA "generations that the Genealogy ON"
5740 DATA "DISPLAY programs will handle."
5750 DATA ".sp"
5760 DATA "Because of the indexes, which relate"
5770 DATA "parents with their children, coupled"
5780 DATA "with the information in the Marriages"
5790 DATA "File, and the index to that file, it"
5800 DATA "is possible to relate any number of"
5810 DATA "persons together in families, showing"
5820 DATA "them in chronological order by the"
5830 DATA "dates of their births."
5840 DATA ".sp"
5850 DATA "(Note: there is no specific limit to"
5860 DATA "the number of families that the"
5870 DATA "Genealogy ON DISPLAY programs will"
5880 DATA "handle, other than the total number"
5890 DATA "of marriages defined.)
5900 DATA ".sp"
5910 DATA "(There is also no limit to the number"
5920 DATA "of children per family.)"
5930 DATA ".pa"
5940 DATA ".h2 BEFORE YOU START"
5950 DATA ".h3 List of Persons"
5960 DATA "Begin by making a numbered list, which"
5970 DATA "contains the people who will be in your"
5980 DATA "Persons File."
5990 DATA ".sp"
6000 DATA "This may look somewhat like:"
6010 DATA ".sp"
6020 DATA "No. Surname Given-Names"
6030 DATA "--- ----------- -----------"
6040 DATA " 1 ABLE Melvin Otto"
6050 DATA " 2 LOVELY Helen Lillian"
6060 DATA " 3 ABLE Melvin Kent"
6070 DATA " 4 ABLE Ronald Robert"
6080 DATA " 5 ABLE Carolyn Elizabeth"
6090 DATA " 6 ABLE Linda Ann"
6100 DATA " 7 ABLE Otto"
6110 DATA " 8 BAKER Beatrice"
6120 DATA "etc. etc. etc."
6130 DATA ".pa"
6140 DATA "Now go back and add the number which you"
6150 DATA "have assigned, which represents each"
6160 DATA "person's father and mother, such as:"
6170 DATA ".sp"
6180 DATA ".pk No. Surname Given-Names Father Mother"
6190 DATA ".pk --- ----------- ----------- ------ ------"
6200 DATA ".pk 1 ABLE Melvin Otto 7 8"
6210 DATA ".pk 2 LOVELY Helen Lillian"
6220 DATA ".pk 3 ABLE Melvin Kent 1 2"
6230 DATA ".pk 4 ABLE Ronald Robert 1 2"
6240 DATA ".pk 5 ABLE Carolyn Elizabeth 1 2"
6250 DATA ".pk 6 ABLE Linda Ann 1 2"
6260 DATA ".pk 7 ABLE Otto"
6270 DATA ".pk 8 BAKER Beatrice"
6280 DATA ".pk etc. etc. etc. etc. etc."
6290 DATA ".sp"
6300 DATA "Note: This is your master list of"
6310 DATA "persons. It will continue to grow as you"
6320 DATA "add more and more names. After you have"
6330 DATA "updated the Persons File with these"
6340 DATA "people, you can produce the list by"
6350 DATA "selecting the LISTPER Program to be"
6360 DATA "run."
6370 DATA ".pa"
6380 DATA ".h3 List of Marriages"
6390 DATA "Now make a second numbered list. Enter"
6400 DATA "the record-numbers of the persons who"
6410 DATA "are married. This may appear as:"
6420 DATA ".sp"
6430 DATA "Marriage Husband's Wife's"
6440 DATA "Number Record-no. Record-no."
6450 DATA "-------- ---------- ----------"
6460 DATA " 1 1 2"
6470 DATA " 2 7 8"
6480 DATA " etc. etc. etc."
6490 DATA ".sp"
6500 DATA "If you find it convenient, you may also"
6510 DATA "want to include names in this list."
6520 DATA ".sp"
6530 DATA "Note: This is your master list of"
6540 DATA "marriages. It will continue to grow as"
6550 DATA "you add more and more marriages. After"
6560 DATA "you have updated the Marriages File,"
6570 DATA "you can produce the list by selecting"
6580 DATA "the LISTMAR Program to be run."
6590 DATA ".eof"
6600 END
INDEXMAR.BAS
100 REM INDEXMAR Program
110 REM Forms the Marriages Index
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Prepare the Marriages Index"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
920 MAX.STACK = 2*INT(SQR(MAX.MAR)+1)
930 IF MAX.STACK < 10 THEN MAX.STACK = 10
940 DIM STACK(MAX.STACK)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM INDEXMAR Program Starts Here
2010 OPEN CC.MARRFILE$ AS #2 LEN = 128
2020 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$
2030 REM Read all records, and count the actual marriages
2040 KEY ON : CLS : KEY OFF
2050 LOCATE 9,1 : PRINT "Counting the number of actual marriages";
2060 FOR I = 1 TO MAX.MAR
2070 GET #2, I
2080 LOCATE 10,1 : PRINT "Processing Marriage Record:"; I;
2090 REM Extract information from the file
2100 T1! = CVS(M1$) : T1 = T1! 'Marriage-id
2110 IF T1 <> I THEN 2150
2120 T2! = CVS(M2$) : T2 = T2! 'Husband-id
2130 T3! = CVS(M3$) : T3 = T3! 'Wife-id
2140 IF T2 <> 0 AND T3 <> 0 THEN M.COUNT = M.COUNT + 1
2150 NEXT I
2160 '
2170 LOCATE 12,1 : PRINT "Reserving Index Space"
2180 DIM REC.NO(2*M.COUNT+1), PERS.ID(2*M.COUNT+1), M.DATE!(2*M.COUNT+1)
2190 '
2200 REM Read all records, and create the index.
2210 C = 0
2220 LOCATE 14,1 : PRINT "Forming Marriage Index Records";
2230 FOR I = 1 TO MAX.MAR
2240 GET #2, I
2250 LOCATE 15,1 : PRINT "Processing Marriage Record:"; I;
2260 REM Extract information from the file
2270 T1! = CVS(M1$) : T1 = T1! 'Marriage-id
2280 IF T1 <> I THEN 2610
2290 T2! = CVS(M2$) : T2 = T2! 'Husband-id
2300 T3! = CVS(M3$) : T3 = T3! 'Wife-id
2310 T5$ = M5$ 'Marriage-date as dd mmm yyyy
2320 IF T5$ = " " THEN MD! = 0 : GOTO 2490
2330 REM convert Marriage Date
2340 MD! = VAL(RIGHT$(T5$,4))*10000!
2350 MO$ = MID$(T5$,4,3)
2360 IF MO$ = "Jan" THEN MD! = MD! + 100 : GOTO 2480
2370 IF MO$ = "Feb" THEN MD! = MD! + 200 : GOTO 2480
2380 IF MO$ = "Mar" THEN MD! = MD! + 300 : GOTO 2480
2390 IF MO$ = "Apr" THEN MD! = MD! + 400 : GOTO 2480
2400 IF MO$ = "May" THEN MD! = MD! + 500 : GOTO 2480
2410 IF MO$ = "Jun" THEN MD! = MD! + 600 : GOTO 2480
2420 IF MO$ = "Jul" THEN MD! = MD! + 700 : GOTO 2480
2430 IF MO$ = "Aug" THEN MD! = MD! + 800 : GOTO 2480
2440 IF MO$ = "Sep" THEN MD! = MD! + 900 : GOTO 2480
2450 IF MO$ = "Oct" THEN MD! = MD! + 1000 : GOTO 2480
2460 IF MO$ = "Nov" THEN MD! = MD! + 1100 : GOTO 2480
2470 IF MO$ = "Dec" THEN MD! = MD! + 1200 : GOTO 2480
2480 MD! = MD! + VAL(LEFT$(T5$,2))
2490 REM create the male spouse's index record
2500 IF T2 = 0 THEN 2550 'skip if zero
2510 C = C + 1
2520 REC.NO(C) = T1
2530 PERS.ID(C) = T2
2540 M.DATE!(C) = MD!
2550 REM create the female spouse's index record
2560 IF T3 = 0 THEN 2610 'skip if zero
2570 C = C + 1
2580 REC.NO(C) = T1
2590 PERS.ID(C) = T3
2600 M.DATE!(C) = MD!
2610 NEXT I
2620 CLOSE #2
2630 LOCATE 17,1 : PRINT "There are:"; C; "Index Records"
2640 PRINT "Sort the Index Records into ascending sequence"
2650 REM *** MQUIKSOR Begins Here ***
2660 '
2670 REM Establish Initial Constants
2680 PERS.ID(C+1) = 32766 'Maximum Integer in BASIC
2690 K1 = 0
2700 K2 = C
2710 K3 = 0
2720 LOCATE 20,1 : PRINT "Stack size:";
2730 LOCATE 20,15 : PRINT K3;
2740 '
2750 REM
2760 IF K1 >= K2 THEN 3360
2770 '
2780 REM
2790 J = K2 + 1
2800 I = K1
2810 K5 = INT((K2-K1)/2) + K1
2820 K4 = PERS.ID(K5)
2830 XK4! = M.DATE!(K5)
2840 YK4 = REC.NO(K5)
2850 PERS.ID(K5) = PERS.ID(K1)
2860 M.DATE!(K5) = M.DATE!(K1)
2870 REC.NO(K5) = REC.NO(K1)
2880 PERS.ID(K1) = K4
2890 M.DATE!(K1) = XK4!
2900 REC.NO(K1) = YK4
2910 '
2920 REM Increment I
2930 I = I + 1
2940 IF PERS.ID(I) < K4 THEN 2920
2950 IF PERS.ID(I) = K4 AND M.DATE!(I) < XK4! THEN 2920
2960 '
2970 REM Decrement J
2980 J = J - 1
2990 IF PERS.ID(J) > K4 THEN 2970
3000 IF PERS.ID(J) = K4 AND M.DATE!(J) > XK4! THEN 2970
3010 '
3020 REM Compare I and J
3030 IF J <= I THEN 3110
3040 '
3050 REM Interchange Elements
3060 SWAP PERS.ID(I), PERS.ID(J)
3070 SWAP M.DATE!(I), M.DATE!(J)
3080 SWAP REC.NO(I), REC.NO(J)
3090 GOTO 2920
3100 '
3110 REM Interchange and Test
3120 PERS.ID(K1) = PERS.ID(J)
3130 M.DATE!(K1) = M.DATE!(J)
3140 REC.NO(K1) = REC.NO(J)
3150 PERS.ID(J) = K4
3160 M.DATE!(J) = XK4!
3170 REC.NO(J) = YK4
3180 IF J-K1 < K2-J THEN 3260
3190 '
3200 REM Change the Stack Array
3210 STACK(K3+1) = K1
3220 STACK(K3+2) = J - 1
3230 K1 = J + 1
3240 GOTO 3310
3250 '
3260 REM Change the Stack Array
3270 STACK(K3+1) = J + 1
3280 STACK(K3+2) = K2
3290 K2 = J - 1
3300 '
3310 REM Increment K3 by 2
3320 K3 = K3 + 2
3330 LOCATE 20,15 : PRINT K3;
3340 GOTO 2750
3350 '
3360 REM Test for Sort Complete
3370 IF K3 = 0 THEN 3460
3380 '
3390 REM Remove from Stack
3400 K2 = STACK(K3)
3410 K1 = STACK(K3-1)
3420 K3 = K3 - 2
3430 LOCATE 20,15 : PRINT K3;
3440 GOTO 2750
3450 '
3460 REM Sort is Complete
3470 '
3480 REM Write the Marriage Index
3490 LOCATE 22,1 : PRINT "Writing the Marriage Index"
3500 OPEN CC.MINDEX$ FOR OUTPUT AS #3
3510 WRITE #3,C
3520 FOR I = 1 TO C
3530 WRITE #3, PERS.ID(I)
3540 WRITE #3, REC.NO(I)
3550 NEXT I
3560 CLOSE
3570 PRINT "End of Program"
3580 RUN CC.MENU$
INDEXPC.BAS
100 REM INDEXPC Program
110 REM Forms the Parent/Child Index
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Prepare the Parent/Child Index"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
900 REM Dimension Statements
920 MAX.STACK = 2*INT(SQR(MAX.PER)+1)
930 IF MAX.STACK < 10 THEN MAX.STACK = 10
940 DIM STACK(MAX.STACK)
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM INDEXPC Program Starts Here
2010 OPEN CC.PERSFILE$ AS #1 LEN = 256
2020 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$
2030 REM Read all records, and count the parents.
2040 KEY ON : CLS : KEY OFF
2050 LOCATE 9,1 : PRINT "Counting the number of Actual Parents";
2060 FOR I = 1 TO MAX.PER
2070 GET #1, I
2080 LOCATE 10,1 : PRINT "Processing Person Record:"; I;
2090 REM Extract information from the file
2100 T1! = CVS(F1$) : T1 = T1! 'Child-id
2110 IF T1 <> I THEN 2160
2120 T6! = CVS(F6$) : T6 = T6!
2130 T7! = CVS(F7$) : T7 = T7!
2140 IF T6 <> 0 AND T7 <> 0 THEN PC.COUNT = PC.COUNT + 2 : GOTO 2160
2150 IF T6 <> 0 OR T7 <> 0 THEN PC.COUNT = PC.COUNT + 1
2160 NEXT I
2170 '
2180 LOCATE 12,1 : PRINT "Reserving Index Space"
2190 DIM PA.ID(PC.COUNT+1), CH.ID(PC.COUNT+1), B.DATE!(PC.COUNT+1)
2200 '
2210 REM Read all records, and create the index.
2220 C = 0
2230 LOCATE 14,1 : PRINT "Forming Parent/Child Index Records";
2240 FOR I = 1 TO MAX.PER
2250 GET #1, I
2260 LOCATE 15,1 : PRINT "Processing Person Record:"; I;
2270 REM Extract information from the file
2280 T1! = CVS(F1$) : T1 = T1! 'Child-id
2290 IF T1! <> I THEN 2620
2300 T6! = CVS(F6$) : T6 = T6! 'Father-id
2310 T7! = CVS(F7$) : T7 = T7! 'Mother-id
2320 T8$ = F8$ 'Birthdate as dd mmm yyyy
2330 IF T8$ = " " THEN BD! = 0 : GOTO 2500
2340 REM convert Birthdate
2350 BD! = VAL(RIGHT$(T8$,4))*10000!
2360 MO$ = MID$(T8$,4,3)
2370 IF MO$ = "Jan" THEN BD! = BD! + 100 : GOTO 2490
2380 IF MO$ = "Feb" THEN BD! = BD! + 200 : GOTO 2490
2390 IF MO$ = "Mar" THEN BD! = BD! + 300 : GOTO 2490
2400 IF MO$ = "Apr" THEN BD! = BD! + 400 : GOTO 2490
2410 IF MO$ = "May" THEN BD! = BD! + 500 : GOTO 2490
2420 IF MO$ = "Jun" THEN BD! = BD! + 600 : GOTO 2490
2430 IF MO$ = "Jul" THEN BD! = BD! + 700 : GOTO 2490
2440 IF MO$ = "Aug" THEN BD! = BD! + 800 : GOTO 2490
2450 IF MO$ = "Sep" THEN BD! = BD! + 900 : GOTO 2490
2460 IF MO$ = "Oct" THEN BD! = BD! + 1000 : GOTO 2490
2470 IF MO$ = "Nov" THEN BD! = BD! + 1100 : GOTO 2490
2480 IF MO$ = "Dec" THEN BD! = BD! + 1200 : GOTO 2490
2490 BD! = BD! + VAL(LEFT$(T8$,2))
2500 REM create the father/child index record
2510 IF T6 = 0 THEN 2560 'skip if zero
2520 C = C + 1
2530 CH.ID(C) = T1
2540 PA.ID(C) = T6
2550 B.DATE!(C) = BD!
2560 REM create the mother/child index record
2570 IF T7 = 0 THEN 2620 'skip if zero
2580 C = C + 1
2590 CH.ID(C) = T1
2600 PA.ID(C) = T7
2610 B.DATE!(C) = BD!
2620 NEXT I
2630 CLOSE #1
2640 LOCATE 17,1 : PRINT "There are:"; C; "Index Records"
2650 PRINT "Sort the Index Records into ascending sequence"
2660 REM *** QUICKSORT Begins Here ***
2670 '
2680 REM Establish Initial Constants
2690 PA.ID(C+1) = 32766 'Maximum Integer in BASIC
2700 K1 = 0
2710 K2 = C
2720 K3 = 0
2730 LOCATE 20,1 : PRINT "Stack size:";
2740 LOCATE 20,15 : PRINT K3;
2750 '
2760 REM
2770 IF K1 >= K2 THEN 3370
2780 '
2790 REM
2800 J = K2 + 1
2810 I = K1
2820 K5 = INT((K2-K1)/2) + K1
2830 K4 = PA.ID(K5)
2840 XK4! = B.DATE!(K5)
2850 YK4 = CH.ID(K5)
2860 PA.ID(K5) = PA.ID(K1)
2870 B.DATE!(K5)= B.DATE!(K1)
2880 CH.ID(K5) = CH.ID(K1)
2890 PA.ID(K1) = K4
2900 B.DATE!(K1)= XK4!
2910 CH.ID(K1) = YK4
2920 '
2930 REM Increment I
2940 I = I + 1
2950 IF PA.ID(I) < K4 THEN 2930
2960 IF PA.ID(I) = K4 AND B.DATE!(I) < XK4! THEN 2930
2970 '
2980 REM Decrement J
2990 J = J - 1
3000 IF PA.ID(J) > K4 THEN 2980
3010 IF PA.ID(J) = K4 AND B.DATE!(J) > XK4! THEN 2980
3020 '
3030 REM Compare I and J
3040 IF J <= I THEN 3120
3050 '
3060 REM Interchange Elements
3070 SWAP PA.ID(I), PA.ID(J)
3080 SWAP B.DATE!(I), B.DATE!(J)
3090 SWAP CH.ID(I), CH.ID(J)
3100 GOTO 2930
3110 '
3120 REM Interchange and Test
3130 PA.ID(K1) = PA.ID(J)
3140 B.DATE!(K1)= B.DATE!(J)
3150 CH.ID(K1) = CH.ID(J)
3160 PA.ID(J) = K4
3170 B.DATE!(J) = XK4!
3180 CH.ID(J) = YK4
3190 IF J-K1 < K2-J THEN 3270
3200 '
3210 REM Change the Stack Array
3220 STACK(K3+1) = K1
3230 STACK(K3+2) = J - 1
3240 K1 = J + 1
3250 GOTO 3320
3260 '
3270 REM Change the Stack Array
3280 STACK(K3+1) = J + 1
3290 STACK(K3+2) = K2
3300 K2 = J - 1
3310 '
3320 REM Increment K3 by 2
3330 K3 = K3 + 2
3340 LOCATE 20,15 : PRINT K3;
3350 GOTO 2760
3360 '
3370 REM Test for Sort Complete
3380 IF K3 = 0 THEN 3470
3390 '
3400 REM Remove from Stack
3410 K2 = STACK(K3)
3420 K1 = STACK(K3-1)
3430 K3 = K3 - 2
3440 LOCATE 20,15 : PRINT K3;
3450 GOTO 2760
3460 '
3470 REM Sort is Complete
3480 '
3490 REM Write the Parent/Child Index
3500 LOCATE 22,1 : PRINT "Writing the Parent/Child Index"
3510 OPEN CC.PCINDEX$ FOR OUTPUT AS #2
3520 WRITE #2,C
3530 FOR I = 1 TO C
3540 WRITE #2, PA.ID(I)
3550 WRITE #2, CH.ID(I)
3560 NEXT I
3570 CLOSE
3580 PRINT "End of Program"
3590 RUN CC.MENU$
INTRODUC.BAS
100 REM INTRODUC Program.
110 REM Documentation. Introduction.
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 DATA Genealogy
140 DATA User's Manual
150 DATA -5
160 DATA 1
170 INDENT = 0
180 REM Printer Definitions
190 FORM.FEED$ = CHR$(12)
200 COMPR.OFF$ = CHR$(18) : COMPR.ON$ = CHR$(15)
210 BOLD.OFF$ = CHR$(27)+"F" : BOLD.ON$ = CHR$(27)+"E"
220 EXPAND.OFF$ = CHR$(18) : EXPAND.ON$ = CHR$(14)
230 DASHES$ = "+"+STRING$(54,45)+"+"
240 TRIM.LINE$ = "(Trim-line)"
300 REM Program begins here
310 READ TITLE$, DOC.NAME$, PAGE.NO, LINE.NO
320 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
330 GOSUB 920 'For trim line and heading space
340 FOR I = 1 TO 6 : LPRINT : NEXT I
350 LPRINT BOLD.ON$; 'Set Emphasized mode
360 LPRINT EXPAND.ON$; 'Set Expanded Print
370 LPRINT TAB(TAB.POS-1);TITLE$
380 LPRINT EXPAND.OFF$; 'Return to normal
390 LPRINT BOLD.OFF$; 'Return to normal
400 FOR I = 1 TO 3 : LPRINT : NEXT I
410 LPRINT BOLD.ON$; 'Set Emphasized mode
420 LPRINT TAB(TAB.POS+12);"ON DISPLAY"
430 LPRINT BOLD.OFF$; 'Return to normal
440 LPRINT : LPRINT : LPRINT
450 LPRINT TAB(TAB.POS+11);"Version 6.0"
460 FOR I = 1 TO 11 : LPRINT : NEXT I
470 LPRINT TAB(TAB.POS+10); DOC.NAME$
480 LINE.NO = LINE.NO + 27
490 '
500 READ REPLY$
510 REM First, change tildes to quotes
520 FOR Q = 1 TO LEN(REPLY$)
530 IF MID$(REPLY$,Q,1)="~"THEN MID$(REPLY$,Q,1)=CHR$(34)
540 NEXT Q
550 IF LEFT$(REPLY$,1) = "." THEN GOSUB 1270: GOTO 500
560 IF LINE.NO > 44 THEN GOSUB 1030
570 REM Print the line if not a command
580 LPRINT TAB(TAB.POS);REPLY$
590 LINE.NO = LINE.NO + 1
600 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
610 GOTO 500
620 REM Data for the Copyright Page
630 DATA ".pa"
640 DATA " "
650 DATA ".vt 31"
870 DATA "Copyright (c) 1982 ... 1989, by:"
880 DATA "Melvin O. Duke."
890 DATA ".sp"
900 DATA "All rights reserved."
910 '
920 REM Top of each page routine
930 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
940 LPRINT
950 LPRINT TAB(30); TRIM.LINE$
960 LPRINT DASHES$ 'Dashes
970 FOR I = 1 TO 6
980 LPRINT
990 NEXT I
1000 LINE.NO = LINE.NO + 6
1010 RETURN
1020 '
1030 REM Bottom of each page Routine
1040 IF PAGE.NO < 1 THEN LPRINT : LPRINT : LPRINT : GOTO 1160
1050 LPRINT TAB(TAB.POS); STRING$(40,45) 'on line 46
1060 LPRINT TAB(TAB.POS+3); TITLE$+" ON DISPLAY. Version 6.0" 'on line 47
1070 IF PAGE.NO MOD 2 = 1 THEN 1110
1080 LPRINT TAB(TAB.POS);"Page";PAGE.NO;
1090 LPRINT TAB(TAB.POS+27);"User's Manual"
1100 GOTO 1160
1110 LPRINT TAB(TAB.POS); "User's Manual";
1120 IF PAGE.NO < 10 THEN DELTA = 34
1130 IF PAGE.NO > 9 THEN DELTA = 33
1140 IF PAGE.NO > 99 THEN DELTA = 32
1150 LPRINT TAB(TAB.POS+DELTA); "Page"; PAGE.NO 'on line 48
1160 LPRINT : LPRINT : LPRINT
1170 LPRINT DASHES$ 'dashes after 51
1180 LPRINT TAB(30); TRIM.LINE$
1190 LPRINT FORM.FEED$;
1200 PAGE.NO = PAGE.NO + 1
1210 LINE.NO = 1
1220 IF REPLY$ = ".eof" THEN 1240 'Bypass after last page
1230 GOSUB 920 'For top of next page
1240 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1250 RETURN
1260 '
1270 REM Command Processor
1280 IF LEFT$(REPLY$,3) = ".h1" THEN 1390
1290 IF LEFT$(REPLY$,3) = ".h2" THEN 1550
1300 IF LEFT$(REPLY$,3) = ".h3" THEN 1660
1310 IF LEFT$(REPLY$,3) = ".sp" THEN 1770
1320 IF LEFT$(REPLY$,4) = ".eof" THEN 1820
1330 IF LEFT$(REPLY$,3) = ".pa" THEN 1860
1340 IF LEFT$(REPLY$,3) = ".pn" THEN PAGE.NO = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3)) : RETURN
1350 IF LEFT$(REPLY$,3) = ".vt" THEN 1930
1360 IF LEFT$(REPLY$,3) = ".pk" THEN 2040
1370 IF LEFT$(REPLY$,3) = ".in" THEN 2170
1380 STOP
1390 REM Head 1 Processor
1400 FOR I = LINE.NO TO 44
1410 LPRINT
1420 NEXT I
1430 GOSUB 1030 'Bottom of page Routine
1440 IF PAGE.NO MOD 2 = 0 THEN GOSUB 1860 'For h1 on Odd pages
1450 LPRINT BOLD.ON$; 'Set emphasized print
1460 LPRINT EXPAND.ON$; 'Set expanded print
1470 IF PAGE.NO MOD 2 = 0 THEN ADJUST = -2 ELSE ADJUST = -5
1480 LPRINT TAB(TAB.POS+ADJUST); RIGHT$(REPLY$,LEN(REPLY$)-4)
1490 LPRINT EXPAND.OFF$; 'Return to normal
1500 LPRINT BOLD.OFF$; 'Return to non-bold
1510 LINE.NO = LINE.NO+1
1520 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1530 RETURN
1540 '
1550 REM Head 2 Processor
1560 IF LINE.NO = 7 THEN 1580 'skip spacing if at top of page
1570 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1580 LPRINT BOLD.ON$; 'Set emphasized print
1590 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1600 LPRINT BOLD.OFF$; 'Return to normal
1610 LPRINT
1620 LINE.NO = LINE.NO + 2
1630 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1640 RETURN
1650 '
1660 REM Head 3 Processor
1670 IF LINE.NO = 7 THEN 1690 'skip spacing if at top of page
1680 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1690 LPRINT BOLD.ON$; 'Set emphasized print
1700 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1710 LPRINT BOLD.OFF$; 'Return to normal
1720 LPRINT
1730 LINE.NO = LINE.NO + 2
1740 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1750 RETURN
1760 '
1770 REM Single Space Processor
1780 IF LINE.NO = 7 THEN 1800
1790 IF LINE.NO > 44 THEN GOSUB 1860 ELSE LPRINT : LINE.NO = LINE.NO + 1
1800 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1810 RETURN
1820 REM End of File Processor
1830 GOSUB 1860 'Bottom of Page
1850 GOTO 4890
1860 REM Page Eject Processor
1870 FOR I = LINE.NO TO 44
1880 LPRINT
1890 LINE.NO = LINE.NO + 1
1900 NEXT I
1910 GOSUB 1030 'Bottom of Page Processing
1920 RETURN
1930 REM Vertical Tab Processor
1940 IF LINE.NO = 7 THEN 2030
1950 IF LINE.NO > 44 THEN GOSUB 1030 'End of page
1960 QTY = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
1970 FOR I = 1 TO QTY
1980 LPRINT
1990 LINE.NO = LINE.NO + 1
2000 IF LINE.NO > 44 THEN I = QTY
2010 NEXT I
2020 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2030 RETURN
2040 REM Pack Processor
2050 IF LINE.NO > 44 THEN GOSUB 1030
2060 IF TAB.POS = 8 THEN ADJUST = 4
2070 IF TAB.POS = 13 THEN ADJUST = 7
2080 TAB.POS = TAB.POS + ADJUST + INDENT
2090 WIDTH "lpt1:", 132 'set condensed width
2100 LPRINT COMPR.ON$; 'Packed printing
2110 LPRINT TAB(TAB.POS); RIGHT$(REPLY$,LEN(REPLY$)-3)
2120 LPRINT COMPR.OFF$; 'Return to normal
2130 WIDTH "lpt1:", 80 'return to normal
2140 LINE.NO = LINE.NO + 1
2150 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2160 RETURN
2170 REM Indent Processor
2180 INDENT = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
2190 RETURN
3000 DATA ".h1 INTRODUCTION"
3010 DATA ".pn 1"
3020 DATA ".h2 OVERVIEW"
3030 DATA "The Genealogy ON DISPLAY Programs pro-"
3040 DATA "vide the user with the capability to"
3050 DATA "create and maintain data files which"
3060 DATA "contain information about his or her"
3070 DATA "ancestors and relatives, to interro-"
3080 DATA "gate the contents of the files, and to"
3090 DATA "obtain printouts of charts of ances-"
3100 DATA "tors, charts of families, and charts of"
3110 DATA "descendants in standard formats, using"
3120 DATA "the information from those files."
3130 DATA ".sp"
3140 DATA "Other than the total size of the files,"
3150 DATA "there is no practical limit to the"
3160 DATA "number of generations contained in the"
3170 DATA "files, or capable of being displayed or"
3180 DATA "printed."
3190 DATA ".h2 CAPABILITIES"
3200 DATA "Following are the capabilities of the"
3210 DATA "the group of programs known as the"
3220 DATA "Genealogy ON DISPLAY Programs."
3230 DATA ".pa"
3240 DATA ".h3 Display the Genealogy."
3250 DATA "The DISPLAY Program is one of the four"
3260 DATA "principal programs in the Genealogy ON"
3270 DATA "DISPLAY set of programs. (Note: All of"
3280 DATA "the other programs supplement these four"
3290 DATA "principal programs.)"
3300 DATA ".sp"
3310 DATA "By using the DISPLAY Program, a user may"
3320 DATA "display personal information, ancestors,"
3330 DATA "and family groups, for any person whose"
3340 DATA "records are in the data files."
3350 DATA ".h2 Print Charts of Ancestors"
3360 DATA "The ANCESTOR Program is the second of"
3370 DATA "the four principal programs in the"
3380 DATA "Genealogy ON DISPLAY set of programs."
3390 DATA ".sp"
3400 DATA "By using this program, a user may obtain"
3410 DATA "a printout of a chart of the ancestors"
3420 DATA "of any person whose records are in the"
3430 DATA "data files."
3440 DATA ".pa"
3450 DATA ".h2 Print Charts of Families"
3460 DATA "The FAMILY Program is the third of the"
3470 DATA "four principal programs in the Genealogy"
3480 DATA "ON DISPLAY set of programs."
3490 DATA ".sp
3500 DATA "By using this program, a user may obtain"
3510 DATA "a printout of a chart of the family of"
3520 DATA "any person whose records are in the data"
3530 DATA "files."
3540 DATA ".h2 Produce Charts of Descendants"
3550 DATA "The DESCEND Program is the fourth of"
3560 DATA "the four principal programs in the"
3570 DATA "Genealogy ON DISPLAY set of programs."
3580 DATA ".sp
3590 DATA "By using this program, a user may dis-"
3600 DATA "play (and optionally obtain a printout)"
3610 DATA "a chart of the descendants of any person"
3620 DATA "whose records are in the data files."
3630 DATA ".h3 Format the Data Files."
3640 DATA "Three programs, the CREATPER, the"
3650 DATA "CREATMAR, and the CREATORD Programs,"
3660 DATA "provide formatting of the records in the"
3670 DATA "PERSFILE, the MARRFILE, and the ORDFILE"
3680 DATA "respectively."
3690 DATA ".pa"
3700 DATA ".h3 Update the Data Files."
3710 DATA "Three programs, the UPDATPER, the"
3720 DATA "UPDATMAR, and the UPDATORD Programs,"
3730 DATA "permit update of the records in the"
3740 DATA "PERSFILE, the MARRFILE, and the ORDFILE"
3750 DATA "respectively."
3760 DATA ".h3 Prepare the Indexes."
3770 DATA "Two programs, the INDEXPC and the"
3780 DATA "INDEXMAR programs, prepare the indexes"
3790 DATA "PCINDEX and MINDEX respectively."
3800 DATA ".sp"
3810 DATA "Note: These two indexes are essential"
3820 DATA "to the DISPLAY, ANCESTOR, FAMILY, and"
3830 DATA "DESCEND Programs, as they provide all"
3840 DATA "of the linkages between persons, ances-"
3850 DATA "tors, families, and descendants."
3860 DATA ".h3 List the Records in the Files."
3870 DATA "Two programs, the LISTPER and the"
3880 DATA "LISTMAR Programs, provide listings"
3890 DATA "of the records in the PERSFILE and"
3900 DATA "MARRFILE, respectively. These are"
3910 DATA "one-line summary listings of the"
3920 DATA "records in the files."
3930 DATA ".pa"
3940 DATA ".h3 Printing the Contents of the Files."
3950 DATA "Two programs, the PRINTPER, and the"
3960 DATA "PRINTMAR Programs, provide for print-"
3970 DATA "ing individual records or for complete"
3980 DATA "printouts of the files. The PRINTPER"
3990 DATA "Program provides a combined printout"
4000 DATA "of the PERSFILE and the ORDFILE. The"
4010 DATA "PRINTMAR Program provides a printout"
4020 DATA "of the MARRFILE."
4030 DATA ".h3 Alphabetical Lists."
4040 DATA "Two programs, the ALPHAPER, and the"
4050 DATA "ALPHAMAR Programs, provide alphabetical"
4060 DATA "listings of the persons in the Persons"
4070 DATA "File, and marriages in the Marriages"
4080 DATA "File, respectively. Note: These two"
4090 DATA "lists are very helpful in permitting the"
4100 DATA "user to locate records of persons and of"
4110 DATA "marriages."
4120 DATA ".h3 Parent/Child Index List"
4130 DATA "One program, the LISTPCI Program, pro-"
4140 DATA "vides a list of all persons who are"
4150 DATA "parents, together with the children of"
4160 DATA "those persons."
4170 DATA ".pa"
4180 DATA ".h2 BENEFITS/ADVANTAGES"
4190 DATA "The Genealogy ON DISPLAY Programs pro-"
4200 DATA "vide an organized, cohesive set of"
4210 DATA "programs, to permit a user to create and"
4220 DATA "maintain that person's genealogical"
4230 DATA "information."
4240 DATA ".sp"
4250 DATA "One major advantage of this technique is"
4260 DATA "that the user only enters information a"
4270 DATA "single time, in a single place. Hence,"
4280 DATA "there is never any discrepancy between"
4290 DATA "separate reportings of the data."
4300 DATA ".sp"
4310 DATA "The programs use the relationships be-"
4320 DATA "tween persons for extracting and report-"
4330 DATA "ing the data in meaningful formats."
4340 DATA ".sp"
4350 DATA "Since most genealogical information is"
4360 DATA "not complete, whenever new information"
4370 DATA "is obtained, the user may readily add"
4380 DATA "that new information (or change any"
4390 DATA "erroneous old information) as the user"
4400 DATA "desires."
4410 DATA ".h2 RESULTS"
4420 DATA "The final results are a well-organized"
4430 DATA "set of data files and indices, which"
4440 DATA "permit a user to obtain related infor-"
4450 DATA "mation in formats which are meaningful"
4460 DATA "to that user."
4470 DATA ".pa"
4480 DATA "Charts of Ancestors, Charts of Famil-"
4490 DATA "ies, Charts of Descendants, as well as"
4500 DATA "personal information about each indivi-"
4510 DATA "dual are available upon demand, either"
4520 DATA "on the printer or on the display."
4530 DATA ".h2 REQUIREMENTS"
4540 DATA ".h2 Software Requirements."
4550 DATA "IBM PC DOS (Version 2.1 or later), or"
4560 DATA "a compatible equivalent."
4570 DATA ".sp"
4580 DATA "IBM PC BASIC (PCjr Level or higher), or"
4590 DATA "a compatible equivalent."
4600 DATA ".pa"
4610 DATA ".h3 Hardware Requirements"
4620 DATA "Any member of the IBM PC Family of"
4630 DATA "computers, from the PCjr upward (in-"
4640 DATA "cluding 'Truly-Compatibles), with at"
4650 DATA "least the following:"
4660 DATA ".sp"
4670 DATA " One double-sided Diskette Drive."
4680 DATA ".sp"
4690 DATA " 60K of Main Memory available to the"
4700 DATA " Genealogy ON DISPLAY Programs, after"
4710 DATA " the Operating System and the BASIC"
4720 DATA " Processor have been loaded."
4730 DATA ".sp"
4740 DATA " A printer, such as the IBM Matrix"
4750 DATA " printer, which has the capability"
4760 DATA " of controlling the appearance of the"
4770 DATA " output, including the following:"
4780 DATA ".sp"
4790 DATA " 120 Print Positions"
4800 DATA " For full-sized printouts of the"
4810 DATA " Charts of Ancestors, and Charts"
4820 DATA " of Families, a 132 character"
4830 DATA " (10 char/in) printer is required."
4840 DATA " Normal Printing"
4850 DATA " Compressed Printing"
4860 DATA " Emphasized Printing"
4870 DATA " Form Feed (Page Eject)"
4880 DATA ".eof"
4890 END
LISTMAR.BAS
100 REM LISTMAR Program.
110 REM Prints a List of Marriages
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "List the Marriages File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM LISTMAR Program Starts Here.
2010 REM Prevent common user errors
2020 IF START.MAR < 1 THEN START.MAR = 1
2030 IF START.MAR > MAX.MAR THEN START.MAR = MAX.MAR
2040 REM Open the Persons File
2050 OPEN CC.PERSFILE$ AS #1 LEN = 256
2060 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$
2070 REM open the Marriages File
2080 IF WHERE.LIST = 1 THEN OPEN "lpt1:" FOR OUTPUT AS #3 ELSE OPEN "scrn:" FOR OUTPUT AS #3
2090 OPEN CC.MARRFILE$ AS #2 LEN = 128
2100 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$
2110 REM Read the Marriage Records
2120 KEY ON : CLS : KEY OFF : LOCATE 21,1
2130 IF WHERE.LIST <> 1 THEN KEY ON : CLS : KEY OFF : GOTO 2160
2140 COLOR W,K
2150 PRINT "Listing the Records in the Marriages File"
2160 FF = 0
2170 GOSUB 2190
2180 GOTO 2290
2190 COLOR O,K
2200 PRINT #3, " List of the Records in the Marriages File ";DATE$;" ";TIME$
2210 PRINT #3, " "
2220 PRINT #3, " REC No. MALE SPOUSE";
2230 PRINT #3, TAB(42);" No. FEMALE SPOUSE"
2240 COLOR P,K
2250 PRINT #3, " --- ---- --------------------------";
2260 PRINT #3, TAB(42);" ---- --------------------------"
2270 COLOR W,K
2280 RETURN
2290 REM Get all the records and print them
2300 FOR I = START.MAR TO MAX.MAR
2310 GET #2,I
2320 REM verify if valid record
2330 TT1! = CVS(M1$) : TT1 = TT1!
2340 IF WHERE.LIST <> 1 THEN 2370
2350 COLOR W,K
2360 LOCATE 23,1 : PRINT "Listing Record:"; I;
2370 IF TT1 < 1 THEN 2620
2380 FF = FF + 1
2390 COLOR W,K
2400 PRINT #3, USING "#####"; TT1;
2410 COLOR G,K
2420 REM Male Spouse
2430 TT2! = CVS(M2$) : TT2 = TT2!
2440 IF TT2 = 0 THEN GOSUB 2750 ELSE GET #1, TT2 : GOSUB 2640
2450 REM Print the Male Spouse
2460 PRINT #3, TAB(8);
2470 COLOR W,K
2480 PRINT #3, USING "#####"; TT2;
2490 COLOR G,K
2500 PRINT #3, LEFT$(" "+T2$+", "+T3$,28);
2510 REM Female Spouse
2520 TT3! = CVS(M3$) : TT3 = TT3!
2530 IF TT3 = 0 THEN GOSUB 2750 ELSE GET #1, TT3 : GOSUB 2640
2540 REM Print the Female Spouse
2550 PRINT #3, TAB(42);
2560 COLOR W,K
2570 PRINT #3, USING "#####"; TT3;
2580 COLOR G,K
2590 PRINT #3, LEFT$(" "+T2$+", "+T3$,28)
2600 IF WHERE.LIST <> 1 THEN 2620
2610 IF FF MOD 55 = 0 THEN PRINT #3, FORM.FEED$;: GOSUB 2190
2620 NEXT I
2630 GOTO 2800
2640 REM Routine to Extract Personal Information
2650 T1! = CVS(F1$) : T1 = T1!
2660 T2$ = F2$
2670 FOR J = 1 TO LEN(F2$) -1
2680 IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
2690 T3$ = F3$
2700 NEXT J
2710 FOR J = 1 TO LEN(F3$) -1
2720 IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
2730 NEXT J
2740 RETURN
2750 REM Blank out a Record
2760 T1 = 0
2770 T2$ = ""
2780 T3$ = ""
2790 RETURN
2800 IF WHERE.LIST <> 1 THEN 2830
2810 PRINT #3, FORM.FEED$;
2820 GOTO 2850
2830 COLOR W,K : LOCATE 25,1 : PRINT "Press any key to continue";
2840 A$ = INKEY$ : IF A$ = "" THEN 2840
2850 CLOSE
2860 KEY ON : CLS : KEY OFF : LOCATE 21,1
2870 PRINT "End of Program"
2880 RUN CC.MENU$
LISTPCI.BAS
100 REM LISTPCI Program.
110 REM Prints the Parent/Child Index
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "List the Parent/Child Index"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM LISTPCI Program Starts Here.
2010 OPEN CC.PERSFILE$ AS #1 LEN = 256
2020 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$
2030 IF WHERE.LIST = 1 THEN OPEN "lpt1:" FOR OUTPUT AS #3 ELSE OPEN "scrn:" FOR OUTPUT AS #3
2040 REM Read all records, and print the actual ones
2050 OPEN CC.PCINDEX$ FOR INPUT AS #2
2060 KEY ON : CLS : KEY OFF
2070 LOCATE 4,1 : PRINT "Open the Parent/Child Index"
2080 INPUT #2, PC.COUNT
2090 IF PC.COUNT <> 0 THEN 2140
2100 PRINT "Parent/Child Index has no Index Records"
2110 PRINT "Press any key to continue"
2120 A$ = INKEY$ : IF A$ = "" THEN 2120
2130 GOTO 2750
2140 IF WHERE.LIST <> 1 THEN 2180
2150 LOCATE 19,1
2160 COLOR W,K
2170 PRINT "There are";PC.COUNT;"Parent/Child Index Records in the File"
2180 IF WHERE.LIST <> 1 THEN KEY ON : CLS : KEY OFF
2190 GOSUB 2210
2200 GOTO 2300
2210 COLOR O,K
2220 PRINT #3, "Listing of the Parent/Child Index Records ";DATE$;" ";TIME$
2230 PRINT #3, " "
2240 PRINT #3, "PARENT PARENT-NAME";
2250 PRINT #3, TAB(40);"CHILD CHILD-NAME"
2260 COLOR P,K
2270 PRINT #3, "------ ------------------------";
2280 PRINT #3, TAB(40);"----- ------------------------"
2290 RETURN
2300 FOR I = 1 TO PC.COUNT
2310 INPUT #2, PAR.ID
2320 IF WHERE.LIST <> 1 THEN 2350
2330 COLOR W,K
2340 LOCATE 23,1 : PRINT "Listing Parent/Child Index Record";I
2350 COLOR W,K
2360 PRINT #3, USING "#####"; PAR.ID;
2370 IF PAR.ID = PREV.PAR.ID THEN 2500
2380 GET #1, PAR.ID
2390 REM Extract information from the file for use
2400 T2$ = F2$
2410 T3$ = F3$
2420 FOR J = 1 TO LEN(F2$)-1
2430 IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
2440 NEXT J
2450 FOR J = 1 TO LEN(F3$)-1
2460 IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
2470 NEXT J
2480 PAR.NAME$ = LEFT$(T2$+", "+T3$,31)
2490 PREV.PAR.ID = PAR.ID
2500 COLOR G,K
2510 PRINT #3, TAB(8); PAR.NAME$;
2520 INPUT #2, CHI.ID
2530 COLOR W,K
2540 PRINT #3, TAB(40);: PRINT #3, USING "#####"; CHI.ID;
2550 GET #1, CHI.ID
2560 T2$ = F2$
2570 T3$ = F3$
2580 FOR J = 1 TO LEN(F2$)-1
2590 IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
2600 NEXT J
2610 FOR J = 1 TO LEN(F3$)-1
2620 IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
2630 NEXT J
2640 COLOR G,K
2650 PRINT #3, TAB(47); LEFT$(T2$+", "+T3$,32)
2660 COLOR W,K
2670 IF WHERE.LIST <> 1 THEN 2690
2680 IF I MOD 55 = 0 THEN PRINT #3, FORM.FEED$;: GOSUB 2210
2690 NEXT I
2700 IF WHERE.LIST <> 1 THEN 2730
2710 PRINT #3, FORM.FEED$;
2720 GOTO 2750
2730 COLOR W,K : LOCATE 25,1 : PRINT "Press any key to continue";
2740 A$ = INKEY$ : IF A$ = "" THEN 2740
2750 CLOSE
2760 KEY ON : CLS : KEY OFF : LOCATE 21,1
2770 PRINT "End of Program"
2780 RUN CC.MENU$
LISTPER.BAS
100 REM LISTPER Program.
110 REM Prints a List of Persons
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "List the Persons File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM LISTPER Program Starts Here
2010 REM Prevent common users errors
2020 IF START.PER < 1 THEN START.PER = 1
2030 IF START.PER > MAX.PER THEN START.PER = MAX.PER
2040 OPEN CC.PERSFILE$ AS #1 LEN = 256
2050 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$
2060 IF WHERE.LIST = 1 THEN OPEN "lpt1:" FOR OUTPUT AS #3 ELSE OPEN "scrn:" FOR OUTPUT AS #3
2070 REM Read all records, and print the actual ones
2080 FF = 0
2090 IF WHERE.LIST <> 1 THEN 2130
2100 KEY ON : CLS : KEY OFF : LOCATE 21,1
2110 COLOR W,K
2120 PRINT "Printing a List of Records in the Persons File"
2130 GOSUB 2150
2140 GOTO 2230
2150 COLOR O,K
2160 PRINT #3, " List of the Records in the Persons File ";DATE$;" ";TIME$
2170 PRINT #3, " "
2180 PRINT #3, " REC GIVEN NAMES-SURNAME";TAB(50);"BIRTHDATE FATHER MOTHER
2190 COLOR P,K
2200 PRINT #3, " --- -------------------";TAB(50);"----------- ------ ------
2210 COLOR W,K
2220 RETURN
2230 REM Get all the records and print them
2240 FOR I = START.PER TO MAX.PER
2250 GET #1, I
2260 IF WHERE.LIST <> 1 THEN 2290
2270 COLOR W,K
2280 LOCATE 23,1 : PRINT "Printing Record:";I
2290 REM Extract information from the file for use
2300 T1! = CVS(F1$) : T1 = T1!
2310 IF T1 < 1 THEN 2540
2320 FF = FF + 1
2330 T2$ = F2$
2340 FOR J = 1 TO LEN(F2$)-1
2350 IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
2360 NEXT J
2370 T3$ = F3$
2380 FOR J = 1 TO LEN(F3$)-1
2390 IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
2400 NEXT J
2410 T6! = CVS(F6$) : T6 = T6!
2420 T7! = CVS(F7$) : T7 = T7!
2430 T8$ = F8$
2440 COLOR W,K
2450 PRINT #3, USING "########";T1;
2460 COLOR G,K
2470 PRINT #3, " "; LEFT$(T3$+" "+T2$,39); TAB(50); T8$;
2480 COLOR W,K
2490 PRINT #3, USING " ###### ######";T6, T7
2500 COLOR G,K
2510 IF WHERE.LIST <> 1 THEN 2540
2520 IF FF MOD 55 = 0 THEN PRINT #3, FORM.FEED$;: GOSUB 2150
2530 COLOR W,K
2540 NEXT I
2550 IF WHERE.LIST <> 1 THEN 2580
2560 PRINT #3, FORM.FEED$;
2570 GOTO 2600
2580 COLOR W,K : LOCATE 25,1 : PRINT "Press any key to continue";
2590 A$ = INKEY$ : IF A$ = "" THEN 2590
2600 CLOSE
2610 KEY ON : CLS : KEY OFF : LOCATE 21,1
2620 PRINT "End of Program"
2630 RUN CC.MENU$
MENU.BAS
100 REM MENU Program
110 REM for Version 6.0 of Genealogy ON DISPLAY.
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
200 REM Screen Definitions
210 S1 = 0 'Set Text Mode
220 S2 = 1 'Enable Color
230 S3 = 0 'Active Page
240 '
250 WIDTH "scrn:",80
260 SCREEN S1, S2, S3
300 REM Color Definitions
310 K = 0 'blacK
320 N = 1 'blue (Navy or uNderline)
330 G = 2 'Green
340 B = 3 'cyan (light Blue)
350 R = 4 'Red
360 P = 5 'magenta (Purple)
370 O = 6 'brown (Orange)
380 W = 7 'White
400 REM Disk Definitions
410 DD.MENU$ = "" 'Path to the Menu
420 DD.VERI$ = "" 'Path to the Verifile
430 DD.PROG$ = "" 'Path to the Programs
440 DD.PERS$ = "" 'Path to the Persons File
450 DD.MARR$ = "" 'Path to the Marriages File
460 DD.ORD$ = "no" 'Path to the Ordinances File
470 DD.PCIDX$ = "" 'Path to the Parent/Child Index
480 DD.MARIDX$ = "" 'Path to the Marriages Index
490 REM Printer Definitions
500 PTR.SCRN = 0 'Character sets differ
510 FORM.FEED$ = CHR$(12) 'Form Feed the Paper
520 PAP.SENS.ON$ = CHR$(27)+"9" 'Detect out-of-paper
530 PAP.SENS.OFF$ = CHR$(27)+"8" 'Ignore out-of-paper
540 PAP.LONG$ = CHR$(27)+"C"+CHR$(66) '66 Lines per Page
550 PAP.SHORT$ = CHR$(27)+"C"+CHR$(51) '51 Lines per Page
560 COMPR.ON$ = CHR$(15) 'Compressed Printing ON
570 COMPR.OFF$ = CHR$(18) 'Compressed Printing OFF
580 BOLD.ON$ = CHR$(27)+"E" 'Emphasized Printing ON
590 BOLD.OFF$ = CHR$(27)+"F" 'Emphasized Printing OFF
600 REM Constants
610 MAX.PER = 500 'Maximum Number of Persons
620 MAX.MAR = 200 'Maximum Number of Marriages
630 OLD.MAX.PER = 0 'Previous Maximum Number of Persons
640 OLD.MAX.MAR = 0 'Previous Maximum Number of Marriages
650 MAX.GEN = 30 'Maximum Number of Generations in DESCEND
660 MAX.LINES = 55 'Lines per page in DESCEND
670 CHART.NOS$ = "n" 'Show Person Numbers Instead
680 START.PER = 1 'For beginning lists of Persons
690 START.MAR = 1 'For beginning lists of Marriages
700 GENS = 5 'Generations for ANCESTOR
710 LEFT.SPACE = 10 'Binding Space for FAMILY
720 BEGIN.LTR$ = " " 'Start Alphabetized List
730 END.LTR$ = "Z" 'End Alphabetized List
740 MALE.LTR$ = "M" : MALE.SEX$ = "Male" 'Sex Designators
750 FEMALE.LTR$ = "F" : FEMALE.SEX$ = "Female" 'Sex Designators
760 WIDE = 1 'Narrow Paper (8-1/2 Inches)
770 LENGTH = 2 'Long Paper (11 Inches)
780 FORMS = 1 'Continuous Forms
790 WHERE.LIST = 1 'Lists to the Printer
800 REM Function Key Settings
810 KEY 1, "" 'Function Key 1
820 KEY 2, "" 'Function Key 2
830 KEY 3, "" 'Function Key 3
840 KEY 4, "" 'Function Key 4
850 KEY 5, "" 'Function Key 5
860 KEY 6, "" 'Function Key 6
870 KEY 7, "" 'Function Key 7
880 KEY 8, "" 'Function Key 8
890 KEY 9, "" 'Function Key 9
900 KEY 10, "" 'Function Key 10
910 REM Identify LDS Pre-printed Forms
920 PP.FORMS = 0 '1 if Forms available
930 REM Eliminate CODE
940 CODE$ = "no" 'Delete if Code is Desired
950 REM Prepared by:
960 PREP1$ = "" 'Name & Address, Line 1
970 PREP2$ = "" 'Name & Address, Line 2
980 PREP3$ = "" 'Name & Address, Line 3
990 PREP4$ = "" 'Name & Address, Line 4
1000 REM Titles
1010 TITLE$ = "MENU of Programs in Genealogy"
1020 TITLE$ = TITLE$ + " ON DISPLAY"
1030 VERSION$ = "Version 6.0"
1040 COPY1$ = "Copyright (c) 1982 ... 1989, by:"
1050 COPY2$ = "Melvin O. Duke"
1060 PRICE$ = "$49"
1070 ADDR1$ = "Melvin O. Duke"
1080 ADDR2$ = "P. O. Box 2048"
1090 ADDR3$ = "Morgan Hill, CA 95038-2048"
1100 DATADISK$ = "Have Data Diskette(s) in Place, then Press any key to Continue."
1110 REM Concatenate all Paths and Filenames
1120 CC.MENU$ = DD.MENU$+"menu"
1130 CC.VERIFILE$ = DD.VERI$+"verifile"
1140 CC.CREATPER$ = DD.PROG$+"creatper"
1150 CC.CREATMAR$ = DD.PROG$+"creatmar"
1160 IF DD.ORD$ = "no" THEN 1180
1170 CC.CREATORD$ = DD.PROG$+"creatord"
1180 CC.UPDATPER$ = DD.PROG$+"updatper"
1190 CC.UPDATMAR$ = DD.PROG$+"updatmar"
1200 IF DD.ORD$ = "no" THEN 1220
1210 CC.UPDATORD$ = DD.PROG$+"updatord"
1220 CC.INDEXPC$ = DD.PROG$+"indexpc"
1230 CC.INDEXMAR$ = DD.PROG$+"indexmar"
1240 CC.PRINTPER$ = DD.PROG$+"printper"
1250 CC.PRINTMAR$ = DD.PROG$+"printmar"
1260 CC.LISTPER$ = DD.PROG$+"listper"
1270 CC.LISTMAR$ = DD.PROG$+"listmar"
1280 CC.LISTPCI$ = DD.PROG$+"listpci"
1290 CC.ALPHAPER$ = DD.PROG$+"alphaper"
1300 CC.ALPHAMAR$ = DD.PROG$+"alphamar"
1310 CC.DISPLAY$ = DD.PROG$+"display"
1320 CC.ANCESTOR$ = DD.PROG$+"ancestor"
1330 CC.FAMILY$ = DD.PROG$+"family"
1340 CC.DESCEND$ = DD.PROG$+"descend"
1350 CC.PERSFILE$ = DD.PERS$+"persfile"
1360 CC.MARRFILE$ = DD.MARR$+"marrfile"
1370 IF DD.ORD$ = "no" THEN 1390
1380 CC.ORDFILE$ = DD.ORD$+"ordfile"
1390 CC.PCINDEX$ = DD.PCIDX$+"pcindex"
1400 CC.MINDEX$ = DD.MARIDX$+"mindex"
1410 '
1420 REM Make sure that BASIC was invoked with /s:256
1430 ON ERROR GOTO 1500
1440 OPEN CC.VERIFILE$ AS #1 LEN = 256
1450 ON ERROR GOTO 0
1460 FIELD 1, 128 AS DUMY1$, 128 AS DUMY2$
1470 CLOSE
1480 GOTO 2000
1490 '
1500 IF ERR = 5 THEN 1510 ELSE ON ERROR GOTO 0 : GOTO 1440
1510 REM File Buffer less than 256 bytes
1520 KEY ON : CLS : LOCATE 10,1 : COLOR R,B
1530 PRINT "BASIC must be brought up with /s:256, for Genealogy Records."
1540 PRINT "Program has been Terminated."
1550 PRINT "Enter CONT to return to DOS"
1560 COLOR W,K : STOP
1570 SYSTEM
1580 '
2000 REM Produce the first screen
2010 KEY ON : CLS : KEY OFF
2020 REM Draw the outer double box
2030 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 2300
2040 REM Find the title location
2050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
2060 REM Draw the title box
2070 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 2440
2080 REM Print the title
2090 LOCATE 4,TITLE.POS : PRINT TITLE$
2100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
2110 REM Draw the Contribution box
2120 R1 = 7 : C1 = 18 : R2 = 17 : C2 = 61 : GOSUB 2300
2130 REM Request the Contribution
2140 LOCATE 8,20 : PRINT "If you are using these programs, you are"
2150 LOCATE 9,21 : PRINT "expected to become a Registered User,"
2160 LOCATE 10,20 : PRINT "by making a contribution to the author"
2170 LOCATE 11,23 : PRINT "of the programs ("+PRICE$+" suggested)."
2180 REM Draw the Mailing Label
2190 R1 = 12 : C1 = 25 : R2 = 16 : C2 = 55 : GOSUB 2440
2200 REM Print the Name and Address
2210 LOCATE 13,40-INT(LEN(ADDR1$)/2) : PRINT ADDR1$;
2220 LOCATE 14,40-INT(LEN(ADDR2$)/2) : PRINT ADDR2$;
2230 LOCATE 15,40-INT(LEN(ADDR3$)/2) : PRINT ADDR3$;
2240 REM Draw the Copyright box
2250 R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 2300
2260 REM Print the Copyright
2270 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
2280 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
2290 GOTO 2580
2300 REM subroutine to print a double box
2310 COLOR P
2320 FOR I = R1 + 1 TO R2 - 1
2330 LOCATE I, C1 : PRINT CHR$(186);
2340 LOCATE I, C2 : PRINT CHR$(186);
2350 NEXT I
2360 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
2370 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
2380 LOCATE R1, C1 : PRINT CHR$(201);
2390 LOCATE R1, C2 : PRINT CHR$(187);
2400 LOCATE R2, C1 : PRINT CHR$(200);
2410 LOCATE R2, C2 : PRINT CHR$(188);
2420 COLOR W
2430 RETURN
2440 REM subroutine to print a single box
2450 COLOR B
2460 FOR I = R1 + 1 TO R2 - 1
2470 LOCATE I, C1 : PRINT CHR$(179);
2480 LOCATE I, C2 : PRINT CHR$(179);
2490 NEXT I
2500 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
2510 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,196);
2520 LOCATE R1, C1 : PRINT CHR$(218);
2530 LOCATE R1, C2 : PRINT CHR$(191);
2540 LOCATE R2, C1 : PRINT CHR$(192);
2550 LOCATE R2, C2 : PRINT CHR$(217);
2560 COLOR W
2570 RETURN
2580 REM ask user to press a key to continue
2590 LOCATE 25,1
2600 PRINT "Have Program Diskette in Place, then Press any key to continue.";
2610 A$ = INKEY$ : IF A$ = "" THEN 2610
2620 KEY ON : CLS : KEY OFF
2630 '
2640 REM Prevent Common User Errors
2650 IF WIDE < 1 OR WIDE > 2 THEN WIDE = 1
2660 IF LENGTH < 1 OR LENGTH > 2 THEN LENGTH = 2
2670 IF FORMS < 1 OR FORMS > 2 THEN FORMS = 1
2680 IF PP.FORMS = 1 THEN WIDE = 2
2690 IF PP.FORMS = 1 THEN FORMS = 2
2700 '
2710 REM MENU Selection Starts Here.
2720 REM Draw the Menu itself.
2730 REM Draw the Outer Double Box.
2740 R1 = 1 : C1 = 1 : R2 = 23 : C2 = 79 : GOSUB 2300
2750 REM Draw the Heading Separator.
2760 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3900
2770 REM Draw the Vertical Separators.
2780 R1 = 1 : C1 = 6 : R2 = 23 : C2 = 6 : GOSUB 3970
2790 R1 = 1 : C1 =17 : R2 = 23 : C2 =17 : GOSUB 3970
2800 REM Attach the intersections
2810 COLOR P
2820 LOCATE 3, 6 : PRINT CHR$(197);
2830 LOCATE 3,17 : PRINT CHR$(197);
2840 COLOR W,K
2850 REM Print the content of the menu.
2860 COLOR K,W
2870 LOCATE 2,3 : PRINT "No";
2880 LOCATE 2,8 : PRINT "Name"
2890 LOCATE 2,19 : PRINT "Function of the Program"
2900 COLOR W,K
2910 COLOR K,W : LOCATE 4,3 : PRINT " 1"; : COLOR R,K
2920 LOCATE 4, 8 : PRINT "CREATPER";
2930 LOCATE 4, 19 : PRINT "Creates (FORMATS) a Persons File.";
2940 COLOR K,W : LOCATE 5,3 : PRINT " 2"; : COLOR R,K
2950 LOCATE 5, 8 : PRINT "CREATMAR";
2960 LOCATE 5, 19 : PRINT "Creates (FORMATS) a Marriages File.";
2970 IF DD.ORD$ = "no" THEN 2980 ELSE 3010
2980 COLOR R,K
2990 LOCATE 6,19 : PRINT " **(Formatting of Ordinance File has been Bypassed.)**"
3000 GOTO 3040
3010 COLOR K,W : LOCATE 6,3 : PRINT " 3"; : COLOR R,K
3020 LOCATE 6, 8 : PRINT "CREATORD";
3030 LOCATE 6, 19 : PRINT "Creates (FORMATS) an Ordinances File.";
3040 COLOR K,W : LOCATE 7,3 : PRINT " 4"; : COLOR G,K
3050 LOCATE 7, 8 : PRINT "UPDATPER";
3060 LOCATE 7, 19 : PRINT "Updates Information in the Persons File."
3070 COLOR K,W : LOCATE 8,3 : PRINT " 5"; : COLOR G,K
3080 LOCATE 8, 8 : PRINT "UPDATMAR";
3090 LOCATE 8, 19 : PRINT "Updates Information in the Marriages File."
3100 IF DD.ORD$ = "no" THEN 3110 ELSE 3140
3110 COLOR G,K
3120 LOCATE 9,19 : PRINT " **(Updating of Ordinance File has been Bypassed.)**"
3130 GOTO 3170
3140 COLOR K,W : LOCATE 9,3 : PRINT " 6"; : COLOR G,K
3150 LOCATE 9, 8 : PRINT "UPDATORD";
3160 LOCATE 9, 19 : PRINT "Updates Information in the Ordinances File."
3170 COLOR K,W : LOCATE 10,3 : PRINT " 7"; : COLOR R,K
3180 LOCATE 10, 8 : PRINT "INDEXPC ";
3190 LOCATE 10, 19 : PRINT "Prepares a Parent/Child Index. (For 13, 16, 18 and 19.)";
3200 COLOR K,W : LOCATE 11,3 : PRINT " 8"; : COLOR R,K
3210 LOCATE 11, 8 : PRINT "INDEXMAR";
3220 LOCATE 11, 19 : PRINT "Prepares a Marriages Index. (For 15, 16, 17, 18 and 19.)";
3230 COLOR K,W : LOCATE 12,3 : PRINT " 9"; : COLOR O,K
3240 LOCATE 12, 8 : PRINT "PRINTPER";
3250 LOCATE 12, 19 : PRINT "Prints Detailed Information about Persons.";
3260 COLOR K,W : LOCATE 13,3 : PRINT "10"; : COLOR O,K
3270 LOCATE 13, 8 : PRINT "PRINTMAR";
3280 LOCATE 13, 19 : PRINT "Prints Detailed Information about Marriages."
3290 COLOR K,W : LOCATE 14,3 : PRINT "11"; : COLOR O,K
3300 LOCATE 14, 8 : PRINT "LISTPER ";
3310 LOCATE 14, 19 : PRINT "List of Persons, in Numerical Order."
3320 COLOR K,W : LOCATE 15,3 : PRINT "12"; : COLOR O,K
3330 LOCATE 15, 8 : PRINT "LISTMAR ";
3340 LOCATE 15, 19 : PRINT "List of Marriages, in Numerical Order."
3350 COLOR K,W : LOCATE 16,3 : PRINT "13"; : COLOR O,K
3360 LOCATE 16, 8 : PRINT "LISTPCI ";
3370 LOCATE 16, 19 : PRINT "List of the Parent/Child Index.";
3380 COLOR K,W : LOCATE 17,3 : PRINT "14"; : COLOR O,K
3390 LOCATE 17, 8 : PRINT "ALPHAPER";
3400 LOCATE 17, 19 : PRINT "List of Persons, in Alphabetical Order."
3410 COLOR K,W : LOCATE 18,3 : PRINT "15"; : COLOR O,K
3420 LOCATE 18, 8 : PRINT "ALPHAMAR";
3430 LOCATE 18, 19 : PRINT "List of Marriages, in Alphabetical Order."
3440 COLOR K,W : LOCATE 19,3 : PRINT "16"; : COLOR B,K
3450 LOCATE 19, 8 : PRINT "DISPLAY ";
3460 LOCATE 19, 19 : PRINT "Displays Genealogical Information on the Screen."
3470 COLOR K,W : LOCATE 20,3 : PRINT "17"; : COLOR G,K
3480 LOCATE 20, 8 : PRINT "ANCESTOR";
3490 LOCATE 20, 19 : PRINT "Prints Charts of Ancestors."
3500 COLOR K,W : LOCATE 21,3 : PRINT "18"; : COLOR G,K
3510 LOCATE 21, 8 : PRINT "FAMILY ";
3520 LOCATE 21, 19 : PRINT "Prints Charts of Families."
3530 COLOR K,W : LOCATE 22,3 : PRINT "19"; : COLOR B,K
3540 LOCATE 22, 8 : PRINT "DESCEND";
3550 LOCATE 22, 19 : PRINT "Displays (and Optionally Prints) Charts of Descendants."
3560 COLOR W,K
3570 REM Now obtain User Response
3580 LOCATE 25,2 : PRINT "(0 to quit, 20 to restart the MENU, 21 to return to DOS)";
3590 LOCATE 24,1
3600 LINE INPUT "Type a Program Number, and press the 'enter' key.: "; REPLY$
3610 IF REPLY$ = "" THEN 2620
3620 IF REPLY$ = "0" THEN 4060
3630 REPLY = VAL(REPLY$)
3640 IF REPLY < 0 OR REPLY > 21 THEN 2620
3650 IF REPLY = 21 THEN SYSTEM
3660 IF REPLY = 1 THEN KEY ON : CHAIN CC.CREATPER$,,ALL
3670 IF REPLY = 2 THEN KEY ON : CHAIN CC.CREATMAR$,,ALL
3680 IF DD.ORD$ = "no" THEN 3700
3690 IF REPLY = 3 THEN KEY ON : CHAIN CC.CREATORD$,,ALL
3700 IF REPLY = 4 THEN KEY ON : CHAIN CC.UPDATPER$,,ALL
3710 IF REPLY = 5 THEN KEY ON : CHAIN CC.UPDATMAR$,,ALL
3720 IF DD.ORD$ = "no" THEN 3740
3730 IF REPLY = 6 THEN KEY ON : CHAIN CC.UPDATORD$,,ALL
3740 IF REPLY = 7 THEN KEY ON : CHAIN CC.INDEXPC$ ,,ALL
3750 IF REPLY = 8 THEN KEY ON : CHAIN CC.INDEXMAR$,,ALL
3760 IF REPLY = 9 THEN KEY ON : CHAIN CC.PRINTPER$,,ALL
3770 IF REPLY = 10 THEN KEY ON : CHAIN CC.PRINTMAR$,,ALL
3780 IF REPLY = 11 THEN KEY ON : CHAIN CC.LISTPER$ ,,ALL
3790 IF REPLY = 12 THEN KEY ON : CHAIN CC.LISTMAR$ ,,ALL
3800 IF REPLY = 13 THEN KEY ON : CHAIN CC.LISTPCI$ ,,ALL
3810 IF REPLY = 14 THEN KEY ON : CHAIN CC.ALPHAPER$,,ALL
3820 IF REPLY = 15 THEN KEY ON : CHAIN CC.ALPHAMAR$,,ALL
3830 IF REPLY = 16 THEN KEY ON : CHAIN CC.DISPLAY$ ,,ALL
3840 IF REPLY = 17 THEN KEY ON : CHAIN CC.ANCESTOR$,,ALL
3850 IF REPLY = 18 THEN KEY ON : CHAIN CC.FAMILY$ ,,ALL
3860 IF REPLY = 19 THEN KEY ON : CHAIN CC.DESCEND$ ,,ALL
3870 IF REPLY = 20 THEN KEY ON : RUN CC.MENU$
3880 REM Improper Response
3890 GOTO 2620
3900 REM Subroutine to draw a single horizontal line. Attach to double.
3910 COLOR P
3920 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
3930 LOCATE R1,C1 : PRINT CHR$(199);
3940 LOCATE R1,C2 : PRINT CHR$(182);
3950 COLOR W
3960 RETURN
3970 REM Subroutine to draw a single vertical line. Attach to double.
3980 COLOR P
3990 FOR I = R1 + 1 TO R2 - 1
4000 LOCATE I,C1 : PRINT CHR$(179);
4010 NEXT I
4020 LOCATE R1,C1 : PRINT CHR$(209);
4030 LOCATE R2,C1 : PRINT CHR$(207);
4040 COLOR W
4050 RETURN
4060 KEY ON : CLS
4070 REM Reset the Function Keys
4080 KEY 1, "LIST "
4090 KEY 2, "RUN"+CHR$(13)
4100 KEY 3, "LOAD"+CHR$(34)
4110 KEY 4, "SAVE"+CHR$(34)
4120 KEY 5, "CONT"+CHR$(13)
4130 KEY 6, ","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13)
4140 KEY 7, "TRON"+CHR$(13)
4150 KEY 8, "TROFF"+CHR$(13)
4160 KEY 9, "KEY "
4170 KEY 10, "SCREEN 0,0,0"+CHR$(13)
4180 LOCATE 21,1
4190 PRINT "End of Program"
4200 END
OVERVIEW.BAS
100 REM OVERVIEW Program
110 REM Screen Overview of Genealogy ON DISPLAY
120 REM Copyright 1986 ... 1989 by: Melvin O. Duke
130 KEY OFF
140 SCREEN 0,1,0
150 SCREEN 1 : COLOR 1 : CLS
160 LOCATE 4,10 : PRINT "Genealogy ON DISPLAY";
170 LOCATE 6,14 : PRINT "Version 6.0";
180 LOCATE 10, 8 : PRINT "A User-Supported Program";
190 LOCATE 14,10 : PRINT "By: Melvin O. Duke";
200 LOCATE 16,13 : PRINT "P.O. Box 2048";
210 LOCATE 18, 6 : PRINT "Morgan Hill, CA 95038-2048";
220 LOCATE 23, 1 : PRINT "Press the escape key (Esc) to end, or";
230 LOCATE 24, 1 : PRINT "Press any key to continue at each pause";
240 GOSUB 3870 'pause
250 CLS
260 LOCATE 1,10 : PRINT "CAPABILITIES";
270 LOCATE 4, 2 : PRINT "CHARTS:";
280 LOCATE 4,15 : PRINT "Ancestors";
290 LOCATE 6,15 : PRINT "Families";
300 LOCATE 8,15 : PRINT "Descendants";
310 GOSUB 3870 'pause
320 LOCATE 11, 2 : PRINT "LISTS:";
330 LOCATE 11,15 : PRINT "Persons (numeric)";
340 LOCATE 13,15 : PRINT "Persons (alphabetic)";
350 LOCATE 15,15 : PRINT "Marriages (numeric)";
360 LOCATE 17,15 : PRINT "Marriages (alphabetic)";
370 LOCATE 19,15 : PRINT "Parent/Child Index";
380 GOSUB 3870 'pause
390 LOCATE 22, 2 : PRINT "DETAILS:";
400 LOCATE 22,15 : PRINT "About Persons";
410 LOCATE 24,15 : PRINT "About Marriages";
420 GOSUB 3870 'pause
430 CLS
440 LOCATE 1,10 : PRINT "CAPABILITIES, Cont.";
450 LOCATE 4, 2 : PRINT "SCREEN:";
460 LOCATE 4,15 : PRINT "(This is where";
470 LOCATE 6,15 : PRINT "Genealogy ON DISPLAY";
480 LOCATE 8,15 : PRINT "Got its Name)";
490 LOCATE 12,15 : PRINT "Ancestors";
500 LOCATE 14,15 : PRINT "Families";
510 LOCATE 16,15 : PRINT "Descendants";
520 LOCATE 18,15 : PRINT "Personal Detail";
530 LOCATE 20,15 : PRINT "LDS Ordinances";
540 GOSUB 3870 'pause
550 CLS
560 LOCATE 2,10 : PRINT "DATA STORAGE PRINCIPLE";
570 LOCATE 6, 2 : PRINT "Information Must be Recorded one time";
580 LOCATE 8, 2 : PRINT "only.";
590 GOSUB 3870 'pause
600 LOCATE 13,10 : PRINT "DATA BASE PRINCIPLE";
610 LOCATE 17, 2 : PRINT "Data Storage Must be Separated from";
620 LOCATE 19, 2 : PRINT "Data Presentation.";
630 GOSUB 3870 'pause
640 CLS
650 LOCATE 2,10 : PRINT "FILES";
660 LOCATE 7, 2 : PRINT "DATA FILES:";
670 LOCATE 7,15 : PRINT "Persons File";
680 LOCATE 9,15 : PRINT "Marriages File";
690 LOCATE 11,15 : PRINT "Ordinances File (LDS)";
700 GOSUB 3870 'pause
710 LOCATE 17, 2 : PRINT "INDEXES:";
720 LOCATE 17,15 : PRINT "Parent/Child Index";
730 LOCATE 19,15 : PRINT "Marriage Index";
740 GOSUB 3870 'pause
750 CLS
760 LOCATE 2,10 : PRINT "RECORDS";
770 LOCATE 6, 2 : PRINT "Person Record";
780 R1 = 7 : C1 = 1 : R2 = 9 : C2 = 40 : GOSUB 3970 'box
790 R1 = 7 : C1 = 7 : R2 = 9 : C2 = 7 : GOSUB 4020 'line
800 R1 = 7 : C1 = 30 : R2 = 9 : C2 = 30 : GOSUB 3970 'line
810 R1 = 7 : C1 = 35 : R2 = 9 : C2 = 35 : GOSUB 3970 'line
820 LOCATE 8, 3 : PRINT "P.No";
830 LOCATE 8,10 : PRINT "Vital Statistics";
840 LOCATE 8,31 : PRINT "F.No";
850 LOCATE 8,36 : PRINT "M.No";
860 GOSUB 3870 'pause
870 LOCATE 13, 2 : PRINT "Marriage Record"
880 R1 = 14 : C1 = 1 : R2 = 16 : C2 = 40 : GOSUB 3970 'box
890 R1 = 14 : C1 = 7 : R2 = 16 : C2 = 7 : GOSUB 4020 'line
900 R1 = 14 : C1 = 30 : R2 = 16 : C2 = 30 : GOSUB 4020 'line
910 R1 = 14 : C1 = 35 : R2 = 16 : C2 = 35 : GOSUB 4020 'line
920 LOCATE 15, 3 : PRINT "M.No";
930 LOCATE 15,10 : PRINT "Vital Statistics";
940 LOCATE 15,31 : PRINT "H.No";
950 LOCATE 15,36 : PRINT "W.No";
960 GOSUB 3870 'pause
970 LOCATE 20, 2 : PRINT "Ordinance Record"
980 R1 = 21 : C1 = 1 : R2 = 23 : C2 = 40 : GOSUB 3970 'box
990 R1 = 21 : C1 = 7 : R2 = 23 : C2 = 7 : GOSUB 4020 'box
1000 LOCATE 22, 3 : PRINT "P.No";
1010 LOCATE 22,10 : PRINT "LDS Ordinances";
1020 GOSUB 3870 'pause
1030 CLS
1040 LOCATE 2,10 : PRINT "BUILDING A CHART OF ANCESTORS";
1050 REM Person
1060 LOCATE 14, 2 : PRINT "P F M";
1070 R1 = 13 : C1 = 1 : R2 = 15 : C2 = 13 : GOSUB 3970 'box
1080 R1 = 13 : C1 = 9 : R2 = 15 : C2 = 9 : GOSUB 4020 'line
1090 R1 = 13 : C1 = 11 : R2 = 15 : C2 = 11 : GOSUB 4020 'line
1100 GOSUB 3870 'pause
1110 REM Father
1120 LOCATE 8,10 : PRINT "P F M";
1130 R1 = 7 : C1 = 9 : R2 = 9 : C2 = 21 : GOSUB 3970 'box
1140 R1 = 7 : C1 = 17 : R2 = 9 : C2 = 17 : GOSUB 4020 'line
1150 R1 = 7 : C1 = 19 : R2 = 9 : C2 = 19 : GOSUB 4020 'line
1160 R1 = 13 : C1 = 10 : R2 = 9 : C2 = 10 : GOSUB 4020 'line
1170 GOSUB 3870 'pause
1180 REM Mother
1190 LOCATE 20,12 : PRINT "P F M";
1200 R1 = 19 : C1 = 11 : R2 = 21 : C2 = 23 : GOSUB 3970 'box
1210 R1 = 19 : C1 = 19 : R2 = 21 : C2 = 19 : GOSUB 4020 'line
1220 R1 = 19 : C1 = 21 : R2 = 21 : C2 = 21 : GOSUB 4020 'line
1230 R1 = 15 : C1 = 12 : R2 = 19 : C2 = 12 : GOSUB 4020 'line
1240 GOSUB 3870 'pause
1250 REM Paternal Grandfather
1260 LOCATE 5,18 : PRINT "P F M";
1270 R1 = 4 : C1 = 17 : R2 = 6 : C2 = 29 : GOSUB 3970 'box
1280 R1 = 4 : C1 = 25 : R2 = 6 : C2 = 25 : GOSUB 4020 'line
1290 R1 = 4 : C1 = 27 : R2 = 6 : C2 = 27 : GOSUB 4020 'line
1300 R1 = 6 : C1 = 18 : R2 = 7 : C2 = 18 : GOSUB 4020 'line
1310 GOSUB 3870 'pause
1320 REM Paternal Grandmother
1330 LOCATE 11,20 : PRINT "P F M";
1340 R1 = 10 : C1 = 19 : R2 = 12 : C2 = 31 : GOSUB 3970 'box
1350 R1 = 10 : C1 = 27 : R2 = 12 : C2 = 27 : GOSUB 4020 'line
1360 R1 = 10 : C1 = 29 : R2 = 12 : C2 = 29 : GOSUB 4020 'line
1370 R1 = 9 : C1 = 20 : R2 = 10 : C2 = 20 : GOSUB 4020 'line
1380 GOSUB 3870 'pause
1390 REM Maternal Grandfather
1400 LOCATE 17,20 : PRINT "P F M";
1410 R1 = 16 : C1 = 19 : R2 = 18 : C2 = 31 : GOSUB 3970 'box
1420 R1 = 16 : C1 = 27 : R2 = 18 : C2 = 27 : GOSUB 4020 'line
1430 R1 = 16 : C1 = 29 : R2 = 18 : C2 = 29 : GOSUB 4020 'line
1440 R1 = 18 : C1 = 20 : R2 = 19 : C2 = 20 : GOSUB 4020 'line
1450 GOSUB 3870 'pause
1460 REM Maternal Grandmother
1470 LOCATE 23,22 : PRINT "P F M";
1480 R1 = 22 : C1 = 21 : R2 = 24 : C2 = 33 : GOSUB 3970 'box
1490 R1 = 22 : C1 = 29 : R2 = 24 : C2 = 29 : GOSUB 4020 'line
1500 R1 = 22 : C1 = 31 : R2 = 24 : C2 = 31 : GOSUB 4020 'line
1510 R1 = 22 : C1 = 22 : R2 = 21 : C2 = 22 : GOSUB 4020 'line
1520 GOSUB 3870 'pause
1530 CLS
1540 LOCATE 2,10 : PRINT "INDEXES";
1550 LOCATE 6, 2 : PRINT "Parent/Child Index";
1560 R1 = 7 : C1 = 8 : R2 = 13 : C2 = 28 : GOSUB 3970 'box
1570 R1 = 7 : C1 = 15 : R2 = 13 : C2 = 15 : GOSUB 4020 'line
1580 R1 = 7 : C1 = 21 : R2 = 13 : C2 = 21 : GOSUB 4020 'line
1590 R1 = 9 : C1 = 8 : R2 = 9 : C2 = 28 : GOSUB 4020 'line
1600 R1 = 11 : C1 = 8 : R2 = 11 : C2 = 28 : GOSUB 4020 'line
1610 LOCATE 8, 9 : PRINT "Parent";
1620 LOCATE 8,16 : PRINT "Child";
1630 LOCATE 8,22 : PRINT "B-Date";
1640 LOCATE 10, 9 : PRINT "Parent";
1650 LOCATE 10,16 : PRINT "Child";
1660 LOCATE 10,22 : PRINT "B-Date";
1670 LOCATE 12, 9 : PRINT "Parent";
1680 LOCATE 12,16 : PRINT "Child";
1690 LOCATE 12,22 : PRINT "B-Date";
1700 GOSUB 3870 'pause
1710 LOCATE 16, 2 : PRINT "Marriages Index";
1720 R1 = 17 : C1 = 8 : R2 = 23 : C2 = 28 : GOSUB 3970 'box
1730 R1 = 19 : C1 = 8 : R2 = 19 : C2 = 28 : GOSUB 4020 'line
1740 R1 = 21 : C1 = 8 : R2 = 21 : C2 = 28 : GOSUB 4020 'line
1750 R1 = 17 : C1 = 15 : R2 = 23 : C2 = 15 : GOSUB 4020 'line
1760 R1 = 17 : C1 = 21 : R2 = 23 : C2 = 21 : GOSUB 4020 'line
1770 LOCATE 18, 9 : PRINT "Person";
1780 LOCATE 18,16 : PRINT "Marr.";
1790 LOCATE 18,22 : PRINT "M-Date";
1800 LOCATE 20, 9 : PRINT "Person";
1810 LOCATE 20,16 : PRINT "Marr.";
1820 LOCATE 20,22 : PRINT "M-Date";
1830 LOCATE 22, 9 : PRINT "Person";
1840 LOCATE 22,16 : PRINT "Marr.";
1850 LOCATE 22,22 : PRINT "M-Date";
1860 GOSUB 3870 'pause
1870 CLS
1880 LOCATE 4,14 : PRINT "DATA BASE";
1890 LOCATE 10, 8 : PRINT "A Relationship-Indexed";
1900 LOCATE 12, 8 : PRINT "Data-base Organization";
1910 LOCATE 20, 9 : PRINT "Ties it all together";
1920 GOSUB 3870 'pause
1930 CLS
1940 LOCATE 2,10 : PRINT "BUILDING A CHART OF A FAMILY";
1950 R1 = 10 : C1 = 2 : R2 = 12 : C2 = 11 : GOSUB 3970 'box
1960 LOCATE 11, 3 : PRINT "Marriage";
1970 GOSUB 3870 'pause
1980 R1 = 5 : C1 = 2 : R2 = 7 : C2 = 11 : GOSUB 3970 'box
1990 LOCATE 6, 3 : PRINT "Person";
2000 R1 = 7 : C1 = 20 : R2 = 10 : C2 = 29 : GOSUB 3970 'box
2010 LOCATE 8,21 : PRINT "Marriage";
2020 LOCATE 9,21 : PRINT "Index";
2030 R1 = 7 : C1 = 11 : R2 = 7 : C2 = 20 : GOSUB 4020 'line
2040 R1 = 10 : C1 = 20 : R2 = 10 : C2 = 11 : GOSUB 4020 'line
2050 GOSUB 3870 'pause
2060 R1 = 12 : C1 = 20 : R2 = 16 : C2 = 29 : GOSUB 3970 'box
2070 LOCATE 13,21 : PRINT "Parent/";
2080 LOCATE 14,21 : PRINT " Child";
2090 LOCATE 15,21 : PRINT "Index";
2100 R1 = 16 : C1 = 2 : R2 = 18 : C2 = 11 : GOSUB 3970 'box
2110 LOCATE 17, 3 : PRINT "Child";
2120 R1 = 12 : C1 = 11 : R2 = 12 : C2 = 20 : GOSUB 4020 'line
2130 R1 = 16 : C1 = 20 : R2 = 16 : C2 = 11 : GOSUB 4020 'line
2140 GOSUB 3870 'pause
2150 R1 = 18 : C1 = 2 : R2 = 20 : C2 = 11 : GOSUB 3970 'box
2160 LOCATE 19, 3 : PRINT "Child";
2170 GOSUB 3870 'pause
2180 R1 = 20 : C1 = 2 : R2 = 22 : C2 = 11 : GOSUB 3970 'box
2190 LOCATE 21, 3 : PRINT "Child";
2200 GOSUB 3870 'pause
2210 R1 = 22 : C1 = 2 : R2 = 24 : C2 = 11 : GOSUB 3970 'box
2220 LOCATE 23, 3 : PRINT "Child";
2230 GOSUB 3870 'pause
2240 CLS
2250 LOCATE 2,10 : PRINT "GETTING STARTED";
2260 LOCATE 8, 2 : PRINT "List of Persons";
2270 LOCATE 12, 2 : PRINT "List of Marriages";
2280 LOCATE 16, 2 : PRINT "Available Space for Data";
2290 GOSUB 3870 'pause
2300 CLS
2310 LOCATE 2,10 : PRINT "LIST OF PERSONS";
2320 LOCATE 5, 2 : PRINT "Number Name F.No M.No"
2330 LOCATE 7, 2 : PRINT " 1";
2340 LOCATE 9, 2 : PRINT " 2";
2350 LOCATE 11, 2 : PRINT " 3";
2360 LOCATE 13, 2 : PRINT " 4";
2370 LOCATE 15, 2 : PRINT " 5";
2380 LOCATE 17, 2 : PRINT " 6";
2390 LOCATE 19, 2 : PRINT " 7";
2400 LOCATE 21, 2 : PRINT " 8";
2410 GOSUB 3870 'pause
2420 LOCATE 7,10 : PRINT "You";
2430 GOSUB 3870 'pause
2440 LOCATE 9,10 : PRINT "Your Father";
2450 GOSUB 3870 'pause
2460 LOCATE 11,10 : PRINT "Your Mother";
2470 GOSUB 3870 'pause
2480 LOCATE 7,26 : PRINT " 2";
2490 LOCATE 7,32 : PRINT " 3";
2500 GOSUB 3870 'pause
2510 LOCATE 13,10 : PRINT "Your Spouse";
2520 GOSUB 3870 'pause
2530 CLS
2540 LOCATE 2,10 : PRINT "LIST OF MARRIAGES";
2550 LOCATE 5, 2 : PRINT "M.No. H.No Husband W.No Wife";
2560 LOCATE 7, 2 : PRINT " 1";
2570 LOCATE 9, 2 : PRINT " 2";
2580 LOCATE 11, 2 : PRINT " 3";
2590 LOCATE 13, 2 : PRINT " 4";
2600 LOCATE 15, 2 : PRINT " 5";
2610 LOCATE 17, 2 : PRINT " 6";
2620 LOCATE 19, 2 : PRINT " 7";
2630 LOCATE 21, 2 : PRINT " 8";
2640 GOSUB 3870 'pause
2650 LOCATE 7, 9 : PRINT " 2 Dad";
2660 LOCATE 7,26 : PRINT " 3 Mom";
2670 GOSUB 3870 'pause
2680 LOCATE 9, 9 : PRINT " 1 Mel";
2690 LOCATE 9,26 : PRINT " 4 Helen";
2700 GOSUB 3870 'pause
2710 CLS
2720 LOCATE 10,10 : PRINT "LET'S GET STARTED";
2730 GOSUB 3870 'pause
2740 CLS
2750 LOCATE 3, 6 : PRINT "BRING UP BASIC";
2760 LOCATE 7, 2 : PRINT "Type: basic/s:256";
2770 LOCATE 9, 4 : PRINT "and press the 'enter' key.";
2780 LOCATE 13, 4 : PRINT "(Need a 256 byte file buffer"
2790 LOCATE 15, 4 : PRINT " for the Genealogy Records)"
2800 GOSUB 3870 'pause
2810 CLS
2820 LOCATE 3, 6 : PRINT "BRING UP THE GENEALOGY MENU";
2830 LOCATE 7, 2 : PRINT "Type: run ";CHR$(34);"menu";CHR$(34);
2840 LOCATE 9, 4 : PRINT "and press the 'enter' key.";
2850 GOSUB 3870 'pause
2860 CLS
2870 LOCATE 2,10 : PRINT "CREATE THE DATA FILES";
2880 LOCATE 7, 2 : PRINT "Create (format) the Persons File";
2890 LOCATE 9, 4 : PRINT "Select the CREATPER Program";
2900 GOSUB 3870 'pause
2910 LOCATE 13, 2 : PRINT "Create (format) the Marriages File";
2920 LOCATE 15, 4 : PRINT "Select the CREATMAR Program";
2930 GOSUB 3870 'pause
2940 LOCATE 19, 2 : PRINT "Create (format) the Ordinances File";
2950 LOCATE 21, 4 : PRINT "Select the CREATORD Program";
2960 GOSUB 3870 'pause
2970 CLS
2980 LOCATE 2,10 : PRINT "ENTER YOUR DATA";
2990 LOCATE 6, 2 : PRINT "Enter Personal Information";
3000 LOCATE 8, 4 : PRINT "Select the UPDATPER Program";
3010 GOSUB 3870 'pause
3020 LOCATE 12, 2 : PRINT "Enter Marriage Information";
3030 LOCATE 14, 4 : PRINT "Select the UPDATMAR Program";
3040 GOSUB 3870 'pause
3050 LOCATE 18, 2 : PRINT "Enter Ordinances Information";
3060 LOCATE 20, 4 : PRINT "Select the UPDATORD Program";
3070 GOSUB 3870 'pause
3080 CLS
3090 LOCATE 2,10 : PRINT "FORM THE INDEXES";
3100 LOCATE 6, 2 : PRINT "Form the Parent/Child Index";
3110 LOCATE 8, 4 : PRINT "Select the INDEXPC Program";
3120 LOCATE 10, 6 : PRINT "(Run when Person Records Change)";
3130 GOSUB 3870 'pause
3140 LOCATE 16, 2 : PRINT "Form the Marriages Index";
3150 LOCATE 18, 4 : PRINT "Select the INDEXMAR Program";
3160 LOCATE 20, 6 : PRINT "(Run when Marriage Records Change)";
3170 GOSUB 3870 'pause
3180 CLS
3190 LOCATE 11,10 : PRINT "NOW THE FUN BEGINS";
3200 GOSUB 3870 'pause
3210 CLS
3220 LOCATE 2,10 : PRINT "VIEW YOUR GENEALOGY";
3230 LOCATE 5, 2 : PRINT "Select the DISPLAY Program";
3240 LOCATE 7, 4 : PRINT "View Personal Information";
3250 LOCATE 9, 4 : PRINT "View Ancestors";
3260 LOCATE 11, 4 : PRINT "View Families";
3270 LOCATE 13, 4 : PRINT "View Ordinances";
3280 GOSUB 3870 'pause
3290 LOCATE 18, 2 : PRINT "Select the DESCEND Program";
3300 LOCATE 20, 4 : PRINT "View Descendants";
3310 GOSUB 3870 'pause
3320 CLS
3330 LOCATE 2,10 : PRINT "PAPER FOR THE CHARTS";
3340 LOCATE 5, 2 : PRINT "Narrow (8-1/2 inch), or"
3350 LOCATE 7, 2 : PRINT "Wide (14 inch) Paper";
3360 LOCATE 11, 2 : PRINT "Long (11 inch), or";
3370 LOCATE 13, 2 : PRINT "Short (8-1/2 inch) Paper";
3380 LOCATE 17, 2 : PRINT "Continuous Forms, or";
3390 LOCATE 19, 2 : PRINT "Single Sheets";
3400 GOSUB 3870 'pause
3410 CLS
3420 LOCATE 2,10 : PRINT "PRINT THE CHARTS";
3430 LOCATE 5, 2 : PRINT "Print Charts of Ancestors";
3440 LOCATE 7, 4 : PRINT "Select the ANCESTOR Program";
3450 GOSUB 3870 'pause
3460 LOCATE 11, 2 : PRINT "Print Charts of Families";
3470 LOCATE 13, 4 : PRINT "Select the FAMILY Program";
3480 GOSUB 3870 'pause
3490 LOCATE 17, 2 : PRINT "Print Charts of Descendants";
3500 LOCATE 19, 4 : PRINT "Select the DESCEND Program";
3510 GOSUB 3870 'pause
3520 CLS
3530 LOCATE 2,10 : PRINT "LISTS";
3540 LOCATE 5, 2 : PRINT "List of Persons by Number";
3550 LOCATE 7, 4 : PRINT "Select the LISTPER Program";
3560 GOSUB 3870 'pause
3570 LOCATE 9, 2 : PRINT "Alphabetized List of Persons";
3580 LOCATE 11, 4 : PRINT "Select the ALPHAPER Program";
3590 GOSUB 3870 'pause
3600 LOCATE 13, 2 : PRINT "List of Marriages by Number";
3610 LOCATE 15, 4 : PRINT "Select the LISTMAR Program";
3620 GOSUB 3870 'pause
3630 LOCATE 17, 2 : PRINT "Alphabetized List of Marriages";
3640 LOCATE 19, 4 : PRINT "Select the ALPHAMAR Program";
3650 GOSUB 3870 'pause
3660 LOCATE 21, 2 : PRINT "List the Parent/Child Index";
3670 LOCATE 23, 4 : PRINT "Select the LISTPCI Program";
3680 GOSUB 3870 'pause
3690 CLS
3700 LOCATE 2, 5 : PRINT "PRINT DETAILED INFORMATION";
3710 LOCATE 6, 2 : PRINT "Print Detailed Personal Data";
3720 LOCATE 9, 4 : PRINT "Select the PRINTPER Program";
3730 GOSUB 3870 'pause
3740 LOCATE 14, 2 : PRINT "Print Detailed Marriage Data";
3750 LOCATE 17, 4 : PRINT "Select the PRINTMAR Program";
3760 GOSUB 3870 'pause
3770 CLS
3780 LOCATE 4,10 : PRINT "Genealogy ON DISPLAY";
3790 LOCATE 6,14 : PRINT "Version 6.0";
3800 LOCATE 10, 8 : PRINT "A User-Supported Program";
3810 LOCATE 14,10 : PRINT "By: Melvin O. Duke";
3820 LOCATE 16,13 : PRINT "P.O. Box 2048";
3830 LOCATE 18, 6 : PRINT "Morgan Hill, CA 95038-2048";
3840 LOCATE 23, 1
3850 GOSUB 3870 'pause
3860 GOTO 3900
3870 REM Generalized Pause Routine
3880 A$ = INKEY$
3890 IF A$ = CHR$(27) THEN 3900 ELSE 3940
3900 CLS
3910 SCREEN 0,0,0,0
3920 WIDTH "scrn:",80
3930 GOTO 4070
3940 IF A$ = "" THEN 3880
3950 RETURN
3960 '
3970 REM Generalized Box Routine
3980 REM Entry is R1, C1, R2, C2
3990 LINE (8*C1-4,8*R1-4)-(8*C2-4,8*R2-4),,B
4000 RETURN
4010 '
4020 REM Generalized Line Routine
4030 REM Entry is R1, C1, R2, C2
4040 LINE (8*C1-4,8*R1-4)-(8*C2-4,8*R2-4)
4050 RETURN
4060 '
4070 END
PRINTERS.BAS
100 LPRINT TAB(10);"Changes to Documentation Programs to support Other Printers."
110 LPRINT
120 LPRINT TAB(10);"Each of the documentation programs contains its own text"
130 LPRINT TAB(10);"processor. There is a determination of whether each line"
140 LPRINT TAB(10);"is a command (begun with a period) or is normal text."
150 LPRINT TAB(10);"If it is a command, then additional processing is done,"
160 LPRINT TAB(10);"including the use of some of the characterists of the"
170 LPRINT TAB(10);"printer."
180 LPRINT
190 LPRINT TAB(10);"The definitions for the characters which control the"
200 LPRINT TAB(10);"printer are found in lines 180 to 220 in each of the"
210 LPRINT TAB(10);"documentation programs. They are:"
220 LPRINT
230 LPRINT TAB(10);"Variable Name Purpose"
240 LPRINT TAB(10);"-------------- -------------------------------"
250 LPRINT TAB(10);"FORM.FEED$ Moves Paper to Top of Next Page"
260 LPRINT TAB(10);"COMPR.ON$ Sets Compressed Printing On"
270 LPRINT TAB(10);"COMPR.OFF$ Sets Compressed Printing Off"
280 LPRINT TAB(10);"BOLD.ON$ Sets Emphasized Printing On"
290 LPRINT TAB(10);"BOLD.OFF$ Sets Emphasized Printing Off"
300 LPRINT TAB(10);"EXPAND.ON$ Sets Expanded Printing On"
310 LPRINT TAB(10);"EXPAND.OFF$ Sets Expanded Printing Off"
320 LPRINT
330 LPRINT TAB(10);"The definitions in the lines of the programs should be"
340 LPRINT TAB(10);"changed to the definitions for the printer which you"
350 LPRINT TAB(10);"will be using."
360 FOR I = 1 TO 40 : LPRINT : NEXT I
370 END
PRINTMAR.BAS
100 REM PRINTMAR Program.
110 REM Prints Detailed Marriage Information
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Print the Marriages File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM PRINTMAR Program Starts Here
2010 REM Prevent common user errors
2020 IF START.MAR < 1 THEN START.MAR = 1
2030 IF START.MAR > MAX.MAR THEN START.MAR = MAX.MAR
2040 OPEN CC.PERSFILE$ AS #1 LEN = 256
2050 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$
2060 OPEN CC.MARRFILE$ AS #2 LEN = 128
2070 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$
2080 REM Determine User Wants
2090 KEY ON : CLS : KEY OFF : LOCATE 21,1
2100 PRINT "Enter the Marriage Number to be Printed (0 to quit), or 'all': ";
2110 LINE INPUT REPLY$
2120 IF REPLY$ = "0" THEN 2930
2130 FF = 0
2140 GOTO 2190
2150 LPRINT TAB(10);"Print-out of Contents of the Marriages File"
2160 LPRINT TAB(10);DATE$,TIME$
2170 LPRINT
2180 RETURN
2190 IF LEFT$(REPLY$,1) = "a" OR LEFT$(REPLY$,1) = "A" THEN 2250
2200 FF = 4
2210 I = VAL(REPLY$)
2220 IF I < 1 OR I > MAX.MAR THEN KEY ON : CLS : KEY OFF : LOCATE 20,1 : PRINT "Number is out of range"; : GOTO 2100
2230 GOSUB 2150
2240 GOSUB 2300 : GOTO 2090
2250 REM Read all records, and print the actual ones
2260 FOR I = START.MAR TO MAX.MAR
2270 LOCATE 22,1 : PRINT "Processing Record";I;
2280 GOSUB 2300
2290 GOTO 2860
2300 GET #2, I
2310 REM Extract information from the file for use
2320 T1! = CVS(M1$) : T1 = T1!
2330 IF T1 < 1 THEN 2850
2340 FF = FF + 1
2350 IF FF MOD 5 = 1 THEN GOSUB 2150
2360 T2! = CVS(M2$) : T2 = T2!
2370 T3! = CVS(M3$) : T3 = T3!
2380 T4! = CVS(M4$)
2390 T5$ = M5$
2400 T6$ = M6$
2410 T7$ = M7$
2420 T8$ = M8$
2430 T9$ = M9$
2440 REM Obtain the name of the Male Spouse
2450 GET #1, T2
2460 REM Obtain the last and given names
2470 TEMP$ = F2$ 'Male Spouse`s last name
2480 TMP$ = F2$
2490 GOSUB 2880
2500 TT2$ = TMP$
2510 TEMP$ = F3$ 'Male Spouse's given names
2520 TMP$ = F3$
2530 GOSUB 2880
2540 TT3$ = TMP$
2550 REM Obtain the name of the Female Spouse
2560 GET #1, T3
2570 REM Obtain the last and given names
2580 TEMP$ = F2$ 'Female Spouse`s last name
2590 TMP$ = F2$
2600 GOSUB 2880
2610 TT4$ = TMP$
2620 TEMP$ = F3$ 'Female Spouse's given names
2630 TMP$ = F3$
2640 GOSUB 2880
2650 TT5$ = TMP$
2660 REM Now Print the Information
2670 LPRINT TAB(10);"Marriage Record-number : ";
2680 LPRINT USING "####"; T1
2690 LPRINT TAB(10);"Male Spouse : ";
2700 LPRINT USING "####"; T2;
2710 LPRINT TAB(42); LEFT$(TT2$+", "+TT3$,37)
2720 LPRINT TAB(10);"Female Spouse : ";
2730 LPRINT USING "####"; T3;
2740 LPRINT TAB(42); LEFT$(TT4$+", "+TT5$,37)
2750 IF CODE$ = "no" THEN 2770
2760 LPRINT TAB(10);"Marriage-code : ";T4!
2770 LPRINT TAB(10);"Marriage-date : ";T5$
2780 LPRINT TAB(10);"Marriage-city : ";T6$
2790 LPRINT TAB(10);"Marriage-county : ";T7$
2800 LPRINT TAB(10);"Marriage-state : ";T8$
2810 LPRINT TAB(10);"Comments: ";T9$
2820 IF CODE$ = "no" THEN LPRINT
2830 LPRINT : LPRINT
2840 IF FF MOD 5 = 0 THEN LPRINT FORM.FEED$;
2850 RETURN
2860 NEXT I
2870 GOTO 2930
2880 REM rtrim$ subroutine
2890 FOR J = 1 TO LEN(TEMP$)-1
2900 IF RIGHT$(TMP$,1)=" " THEN TMP$ = LEFT$(TMP$,LEN(TMP$)-1) ELSE J = LEN(TEMP$)-1
2910 NEXT J
2920 RETURN
2930 CLOSE #1
2940 KEY ON : CLS : KEY OFF : LOCATE 21,1
2950 PRINT "End of Program"
2960 IF (LEFT$(REPLY$,1) = "a" OR LEFT$(REPLY$,1) = "A") AND FF MOD 5 <> 0 THEN 2970 ELSE 2980
2970 LPRINT FORM.FEED$;
2980 RUN CC.MENU$
PRINTPER.BAS
100 REM PRINTPER Program.
110 REM Prints Detailed Personal Information
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Print the Persons "
611 IF DD.ORD$ = "no" THEN 613
612 TITLE$ = TITLE$ + "and Ordinances "
613 TITLE$ = TITLE$ + "File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM PRINTPER Program Starts Here.
2010 IF DD.ORD$ = "no" THEN 2050
2020 OPEN CC.ORDFILE$ AS #2 LEN = 256
2030 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$
2040 REM
2050 OPEN CC.PERSFILE$ AS #1 LEN = 256
2060 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$
2070 REM Read all records, and print the actual ones
2080 KEY ON : CLS : KEY OFF
2090 LOCATE 22,1
2100 PRINT "Enter the Record Number to be Printed (0 to quit) or 'all': ";
2110 LINE INPUT REPLY$
2120 IF LEFT$(REPLY$,1) = "a" OR LEFT$(REPLY$,1) = "A" THEN 2180
2130 IF REPLY$ = "0" THEN 3770
2140 I = VAL(REPLY$)
2150 IF I < 1 OR I > MAX.PER THEN KEY ON : CLS : KEY OFF : LOCATE 22,1 : PRINT "Number is out of range"; : GOTO 2090
2160 GOSUB 2230 'to print
2170 GOTO 2080
2180 IF START.PER < 1 THEN START.PER = 1
2190 KEY ON : CLS : KEY OFF
2200 FOR I = START.PER TO MAX.PER
2210 GOSUB 2230
2220 GOTO 3760
2230 GET #1, I
2240 LOCATE 23,1 : PRINT "Processing Record #";I
2250 REM Extract information from the file for use
2260 T1! = CVS(F1$) : T1 = T1!
2270 IF T1 < 1 THEN 3750 'return
2280 REM Print a Title on Each Page
2290 LPRINT ,"Content of the Persons ";
2300 IF DD.ORD$ = "no" THEN 2320
2310 LPRINT "and Ordinances ";
2320 IF DD.ORD$ = "no" THEN LPRINT "File" ELSE LPRINT "Files"
2330 LPRINT ,DATE$, TIME$
2340 LPRINT
2350 T2$ = F2$
2360 T3$ = F3$
2370 FOR J = 1 TO LEN(F3$)-1
2380 IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
2390 NEXT J
2400 T4$ = F4$
2410 IF LEFT$(T4$,1) = MALE.LTR$ THEN T4$ = MALE.SEX$
2420 IF LEFT$(T4$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.SEX$
2430 T5! = CVS(F5$)
2440 T6! = CVS(F6$) : T6 = T6!
2450 T7! = CVS(F7$) : T7 = T7!
2460 T8$ = F8$
2470 T9$ = F9$
2480 T10$ = F10$
2490 T11$ = F11$
2500 T12$ = F12$
2510 T13$ = F13$
2520 T14$ = F14$
2530 T15$ = F15$
2540 T16$ = F16$
2550 T17$ = F17$
2560 T18$ = F18$
2570 T19$ = F19$
2580 IF DD.ORD$ = "no" THEN 2870
2590 REM Extract Ordinance Information
2600 GET #2, I
2610 U1! = CVS(O1$) : U1 = U1!
2620 REM bypass if no Ordinances Record Present
2630 IF U1 = 0 THEN GOSUB 3880 : GOTO 2870
2640 U2$ = O2$
2650 U3$ = O3$
2660 U4$ = O4$
2670 U5! = CVS(O5$) : U5 = U5!
2680 U6! = CVS(O6$) : U6 = U6!
2690 U7$ = O7$
2700 U8$ = O8$
2710 U9$ = O9$
2720 U10$ = O10$
2730 U11$ = O11$
2740 U12! = CVS(O12$) : U12 = U12!
2750 U13$ = O13$
2760 U14$ = O14$
2770 U15$ = O15$
2780 U16$ = O16$
2790 U17$ = O17$
2800 U18$ = O18$
2810 U19$ = O19$
2820 U20$ = O20$
2830 U21$ = O21$
2840 U22$ = O22$
2850 U23$ = O23$
2860 U24$ = O24$
2870 REM Print out of Personal Information
2880 LPRINT BOLD.ON$;
2890 LPRINT ,"Personal Information"
2900 LPRINT BOLD.OFF$;
2910 LPRINT
2920 LPRINT ,"Record-Number:",T1
2930 LPRINT ,"Surname:",,T2$
2940 LPRINT ,"Given-names:",,T3$
2950 LPRINT ,"Sex:",,T4$
2960 IF CODE$ = "no" THEN 2980
2970 LPRINT ,"Code:",,T5!
2980 LPRINT ,"Father's Record-number:",T6
2990 LPRINT ,"Father's Name: ",
3000 IF T6 = 0 THEN LPRINT : GOTO 3050
3010 GET #1, T6
3020 TMP$ = F2$ : GOSUB 3820 : TT2$ = TMP$
3030 TMP$ = F3$ : GOSUB 3820 : TT3$ = TMP$
3040 LPRINT LEFT$(TT3$ + " " + TT2$,33)
3050 LPRINT ,"Mother's Record-number:",T7
3060 LPRINT ,"Mother's Name: ",
3070 IF T7 = 0 THEN LPRINT : GOTO 3120
3080 GET #1, T7
3090 TMP$ = F2$ : GOSUB 3820 : TT2$ = TMP$
3100 TMP$ = F3$ : GOSUB 3820 : TT3$ = TMP$
3110 LPRINT LEFT$(TT3$ + " " + TT2$,33)
3120 LPRINT ,"Birth-date:",,T8$
3130 LPRINT ,"Birth-city:",,T9$
3140 LPRINT ,"Birth-county:",,T10$
3150 LPRINT ,"Birth-state:",,T11$
3160 LPRINT ,"Death-date:",,T12$
3170 LPRINT ,"Death-city:",,T13$
3180 LPRINT ,"Death-county:",,T14$
3190 LPRINT ,"Death-state:",,T15$
3200 LPRINT ,"Burial-date:",,T16$
3210 LPRINT ,"Burial-city:",,T17$
3220 LPRINT ,"Burial-county:",T18$
3230 LPRINT ,"Burial-state:",,T19$
3240 LPRINT : LPRINT : LPRINT
3250 IF DD.ORD$ = "no" THEN 3740
3260 LPRINT BOLD.ON$;
3270 LPRINT ,"Ordinance Information"
3280 LPRINT BOLD.OFF$;
3290 LPRINT
3300 REM Print the Ordinance Information
3310 LPRINT ,"Christening Date:",U2$
3320 LPRINT ,"Blessing Date:",U3$
3330 LPRINT ,"Sealed to Parents:",U4$
3340 LPRINT ,"Father's Record-Number:",U5
3350 LPRINT ,"Father's Name: ",
3360 IF U5 = 0 THEN LPRINT : GOTO 3410
3370 GET #1, U5
3380 TMP$ = F2$ : GOSUB 3820 : TT2$ = TMP$
3390 TMP$ = F3$ : GOSUB 3820 : TT3$ = TMP$
3400 LPRINT LEFT$(TT3$ + " " + TT2$,33)
3410 LPRINT ,"Mother's Record-Number:",U6
3420 LPRINT ,"Mother's Name: ",
3430 IF U6 = 0 THEN LPRINT : GOTO 3480
3440 GET #1, U6
3450 TMP$ = F2$ : GOSUB 3820 : TT2$ = TMP$
3460 TMP$ = F3$ : GOSUB 3820 : TT3$ = TMP$
3470 LPRINT LEFT$(TT3$ + " " + TT2$,33)
3480 LPRINT ,"Baptism Date:",,U7$
3490 LPRINT ,"Confirmation Date:",U8$
3500 LPRINT ,"Patriarchal Blessing:",U9$
3510 LPRINT ,"Endowment Date:",U10$
3520 IF LEFT$(T4$,1) = "M" THEN 3610
3530 LPRINT ,"Sealed to Husband Date:",U11$
3540 LPRINT ,"Husband's Record-Number:",U12
3550 LPRINT ,"Husband's Name: ",
3560 IF U12 = 0 THEN LPRINT : GOTO 3610
3570 GET #1, U12
3580 TMP$ = F2$ : GOSUB 3820 : TT2$ = TMP$
3590 TMP$ = F3$ : GOSUB 3820 : TT3$ = TMP$
3600 LPRINT LEFT$(TT3$ + " " + TT2$,33)
3610 IF LEFT$(T4$,1) <> "M" THEN 3730
3620 LPRINT ,"Aaronic Priesthood Date:",U13$
3630 LPRINT ,"Deacon Date:",,U14$
3640 LPRINT ,"Teacher Date:",,U15$
3650 LPRINT ,"Priest Date:",,U16$
3660 LPRINT ,"Melchizedek Priesthood:",U17$
3670 LPRINT ,"Elder Date:",,U18$
3680 LPRINT ,"Seventy Date:",,U19$
3690 LPRINT ,"High Priest Date:",U20$
3700 LPRINT ,"Bishop Date:",,U21$
3710 LPRINT ,"Patriarch Date:",U22$
3720 LPRINT ,"Apostle Date:",,U23$
3730 LPRINT ,"Occupation:",,U24$
3740 LPRINT FORM.FEED$;
3750 RETURN
3760 NEXT I
3770 CLOSE #1
3780 CLOSE #2
3790 KEY ON : CLS : KEY OFF : LOCATE 21,1
3800 PRINT "End of Program"
3810 RUN CC.MENU$
3820 REM Right-trim routine
3830 TMP2$ = TMP$
3840 FOR TRM = 1 TO LEN(TMP$)-1
3850 IF RIGHT$(TMP$,1) = " " THEN TMP$ = LEFT$(TMP$,LEN(TMP$)-1) ELSE TRM = LEN(TMP2$)-1
3860 NEXT TRM
3870 RETURN
3880 REM Blank Ordinances if No Ord Record
3890 U2$ = "" : U3$ = "" : U4$ = ""
3900 U5 = 0 : U6 = 0 : U12 = 0
3910 U7$ = "" : U8$ = "" : U9$ = "" : U10$ = ""
3920 U11$ = "" : U13$ = "" : U14$ = "" : U15$ = ""
3930 U16$ = "" : U17$ = "" : U18$ = "" : U19$ = ""
3940 U20$ = "" : U21$ = "" : U22$ = "" : U23$ = ""
3950 U24$ = ""
3960 RETURN
REFERENC.BAS
100 REM REFERENC Program.
110 REM Documentation. Reference Material.
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 DATA Genealogy
140 DATA User's Manual
150 DATA -5
160 DATA 1
170 INDENT = 0
180 REM Printer Definitions
190 FORM.FEED$ = CHR$(12)
200 COMPR.OFF$ = CHR$(18) : COMPR.ON$ = CHR$(15)
210 BOLD.OFF$ = CHR$(27)+"F" : BOLD.ON$ = CHR$(27)+"E"
220 EXPAND.OFF$ = CHR$(18) : EXPAND.ON$ = CHR$(14)
230 DASHES$ = "+"+STRING$(54,45)+"+"
240 TRIM.LINE$ = "(Trim-line)"
300 REM Program begins here
310 READ TITLE$, DOC.NAME$, PAGE.NO, LINE.NO
320 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
330 GOSUB 920 'For trim line and heading space
340 FOR I = 1 TO 6 : LPRINT : NEXT I
350 LPRINT BOLD.ON$; 'Set Emphasized mode
360 LPRINT EXPAND.ON$; 'Set Expanded Print
370 LPRINT TAB(TAB.POS-1);TITLE$
380 LPRINT EXPAND.OFF$; 'Return to normal
390 LPRINT BOLD.OFF$; 'Return to normal
400 FOR I = 1 TO 3 : LPRINT : NEXT I
410 LPRINT BOLD.ON$; 'Set Emphasized mode
420 LPRINT TAB(TAB.POS+12);"ON DISPLAY"
430 LPRINT BOLD.OFF$; 'Return to normal
440 LPRINT : LPRINT : LPRINT
450 LPRINT TAB(TAB.POS+11);"Version 6.0"
460 FOR I = 1 TO 11 : LPRINT : NEXT I
470 LPRINT TAB(TAB.POS+10); DOC.NAME$
480 LINE.NO = LINE.NO + 27
490 '
500 READ REPLY$
510 REM First, change tildes to quotes
520 FOR Q = 1 TO LEN(REPLY$)
530 IF MID$(REPLY$,Q,1)="~"THEN MID$(REPLY$,Q,1)=CHR$(34)
540 NEXT Q
550 IF LEFT$(REPLY$,1) = "." THEN GOSUB 1270: GOTO 500
560 IF LINE.NO > 44 THEN GOSUB 1030
570 REM Print the line if not a command
580 LPRINT TAB(TAB.POS);REPLY$
590 LINE.NO = LINE.NO + 1
600 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
610 GOTO 500
620 REM Data for the Copyright Page
630 DATA ".pa"
640 DATA " "
750 DATA ".vt 31"
870 DATA "Copyright (c) 1983 ... 1989, by:"
880 DATA "Melvin O. Duke."
890 DATA ".sp"
900 DATA "All rights reserved."
910 '
920 REM Top of each page routine
930 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
940 LPRINT
950 LPRINT TAB(30); TRIM.LINE$
960 LPRINT DASHES$ 'Dashes
970 FOR I = 1 TO 6
980 LPRINT
990 NEXT I
1000 LINE.NO = LINE.NO + 6
1010 RETURN
1020 '
1030 REM Bottom of each page Routine
1040 IF PAGE.NO < 1 THEN LPRINT : LPRINT : LPRINT : GOTO 1160
1050 LPRINT TAB(TAB.POS); STRING$(40,45) 'on line 46
1060 LPRINT TAB(TAB.POS+2); TITLE$+" ON DISPLAY. Version 6.0" 'on line 47
1070 IF PAGE.NO MOD 2 = 1 THEN 1110
1080 LPRINT TAB(TAB.POS);"Page";PAGE.NO;
1090 LPRINT TAB(TAB.POS+27);"User's Manual"
1100 GOTO 1160
1110 LPRINT TAB(TAB.POS); "User's Manual";
1120 IF PAGE.NO < 10 THEN DELTA = 34
1130 IF PAGE.NO > 9 THEN DELTA = 33
1140 IF PAGE.NO > 99 THEN DELTA = 32
1150 LPRINT TAB(TAB.POS+DELTA); "Page"; PAGE.NO 'on line 48
1160 LPRINT : LPRINT : LPRINT
1170 LPRINT DASHES$ 'dashes after 51
1180 LPRINT TAB(30); TRIM.LINE$
1190 LPRINT FORM.FEED$;
1200 PAGE.NO = PAGE.NO + 1
1210 LINE.NO = 1
1220 IF REPLY$ = ".eof" THEN 1240 'Bypass after last page
1230 GOSUB 920 'For top of next page
1240 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1250 RETURN
1260 '
1270 REM Command Processor
1280 IF LEFT$(REPLY$,3) = ".h1" THEN 1390
1290 IF LEFT$(REPLY$,3) = ".h2" THEN 1550
1300 IF LEFT$(REPLY$,3) = ".h3" THEN 1660
1310 IF LEFT$(REPLY$,3) = ".sp" THEN 1770
1320 IF LEFT$(REPLY$,4) = ".eof" THEN 1820
1330 IF LEFT$(REPLY$,3) = ".pa" THEN 1860
1340 IF LEFT$(REPLY$,3) = ".pn" THEN PAGE.NO = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3)) : RETURN
1350 IF LEFT$(REPLY$,3) = ".vt" THEN 1930
1360 IF LEFT$(REPLY$,3) = ".pk" THEN 2040
1370 IF LEFT$(REPLY$,3) = ".in" THEN 2170
1380 STOP
1390 REM Head 1 Processor
1400 FOR I = LINE.NO TO 44
1410 LPRINT
1420 NEXT I
1430 GOSUB 1030 'Bottom of page Routine
1440 IF PAGE.NO MOD 2 = 0 THEN GOSUB 1860 'For h1 on Odd pages
1450 LPRINT BOLD.ON$; 'Set emphasized print
1460 LPRINT EXPAND.ON$; 'Set expanded print
1470 IF PAGE.NO MOD 2 = 0 THEN ADJUST = -2 ELSE ADJUST = -5
1480 LPRINT TAB(TAB.POS+ADJUST); RIGHT$(REPLY$,LEN(REPLY$)-4)
1490 LPRINT EXPAND.OFF$; 'Return to normal
1500 LPRINT BOLD.OFF$; 'Return to non-bold
1510 LINE.NO = LINE.NO+1
1520 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1530 RETURN
1540 '
1550 REM Head 2 Processor
1560 IF LINE.NO = 7 THEN 1580 'skip spacing if at top of page
1570 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1580 LPRINT BOLD.ON$; 'Set emphasized print
1590 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1600 LPRINT BOLD.OFF$; 'Return to normal
1610 LPRINT
1620 LINE.NO = LINE.NO + 2
1630 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1640 RETURN
1650 '
1660 REM Head 3 Processor
1670 IF LINE.NO = 7 THEN 1690 'skip spacing if at top of page
1680 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1690 LPRINT BOLD.ON$; 'Set emphasized print
1700 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1710 LPRINT BOLD.OFF$; 'Return to normal
1720 LPRINT
1730 LINE.NO = LINE.NO + 2
1740 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1750 RETURN
1760 '
1770 REM Single Space Processor
1780 IF LINE.NO = 7 THEN 1800
1790 IF LINE.NO > 44 THEN GOSUB 1860 ELSE LPRINT : LINE.NO = LINE.NO + 1
1800 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1810 RETURN
1820 REM End of File Processor
1830 GOSUB 1860 'Bottom of Page
1850 GOTO 6020
1860 REM Page Eject Processor
1870 FOR I = LINE.NO TO 44
1880 LPRINT
1890 LINE.NO = LINE.NO + 1
1900 NEXT I
1910 GOSUB 1030 'Bottom of Page Processing
1920 RETURN
1930 REM Vertical Tab Processor
1940 IF LINE.NO = 7 THEN 2030
1950 IF LINE.NO > 44 THEN GOSUB 1030 'End of page
1960 QTY = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
1970 FOR I = 1 TO QTY
1980 LPRINT
1990 LINE.NO = LINE.NO + 1
2000 IF LINE.NO > 44 THEN I = QTY
2010 NEXT I
2020 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2030 RETURN
2040 REM Pack Processor
2050 IF LINE.NO > 44 THEN GOSUB 1030
2060 IF TAB.POS = 8 THEN ADJUST = 4
2070 IF TAB.POS = 13 THEN ADJUST = 7
2080 TAB.POS = TAB.POS + ADJUST + INDENT
2090 WIDTH "lpt1:", 132 'set condensed width
2100 LPRINT COMPR.ON$; 'Packed printing
2110 LPRINT TAB(TAB.POS); RIGHT$(REPLY$,LEN(REPLY$)-3)
2120 LPRINT COMPR.OFF$; 'Return to normal
2130 WIDTH "lpt1:", 80 'return to normal
2140 LINE.NO = LINE.NO + 1
2150 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2160 RETURN
2170 REM Indent Processor
2180 INDENT = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
2190 RETURN
3000 DATA ".h1 REFERENCE MATERIAL"
3010 DATA ".pn 51"
3020 DATA ".h2 SAMPLE SCREENS AND PROMPTING MESSAGES"
3030 DATA "The following is a sample session, using"
3040 DATA "a One-drive system (e.g. IBM PCjr),"
3050 DATA "where the user wishes to view his"
3060 DATA "Genealogy the screen, through the use of"
3070 DATA "the DISPLAY Program, and where he has"
3080 DATA "included an (LDS) Ordinance File."
3090 DATA ".vt 2"
3100 DATA "He begins in the normal manner. He"
3110 DATA "has the DOS Diskette in place, and has"
3120 DATA "Cartridge BASIC in place since he is"
3130 DATA "using a PCjr."
3140 DATA ".sp"
3150 DATA "He turns the system on, and responds to"
3160 DATA "any messages which ask for date and time."
3170 DATA ".sp"
3180 DATA "He then requests BASIC by typing:"
3190 DATA ".sp"
3200 DATA " basic/s:256"
3210 DATA " and presses the 'enter' key."
3220 DATA ".sp"
3230 DATA "He replaces the DOS Diskette with the"
3240 DATA "Genealogy ON DISPLAY Program Diskette."
3250 DATA ".sp"
3260 DATA "He then starts Genealogy ON DISPLAY"
3270 DATA "by typing:"
3280 DATA ".sp"
3290 DATA " run ~menu~"
3300 DATA " and presses the 'enter' key."
3310 DATA ".pa"
3320 DATA "The display screen then appears as:"
3330 DATA ".sp"
3340 DATA ".vt 3"
3350 DATA ".pk MENU of Programs in Genealogy ON DISPLAY"
3360 DATA ".pk Version 6.0"
3370 DATA ".vt 2"
3380 DATA ".pk If you are using these programs, you are"
3390 DATA ".pk expected to become a Registered User,"
3400 DATA ".pk by making a contribution to the author"
3410 DATA ".pk of the programs ($49 suggested)."
3420 DATA ".sp"
3430 DATA ".pk Melvin O. Duke"
3440 DATA ".pk P. O. Box 2048"
3450 DATA ".pk Morgan Hill, CA 95038-2048"
3460 DATA ".vt 3"
3470 DATA ".pk Copyright (c) 1982 ... 1989, by:"
3480 DATA ".pk Melvin O. Duke"
3490 DATA ".vt 3"
3500 DATA ".pk Have Program Diskette in place, then press any key to continue."
3510 DATA ".sp"
3520 DATA "Since the Program Diskette is already"
3530 DATA "in place, he just presses a key."
3540 DATA ".pa"
3550 DATA "A new screen appears, which shows the"
3560 DATA "available programs. It appears as:"
3570 DATA ".sp"
3580 DATA ".in -3"
3590 DATA ".pk No Name Function of the Program"
3600 DATA ".sp"
3610 DATA ".pk 1 CREATPER Creates (FORMATS) a Persons File."
3620 DATA ".pk 2 CREATMAR Creates (FORMATS) a Marriages File."
3630 DATA ".pk 3 CREATORD Creates (FORMATS) an Ordinances File."
3640 DATA ".pk 4 UPDATPER Updates Information in the Persons File."
3650 DATA ".pk 5 UPDATMAR Updates Information in the Marriages File."
3660 DATA ".pk 6 UPDATORD Updates Information in the Ordinances File."
3670 DATA ".pk 7 INDEXPC Prepares a Parent/Child Index. (For 13, 16, 18 and 19.)"
3680 DATA ".pk 8 INDEXMAR Prepares a Marriages Index. (For 15, 16, 17, 18 and 19.)"
3690 DATA ".pk 9 PRINTPER Prints Detailed Information about Persons."
3700 DATA ".pk 10 PRINTMAR Prints Detailed Information about Marriages."
3710 DATA ".pk 11 LISTPER List of Persons, in Numerical Order."
3720 DATA ".pk 12 LISTMAR List of Marriages, in Numerical Order."
3730 DATA ".pk 13 LISTPCI List of the Parent/Child Index."
3740 DATA ".pk 14 ALPHAPER List of Persons, in Alphabetical Order."
3750 DATA ".pk 15 ALPHAMAR List of Marriages, in Alphabetical Order."
3760 DATA ".pk 16 DISPLAY Displays Genealogical Information on the Screen."
3770 DATA ".pk 17 ANCESTOR Prints Charts of Ancestors."
3780 DATA ".pk 18 FAMILY Prints Charts of Families."
3790 DATA ".pk 19 DESCEND Displays (and Optionally Prints) Charts of Descendants."
3800 DATA ".sp"
3810 DATA ".pk Type a Program Number, and press the 'enter' key.: "
3820 DATA ".pk (0 to quit, 20 to restart the MENU, 21 to return to DOS)"
3830 DATA ".in 0"
3840 DATA ".sp"
3850 DATA "The user selects program 16, by typing"
3860 DATA ".sp"
3870 DATA " 16"
3880 DATA " and presses the enter key."
3890 DATA ".pa"
3900 DATA "The user then sees the logo of the"
3910 DATA "DISPLAY Program as:"
3920 DATA ".vt 3"
3930 DATA ".pk Display Program ON DISPLAY"
3940 DATA ".pk Version 6.0"
3950 DATA ".vt 2"
3960 DATA ".sp"
3970 DATA ".sp"
3980 DATA ".sp"
3990 DATA ".vt 2"
4000 DATA ".sp"
4010 DATA ".sp"
4020 DATA ".sp"
4030 DATA ".sp"
4040 DATA ".pk Copyright (c) 1982 ... 1989 by:"
4050 DATA ".pk Melvin O. Duke"
4060 DATA ".vt 4"
4070 DATA ".pk Have Data Diskette(s) in Place, then Press any key to continue."
4080 DATA ".vt 3"
4090 DATA "The user replaces the Program Diskette"
4100 DATA "with the Data Diskette, then presses a"
4110 DATA "key."
4120 DATA ".pa"
4130 DATA "After pressing a key, the user watches"
4140 DATA "the screen as the indexes are read, and"
4150 DATA "the data files are opened. He sees:"
4160 DATA ".sp"
4170 DATA ".pk Open the Parent/Child Index"
4180 DATA ".pk Reading Index Record #: 592"
4190 DATA ".sp"
4200 DATA ".pk Open the Marriage Index"
4210 DATA ".pk Reading Marriage Index Record #: 262"
4220 DATA ".sp"
4230 DATA ".pk Open the Persons File"
4240 DATA ".sp"
4250 DATA ".pk Open the Marriages File"
4260 DATA ".sp"
4270 DATA ".pk Open the Ordinances File"
4280 DATA ".vt 4"
4290 DATA ".pk Enter the Record-number of a Person?"
4300 DATA ".vt 2"
4310 DATA "The user responds with a number, such as"
4320 DATA "1, as:"
4330 DATA ".sp"
4340 DATA ".pk Enter the Record-number of a Person: 1"
4350 DATA ".pa"
4360 DATA "He then sees:"
4370 DATA ".vt 2"
4380 DATA ".pk Personal Information for: Melvin Otto ABLE Person: 1"
4390 DATA ".sp"
4400 DATA ".pk Person: Person's Vital Statistics:"
4410 DATA ".pk Record-no.: 1"
4420 DATA ".pk Surname: ABLE Birth-date: 5 Oct 1925"
4430 DATA ".pk Given Names: Melvin Otto Birth-city: Salt Lake City"
4440 DATA ".pk Sex: Male Birth-county: Salt Lake"
4450 DATA ".pk Birth-state: Utah"
4460 DATA ".pk Male Parent:"
4470 DATA ".pk Record-no.: 7 Death-date:"
4480 DATA ".pk Surname: ABLE Death-city:"
4490 DATA ".pk Given-names: Otto Death-county:"
4500 DATA ".pk Birth-date: 31 Mar 1899 Death-state:"
4510 DATA ".sp"
4520 DATA ".pk Female Parent: Burial-date:"
4530 DATA ".pk Record-no.: 8 Burial-city:"
4540 DATA ".pk Surname: BAKER Burial-county:"
4550 DATA ".pk Given-names: Beatrice Burial-state:"
4560 DATA ".pk Birth-date: 27 Sep 1902"
4570 DATA ".sp 2"
4580 DATA ".pk Type a Request. Then press the 'enter' key.: "
4590 DATA ".pk (Possible Requests: ps, an, fg, o, p1...pn, m1...mn, q)"
4600 DATA ".pa
4610 DATA "The user asks for a Chart of Ancestors,"
4620 DATA "by typing: an, as:"
4630 DATA ".sp"
4640 DATA ".pk Type a Request. Then press the 'enter' key.? an"
4650 DATA ".sp"
4660 DATA "The user then sees:"
4670 DATA ".vt 2"
4680 DATA ".in -3"
4690 DATA ".pk Ancestors of: Melvin Otto ABLE Person: 1 "
4700 DATA ".sp"
4710 DATA ".pk Birthdate:"
4720 DATA ".pk __8_(40) ABLE, John_____________________ 28 Nov 1834"
4730 DATA ".pk __4_(30) ABLE, James Alfred_____________________ 19 Jan 1866"
4740 DATA ".pk | |_ 9_(47) YOUNGER, Martha Vance__________ 8 Feb 1842"
4750 DATA ".pk __2_(7) ABLE, Otto____________________________________ 31 Mar 1899"
4760 DATA ".pk | | __10_(51) FARMER, Charles_______________ 19 Jan 1833"
4770 DATA ".pk | |_5_(31) FARMER, Janet__________________________ 18 Feb 1876"
4780 DATA ".pk | |_11_(52) BIGBY, Susanna________________ 5 Nov 1834"
4790 DATA ".pk 1_(1) ABLE, Melvin Otto______________________________________ 5 Oct 1925"
4800 DATA ".pk | __12_(82) BAKER, William________________ 12 Apr 1803"
4810 DATA ".pk | __6_(32) BAKER, Jabez Thompson__________________ 26 Apr 1840"
4820 DATA ".pk | | |_ 13_(83) THOMASON, Martha______________ 22 Aug 1805"
4830 DATA ".pk |_3_(8) BAKER, Beatrice________________________________ 27 Sep 1902"
4840 DATA ".pk | __14_(84) SWENSON, Karl Kristian________ 11 Jul 1834"
4850 DATA ".pk |_7_(33) SWENSON, Anna Pauline__________________ 8 Aug 1866"
4860 DATA ".pk |_15_(85) KRALL, Wilhelmina_____________ 23 Mar 1833"
4870 DATA ".vt 2"
4880 DATA ".pk Type a Request. Then press the 'enter' key.: "
4890 DATA ".pk (Possible Requests: ps, an, fg, o, l1...ln, p1...pn, m1...mn, q)"
4900 DATA ".in 0"
4910 DATA ".pa"
4920 DATA "Instead of asking for a Chart of An-"
4930 DATA "cestors, the user may have asked for"
4940 DATA "a Family Group (fg), as:"
4950 DATA ".sp"
4960 DATA ".pk Type a Request. Then press the 'enter' key.? fg"
4970 DATA ".sp"
4980 DATA "The user would then have seen:"
4990 DATA ".vt 2"
5000 DATA ".pk Family Group Marriage: 1"
5010 DATA ".sp"
5020 DATA ".pk Father: (1) ABLE, Melvin Otto Birthdate: 5 Oct 1925"
5030 DATA ".pk Mother: (2) LOVELY, Helen Lillian Birthdate: 13 Jun 1928"
5040 DATA ".sp"
5050 DATA ".pk Marriage Date: 16 Jun 1947 Location: Salt Lake City, Utah"
5060 DATA ".sp"
5070 DATA ".pk No. S Children: Birthdate: Birth Location:"
5080 DATA ".sp"
5090 DATA ".pk 1 M ABLE, Melvin Kent 6 Jan 1949 Salt Lake City, Utah"
5100 DATA ".pk 2 M ABLE, Ronald Robert 24 Jun 1951 Oklahoma City, Oklahoma"
5110 DATA ".pk 3 F ABLE, Carolyn Elizabeth 26 Apr 1955 Wichita, Kansas"
5120 DATA ".pk 4 F ABLE, Linda Ann 22 Aug 1962 Bellevue, Washington"
5130 DATA ".sp"
5140 DATA ".sp"
5150 DATA ".sp"
5160 DATA ".sp"
5170 DATA ".sp"
5180 DATA ".sp"
5190 DATA ".sp"
5200 DATA ".sp"
5210 DATA ".pk Type a Request. Then press the 'enter' key.: "
5220 DATA ".pk (Possible Requests: ps, f, m, p1...pn, c1...cn, m1...mn, q)"
5230 DATA ".pa"
5240 DATA "Instead of asking for a Chart of An-"
5250 DATA "cestors, the user may have asked for"
5260 DATA "the Ordinances of the person (o), as:"
5270 DATA ".sp"
5280 DATA ".pk Type a Request. Then press the 'enter' key.? o"
5290 DATA ".sp"
5300 DATA "The user would have seen:"
5310 DATA ".sp"
5320 DATA ".in -3"
5330 DATA ".pk Ordinances of: Melvin Otto ABLE Rec.no: 1"
5340 DATA ".sp"
5350 DATA ".pk Personal Record Priesthood Record"
5360 DATA ".pk Christening: Aaronic: 10 Oct 1937"
5370 DATA ".pk Blessing: 1 Nov 1925 Deacon: 10 Oct 1937"
5380 DATA ".pk Sealed to Parents: BIC Teacher: 16 Feb 1941"
5390 DATA ".pk Father's Rec.no: 0 Priest: 18 Oct 1942"
5400 DATA ".pk Name:"
5410 DATA ".pk Mother's Rec.no: 0 Melchizedek: 18 Apr 1944"
5420 DATA ".pk Name: Elder: 18 Apr 1944"
5430 DATA ".pk Baptism: 4 Nov 1933 Seventy:"
5440 DATA ".pk Confirmation: 5 Nov 1933 High Priest:
5450 DATA ".pk Patriarchal Blessing: 13 Jun 1939"
5460 DATA ".pk Endowment: 16 Jun 1947 Bishop:"
5470 DATA ".pk Patriarch:"
5480 DATA ".pk Apostle:"
5490 DATA ".sp
5500 DATA ".sp"
5510 DATA ".pk Occupation: Author"
5520 DATA ".sp"
5530 DATA ".pk Type a Request. Then press the 'enter' key.: "
5540 DATA ".pk (Possible Requests: ps, an, fg, o, p1...pn, m1...mn, q)"
5550 DATA ".in 0"
5560 DATA ".pa"
5570 DATA "The user decides to quit, and types:"
5580 DATA ".sp"
5590 DATA " q"
5600 DATA " and presses the enter key."
5610 DATA ".vt 2"
5620 DATA "He once again sees the menu. Since he"
5630 DATA "has decided to quit, he types:"
5640 DATA ".sp"
5650 DATA " 0"
5660 DATA " and presses the enter key."
5670 DATA ".vt 2"
5680 DATA "At the bottom of the screen he sees:"
5690 DATA ".sp"
5700 DATA ".pk End of Program"
5710 DATA ".pk OK"
5720 DATA ".pk _"
5730 DATA ".pa"
5740 DATA ".h2 COMMANDS USED."
5750 DATA ".h3 basic/s:256"
5760 DATA ".sp"
5770 DATA "The basic command is used in order to"
5780 DATA "load the basic processor from either"
5790 DATA "the PCjr's BASIC Cartridge, or from"
5800 DATA "wherever it is located, into storage,"
5810 DATA "and to establish a buffer size for"
5820 DATA "the data files."
5830 DATA ".h3 load (or the F3 function-key)"
5840 DATA ".sp"
5850 DATA "The load command is used in order to"
5860 DATA "load a program prior to running it"
5870 DATA "or prior to editing it."
5880 DATA ".h3 save (or the F4 function-key)"
5890 DATA ".sp"
5900 DATA "The save command is used in order to"
5910 DATA "save an edited program."
5920 DATA ".pa"
5930 DATA ".h3 run"
5940 DATA ".sp"
5950 DATA "The run command is used to cause any"
5960 DATA "of the Genealogy ON DISPLAY documen-"
5970 DATA "tation programs to begin."
5980 DATA ".sp"
5990 DATA "It is also used to cause the MENU"
6000 DATA "Program to be run."
6010 DATA ".eof"
6020 END
TABLEOFC.BAS
100 REM TABLEOFC Program.
110 REM Documentation. Table of Contents.
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 DATA Genealogy
140 DATA User's Manual
150 DATA -7
160 DATA 1
170 INDENT = 0
180 REM Printer Definitions
190 FORM.FEED$ = CHR$(12)
200 COMPR.OFF$ = CHR$(18) : COMPR.ON$ = CHR$(15)
210 BOLD.OFF$ = CHR$(27)+"F" : BOLD.ON$ = CHR$(27)+"E"
220 EXPAND.OFF$ = CHR$(18) : EXPAND.ON$ = CHR$(14)
230 DASHES$ = "+"+STRING$(54,45)+"+"
240 TRIM.LINE$ = "(Trim-line)"
300 REM Program begins here
310 READ TITLE$, DOC.NAME$, PAGE.NO, LINE.NO
320 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
330 GOSUB 920 'For trim line and heading space
340 FOR I = 1 TO 6 : LPRINT : NEXT I
350 LPRINT BOLD.ON$; 'Set Emphasized mode
360 LPRINT EXPAND.ON$; 'Set Expanded Print
370 LPRINT TAB(TAB.POS+0);TITLE$
380 LPRINT EXPAND.OFF$; 'Return to normal
390 LPRINT BOLD.OFF$; 'Return to normal
400 FOR I = 1 TO 3 : LPRINT : NEXT I
410 LPRINT BOLD.ON$; 'Set Emphasized mode
420 LPRINT TAB(TAB.POS+12);"ON DISPLAY"
430 LPRINT BOLD.OFF$; 'Return to normal
440 LPRINT : LPRINT : LPRINT
450 LPRINT TAB(TAB.POS+11);"Version 6.0"
460 FOR I = 1 TO 11 : LPRINT : NEXT I
470 LPRINT TAB(TAB.POS+10); DOC.NAME$
480 LINE.NO = LINE.NO + 27
490 '
500 READ REPLY$
510 REM First, change tildes to quotes
520 FOR Q = 1 TO LEN(REPLY$)
530 IF MID$(REPLY$,Q,1)="~"THEN MID$(REPLY$,Q,1)=CHR$(34)
540 NEXT Q
550 IF LEFT$(REPLY$,1) = "." THEN GOSUB 1270: GOTO 500
560 IF LINE.NO > 44 THEN GOSUB 1030
570 REM Print the line if not a command
580 LPRINT TAB(TAB.POS);REPLY$
590 LINE.NO = LINE.NO + 1
600 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
610 GOTO 500
620 REM Data for the Copyright Page
630 DATA ".pa"
640 DATA " "
750 DATA ".vt 2"
754 DATA "If you are using these programs, you are"
758 DATA "expected to become a Registered User,"
762 DATA "by making a contribution to the Author"
766 DATA "of the programs ($49.00 suggested)."
770 DATA "Registration is by each individual,"
774 DATA "and not by any company or group."
778 DATA ".vt 2"
782 DATA "Users are encouraged to copy and to"
786 DATA "share the programs with others."
820 DATA ".vt 13"
830 DATA "Melvin O. Duke"
840 DATA "P. O. Box 2048"
850 DATA "Morgan Hill, CA 95038-2048"
860 DATA ".vt 4"
870 DATA "Copyright (c) 1982 ... 1989, by:"
880 DATA "Melvin O. Duke."
890 DATA ".sp"
900 DATA "All rights reserved."
910 '
920 REM Top of each page routine
930 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
940 LPRINT
950 LPRINT TAB(30); TRIM.LINE$
960 LPRINT DASHES$ 'Dashes
970 FOR I = 1 TO 6
980 LPRINT
990 NEXT I
1000 LINE.NO = LINE.NO + 6
1010 RETURN
1020 '
1030 REM Bottom of each page Routine
1040 IF PAGE.NO < 1 THEN LPRINT : LPRINT : LPRINT : GOTO 1160
1050 LPRINT TAB(TAB.POS); STRING$(40,45) 'on line 46
1060 LPRINT TAB(TAB.POS+2); TITLE$+" ON DISPLAY. Version 6.0" 'on line 47
1070 IF PAGE.NO MOD 2 = 1 THEN 1110
1080 LPRINT TAB(TAB.POS);"Page";PAGE.NO;
1090 LPRINT TAB(TAB.POS+27);"User's Manual"
1100 GOTO 1160
1110 LPRINT TAB(TAB.POS); "User's Manual";
1120 IF PAGE.NO < 10 THEN DELTA = 34
1130 IF PAGE.NO > 9 THEN DELTA = 33
1140 IF PAGE.NO > 99 THEN DELTA = 32
1150 LPRINT TAB(TAB.POS+DELTA); "Page"; PAGE.NO 'on line 48
1160 LPRINT : LPRINT : LPRINT
1170 LPRINT DASHES$ 'dashes after 51
1180 LPRINT TAB(30); TRIM.LINE$
1190 LPRINT FORM.FEED$;
1200 PAGE.NO = PAGE.NO + 1
1210 LINE.NO = 1
1220 IF REPLY$ = ".eof" THEN 1240 'Bypass after last page
1230 GOSUB 920 'For top of next page
1240 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
1250 RETURN
1260 '
1270 REM Command Processor
1280 IF LEFT$(REPLY$,3) = ".h1" THEN 1390
1290 IF LEFT$(REPLY$,3) = ".h2" THEN 1550
1300 IF LEFT$(REPLY$,3) = ".h3" THEN 1660
1310 IF LEFT$(REPLY$,3) = ".sp" THEN 1770
1320 IF LEFT$(REPLY$,4) = ".eof" THEN 1820
1330 IF LEFT$(REPLY$,3) = ".pa" THEN 1860
1340 '
1350 IF LEFT$(REPLY$,3) = ".vt" THEN 1930
1360 IF LEFT$(REPLY$,3) = ".pk" THEN 2040
1370 IF LEFT$(REPLY$,3) = ".in" THEN 2170
1380 STOP
1390 REM Head 1 Processor
1400 FOR I = LINE.NO TO 44
1410 LPRINT
1420 NEXT I
1430 GOSUB 1030 'Bottom of page Routine
1440 IF PAGE.NO MOD 2 = 0 THEN GOSUB 1860 'For h1 on Odd pages
1450 LPRINT BOLD.ON$; 'Set emphasized print
1460 LPRINT EXPAND.ON$; 'Set expanded print
1470 IF PAGE.NO MOD 2 = 0 THEN ADJUST = -1 ELSE ADJUST = -4
1480 LPRINT TAB(TAB.POS+ADJUST); RIGHT$(REPLY$,LEN(REPLY$)-4)
1490 LPRINT EXPAND.OFF$; 'Return to normal
1500 LPRINT BOLD.OFF$; 'Return to non-bold
1510 LINE.NO = LINE.NO+1
1520 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
1530 RETURN
1540 '
1550 REM Head 2 Processor
1560 IF LINE.NO = 7 THEN 1580 'skip spacing if at top of page
1570 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1580 LPRINT BOLD.ON$; 'Set emphasized print
1590 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1600 LPRINT BOLD.OFF$; 'Return to normal
1610 LPRINT
1620 LINE.NO = LINE.NO + 2
1630 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
1640 RETURN
1650 '
1660 REM Head 3 Processor
1670 IF LINE.NO = 7 THEN 1690 'skip spacing if at top of page
1680 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1690 LPRINT BOLD.ON$; 'Set emphasized print
1700 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1710 LPRINT BOLD.OFF$; 'Return to normal
1720 LPRINT
1730 LINE.NO = LINE.NO + 2
1740 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
1750 RETURN
1760 '
1770 REM Single Space Processor
1780 IF LINE.NO = 7 THEN 1800
1790 IF LINE.NO > 44 THEN GOSUB 1860 ELSE LPRINT : LINE.NO = LINE.NO + 1
1800 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
1810 RETURN
1820 REM End of File Processor
1830 GOSUB 1860 'Bottom of Page
1850 GOTO 4590
1860 REM Page Eject Processor
1870 FOR I = LINE.NO TO 44
1880 LPRINT
1890 LINE.NO = LINE.NO + 1
1900 NEXT I
1910 GOSUB 1030 'Bottom of Page Processing
1920 RETURN
1930 REM Vertical Tab Processor
1940 IF LINE.NO = 7 THEN 2030
1950 IF LINE.NO > 44 THEN GOSUB 1030 'End of page
1960 QTY = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
1970 FOR I = 1 TO QTY
1980 LPRINT
1990 LINE.NO = LINE.NO + 1
2000 IF LINE.NO > 44 THEN I = QTY
2010 NEXT I
2020 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
2030 RETURN
2040 REM Pack Processor
2050 IF LINE.NO > 44 THEN GOSUB 1030
2060 IF TAB.POS = 8 THEN ADJUST = 4
2070 IF TAB.POS = 13 THEN ADJUST = 7
2080 TAB.POS = TAB.POS + ADJUST + INDENT
2090 WIDTH "lpt1:", 132 'set condensed width
2100 LPRINT COMPR.ON$; 'Packed printing
2110 LPRINT TAB(TAB.POS); RIGHT$(REPLY$,LEN(REPLY$)-3)
2120 LPRINT COMPR.OFF$; 'Return to normal
2130 WIDTH "lpt1:", 80 'return to normal
2140 LINE.NO = LINE.NO + 1
2150 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 6 ELSE TAB.POS = 11
2160 RETURN
2170 REM Indent Processor
2180 INDENT = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
2190 RETURN
3000 DATA ".h1 TABLE OF CONTENTS"
3010 DATA ".sp"
3020 DATA "INTRODUCTION - - - - - - - - - - - - - 1"
3030 DATA " OVERVIEW - - - - - - - - - - - - - - 1"
3040 DATA " CAPABILITIES - - - - - - - - - - - - 1"
3050 DATA " Display the Genealogy - - - - - - 2"
3060 DATA " Print Charts of Ancestors - - - - 2"
3070 DATA " Print Charts of Families - - - - - 3"
3080 DATA " Produce Charts of Descendants - - 3"
3090 DATA " Format the Data Files - - - - - - 3"
3100 DATA " Update the Data Files - - - - - - 4"
3110 DATA " Prepare the Indexes - - - - - - - 4"
3120 DATA " List the Records in the File - - - 4"
3130 DATA " Printing the Contents of the"
3140 DATA " files - - - - - - - - - - - - - 5"
3150 DATA " Alphabetical Lists - - - - - - - - 5"
3160 DATA " Parent/Child Index List - - - - - 5"
3170 DATA " BENEFITS/ADVANTAGES - - - - - - - - 6"
3180 DATA " RESULTS - - - - - - - - - - - - - - 6"
3190 DATA " REQUIREMENTS - - - - - - - - - - - - 7"
3200 DATA " Software Requirements - - - - - - 7"
3210 DATA " Hardware Requirements - - - - - - 8"
3220 DATA ".sp"
3230 DATA "GENERAL INFORMATION - - - - - - - - - 9"
3240 DATA " DATA ACCESS REQUIREMENTS - - - - - - 9"
3250 DATA " DESCRIPTION OF FUNCTIONS - - - - - - 9"
3260 DATA " File Formatting - - - - - - - - - 9"
3270 DATA " File Maintenance - - - - - - - - - 9"
3280 DATA " File Indexes - - - - - - - - - - - 9"
3290 DATA " Summary Lists - - - - - - - - - - 10"
3300 DATA " Detailed Data - - - - - - - - - - 10"
3310 DATA " Displaying the Genealogy - - - - - 10"
3320 DATA " Printing Charts of Ancestors - - - 11"
3330 DATA " Printing Charts of Families - - - 11"
3340 DATA " Producing Charts of Descendants - 11"
3350 DATA ".pa"
3360 DATA " DEFINITION OF TERMS - - - - - - - - 12"
3370 DATA " Information about Persons - - - - 12"
3380 DATA " Information about Ancestors - - - 12"
3390 DATA " Information about Families - - - - 12"
3400 DATA " Information about Descendants - - 13"
3410 DATA " Information about Ordinances - - - 13"
3420 DATA " EXPLANATION OF GENERAL CONCEPTS - - 14"
3430 DATA " Persfile - - - - - - - - - - - - - 15"
3440 DATA " Marrfile - - - - - - - - - - - - - 16"
3450 DATA " Pcindex - - - - - - - - - - - - - 17"
3460 DATA " Mindex - - - - - - - - - - - - - - 17"
3470 DATA " Ordfile - - - - - - - - - - - - - 18"
3480 DATA " Relationships - - - - - - - - - - 19"
3490 DATA " BEFORE YOU START - - - - - - - - - - 20"
3500 DATA " List of Persons - - - - - - - - - 20"
3510 DATA " List of Marriages - - - - - - - - 22"
3520 DATA ".sp"
3530 DATA "USING THE PROGRAMS - - - - - - - - - - 23"
3540 DATA " GETTING STARTED - - - - - - - - - - 23"
3550 DATA " First Time Usage - One-Drive System 24"
3560 DATA " First Time Usage - Two-Drive System 25"
3570 DATA " First Time Usage - Hard-Disk System 27"
3580 DATA " First Time Usage - All Systems - - - 28"
3590 DATA " Formatting the Data Files - - - - 28"
3600 DATA " Caution - - - - - - - - - - - - - 28"
3610 DATA " HOW TO OPERATE - - - - - - - - - - - 29"
3620 DATA " How to Operate - One-Drive System - 29"
3630 DATA " How to Operate - Two-Drive System - 30"
3640 DATA " How to Operate - Hard-Disk System - 31"
3650 DATA " Operating the CREATPER Program - - 32"
3660 DATA " Operating the CREATMAR Program - - 33"
3670 DATA " Operating the CREATORD Program - - 34"
3680 DATA " Operating the UPDATPER Program - - 35"
3690 DATA " Operating the UPDATMAR Program - - 37"
3700 DATA " Operating the UPDATORD Program - - 39"
3710 DATA " Operating the INDEXPC Program - - 40"
3720 DATA " Operating the INDEXMAR Program - - 41"
3730 DATA " Operating the DISPLAY Program - - 42"
3740 DATA " Operating the ANCESTOR Program - - 45"
3750 DATA " Operating the FAMILY Program - - - 46"
3760 DATA " Operating the DESCEND Program - - 47"
3770 DATA " Operating the Other Programs - - - 47"
3780 DATA ".sp"
3790 DATA " HOW TO STOP - - - - - - - - - - - - 48"
3800 DATA " Stopping the update programs - - - 48"
3810 DATA " Stopping the DISPLAY Program - - - 48"
3820 DATA " Stopping the ANCESTOR Program - - 48"
3830 DATA " Stopping the FAMILY Program - - - 49"
3840 DATA " Stopping the DESCEND Program - - - 49"
3850 DATA " Stopping the Other Programs - - - 49"
3860 DATA ".sp"
3870 DATA "REFERENCE MATERIAL - - - - - - - - - - 51"
3880 DATA " SAMPLE SCREENS AND PROMPTING"
3890 DATA " MESSAGES - - - - - - - - - - - - 51"
3900 DATA " Menu Logo - - - - - - - - - - - - 52"
3910 DATA " Menu of Programs - - - - - - - - - 53"
3920 DATA " Display Logo - - - - - - - - - - - 54"
3930 DATA " Personal Information - - - - - - - 56"
3940 DATA " Ancestor Information - - - - - - - 57"
3950 DATA " Family Group Information - - - - - 58"
3960 DATA " Ordinance Information - - - - - - 59"
3970 DATA " COMMANDS USED - - - - - - - - - - - 61"
3980 DATA " Basic Command - - - - - - - - - - 61"
3990 DATA " Load Command - - - - - - - - - - - 61"
4000 DATA " Save Command - - - - - - - - - - - 61"
4010 DATA " Run Command - - - - - - - - - - - 62"
4020 DATA ".sp"
4030 DATA "APPENDIX A. MESSAGES - - - - - - - - 63"
4040 DATA " Start-up Messages - - - - - - - - - 63"
4050 DATA ".sp"
4060 DATA "APPENDIX B. SUMMARY - - - - - - - - - 65"
4070 DATA " General Programs - - - - - - - - - - 65"
4080 DATA " Data Files - - - - - - - - - - - - - 66"
4090 DATA " Indexes - - - - - - - - - - - - - - 67"
4100 DATA " Documentation - - - - - - - - - - - 67"
4110 DATA " Overview Information - - - - - - - - 67"
4120 DATA ".pa"
4130 DATA "APPENDIX C. HINTS - - - - - - - - - - 69"
4140 DATA " Names - - - - - - - - - - - - - - - 69"
4150 DATA " Dates - - - - - - - - - - - - - - - 69"
4160 DATA " Replacing Information - - - - - - - 69"
4170 DATA " Removing a Record - - - - - - - - - 70"
4180 DATA ".sp"
4190 DATA "APPENDIX D. MODIFICATIONS - - - - - - 71"
4200 DATA " Making Changes - - - - - - - - - - - 71"
4210 DATA " Color Considerations - - - - - - - - 71"
4220 DATA " Color Definitions - - - - - - - - - 72"
4230 DATA " Changing the Number of Persons - - - 72"
4240 DATA " Extending Existing Files - - - - - 73"
4250 DATA " Printing a Partial Alphabetic List - 74"
4260 DATA " Changing the Number of Marriages - - 74"
4270 DATA " Extending an Existing File - - - - 75"
4280 DATA " Including Numeric Codes - - - - - - 76"
4290 DATA " Printing Partial Files - - - - - - - 76"
4300 DATA " Partial Printout of Persons - - - 76"
4310 DATA " Partial Printout of Marriages - - 76"
4320 DATA " Repositioning the Files - - - - - - 77"
4330 DATA " Removing Person and Marriage"
4340 DATA " Numbers - - - - - - - - - - - - - 78"
4350 DATA " Changing the Chart of Descendants - 78"
4360 DATA " Continuous Charts of Descendants - 78"
4370 DATA " Changing the Generations Shown - - 79"
4380 DATA " Chart of Family Binding Space - - - 79"
4390 DATA " Adding an LDS Ordinances File - - - 80"
4400 DATA " Changing Number of Ancestor"
4410 DATA " Generations - - - - - - - - - - - 80"
4420 DATA " Changing Sex Designations - - - - - 81"
4430 DATA " Utilizing Other Printers - - - - - - 81"
4440 DATA " Paper Considerations - - - - - - - - 82"
4450 DATA " Use of Wide Paper - - - - - - - - - 83"
4460 DATA " Use of Short Paper - - - - - - - - 83"
4470 DATA " Use of Single Sheets - - - - - - - 83"
4480 DATA " Defining Function Keys - - - - - - - 83"
4490 DATA " Displaying Lists - - - - - - - - - - 84"
4500 DATA ".pa"
4510 DATA " Including Your Name and Address - - 84"
4520 DATA " Using LDS Pre-printed Forms - - - - 84"
4530 DATA ".sp"
4540 DATA "APPENDIX E. TERMS & CONDITIONS - - - 85"
4550 DATA " Terms - - - - - - - - - - - - - - - 85"
4560 DATA " Conditions - - - - - - - - - - - - - 86"
4570 DATA " Disclaimer - - - - - - - - - - - - - 86"
4580 DATA ".eof"
4590 END
UPDATMAR.BAS
100 REM UPDATMAR Program
110 REM Data Entry to the Marriages File
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Update the Marriages File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1280 GOTO 1700
1300 REM subroutine to print a double box
1310 COLOR P
1320 FOR I = R1 + 1 TO R2 - 1
1330 LOCATE I, C1 : PRINT CHR$(186);
1340 LOCATE I, C2 : PRINT CHR$(186);
1350 NEXT I
1360 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
1390 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
1400 LOCATE R1, C1 : PRINT CHR$(201);
1410 LOCATE R1, C2 : PRINT CHR$(187);
1420 LOCATE R2, C1 : PRINT CHR$(200);
1430 LOCATE R2, C2 : PRINT CHR$(188);
1440 COLOR W
1450 RETURN
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM UPDATMAR Program Starts Here.
2010 REM Open the Marriages File
2020 OPEN CC.MARRFILE$ AS #2 LEN = 128
2030 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$
2040 REM Open the Persons File
2050 OPEN CC.PERSFILE$ AS #1 LEN = 256
2060 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$
2070 REM ask the user for input
2080 LOCATE 23,1 : PRINT SPACE$(79);
2090 LOCATE 23,1 : PRINT "(0 to quit, ? to locate unused record)";
2100 LOCATE 22,1 : PRINT SPACE$(79) : LOCATE 22,1
2110 LINE INPUT "Enter Record Number of Marriage to Update: "; REPLY$
2120 IF REPLY$ <> "?" THEN 2270
2130 REM Locate an unused record
2140 FOUND = 0 : IF REC.NO = 0 THEN REC.NO = 1
2150 FOR LOOK = REC.NO TO MAX.MAR
2160 GET #2, LOOK
2170 LOCATE 15,1 : PRINT "Searching Record";LOOK;
2180 TT1 = CVS(M1$)
2190 IF TT1 > 0 THEN 2210
2200 FOUND = 1 : REC.NO = LOOK : LOOK = MAX.MAR
2210 NEXT LOOK
2220 IF FOUND = 1 THEN 2360
2230 PRINT "Unable to find an unused record above record";REC.NO
2240 PRINT "Either start from record 1 or extend the file"
2250 PRINT "Press any key to continue"
2260 GOTO 2070
2270 IF REPLY$ = "0" THEN 4950
2280 REC.NO = VAL(REPLY$)
2290 IF REC.NO < 1 OR REC.NO > MAX.MAR THEN 2300 ELSE 2350
2300 PRINT : PRINT "Number is out of range"
2310 PRINT "Press any key to continue"
2320 A$ = INKEY$ : IF A$ = "" THEN 2320
2330 KEY ON : CLS : KEY OFF
2340 GOTO 2070
2350 GET #2, REC.NO
2360 REM Extract information from the file for use
2370 TT1! = CVS(M1$) : TT1 = TT1!
2380 REM Disallow Update if Rec.no is Zero (never Created)
2390 IF TT1 <> 0 THEN 2460
2400 LOCATE 22,1 : PRINT SPACE$(79);
2410 LOCATE 23,1 : PRINT SPACE$(79); : LOCATE 22,1
2420 PRINT "Record Number is Zero. Must run the CREATMAR Program First."
2430 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
2440 A$ = INKEY$ : IF A$ = "" THEN 2440
2450 GOTO 4950 'Close the Files and return to the Menu
2460 TT2! = CVS(M2$) : TT2 = TT2!
2470 TT3! = CVS(M3$) : TT3 = TT3!
2480 TT4! = CVS(M4$)
2490 TT5$ = M5$
2500 TT6$ = M6$
2510 TT7$ = M7$
2520 TT8$ = M8$
2530 TT9$ = M9$
2540 KEY ON : CLS : KEY OFF
2550 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1300 'Double box
2560 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3330 'Horizontal double
2570 R1 = 19 : C1 = 1 : R2 = 19 : C2 = 79 : GOSUB 3330 'Horizontal double
2580 LOCATE 2,33 : PRINT "Marriage Record"
2590 LOCATE 5, 3 : COLOR O : PRINT "Marriage Record-number:";
2600 LOCATE 7, 3 : PRINT "Male Spouse:";
2610 LOCATE 8, 3 : PRINT "Male Spouse's Name:";
2620 LOCATE 10, 3 : PRINT "Female Spouse:";
2630 LOCATE 11, 3 : PRINT "Female Spouse's Name:";
2640 LOCATE 20, 3 : PRINT "Comments:";
2650 IF CODE$ = "no" THEN 2670
2660 LOCATE 5,42 : PRINT "Marriage Code:";
2670 LOCATE 13, 3 : COLOR N : PRINT "Marriage Statistics:"; : COLOR O
2680 LOCATE 14, 3 : PRINT "Marriage-date:";
2690 LOCATE 15, 3 : PRINT "Marriage-city:";
2700 LOCATE 16, 3 : PRINT "Marriage-county:";
2710 LOCATE 17, 3 : PRINT "State/Country:";
2720 GOSUB 2740 'To print the current information
2730 GOTO 3400 'For User Input
2740 REM Print the Information Currently Present
2750 LOCATE 5,27 : PRINT SPACE$(5);
2760 LOCATE 5,27 : COLOR G : PRINT TT1;
2770 LOCATE 7,27 : PRINT SPACE$(5);
2780 LOCATE 7,27 : COLOR G : PRINT TT2;
2790 LOCATE 8,27 : PRINT SPACE$(51);
2800 REM Obtain the Husband's Record
2810 IF TT2 = 0 THEN GOSUB 5220 : GOTO 2970 ELSE GET #1, TT2 : GOSUB 5100
2820 REM Disallow if not Male
2830 IF LEFT$(T4$,1) = MALE.LTR$ THEN 2970
2840 COLOR W
2850 LOCATE 23,1 : PRINT SPACE$(79);
2860 LOCATE 24,1 : PRINT SPACE$(70);
2870 REM Test for Undefined Sex
2880 IF LEFT$(T4$,1) <> " " THEN 2910
2890 LOCATE 22,1 : PRINT "The Sex of the Male Spouse is Undefined"
2900 GOTO 2920
2910 LOCATE 22,1 : PRINT "The Sex of the Male Spouse is shown as: "; T4$;
2920 LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
2930 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
2940 A$ = INKEY$ : IF A$ = "" THEN 2940
2950 REM Blank the Record and start over
2960 TT1 = -TT1 : GOSUB 5000 : GOSUB 2740 : GOTO 3400
2970 LOCATE 8,27 : COLOR G : PRINT LEFT$(T3$+" "+T2$,51);
2980 LOCATE 10,27 : PRINT SPACE$(5);
2990 LOCATE 10,27 : COLOR G : PRINT TT3;
3000 LOCATE 11,27 : PRINT SPACE$(51);
3010 REM Obtain the Wife's Record
3020 IF TT3 = 0 THEN GOSUB 5220 : GOTO 3180 ELSE GET #1, TT3 : GOSUB 5100
3030 REM Disallow if not Female
3040 IF LEFT$(T4$,1) = FEMALE.LTR$ THEN 3180
3050 COLOR W
3060 LOCATE 23,1 : PRINT SPACE$(79);
3070 LOCATE 24,1 : PRINT SPACE$(70);
3080 REM Test for Undefined Sex
3090 IF LEFT$(T4$,1) <> " " THEN 3120
3100 LOCATE 22,1 : PRINT "The Sex of the Female Spouse is Undefined"
3110 GOTO 3130
3120 LOCATE 22,1 : PRINT "The Sex of the Female Spouse is shown as: "; T4$;
3130 LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
3140 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
3150 A$ = INKEY$ : IF A$ = "" THEN 3150
3160 REM Blank the Record and start over
3170 TT1 = -TT1 : GOSUB 5000 : GOSUB 2740 : GOTO 3400
3180 LOCATE 11,27 : COLOR G : PRINT LEFT$(T3$+" "+T2$,51);
3190 IF CODE$ = "no" THEN 3220
3200 LOCATE 5,57 : PRINT SPACE$(15);
3210 LOCATE 5,57 : COLOR G : PRINT TT4!;
3220 LOCATE 14,28 : PRINT SPACE$(11);
3230 LOCATE 14,28 : COLOR G : PRINT TT5$;
3240 LOCATE 15,28 : PRINT SPACE$(18);
3250 LOCATE 15,28 : COLOR G : PRINT TT6$;
3260 LOCATE 16,28 : PRINT SPACE$(16);
3270 LOCATE 16,28 : COLOR G : PRINT TT7$;
3280 LOCATE 17,28 : PRINT SPACE$(16);
3290 LOCATE 17,28 : COLOR G : PRINT TT8$;
3300 LOCATE 20,20 : PRINT SPACE$(45);
3310 LOCATE 20,20 : COLOR G : PRINT TT9$; : COLOR W
3320 RETURN
3330 REM Subroutine to draw a double horizontal line. Attach to double.
3340 COLOR P
3350 LOCATE R1,C1+1 : PRINT STRING$(C2-C1-1,205);
3360 LOCATE R1,C1 : PRINT CHR$(204);
3370 LOCATE R1,C2 : PRINT CHR$(185);
3380 COLOR W
3390 RETURN
3400 REM Routines to Obtain information from the User
3410 LOCATE 22,1 : PRINT SPACE$(79);
3420 LOCATE 23,1 : PRINT SPACE$(79);
3430 LOCATE 24,1 : PRINT SPACE$(79);
3440 KEY ON
3450 LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown)";
3460 LOCATE 23,1
3470 LINE INPUT "Enter the Record Number: ";REPLY$
3480 IF REPLY$ = "/" THEN 4580
3490 IF REPLY$ = "" THEN 3600
3500 IF ABS(VAL(REPLY$)) = ABS(TT1) THEN 3570 ELSE 3510
3510 REM Prevent Change of Rec.no
3520 LOCATE 24,1 : PRINT SPACE$(79); : LOCATE 22,1
3530 PRINT "Cannot Change the Record Number to another number.";
3540 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
3550 A$ = INKEY$ : IF A$ = "" THEN 3550
3560 GOTO 3400
3570 TT1 = VAL(REPLY$)
3580 IF TT1 < 1 THEN GOSUB 5000 : GOSUB 2740 : GOTO 4580 'Null Record
3590 GOSUB 2740
3600 LOCATE 23,1 : PRINT SPACE$(79);
3610 REM Terminate record update if negative
3620 IF TT1 < 1 THEN 4580
3630 LOCATE 23,1 : COLOR W
3640 LINE INPUT "Enter the Male Spouse's Record-Number: ";REPLY$
3650 IF REPLY$ = "/" THEN 4580
3660 IF REPLY$ = "" THEN 3730
3670 TT2 = VAL(REPLY$)
3680 IF TT2 >= 0 AND TT2 <= MAX.PER THEN 3710
3690 TT2 = 0
3700 LOCATE 22,1 : PRINT "Number out of range"; : GOTO 3600
3710 LOCATE 22,1 : PRINT SPACE$(79);
3720 GOSUB 2770
3730 LOCATE 23,1 : PRINT SPACE$(79);
3740 REM Disallow if Male Spouse's Record-number is zero
3750 IF TT2 <> 0 THEN 3830
3760 COLOR W : LOCATE 24,1 : PRINT SPACE$(79);
3770 LOCATE 22,1 : PRINT "Male Spouse's Record Number Cannot be Zero";
3780 LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
3790 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
3800 A$ = INKEY$ : IF A$ = "" THEN 3800
3810 REM Blank the Record and start over
3820 TT1 = -TT1 : GOSUB 5000 : GOSUB 2740 : GOTO 3400
3830 LOCATE 23,1 : PRINT SPACE$(79);
3840 LOCATE 23,1 : COLOR W
3850 LINE INPUT "Enter the Female Spouse's Record-Number: ";REPLY$
3860 IF REPLY$ = "/" THEN 4580
3870 IF REPLY$ = "" THEN 3940
3880 TT3 = VAL(REPLY$)
3890 IF TT3 >= 0 AND TT3 <= MAX.PER THEN 3920
3900 TT3 = 0
3910 LOCATE 22,1 : PRINT "Number out of range"; : GOTO 3830
3920 LOCATE 22,1 : PRINT SPACE$(79);
3930 GOSUB 2980
3940 LOCATE 23,1 : PRINT SPACE$(79);
3950 REM Disallow if Female Spouse's Record-number is zero
3960 IF TT3 <> 0 THEN 4040
3970 COLOR W : LOCATE 24,1 : PRINT SPACE$(79);
3980 LOCATE 22,1 : PRINT "Female Spouse's Record Number Cannot be Zero";
3990 LOCATE 23,1 : PRINT "Cannot Save this Marriage Record";
4000 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
4010 A$ = INKEY$ : IF A$ = "" THEN 4010
4020 REM Blank the Record and start over
4030 TT1 = -TT1 : GOSUB 5000 : GOSUB 2740 : GOTO 3400
4040 LOCATE 23,1 : COLOR W
4050 IF CODE$ = "no" THEN 4110
4060 LINE INPUT "Enter the Marriage Code: ";REPLY$
4070 IF REPLY$ = "/" THEN 4580
4080 IF REPLY$ = "" THEN 4110
4090 TT4! = VAL(REPLY$)
4100 GOSUB 3200
4110 LOCATE 23,1 : PRINT SPACE$(79);
4120 LOCATE 23,1 : COLOR W
4130 PRINT "Enter the Marriage-Date as: dd Mmm yyyy: ";
4140 LINE INPUT REPLY$
4150 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4160 IF REPLY$ = "/" THEN 4580
4170 IF REPLY$ = "" THEN 4210
4180 REPLY$ = LEFT$(REPLY$,11)
4190 RSET TT5$ = REPLY$
4200 GOSUB 3220
4210 LOCATE 23,1 : PRINT SPACE$(79);
4220 LOCATE 23,1 : COLOR 7
4230 PRINT "Enter the Marriage-City: ";
4240 LINE INPUT REPLY$
4250 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4260 IF REPLY$ = "/" THEN 4580
4270 IF REPLY$ = "" THEN 4300
4280 TT6$ = LEFT$(REPLY$,18)
4290 GOSUB 3240
4300 LOCATE 23,1 : PRINT SPACE$(79);
4310 LOCATE 23,1 : COLOR 7
4320 PRINT "Enter the Marriage-County: ";
4330 LINE INPUT REPLY$
4340 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4350 IF REPLY$ = "/" THEN 4580
4360 IF REPLY$ = "" THEN 4390
4370 TT7$ = LEFT$(REPLY$,16)
4380 GOSUB 3260
4390 LOCATE 23,1 : PRINT SPACE$(79);
4400 LOCATE 23,1 : COLOR 7
4410 PRINT "Enter the Marriage-State or Country: ";
4420 LINE INPUT REPLY$
4430 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4440 IF REPLY$ = "/" THEN 4580
4450 IF REPLY$ = "" THEN 4480
4460 TT8$ = LEFT$(REPLY$,16)
4470 GOSUB 3280
4480 LOCATE 23,1 : PRINT SPACE$(79);
4490 LOCATE 23,1 : COLOR 7
4500 PRINT "Enter any Comments: ";
4510 LINE INPUT REPLY$
4520 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4530 IF REPLY$ = "/" THEN 4580
4540 IF REPLY$ = "" THEN 4570
4550 TT9$ = LEFT$(REPLY$,45)
4560 GOSUB 3300
4570 REM
4580 REM Completed this Record
4590 LOCATE 24,1 : PRINT SPACE$(79);
4600 LOCATE 23,1 : PRINT SPACE$(79);
4610 LOCATE 23,1 : COLOR W
4620 LINE INPUT "Type s (save), m (more), or f (forget): ";REPLY$
4630 IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3400
4640 IF LEFT$(REPLY$,1) = "M" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3400
4650 IF LEFT$(REPLY$,1) = "f" THEN KEY ON : CLS : KEY OFF : GOTO 2070
4660 IF LEFT$(REPLY$,1) = "F" THEN KEY ON : CLS : KEY OFF : GOTO 2070
4670 IF LEFT$(REPLY$,1) = "s" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 4710
4680 IF LEFT$(REPLY$,1) = "S" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 4710
4690 LOCATE 22,1 : PRINT "Error in reply";
4700 GOTO 4600
4710 REM Routine to SAVE the newly updated record
4720 REM Prevent saving of Person/non-Person Marriage
4730 IF TT1 < 0 THEN 4830 'ok if empty
4740 IF TT2 = 0 OR TT3 = 0 THEN 4750 ELSE 4830
4750 LOCATE 22,1 : PRINT SPACE$(79);
4760 LOCATE 22,1
4770 PRINT "Cannot s (save) unless both spouses have numbers that are not zero."
4780 REM Ask for More or Forget, but not Save
4790 LOCATE 23,1 : PRINT SPACE$(79);
4800 LOCATE 23,1 : COLOR W
4810 LINE INPUT "Type m (more), or f (forget): "; REPLY$
4820 GOTO 4630
4830 TT1! = TT1 : LSET M1$ = MKS$(TT1!)
4840 TT2! = TT2 : LSET M2$ = MKS$(TT2!)
4850 TT3! = TT3 : LSET M3$ = MKS$(TT3!)
4860 LSET M4$ = MKS$(TT4!)
4870 RSET M5$ = TT5$
4880 LSET M6$ = TT6$
4890 LSET M7$ = TT7$
4900 LSET M8$ = TT8$
4910 LSET M9$ = TT9$
4920 PUT #2, REC.NO
4930 KEY ON : CLS : KEY OFF
4940 GOTO 2070
4950 CLOSE #2
4960 CLOSE #1
4970 KEY ON : CLS : KEY OFF : LOCATE 21,1
4980 PRINT "End of Program"
4990 RUN CC.MENU$
5000 REM Blank a Negative Record
5010 TT2 = 0
5020 TT3 = 0
5030 TT4! = 0
5040 TT5$ = SPACE$(11)
5050 TT6$ = ""
5060 TT7$ = ""
5070 TT8$ = ""
5080 TT9$ = ""
5090 RETURN
5100 REM Routine to Extract Personal Information
5110 T1! = CVS(F1$) : T1 = T1!
5120 T2$ = F2$
5130 FOR J = 1 TO LEN(F2$) -1
5140 IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
5150 T3$ = F3$
5160 NEXT J
5170 FOR J = 1 TO LEN(F3$) -1
5180 IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
5190 NEXT J
5200 T4$ = F4$
5210 RETURN
5220 REM Blank out a Record
5230 T1 = 0
5240 T2$ = ""
5250 T3$ = ""
5260 T4$ = ""
5270 RETURN
UPDATORD.BAS
100 REM UPDATORD Program
110 REM Data Entry to the Ordinances File
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Update the Ordinances File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1280 GOTO 1700
1300 REM subroutine to print a double box
1310 COLOR P
1320 FOR I = R1 + 1 TO R2 - 1
1330 LOCATE I, C1 : PRINT CHR$(186);
1340 LOCATE I, C2 : PRINT CHR$(186);
1350 NEXT I
1360 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
1390 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
1400 LOCATE R1, C1 : PRINT CHR$(201);
1410 LOCATE R1, C2 : PRINT CHR$(187);
1420 LOCATE R2, C1 : PRINT CHR$(200);
1430 LOCATE R2, C2 : PRINT CHR$(188);
1440 COLOR W
1450 RETURN
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM UPDATORD Program Starts Here
2010 OPEN CC.ORDFILE$ AS #2 LEN = 256
2020 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$
2030 REM
2040 OPEN CC.PERSFILE$ AS #1 LEN = 256
2050 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$
2060 REM ask the user for input
2070 LOCATE 22,1
2080 LINE INPUT "Enter Record Number of Person to Update (0 to quit): "; REPLY$
2090 IF REPLY$ = "0" THEN 7060
2100 REC.NO = VAL(REPLY$)
2110 IF REC.NO < 1 OR REC.NO > MAX.PER THEN T1 = REC.NO : GOTO 2220
2120 GET #2, REC.NO
2130 U1! = CVS(O1$) : U1 = U1!
2140 IF U1 = 0 THEN 2150 ELSE 2190
2150 PRINT "Record Number is Zero. Must run the CREATORD Program First."
2160 PRINT "Press any key to continue"
2170 A$ = INKEY$ : IF A$ = "" THEN 2170
2180 GOTO 7060
2190 SEX$ = "U"
2200 GET #1, REC.NO
2210 GOSUB 2330 'Person Extract
2220 REM Test for empty person record
2230 IF T1 < 1 OR T1 > MAX.PER THEN 2240 ELSE 2300
2240 CLS : LOCATE 22,1 : PRINT SPACE$(79);
2250 LOCATE 22,1 : PRINT "Person Record is Undefined or Out-of-range"
2260 LOCATE 23,1 : PRINT SPACE$(79);
2270 LOCATE 23,1 : PRINT "Press any key to continue";
2280 A$ = INKEY$ : IF A$ = "" THEN 2280
2290 KEY ON : CLS : KEY OFF : GOTO 2060 ' for next input
2300 GOSUB 2450 'Ordinance Extract
2310 SEX$ = LEFT$(T4$,1)
2320 GOTO 2710 'to Print
2330 REM Extract information from the Persons File
2340 T1! = CVS(F1$) : T1 = T1!
2350 T2$ = F2$
2360 FOR J = 1 TO LEN(F2$)-1
2370 IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
2380 NEXT J
2390 T3$ = F3$
2400 FOR J = 1 TO LEN(F3$)-1
2410 IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
2420 NEXT J
2430 T4$ = F4$
2440 RETURN
2450 REM extract the Ordinances Information
2460 UI! = CVS(O1$) : U1 = U1!
2470 U2$ = O2$
2480 U3$ = O3$
2490 U4$ = O4$
2500 U5! = CVS(O5$) : U5 = U5!
2510 U6! = CVS(O6$) : U6 = U6!
2520 U7$ = O7$
2530 U8$ = O8$
2540 U9$ = O9$
2550 U10$ = O10$
2560 U11$ = O11$
2570 U12! = CVS(O12$) : U12 = U12!
2580 U13$ = O13$
2590 U14$ = O14$
2600 U15$ = O15$
2610 U16$ = O16$
2620 U17$ = O17$
2630 U18$ = O18$
2640 U19$ = O19$
2650 U20$ = O20$
2660 U21$ = O21$
2670 U22$ = O22$
2680 U23$ = O23$
2690 U24$ = O24$
2700 RETURN
2710 KEY ON : CLS : KEY OFF
2720 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1300 'Double box
2730 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3820 'Horizontal double
2740 R1 =19 : C1 = 1 : R2 =19 : C2 = 79 : GOSUB 3820 'Horizontal double
2750 LOCATE 2,3 : PRINT "Ordinances of:"
2760 LOCATE 4,7 : COLOR N : PRINT "Personal Record"; : COLOR O
2770 LOCATE 5,3 : PRINT "Christening:";
2780 LOCATE 6,3 : PRINT "Blessing:";
2790 LOCATE 7,3 : PRINT "Sealed to Parents:";
2800 LOCATE 8,5 : PRINT "Father's Rec.no:";
2810 LOCATE 9,6 : PRINT "Name:";
2820 LOCATE 10,5 : PRINT "Mother's Rec.no:";
2830 LOCATE 11,6 : PRINT "Name:";
2840 LOCATE 12,3 : PRINT "Baptism:";
2850 LOCATE 13,3 : PRINT "Confirmation:";
2860 LOCATE 14,3 : PRINT "Patriarchal Blessing:";
2870 LOCATE 15,3 : PRINT "Endowment:";
2880 REM Test for male. Skip if male
2890 IF SEX$ = MALE.LTR$ THEN 2930
2900 LOCATE 16,3 : PRINT "Sealed to Husband:";
2910 LOCATE 17,5 : PRINT "Husband's Rec.no:";
2920 LOCATE 18,6 : PRINT "Name:";
2930 REM test for male. Skip if not.
2940 IF SEX$ <> MALE.LTR$ THEN 3080
2950 R1 = 3 : R2 = 19 : C1 = 51 : C2 = 51 : GOSUB 3890 'Vertical Double
2960 LOCATE 4,57 : COLOR N : PRINT "Priesthood Record"; : COLOR O
2970 LOCATE 5,53 : PRINT "Aaronic:";
2980 LOCATE 6,55 : PRINT "Deacon:";
2990 LOCATE 7,55 : PRINT "Teacher:";
3000 LOCATE 8,55 : PRINT "Priest:";
3010 LOCATE 10,53 : PRINT "Melchizedek:";
3020 LOCATE 11,55 : PRINT "Elder:";
3030 LOCATE 12,55 : PRINT "Seventy:";
3040 LOCATE 13,55 : PRINT "High Priest:";
3050 LOCATE 15,53 : PRINT "Bishop:";
3060 LOCATE 16,53 : PRINT "Patriarch:";
3070 LOCATE 17,53 : PRINT "Apostle:";
3080 LOCATE 20,3 : PRINT "Occupation:";
3090 GOSUB 3110 'Print current information
3100 GOTO 3980 'For user input
3110 REM Print the Information Currently Present
3120 LOCATE 2,18 : PRINT SPACE$(47);
3130 LOCATE 2,18 : COLOR W : PRINT LEFT$(T3$ + " " + T2$,47);
3140 LOCATE 2,66 : PRINT SPACE$(12);
3150 LOCATE 2,66 : PRINT "Rec.no:"; U1;
3160 LOCATE 5,31 : PRINT SPACE$(11);
3170 LOCATE 5,31 : COLOR G : PRINT U2$;
3180 LOCATE 6,31 : PRINT SPACE$(11);
3190 LOCATE 6,31 : COLOR G : PRINT U3$;
3200 LOCATE 7,31 : PRINT SPACE$(11);
3210 LOCATE 7,31 : COLOR G : PRINT U4$;
3220 LOCATE 8,22 : PRINT SPACE$(5);
3230 LOCATE 8,22 : COLOR G : PRINT U5;
3240 IF U5 = 0 THEN T3$ = "" : T2$ = "" : GOTO 3260
3250 GET #1, U5 : GOSUB 2330
3260 IF SEX$ = MALE.LTR$ THEN NO.SP = 38 ELSE NO.SP = 51
3270 LOCATE 9,12 : PRINT SPACE$(NO.SP);
3280 LOCATE 9,12 : COLOR G : PRINT LEFT$(T3$ + " " + T2$,NO.SP);
3290 LOCATE 10,22 : PRINT SPACE$(5);
3300 LOCATE 10,22 : COLOR G : PRINT U6;
3310 IF U6 = 0 THEN T3$ = "" : T2$ = "" : GOTO 3330
3320 GET #1, U6 : GOSUB 2330
3330 LOCATE 11,12 : PRINT SPACE$(NO.SP);
3340 LOCATE 11,12 : COLOR G : PRINT LEFT$(T3$ + " " + T2$,NO.SP);
3350 LOCATE 12,31 : PRINT SPACE$(11);
3360 LOCATE 12,31 : COLOR G : PRINT U7$;
3370 LOCATE 13,31 : PRINT SPACE$(11);
3380 LOCATE 13,31 : COLOR G : PRINT U8$;
3390 LOCATE 14,31 : PRINT SPACE$(11);
3400 LOCATE 14,31 : COLOR G : PRINT U9$;
3410 LOCATE 15,31 : PRINT SPACE$(11);
3420 LOCATE 15,31 : COLOR G : PRINT U10$;
3430 REM Test for Male. Skip if Male.
3440 LOCATE 16,31 : PRINT SPACE$(11);
3450 IF SEX$ = MALE.LTR$ THEN 3540
3460 LOCATE 16,31 : COLOR G : PRINT U11$;
3470 LOCATE 17,22 : PRINT SPACE$(5);
3480 LOCATE 17,22 : COLOR G : PRINT U12;
3490 LOCATE 18,12 : PRINT SPACE$(51);
3500 IF U1 < 0 THEN 3530
3510 IF U12 = 0 THEN 3540
3520 GET #1, U12 : GOSUB 2330
3530 LOCATE 18,12 : COLOR G : PRINT T3$ + " " + T2$;
3540 REM test for male; bypass if not.
3550 IF SEX$ <> MALE.LTR$ THEN 3780
3560 LOCATE 5,67 : PRINT SPACE$(11);
3570 LOCATE 5,67 : COLOR G : PRINT U13$;
3580 LOCATE 6,67 : PRINT SPACE$(11);
3590 LOCATE 6,67 : COLOR G : PRINT U14$;
3600 LOCATE 7,67 : PRINT SPACE$(11);
3610 LOCATE 7,67 : COLOR G : PRINT U15$;
3620 LOCATE 8,67 : PRINT SPACE$(11);
3630 LOCATE 8,67 : COLOR G : PRINT U16$;
3640 LOCATE 10,67 : PRINT SPACE$(11);
3650 LOCATE 10,67 : COLOR G : PRINT U17$;
3660 LOCATE 11,67 : PRINT SPACE$(11);
3670 LOCATE 11,67 : COLOR G : PRINT U18$;
3680 LOCATE 12,67 : PRINT SPACE$(11);
3690 LOCATE 12,67 : COLOR G : PRINT U19$;
3700 LOCATE 13,67 : PRINT SPACE$(11);
3710 LOCATE 13,67 : COLOR G : PRINT U20$;
3720 LOCATE 15,67 : PRINT SPACE$(11);
3730 LOCATE 15,67 : COLOR G : PRINT U21$;
3740 LOCATE 16,67 : PRINT SPACE$(11);
3750 LOCATE 16,67 : COLOR G : PRINT U22$;
3760 LOCATE 17,67 : PRINT SPACE$(11);
3770 LOCATE 17,67 : COLOR G : PRINT U23$;
3780 LOCATE 20,15 : PRINT SPACE$(26);
3790 LOCATE 20,15 : COLOR G : PRINT U24$;
3800 COLOR W
3810 RETURN
3820 REM Subroutine to draw a double horizontal line. Attach to double.
3830 COLOR P
3840 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
3850 LOCATE R1,C1 : PRINT CHR$(204);
3860 LOCATE R1,C2 : PRINT CHR$(185);
3870 COLOR 7
3880 RETURN
3890 REM Subroutine to draw a double vertical line. Attach to double.
3900 COLOR P
3910 FOR I = R1 + 1 TO R2 - 1
3920 LOCATE I,C1 : PRINT CHR$(186);
3930 NEXT I
3940 LOCATE R1,C1 : PRINT CHR$(203);
3950 LOCATE R2,C1 : PRINT CHR$(202);
3960 COLOR W
3970 RETURN
3980 REM Routines to Obtain information from the User
3990 REM Disallow Update if Ord.no is Zero (never Created)
4000 IF U1 <> 0 THEN 4080
4010 LOCATE 22,1 : PRINT SPACE$(79); : LOCATE 22,1
4020 PRINT "Ordinance Record Number is Zero. Must run CREATORD Program First.";
4030 LOCATE 25,1 : PRINT "Press any key to continue";
4040 A$ = INKEY$ : IF A$ = "" THEN 4040
4050 GOTO 7060 'Close the Files and return to the Menu
4060 '
4070 REM Routines to Obtain information from the user if Rec.no is OK
4080 LOCATE 22,1 : PRINT SPACE$(79);
4090 LOCATE 23,1 : PRINT SPACE$(79);
4100 LOCATE 24,1 : PRINT SPACE$(79);
4110 KEY ON : COLOR W
4120 LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
4130 COLOR W,K : LOCATE 23,1
4140 LINE INPUT "Enter the Record Number: ";REPLY$
4150 IF REPLY$ = "/" THEN 6650
4160 IF REPLY$ = "" THEN 4280
4170 IF ABS(VAL(REPLY$)) = ABS(U1) THEN 4240
4180 REM Prevent Change of Rec.no
4190 LOCATE 22,1 : PRINT SPACE$(79); : LOCATE 24,1 : PRINT SPACE$(79); : LOCATE 22,1
4200 PRINT "Cannot Change the Record Number to another number.";
4210 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
4220 A$ = INKEY$ : IF A$ = "" THEN 4220
4230 GOTO 4070
4240 U1 = VAL(REPLY$)
4250 IF U1 < 1 THEN GOSUB 7120 : GOSUB 3110 : GOTO 6650 'Negative
4260 GOSUB 3140 'to Reprint
4270 '
4280 REM Terminate record update if rec.no is negative
4290 IF U1 < 0 THEN 6650 'to save, more, or forget
4300 COLOR W,K : LOCATE 23,1
4310 PRINT "Enter the Christening Date as: dd Mmm yyyy: ";
4320 LINE INPUT REPLY$
4330 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4340 IF REPLY$ = "/" THEN 6650
4350 IF REPLY$ = "" THEN 4390
4360 REPLY$ = LEFT$(REPLY$,11)
4370 RSET U2$ = REPLY$
4380 GOSUB 3160
4390 LOCATE 23,1 : PRINT SPACE$(79);
4400 LOCATE 23,1 : COLOR W
4410 PRINT "Enter the Blessing Date as: dd Mmm yyyy: ";
4420 LINE INPUT REPLY$
4430 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4440 IF REPLY$ = "/" THEN 6650
4450 IF REPLY$ = "" THEN 4490
4460 REPLY$ = LEFT$(REPLY$,11)
4470 RSET U3$ = REPLY$
4480 GOSUB 3180
4490 LOCATE 23,1 : PRINT SPACE$(79);
4500 LOCATE 23,1 : COLOR W
4510 PRINT "Enter the Date of Sealing to the Parents as: dd Mmm yyyy: ";
4520 LINE INPUT REPLY$
4530 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4540 IF REPLY$ = "/" THEN 6650
4550 IF REPLY$ = "" THEN 4590
4560 REPLY$ = LEFT$(REPLY$,11)
4570 RSET U4$ = REPLY$
4580 GOSUB 3200
4590 LOCATE 23,1 : PRINT SPACE$(79);
4600 LOCATE 23,1 : COLOR W
4610 LINE INPUT "Enter the Father's Record Number: ";REPLY$
4620 IF REPLY$ = "/" THEN 6650
4630 IF REPLY$ = "" THEN 4700
4640 U5 = VAL(REPLY$)
4650 IF U5 >= 0 AND U5 <= MAX.PER THEN 4680
4660 U5 = 0
4670 LOCATE 22,1 : PRINT "Number is out of range"; : GOTO 4590
4680 LOCATE 22,1 : PRINT SPACE$(79);
4690 GOSUB 3220
4700 LOCATE 23,1 : PRINT SPACE$(79);
4710 LOCATE 23,1 : COLOR W
4720 LINE INPUT "Enter the Mother's Record Number: ";REPLY$
4730 IF REPLY$ = "/" THEN 6650
4740 IF REPLY$ = "" THEN 4810
4750 U6 = VAL(REPLY$)
4760 IF U6 >= 0 AND U6 <= MAX.PER THEN 4790
4770 U6 = 0
4780 LOCATE 22,1 : PRINT "Number is out of range"; : GOTO 4700
4790 LOCATE 22,1 : PRINT SPACE$(79);
4800 GOSUB 3290
4810 LOCATE 23,1 : PRINT SPACE$(79);
4820 LOCATE 23,1 : COLOR W
4830 PRINT "Enter the Baptism Date as: dd Mmm yyyy: ";
4840 LINE INPUT REPLY$
4850 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4860 IF REPLY$ = "/" THEN 6650
4870 IF REPLY$ = "" THEN 4910
4880 REPLY$ = LEFT$(REPLY$,11)
4890 RSET U7$= REPLY$
4900 GOSUB 3350
4910 LOCATE 23,1 : PRINT SPACE$(79);
4920 LOCATE 23,1 : COLOR W
4930 PRINT "Enter the Confirmation Date as: dd Mmm yyyy: ";
4940 LINE INPUT REPLY$
4950 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4960 IF REPLY$ = "/" THEN 6650
4970 IF REPLY$ = "" THEN 5010
4980 REPLY$ = LEFT$(REPLY$,11)
4990 RSET U8$ = REPLY$
5000 GOSUB 3370
5010 LOCATE 23,1 : PRINT SPACE$(79);
5020 LOCATE 23,1 : COLOR W
5030 PRINT "Enter the Patriarchal Blessing Date as: dd Mmm yyyy: ";
5040 LINE INPUT REPLY$
5050 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5060 IF REPLY$ = "/" THEN 6650
5070 IF REPLY$ = "" THEN 5110
5080 REPLY$ = LEFT$(REPLY$,11)
5090 RSET U9$ = REPLY$
5100 GOSUB 3390
5110 LOCATE 23,1 : PRINT SPACE$(79);
5120 LOCATE 23,1 : COLOR W
5130 PRINT "Enter the Endowment Date as: dd Mmm yyyy: ";
5140 LINE INPUT REPLY$
5150 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5160 IF REPLY$ = "/" THEN 6650
5170 IF REPLY$ = "" THEN 5210
5180 REPLY$ = LEFT$(REPLY$,11)
5190 RSET U10$ = REPLY$
5200 GOSUB 3410
5210 REM Test for male. Skip if male
5220 IF SEX$ = MALE.LTR$ THEN 5450
5230 LOCATE 23,1 : PRINT SPACE$(79);
5240 LOCATE 23,1 : COLOR W
5250 PRINT "Enter the Date of Sealing to Husband as: dd Mmm yyyy: ";
5260 LINE INPUT REPLY$
5270 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5280 IF REPLY$ = "/" THEN 6650
5290 IF REPLY$ = "" THEN 5330
5300 REPLY$ = LEFT$(REPLY$,11)
5310 RSET U11$ = REPLY$
5320 GOSUB 3440
5330 LOCATE 23,1 : PRINT SPACE$(79);
5340 LOCATE 23,1 : COLOR W
5350 LINE INPUT "Enter the Husband's Record Number: ";REPLY$
5360 IF REPLY$ = "/" THEN 6650
5370 IF REPLY$ = "" THEN 5450
5380 U12 = VAL(REPLY$)
5390 IF U12 >= 0 AND U12 <= MAX.PER THEN 5420
5400 U12 = 0
5410 LOCATE 22,1 : PRINT "Number out of range"; : GOTO 5330
5420 LOCATE 22,1 : PRINT SPACE$(79);
5430 GOSUB 3470
5440 REM Skip Priesthood if not male.
5450 IF SEX$ <> "M" THEN 6560
5460 LOCATE 23,1 : PRINT SPACE$(79);
5470 LOCATE 23,1 : COLOR W
5480 PRINT "Enter the Aaronic Priesthood Date as: dd Mmm yyyy: ";
5490 LINE INPUT REPLY$
5500 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5510 IF REPLY$ = "/" THEN 6650
5520 IF REPLY$ = "" THEN 5560
5530 REPLY$ = LEFT$(REPLY$,11)
5540 RSET U13$ = REPLY$
5550 GOSUB 3560
5560 LOCATE 23,1 : PRINT SPACE$(79);
5570 LOCATE 23,1 : COLOR W
5580 PRINT "Enter the Deacon Date as: dd Mmm yyyy: ";
5590 LINE INPUT REPLY$
5600 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5610 IF REPLY$ = "/" THEN 6650
5620 IF REPLY$ = "" THEN 5660
5630 REPLY$ = LEFT$(REPLY$,11)
5640 RSET U14$ = REPLY$
5650 GOSUB 3580
5660 LOCATE 23,1 : PRINT SPACE$(79);
5670 LOCATE 23,1 : COLOR W
5680 PRINT "Enter the Teacher Date as: dd Mmm yyyy: ";
5690 LINE INPUT REPLY$
5700 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5710 IF REPLY$ = "/" THEN 6650
5720 IF REPLY$ = "" THEN 5760
5730 REPLY$ = LEFT$(REPLY$,11)
5740 RSET U15$ = REPLY$
5750 GOSUB 3600
5760 LOCATE 23,1 : PRINT SPACE$(79);
5770 LOCATE 23,1 : COLOR W
5780 PRINT "Enter the Priest Date as: dd Mmm yyyy: ";
5790 LINE INPUT REPLY$
5800 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5810 IF REPLY$ = "/" THEN 6650
5820 IF REPLY$ = "" THEN 5860
5830 REPLY$ = LEFT$(REPLY$,11)
5840 RSET U16$ = REPLY$
5850 GOSUB 3620
5860 LOCATE 23,1 : PRINT SPACE$(79);
5870 LOCATE 23,1 : COLOR W
5880 PRINT "Enter the Melchizedek Priesthood Date as: dd Mmm yyyy: ";
5890 LINE INPUT REPLY$
5900 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5910 IF REPLY$ = "/" THEN 6650
5920 IF REPLY$ = "" THEN 5960
5930 REPLY$ = LEFT$(REPLY$,11)
5940 RSET U17$ = REPLY$
5950 GOSUB 3640
5960 LOCATE 23,1 : PRINT SPACE$(79);
5970 LOCATE 23,1 : COLOR W
5980 PRINT "Enter the Elder Date as: dd Mmm yyyy: ";
5990 LINE INPUT REPLY$
6000 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
6010 IF REPLY$ = "/" THEN 6650
6020 IF REPLY$ = "" THEN 6060
6030 REPLY$ = LEFT$(REPLY$,11)
6040 RSET U18$ = REPLY$
6050 GOSUB 3660
6060 LOCATE 23,1 : PRINT SPACE$(79);
6070 LOCATE 23,1 : COLOR W
6080 PRINT "Enter the Seventy Date as: dd Mmm yyyy: ";
6090 LINE INPUT REPLY$
6100 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
6110 IF REPLY$ = "/" THEN 6650
6120 IF REPLY$ = "" THEN 6160
6130 REPLY$ = LEFT$(REPLY$,11)
6140 RSET U19$ = REPLY$
6150 GOSUB 3680
6160 LOCATE 23,1 : PRINT SPACE$(79);
6170 LOCATE 23,1 : COLOR W
6180 PRINT "Enter the High Priest Date as: dd Mmm yyyy: ";
6190 LINE INPUT REPLY$
6200 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
6210 IF REPLY$ = "/" THEN 6650
6220 IF REPLY$ = "" THEN 6260
6230 REPLY$ = LEFT$(REPLY$,11)
6240 RSET U20$ = REPLY$
6250 GOSUB 3700
6260 LOCATE 23,1 : PRINT SPACE$(79);
6270 LOCATE 23,1 : COLOR W
6280 PRINT "Enter the Bishop Date as: dd Mmm yyyy: ";
6290 LINE INPUT REPLY$
6300 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
6310 IF REPLY$ = "/" THEN 6650
6320 IF REPLY$ = "" THEN 6360
6330 REPLY$ = LEFT$(REPLY$,11)
6340 RSET U21$ = REPLY$
6350 GOSUB 3720
6360 LOCATE 23,1 : PRINT SPACE$(79);
6370 LOCATE 23,1 : COLOR W
6380 PRINT "Enter the Patriarch Date as: dd Mmm yyyy: ";
6390 LINE INPUT REPLY$
6400 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
6410 IF REPLY$ = "/" THEN 6650
6420 IF REPLY$ = "" THEN 6460
6430 REPLY$ = LEFT$(REPLY$,11)
6440 RSET U22$ = REPLY$
6450 GOSUB 3740
6460 LOCATE 23,1 : PRINT SPACE$(79);
6470 LOCATE 23,1 : COLOR W
6480 PRINT "Enter the Apostle Date as: dd Mmm yyyy: ";
6490 LINE INPUT REPLY$
6500 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
6510 IF REPLY$ = "/" THEN 6650
6520 IF REPLY$ = "" THEN 6560
6530 REPLY$ = LEFT$(REPLY$,11)
6540 RSET U23$ = REPLY$
6550 GOSUB 3760
6560 LOCATE 23,1 : PRINT SPACE$(79);
6570 LOCATE 23,1 : COLOR W
6580 PRINT "Enter the Person's Occupation: ";
6590 LINE INPUT REPLY$
6600 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
6610 IF REPLY$ = "/" THEN 6650
6620 IF REPLY$ = "" THEN 6650
6630 U24$ = LEFT$(REPLY$,26)
6640 GOSUB 3780
6650 REM Input is complete, now see if user wants to save the data
6660 LOCATE 24,1 : PRINT SPACE$(79);
6670 LOCATE 23,1 : PRINT SPACE$(79);
6680 LOCATE 23,1 : COLOR W
6690 LINE INPUT "Type s (save), m (more), or f (forget): ";REPLY$
6700 IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3980
6710 IF LEFT$(REPLY$,1) = "M" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3980
6720 IF LEFT$(REPLY$,1) = "f" THEN KEY ON : CLS : KEY OFF : GOTO 2060
6730 IF LEFT$(REPLY$,1) = "F" THEN KEY ON : CLS : KEY OFF : GOTO 2060
6740 IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 6780
6750 IF LEFT$(REPLY$,1) = "S" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 6780
6760 LOCATE 22,1 : PRINT "Error in reply";
6770 GOTO 6670
6780 REM Routine to SAVE the newly updated record
6790 U1! = U1 : LSET O1$ = MKS$(U1!)
6800 RSET O2$ = U2$
6810 RSET O3$ = U3$
6820 RSET O4$ = U4$
6830 U5! = U5 : LSET O5$ = MKS$(U5!)
6840 U6! = U6 : LSET O6$ = MKS$(U6!)
6850 RSET O7$ = U7$
6860 RSET O8$ = U8$
6870 RSET O9$ = U9$
6880 RSET O10$ = U10$
6890 RSET O11$ = U11$
6900 U12! = U12 : LSET O12$ = MKS$(U12!)
6910 RSET O13$ = U13$
6920 RSET O14$ = U14$
6930 RSET O15$ = U15$
6940 RSET O16$ = U16$
6950 RSET O17$ = U17$
6960 RSET O18$ = U18$
6970 RSET O19$ = U19$
6980 RSET O20$ = U20$
6990 RSET O21$ = U21$
7000 RSET O22$ = U22$
7010 RSET O23$ = U23$
7020 LSET O24$ = U24$
7030 PUT #2, REC.NO
7040 KEY ON : CLS : KEY OFF
7050 GOTO 2060
7060 REM Wrapup
7070 CLOSE #1
7080 CLOSE #2
7090 KEY ON : CLS : KEY OFF : LOCATE 21,1
7100 PRINT "End of Program"
7110 RUN CC.MENU$
7120 REM Subroutine to clean the Ordinances
7130 REM U1 is already known, and is negative
7140 U0$ = SPACE$(11)
7150 U2$ = U0$
7160 U3$ = U0$
7170 U4$ = U0$
7180 U5 = 0
7190 U6 = 0
7200 U7$ = U0$
7210 U8$ = U0$
7220 U9$ = U0$
7230 U10$ = U0$
7240 U11$ = U0$
7250 U12 = 0
7260 U13$ = U0$
7270 U14$ = U0$
7280 U15$ = U0$
7290 U16$ = U0$
7300 U17$ = U0$
7310 U18$ = U0$
7320 U19$ = U0$
7330 U20$ = U0$
7340 U21$ = U0$
7350 U22$ = U0$
7360 U23$ = U0$
7370 U24$ = ""
7380 T2$ = ""
7390 T3$ = ""
7400 RETURN
UPDATPER.BAS
100 REM UPDATPER Program.
110 REM Data Entry to the Persons File
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 OPTION BASE 0
140 DEFINT A-Z
600 REM Titles
610 TITLE$ = "Update the Persons File"
620 TITLE$ = TITLE$ + " ON DISPLAY"
700 REM Terminate if not called from the Menu
710 IF COPY2$ = "Melvin O. Duke" THEN 770
720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
730 PRINT "Cannot run the"
740 PRINT TITLE$
750 PRINT "Program, unless selected from the MENU"
760 END
770 REM OK
1000 REM Produce the first screen
1010 KEY ON : CLS : KEY OFF
1040 REM Find the title location
1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
1080 REM Print the title
1090 LOCATE 4,TITLE.POS : PRINT TITLE$
1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
1250 REM Print the Copyright
1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
1280 GOTO 1700
1300 REM subroutine to print a double box
1310 COLOR P
1320 FOR I = R1 + 1 TO R2 - 1
1330 LOCATE I, C1 : PRINT CHR$(186);
1340 LOCATE I, C2 : PRINT CHR$(186);
1350 NEXT I
1360 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
1390 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
1400 LOCATE R1, C1 : PRINT CHR$(201);
1410 LOCATE R1, C2 : PRINT CHR$(187);
1420 LOCATE R2, C1 : PRINT CHR$(200);
1430 LOCATE R2, C2 : PRINT CHR$(188);
1440 COLOR W
1450 RETURN
1700 REM Display the Copyright
1710 '
1720 LOCATE 25,1
1730 PRINT DATADISK$;
1740 K$ = INKEY$ : IF K$ = "" THEN 1740
1750 KEY ON : CLS : KEY OFF
2000 REM UPDATPER Program Starts Here.
2010 OPEN CC.PERSFILE$ AS #1 LEN = 256
2020 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$
2030 REM ask the user for input
2040 LOCATE 23,1 : PRINT SPACE$(79);
2050 LOCATE 23,1 : PRINT "(0 to quit, ? to locate unused record)";
2060 LOCATE 22,1 : PRINT SPACE$(79) : LOCATE 22,1
2070 LINE INPUT "Enter Record Number of Person to Update: "; REPLY$
2080 IF REPLY$ <> "?" THEN 2240
2090 REM Locate an unused record
2100 FOUND = 0 : IF REC.NO = 0 THEN REC.NO = 1
2110 FOR LOOK = REC.NO TO MAX.PER
2120 GET #1, LOOK
2130 LOCATE 15,1 : PRINT "Searching Record";LOOK;
2140 T1 = CVS(F1$)
2150 IF T1 > 0 THEN 2170
2160 FOUND = 1 : REC.NO = LOOK : LOOK = MAX.PER
2170 NEXT LOOK
2180 IF FOUND = 1 THEN 2330
2190 PRINT "Unable to find an unused record above record";REC.NO
2200 PRINT "Either start from record 1 or extend the file"
2210 PRINT "Press any key to continue"
2220 A$ = INKEY$ : IF A$ = "" THEN 2220
2230 GOTO 2030
2240 IF REPLY$ = "0" THEN 6330
2250 REC.NO = VAL(REPLY$)
2260 IF REC.NO < 1 OR REC.NO > MAX.PER THEN 2270 ELSE 2320
2270 PRINT : PRINT "Number is out of range"
2280 PRINT "Press any key to continue"
2290 A$ = INKEY$ : IF A$ = "" THEN 2290
2300 KEY ON : CLS : KEY OFF
2310 GOTO 2030
2320 GET #1, REC.NO
2330 REM Extract information from the file for use
2340 T1! = CVS(F1$) : T1 = T1!
2350 REM Disallow Update if Rec.no is Zero (never Created)
2360 IF T1 <> 0 THEN 2420
2370 LOCATE 22,1 : PRINT SPACE$(79);: LOCATE 23,1 : PRINT SPACE$(79);: LOCATE 22,1
2380 PRINT "Record Number is Zero. Must run the CREATPER Program First."
2390 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
2400 A$ = INKEY$ : IF A$ = "" THEN 2400
2410 GOTO 6330 'Close the Files and return to the Menu
2420 T2$ = F2$ 'Surname
2430 T3$ = F3$ 'Given Names
2440 FOR J = 1 TO LEN(F3$)-1
2450 IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
2460 NEXT J
2470 T4$ = F4$ 'Sex
2480 IF LEFT$(T4$,1) = MALE.LTR$ THEN T4$ = MALE.SEX$
2490 IF LEFT$(T4$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.SEX$
2500 T5! = CVS(F5$) 'Code
2510 T6! = CVS(F6$) : T6 = T6! 'Father's No.
2520 T7! = CVS(F7$) : T7 = T7! 'Mother's No.
2530 T8$ = F8$ 'Birthdate
2540 T9$ = F9$
2550 T10$ = F10$
2560 T11$ = F11$
2570 T12$ = F12$ 'Death Date
2580 T13$ = F13$
2590 T14$ = F14$
2600 T15$ = F15$
2610 T16$ = F16$ 'Burial Date
2620 T17$ = F17$
2630 T18$ = F18$
2640 T19$ = F19$
2650 KEY ON : CLS : KEY OFF
2660 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1300 'Double box
2670 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3750 'Horizontal double
2680 LOCATE 2,3 : PRINT "Personal Information of:"
2690 R1 = 3 : C1 = 43 : R2 = 21 : C2 = 43 : GOSUB 3890 'Vertical Double
2700 LOCATE 4,3 : COLOR N : PRINT "Person:"; : COLOR O
2710 LOCATE 5,3 : PRINT "Record-number:";
2720 LOCATE 7,3 : PRINT "Surname:";
2730 LOCATE 9,3 : PRINT "Given-names:";
2740 LOCATE 11,3 : PRINT "Sex:";
2750 IF CODE$ = "no" THEN 2770
2760 LOCATE 12,3 : PRINT "Code:";
2770 R1 = 13 : C1 = 1 : R2 =13 : C2 = 43 : GOSUB 3750 'Horizontal Double
2780 LOCATE 14,3 : COLOR N : PRINT "Person's Father:"; : COLOR O
2790 LOCATE 15,3 : PRINT "Record-number:";
2800 LOCATE 16,3 : PRINT "Name:";
2810 R1 = 17 : C1 = 1 : R2 = 17 : C2 = 43 : GOSUB 3820 'Horizontal Single
2820 LOCATE 18,3 : COLOR N : PRINT "Person's Mother:"; : COLOR O
2830 LOCATE 19,3 : PRINT "Record-number:";
2840 LOCATE 20,3 : PRINT "Name:";
2850 LOCATE 4,45 : COLOR N : PRINT "Person's Vital Statistics:"; : COLOR O
2860 LOCATE 6,45 : PRINT "Birth-date:";
2870 LOCATE 7,45 : PRINT "Birth-city:";
2880 LOCATE 8,45 : PRINT "Birth-county:";
2890 LOCATE 9,45 : PRINT "State/Country:";
2900 LOCATE 11,45 : PRINT "Death-date:";
2910 LOCATE 12,45 : PRINT "Death-city:";
2920 LOCATE 13,45 : PRINT "Death-county:";
2930 LOCATE 14,45 : PRINT "State/Country:";
2940 LOCATE 16,45 : PRINT "Burial-date:";
2950 LOCATE 17,45 : PRINT "Burial-city:";
2960 LOCATE 18,45 : PRINT "Burial-county:";
2970 LOCATE 19,45 : PRINT "State/Country:";
2980 GOSUB 3000 'To print the current information
2990 GOTO 3980 'For User Input
3000 REM Print the Information Currently Present
3010 LOCATE 2,28 : PRINT SPACE$(50); : COLOR W
3020 LOCATE 2,28 : PRINT LEFT$(T3$ + " " + T2$,50);
3030 LOCATE 6,8 : PRINT SPACE$(5);
3040 LOCATE 6,8 : COLOR G : PRINT T1;
3050 LOCATE 8,9 : PRINT SPACE$(20);
3060 LOCATE 8,9 : COLOR G : PRINT LEFT$(T2$,20);
3070 LOCATE 10,9 : PRINT SPACE$(30);
3080 LOCATE 10,9 : COLOR G : PRINT LEFT$(T3$,30);
3090 LOCATE 11,9 : PRINT SPACE$(20);
3100 LOCATE 11,9 : COLOR G : PRINT LEFT$(T4$,20);
3110 IF CODE$ = "no" THEN 3140
3120 LOCATE 12,8 : PRINT SPACE$(15);
3130 LOCATE 12,8 : COLOR G : PRINT T5!;
3140 LOCATE 15,18 : PRINT SPACE$(5);
3150 LOCATE 15,18 : COLOR G : PRINT T6;
3160 REM Obtain the Father's Record
3170 IF T6 = 0 THEN SN$ = " " : GN$ = " " : GOTO 3270
3180 GET #1, T6
3190 SN$ = F2$ : GN$ = F3$
3200 REM right-trim the names
3210 FOR J = 1 TO LEN(F2$)-1
3220 IF RIGHT$(SN$,1)=" "THEN SN$=LEFT$(SN$,LEN(SN$)-1) ELSE J=LEN(F2$)-1
3230 NEXT J
3240 FOR J = 1 TO LEN(F3$)-1
3250 IF RIGHT$(GN$,1)=" "THEN GN$=LEFT$(GN$,LEN(GN$)-1) ELSE J=LEN(F3$)-1
3260 NEXT J
3270 NM$ = SN$ + ", " + GN$
3280 IF SN$ = " " OR GN$ = " " THEN NM$ = SN$ + " " + GN$
3290 IF SN$ = " " AND GN$ = " " THEN NM$ = " "
3300 LOCATE 16, 9 : PRINT SPACE$(33);
3310 LOCATE 16, 9 : COLOR G : PRINT LEFT$(NM$,33);
3320 LOCATE 19,18 : PRINT SPACE$(5);
3330 LOCATE 19,18 : COLOR G : PRINT T7;
3340 REM Obtain the Mother's Record
3350 IF T7 = 0 THEN SN$ = " " : GN$ = " " : GOTO 3450
3360 GET #1, T7
3370 SN$ = F2$ : GN$ = F3$
3380 REM right-trim the names
3390 FOR J = 1 TO LEN(F2$)-1
3400 IF RIGHT$(SN$,1)=" "THEN SN$=LEFT$(SN$,LEN(SN$)-1) ELSE J=LEN(F2$)-1
3410 NEXT J
3420 FOR J = 1 TO LEN(F3$)-1
3430 IF RIGHT$(GN$,1)=" "THEN GN$=LEFT$(GN$,LEN(GN$)-1) ELSE J=LEN(F3$)-1
3440 NEXT J
3450 NM$ = SN$ + ", " + GN$
3460 IF SN$ = " " OR GN$ = " " THEN NM$ = SN$ + " " + GN$
3470 IF SN$ = " " AND GN$ = " " THEN NM$ = " "
3480 LOCATE 20, 9 : PRINT SPACE$(33);
3490 LOCATE 20, 9 : COLOR G : PRINT LEFT$(NM$,33);
3500 LOCATE 6,60 : PRINT SPACE$(11);
3510 LOCATE 6,60 : COLOR G : PRINT T8$;
3520 LOCATE 7,60 : PRINT SPACE$(18);
3530 LOCATE 7,60 : COLOR G : PRINT T9$;
3540 LOCATE 8,60 : PRINT SPACE$(16);
3550 LOCATE 8,60 : COLOR G : PRINT T10$;
3560 LOCATE 9,60 : PRINT SPACE$(16);
3570 LOCATE 9,60 : COLOR G : PRINT T11$;
3580 LOCATE 11,60 : PRINT SPACE$(11);
3590 LOCATE 11,60 : COLOR G : PRINT T12$;
3600 LOCATE 12,60 : PRINT SPACE$(18);
3610 LOCATE 12,60 : COLOR G : PRINT T13$;
3620 LOCATE 13,60 : PRINT SPACE$(16);
3630 LOCATE 13,60 : COLOR G : PRINT T14$;
3640 LOCATE 14,60 : PRINT SPACE$(16);
3650 LOCATE 14,60 : COLOR G : PRINT T15$;
3660 LOCATE 16,60 : PRINT SPACE$(11);
3670 LOCATE 16,60 : COLOR G : PRINT T16$;
3680 LOCATE 17,60 : PRINT SPACE$(18);
3690 LOCATE 17,60 : COLOR G : PRINT T17$;
3700 LOCATE 18,60 : PRINT SPACE$(16);
3710 LOCATE 18,60 : COLOR G : PRINT T18$;
3720 LOCATE 19,60 : PRINT SPACE$(16);
3730 LOCATE 19,60 : COLOR G : PRINT T19$; : COLOR W
3740 RETURN
3750 REM Subroutine to draw a double horizontal line. Attach to double.
3760 COLOR P
3770 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
3780 LOCATE R1,C1 : PRINT CHR$(204);
3790 LOCATE R1,C2 : PRINT CHR$(185);
3800 COLOR W
3810 RETURN
3820 REM Subroutine to draw a single horizontal line. Attach to double.
3830 COLOR P
3840 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
3850 LOCATE R1,C1 : PRINT CHR$(199);
3860 LOCATE R1,C2 : PRINT CHR$(182);
3870 COLOR W
3880 RETURN
3890 REM Subroutine to draw a double vertical line. Attach to double.
3900 COLOR P
3910 FOR I = R1 + 1 TO R2 - 1
3920 LOCATE I,C1 : PRINT CHR$(186);
3930 NEXT I
3940 LOCATE R1,C1 : PRINT CHR$(203);
3950 LOCATE R2,C1 : PRINT CHR$(202);
3960 COLOR W
3970 RETURN
3980 REM Routines to Obtain information from the User
3990 LOCATE 22,1 : PRINT SPACE$(79);
4000 LOCATE 23,1 : PRINT SPACE$(79);
4010 LOCATE 24,1 : PRINT SPACE$(79);
4020 KEY ON
4030 LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
4040 LOCATE 23,1
4050 LINE INPUT "Enter the Record Number: ";REPLY$
4060 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4070 IF REPLY$ = "/" THEN 5970
4080 IF REPLY$ = "" THEN 4190
4090 IF ABS(VAL(REPLY$)) = ABS(T1) THEN 4160 ELSE 4100
4100 REM Prevent Change of Rec.no
4110 LOCATE 22,1 : PRINT SPACE$(79); : LOCATE 24,1 : PRINT SPACE$(79); : LOCATE 22,1
4120 PRINT "Cannot Change the Record Number to another number.";
4130 KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
4140 A$ = INKEY$ : IF A$ = "" THEN 4140
4150 GOTO 3980
4160 T1 = VAL(REPLY$)
4170 IF T1 < 1 THEN GOSUB 6370 : GOSUB 3000 : GOTO 5970 'Negative
4180 GOSUB 3000
4190 LOCATE 23,1 : PRINT SPACE$(79);
4200 REM Terminate record update if rec.no is negative
4210 IF T1 < 0 THEN 5970
4220 LOCATE 23,1
4230 PRINT "Enter the Person's Surname (all capital letters): ";
4240 LINE INPUT REPLY$
4250 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4260 IF REPLY$ = "/" THEN 5970
4270 IF REPLY$ = "" THEN 4300
4280 T2$ = LEFT$(REPLY$,20)
4290 GOSUB 3000
4300 LOCATE 23,1 : PRINT SPACE$(79);
4310 LOCATE 23,1
4320 PRINT "Enter the Person's Given Names: ";
4330 LINE INPUT REPLY$
4340 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4350 IF REPLY$ = "/" THEN 5970
4360 IF REPLY$ = "" THEN 4390
4370 T3$ = LEFT$(REPLY$,30)
4380 GOSUB 3000
4390 LOCATE 23,1 : PRINT SPACE$(79); : LOCATE 23,1
4400 PRINT "Enter the Person's Sex (";MALE.LTR$;" for ";MALE.SEX$;
4410 PRINT " or ";FEMALE.LTR$;" for ";FEMALE.SEX$;"): ";
4420 LINE INPUT REPLY$
4430 LOCATE 24,1 : PRINT SPACE$(79);
4440 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4450 IF REPLY$ = "/" THEN 5970
4460 IF REPLY$ = "" THEN 4530
4470 T4$ = LEFT$(REPLY$,2)
4480 IF LEFT$(REPLY$,1) = CHR$(ASC(MALE.LTR$)+32) THEN T4$ = MALE.SEX$
4490 IF LEFT$(REPLY$,1) = MALE.LTR$ THEN T4$ = MALE.SEX$
4500 IF LEFT$(REPLY$,1) = CHR$(ASC(FEMALE.LTR$)+32) THEN T4$ = FEMALE.SEX$
4510 IF LEFT$(REPLY$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.SEX$
4520 GOSUB 3090
4530 LOCATE 23,1 : PRINT SPACE$(79);
4540 IF CODE$ = "no" THEN 4630
4550 LOCATE 23,1
4560 LINE INPUT "Enter the Person's Code: ";REPLY$
4570 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4580 IF REPLY$ = "/" THEN 5970
4590 IF REPLY$ = "" THEN 4620
4600 T5! = VAL(REPLY$)
4610 GOSUB 3120
4620 LOCATE 23,1 : PRINT SPACE$(79);
4630 LOCATE 23,1
4640 LINE INPUT "Enter the Father's Record Number: ";REPLY$
4650 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4660 IF REPLY$ = "/" THEN 5970
4670 IF REPLY$ = "" THEN 4740
4680 T6 = VAL(REPLY$)
4690 IF T6 >= 0 AND T6 <= MAX.PER THEN 4720
4700 T6 = 0
4710 LOCATE 22,1 : PRINT "Number out of Range"; : GOTO 4620
4720 LOCATE 22,1 : PRINT SPACE$(79);
4730 GOSUB 3140
4740 LOCATE 23,1 : PRINT SPACE$(79);
4750 LOCATE 23,1
4760 LINE INPUT "Enter the Mother's Record Number: ";REPLY$
4770 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4780 IF REPLY$ = "/" THEN 5970
4790 IF REPLY$ = "" THEN 4860
4800 T7 = VAL(REPLY$)
4810 IF T7 >= 0 AND T7 <= MAX.PER THEN 4840
4820 T7 = 0
4830 LOCATE 22,1 : PRINT "Number out of Range"; : GOTO 4740
4840 LOCATE 22,1 : PRINT SPACE$(79);
4850 GOSUB 3320
4860 LOCATE 23,1 : PRINT SPACE$(79);
4870 LOCATE 23,1
4880 PRINT "Enter the Person's Birth-date as: dd Mmm yyyy: ";
4890 LINE INPUT REPLY$
4900 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
4910 IF REPLY$ = "/" THEN 5970
4920 IF REPLY$ = "" THEN 4960
4930 REPLY$ = LEFT$(REPLY$,11)
4940 RSET T8$ = REPLY$
4950 GOSUB 3500
4960 LOCATE 23,1 : PRINT SPACE$(79);
4970 LOCATE 23,1
4980 PRINT "Enter the Person's Birth-city: ";
4990 LINE INPUT REPLY$
5000 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5010 IF REPLY$ = "/" THEN 5970
5020 IF REPLY$ = "" THEN 5050
5030 T9$ = LEFT$(REPLY$,18)
5040 GOSUB 3520
5050 LOCATE 23,1 : PRINT SPACE$(79);
5060 LOCATE 23,1
5070 PRINT "Enter the Person's Birth-county: ";
5080 LINE INPUT REPLY$
5090 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5100 IF REPLY$ = "/" THEN 5970
5110 IF REPLY$ = "" THEN 5140
5120 T10$ = LEFT$(REPLY$,16)
5130 GOSUB 3540
5140 LOCATE 23,1 : PRINT SPACE$(79);
5150 LOCATE 23,1
5160 PRINT "Enter the Person's Birth-state or Country: ";
5170 LINE INPUT REPLY$
5180 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5190 IF REPLY$ = "/" THEN 5970
5200 IF REPLY$ = "" THEN 5230
5210 T11$ = LEFT$(REPLY$,16)
5220 GOSUB 3560
5230 LOCATE 23,1 : PRINT SPACE$(79);
5240 LOCATE 23,1
5250 PRINT "Enter the Person's Death-date as: dd Mmm yyyy: ";
5260 LINE INPUT REPLY$
5270 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5280 IF REPLY$ = "/" THEN 5970
5290 IF REPLY$ = "" THEN 5330
5300 REPLY$ = LEFT$(REPLY$,11)
5310 RSET T12$ = REPLY$
5320 GOSUB 3580
5330 LOCATE 23,1 : PRINT SPACE$(79);
5340 LOCATE 23,1
5350 PRINT "Enter the Person's Death-city: ";
5360 LINE INPUT REPLY$
5370 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5380 IF REPLY$ = "/" THEN 5970
5390 IF REPLY$ = "" THEN 5420
5400 T13$ = LEFT$(REPLY$,18)
5410 GOSUB 3600
5420 LOCATE 23,1 : PRINT SPACE$(79);
5430 LOCATE 23,1
5440 PRINT "Enter the Person's Death-county: ";
5450 LINE INPUT REPLY$
5460 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5470 IF REPLY$ = "/" THEN 5970
5480 IF REPLY$ = "" THEN 5510
5490 T14$ = LEFT$(REPLY$,16)
5500 GOSUB 3620
5510 LOCATE 23,1 : PRINT SPACE$(79);
5520 LOCATE 23,1
5530 PRINT "Enter the Person's Death-state or Country: ";
5540 LINE INPUT REPLY$
5550 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5560 IF REPLY$ = "/" THEN 5970
5570 IF REPLY$ = "" THEN 5600
5580 T15$ = LEFT$(REPLY$,16)
5590 GOSUB 3640
5600 LOCATE 23,1 : PRINT SPACE$(79);
5610 LOCATE 23,1
5620 PRINT "Enter the Person's Burial-date as: dd Mmm yyyy: ";
5630 LINE INPUT REPLY$
5640 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5650 IF REPLY$ = "/" THEN 5970
5660 IF REPLY$ = "" THEN 5700
5670 REPLY$ = LEFT$(REPLY$,11)
5680 RSET T16$ = REPLY$
5690 GOSUB 3660
5700 LOCATE 23,1 : PRINT SPACE$(79);
5710 LOCATE 23,1
5720 PRINT "Enter the Person's Burial-city: ";
5730 LINE INPUT REPLY$
5740 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5750 IF REPLY$ = "/" THEN 5970
5760 IF REPLY$ = "" THEN 5790
5770 T17$ = LEFT$(REPLY$,18)
5780 GOSUB 3680
5790 LOCATE 23,1 : PRINT SPACE$(79);
5800 LOCATE 23,1
5810 PRINT "Enter the Person's Burial-county: ";
5820 LINE INPUT REPLY$
5830 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5840 IF REPLY$ = "/" THEN 5970
5850 IF REPLY$ = "" THEN 5880
5860 T18$ = LEFT$(REPLY$,16)
5870 GOSUB 3700
5880 LOCATE 23,1 : PRINT SPACE$(79);
5890 LOCATE 23,1
5900 PRINT "Enter the Person's Burial-state or Country: ";
5910 LINE INPUT REPLY$
5920 IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
5930 IF REPLY$ = "/" THEN 5970
5940 IF REPLY$ = "" THEN 5970
5950 T19$ = LEFT$(REPLY$,16)
5960 GOSUB 3720
5970 REM Input is complete, now see if user wants to save the data
5980 LOCATE 24,1 : PRINT SPACE$(79);
5990 LOCATE 23,1 : PRINT SPACE$(79);
6000 LOCATE 23,1
6010 LINE INPUT "Type s (save), m (more), or f (forget): ";REPLY$
6020 IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3980
6030 IF LEFT$(REPLY$,1) = "M" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3980
6040 IF LEFT$(REPLY$,1) = "f" THEN KEY ON : CLS : KEY OFF : GOTO 2030
6050 IF LEFT$(REPLY$,1) = "F" THEN KEY ON : CLS : KEY OFF : GOTO 2030
6060 IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 6100
6070 IF LEFT$(REPLY$,1) = "S" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 6100
6080 LOCATE 22,1 : PRINT "Error in reply";
6090 GOTO 5990
6100 REM Routine to SAVE the newly updated record
6110 T1! = T1 : LSET F1$ = MKS$(T1!)
6120 LSET F2$ = T2$
6130 LSET F3$ = T3$
6140 LSET F4$ = LEFT$(T4$,1)
6150 LSET F5$ = MKS$(T5!)
6160 T6! = T6 : LSET F6$ = MKS$(T6!)
6170 T7! = T7 : LSET F7$ = MKS$(T7!)
6180 RSET F8$ = T8$
6190 LSET F9$ = T9$
6200 LSET F10$ = T10$
6210 LSET F11$ = T11$
6220 RSET F12$ = T12$
6230 LSET F13$ = T13$
6240 LSET F14$ = T14$
6250 LSET F15$ = T15$
6260 RSET F16$ = T16$
6270 LSET F17$ = T17$
6280 LSET F18$ = T18$
6290 LSET F19$ = T19$
6300 PUT #1, REC.NO
6310 KEY ON : CLS : KEY OFF
6320 GOTO 2030
6330 CLOSE #1
6340 KEY ON : CLS : KEY OFF : LOCATE 21,1
6350 PRINT "End of Program"
6360 RUN CC.MENU$
6370 REM Blank out a negative record
6380 T2$ = ""
6390 T3$ = ""
6400 T4$ = ""
6410 T5!= 0
6420 T6 = 0
6430 T7 = 0
6440 T8$ = SPACE$(11)
6450 T9$ = ""
6460 T10$ = ""
6470 T11$ = ""
6480 T12$ = SPACE$(11)
6490 T13$ = ""
6500 T14$ = ""
6510 T15$ = ""
6520 T16$ = SPACE$(11)
6530 T17$ = ""
6540 T18$ = ""
6550 T19$ = ""
6560 RETURN
USINGTHE.BAS
100 REM USINGTHE Program.
110 REM Documentation. Using the Programs.
120 REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
130 DATA Genealogy
140 DATA User's Manual
150 DATA -5
160 DATA 1
170 INDENT = 0
180 REM Printer Definitions
190 FORM.FEED$ = CHR$(12)
200 COMPR.OFF$ = CHR$(18) : COMPR.ON$ = CHR$(15)
210 BOLD.OFF$ = CHR$(27)+"F" : BOLD.ON$ = CHR$(27)+"E"
220 EXPAND.OFF$ = CHR$(18) : EXPAND.ON$ = CHR$(14)
230 DASHES$ = "+"+STRING$(54,45)+"+"
240 TRIM.LINE$ = "(Trim-line)"
300 REM Program begins here
310 READ TITLE$, DOC.NAME$, PAGE.NO, LINE.NO
320 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
330 GOSUB 920 'For trim line and heading space
340 FOR I = 1 TO 6 : LPRINT : NEXT I
350 LPRINT BOLD.ON$; 'Set Emphasized mode
360 LPRINT EXPAND.ON$; 'Set Expanded Print
370 LPRINT TAB(TAB.POS-1);TITLE$
380 LPRINT EXPAND.OFF$; 'Return to normal
390 LPRINT BOLD.OFF$; 'Return to normal
400 FOR I = 1 TO 3 : LPRINT : NEXT I
410 LPRINT BOLD.ON$; 'Set Emphasized mode
420 LPRINT TAB(TAB.POS+12);"ON DISPLAY"
430 LPRINT BOLD.OFF$; 'Return to normal
440 LPRINT : LPRINT : LPRINT
450 LPRINT TAB(TAB.POS+11);"Version 6.0"
460 FOR I = 1 TO 11 : LPRINT : NEXT I
470 LPRINT TAB(TAB.POS+10); DOC.NAME$
480 LINE.NO = LINE.NO + 27
490 '
500 READ REPLY$
510 REM First, change tildes to quotes
520 FOR Q = 1 TO LEN(REPLY$)
530 IF MID$(REPLY$,Q,1)="~"THEN MID$(REPLY$,Q,1)=CHR$(34)
540 NEXT Q
550 IF LEFT$(REPLY$,1) = "." THEN GOSUB 1270: GOTO 500
560 IF LINE.NO > 44 THEN GOSUB 1030
570 REM Print the line if not a command
580 LPRINT TAB(TAB.POS);REPLY$
590 LINE.NO = LINE.NO + 1
600 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
610 GOTO 500
620 REM Data for the Copyright Page
630 DATA ".pa"
640 DATA " "
750 DATA ".vt 31"
870 DATA "Copyright (c) 1983 ... 1989, by:"
880 DATA "Melvin O. Duke."
890 DATA ".sp"
900 DATA "All rights reserved."
910 '
920 REM Top of each page routine
930 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
940 LPRINT
950 LPRINT TAB(30); TRIM.LINE$
960 LPRINT DASHES$ 'Dashes
970 FOR I = 1 TO 6
980 LPRINT
990 NEXT I
1000 LINE.NO = LINE.NO + 6
1010 RETURN
1020 '
1030 REM Bottom of each page Routine
1040 IF PAGE.NO < 1 THEN LPRINT : LPRINT : LPRINT : GOTO 1160
1050 LPRINT TAB(TAB.POS); STRING$(40,45) 'on line 46
1060 LPRINT TAB(TAB.POS+3); TITLE$+" ON DISPLAY. Version 6.0" 'on line 47
1070 IF PAGE.NO MOD 2 = 1 THEN 1110
1080 LPRINT TAB(TAB.POS);"Page";PAGE.NO;
1090 LPRINT TAB(TAB.POS+27);"User's Manual"
1100 GOTO 1160
1110 LPRINT TAB(TAB.POS); "User's Manual";
1120 IF PAGE.NO < 10 THEN DELTA = 34
1130 IF PAGE.NO > 9 THEN DELTA = 33
1140 IF PAGE.NO > 99 THEN DELTA = 32
1150 LPRINT TAB(TAB.POS+DELTA); "Page"; PAGE.NO 'on line 48
1160 LPRINT : LPRINT : LPRINT
1170 LPRINT DASHES$ 'dashes after 51
1180 LPRINT TAB(30); TRIM.LINE$
1190 LPRINT FORM.FEED$;
1200 PAGE.NO = PAGE.NO + 1
1210 LINE.NO = 1
1220 IF REPLY$ = ".eof" THEN 1240 'Bypass after last page
1230 GOSUB 920 'For top of next page
1240 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1250 RETURN
1260 '
1270 REM Command Processor
1280 IF LEFT$(REPLY$,3) = ".h1" THEN 1390
1290 IF LEFT$(REPLY$,3) = ".h2" THEN 1550
1300 IF LEFT$(REPLY$,3) = ".h3" THEN 1660
1310 IF LEFT$(REPLY$,3) = ".sp" THEN 1770
1320 IF LEFT$(REPLY$,4) = ".eof" THEN 1820
1330 IF LEFT$(REPLY$,3) = ".pa" THEN 1860
1340 IF LEFT$(REPLY$,3) = ".pn" THEN PAGE.NO = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3)) : RETURN
1350 IF LEFT$(REPLY$,3) = ".vt" THEN 1930
1360 IF LEFT$(REPLY$,3) = ".pk" THEN 2040
1370 IF LEFT$(REPLY$,3) = ".in" THEN 2170
1380 STOP
1390 REM Head 1 Processor
1400 FOR I = LINE.NO TO 44
1410 LPRINT
1420 NEXT I
1430 GOSUB 1030 'Bottom of page Routine
1440 IF PAGE.NO MOD 2 = 0 THEN GOSUB 1860 'For h1 on Odd pages
1450 LPRINT BOLD.ON$; 'Set emphasized print
1460 LPRINT EXPAND.ON$; 'Set expanded print
1470 IF PAGE.NO MOD 2 = 0 THEN ADJUST = -2 ELSE ADJUST = -5
1480 LPRINT TAB(TAB.POS+ADJUST); RIGHT$(REPLY$,LEN(REPLY$)-4)
1490 LPRINT EXPAND.OFF$; 'Return to normal
1500 LPRINT BOLD.OFF$; 'Return to non-bold
1510 LINE.NO = LINE.NO+1
1520 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1530 RETURN
1540 '
1550 REM Head 2 Processor
1560 IF LINE.NO = 7 THEN 1580 'skip spacing if at top of page
1570 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1580 LPRINT BOLD.ON$; 'Set emphasized print
1590 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1600 LPRINT BOLD.OFF$; 'Return to normal
1610 LPRINT
1620 LINE.NO = LINE.NO + 2
1630 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1640 RETURN
1650 '
1660 REM Head 3 Processor
1670 IF LINE.NO = 7 THEN 1690 'skip spacing if at top of page
1680 IF LINE.NO > 43 THEN GOSUB 1860 ELSE LPRINT:LPRINT:LINE.NO = LINE.NO+2
1690 LPRINT BOLD.ON$; 'Set emphasized print
1700 LPRINT TAB(TAB.POS+1); RIGHT$(REPLY$,LEN(REPLY$)-4)
1710 LPRINT BOLD.OFF$; 'Return to normal
1720 LPRINT
1730 LINE.NO = LINE.NO + 2
1740 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1750 RETURN
1760 '
1770 REM Single Space Processor
1780 IF LINE.NO = 7 THEN 1800
1790 IF LINE.NO > 44 THEN GOSUB 1860 ELSE LPRINT : LINE.NO = LINE.NO + 1
1800 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
1810 RETURN
1820 REM End of File Processor
1830 GOSUB 1860 'Bottom of Page
1850 GOTO 9550
1860 REM Page Eject Processor
1870 FOR I = LINE.NO TO 44
1880 LPRINT
1890 LINE.NO = LINE.NO + 1
1900 NEXT I
1910 GOSUB 1030 'Bottom of Page Processing
1920 RETURN
1930 REM Vertical Tab Processor
1940 IF LINE.NO = 7 THEN 2030
1950 IF LINE.NO > 44 THEN GOSUB 1030 'End of page
1960 QTY = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
1970 FOR I = 1 TO QTY
1980 LPRINT
1990 LINE.NO = LINE.NO + 1
2000 IF LINE.NO > 44 THEN I = QTY
2010 NEXT I
2020 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2030 RETURN
2040 REM Pack Processor
2050 IF LINE.NO > 44 THEN GOSUB 1030
2060 IF TAB.POS = 8 THEN ADJUST = 4
2070 IF TAB.POS = 13 THEN ADJUST = 7
2080 TAB.POS = TAB.POS + ADJUST + INDENT
2090 WIDTH "lpt1:", 132 'set condensed width
2100 LPRINT COMPR.ON$; 'Packed printing
2110 LPRINT TAB(TAB.POS); RIGHT$(REPLY$,LEN(REPLY$)-3)
2120 LPRINT COMPR.OFF$; 'Return to normal
2130 WIDTH "lpt1:", 80 'return to normal
2140 LINE.NO = LINE.NO + 1
2150 IF PAGE.NO MOD 2 = 0 THEN TAB.POS = 8 ELSE TAB.POS = 13
2160 RETURN
2170 REM Indent Processor
2180 INDENT = VAL(RIGHT$(REPLY$,LEN(REPLY$)-3))
2190 RETURN
3000 DATA ".h1 USING THE PROGRAMS"
3010 DATA ".pn 23"
3020 DATA ".h2 GETTING STARTED"
3030 DATA "Whatever the environment, the User"
3040 DATA "should be working with a copy of the"
3050 DATA "Distribution Diskette, not from the"
3060 DATA "original, which should not be changed."
3070 DATA ".sp"
3080 DATA "Whether the User is starting for the"
3090 DATA "first time, or running at a later time,"
3100 DATA "the procedure is the same. BASIC is"
3110 DATA "required (with a record size set to"
3120 DATA "256), and the MENU Program must be run."
3130 DATA ".sp"
3140 DATA "A few differences exist, depending upon"
3150 DATA "the User's Hardware. The following"
3160 DATA "sections describe First Time Usage for"
3170 DATA "three different configurations, as well"
3180 DATA "as Operating within those environments."
3190 DATA ".pa"
3200 DATA ".h2 First Time Usage - One-Drive System"
3210 DATA "Begin with two formatted diskettes."
3220 DATA "(These should be formatted without in-"
3230 DATA "cluding the System.)"
3240 DATA ".sp"
3250 DATA "Label one of them your Data Diskette,"
3260 DATA "and the other your Program Diskette."
3270 DATA ".sp"
3280 DATA "Copy the contents of the Genealogy ON"
3290 DATA "DISPLAY Distribution Diskette to the"
3300 DATA "diskette labeled 'Program Diskette'."
3310 DATA "(Note: Refer to the DISKCOPY Command"
3320 DATA "in your DOS Manual.)"
3330 DATA ".sp"
3340 DATA "Copy MENU.BAS and VERIFILE from the"
3350 DATA "Distribution Diskette to your Data"
3360 DATA "Diskette. (Note: Refer to the COPY"
3370 DATA "Command in your DOS Manual.)"
3380 DATA ".sp"
3390 DATA "(Skip to the section on First Time"
3400 DATA "Usage for all Systems, below.)"
3410 DATA ".pa"
3420 DATA ".h2 First Time Usage - Two-Drive System"
3430 DATA "Begin with two formatted diskettes."
3440 DATA "(These should be formatted without in-"
3450 DATA "cluding the System.)"
3460 DATA ".sp"
3470 DATA "Label one of them your Data Diskette,"
3480 DATA "and the other your Program Diskette."
3490 DATA ".sp"
3500 DATA "Copy the contents of the Genealogy ON"
3510 DATA "DISPLAY Distribution Diskette to the"
3520 DATA "diskette labeled 'Program Diskette'."
3530 DATA "(Note: Refer to the DISKCOPY Command"
3540 DATA "in your DOS Manual.)"
3550 DATA ".sp"
3560 DATA "Next, with your DOS Diskette (which"
3570 DATA "contains BASIC in your a: drive,"
3580 DATA "bring up BASIC by typing:"
3590 DATA ".sp"
3600 DATA " basic/s:256 (and press 'enter')"
3610 DATA ".sp"
3620 DATA "Now, replace the DOS Diskette with"
3630 DATA "your new Program Diskette, and edit"
3640 DATA "the MENU.BAS Program to identify"
3650 DATA "where your files will be. Type:"
3660 DATA ".sp"
3670 DATA " load ~menu~ (and press 'enter')"
3680 DATA ".sp"
3690 DATA "Next, type:"
3700 DATA ".sp"
3710 DATA " edit 440 (and press 'enter')"
3720 DATA ".sp"
3730 DATA "Insert a b:\ between the two quotes"
3740 DATA " (i.e. 440 DD.PERS$ = ~b:\~"
3750 DATA " and press 'enter')"
3760 DATA ".pa"
3770 DATA "Do the same thing for lines 450, 470,"
3780 DATA "and 480."
3790 DATA ".sp"
3800 DATA "If you want an LDS Ordinance File,"
3810 DATA "change the ~no~ in line 460 to ~b:\~"
3820 DATA "as well."
3830 DATA ".sp"
3840 DATA "Save the changed MENU Program. Type:"
3850 DATA ".sp"
3860 DATA " save ~menu~ (and press 'enter')"
3870 DATA ".sp"
3880 DATA "(Skip to the section on First Time"
3890 DATA "Usage for all Systems, below.)"
3900 DATA ".pa"
3910 DATA ".h2 First Time Usage - Hard-Disk System"
3920 DATA "Begin by making a Sub-directory on your"
3930 DATA "hard-disk for the Genealogy ON DISPLAY"
3940 DATA "Programs, and their data files. Type:"
3950 DATA ".sp"
3960 DATA " mkdir \genondis (and press 'enter')"
3970 DATA ".sp"
3980 DATA "Copy the BASIC Processor into the new"
3990 DATA "Sub-directory. Type:"
4000 DATA ".sp"
4010 DATA " copy c:\basic.com c:\genondis"
4020 DATA " (and press 'enter')"
4030 DATA ".sp"
4040 DATA "Next, copy the contents of the Distri-"
4050 DATA "bution Diskette of Genealogy ON DISPLAY"
4060 DATA "to that Sub-directory. Type:"
4070 DATA ".sp"
4080 DATA " copy a:\*.* c:\genondis"
4090 DATA " (and press 'enter')"
4100 DATA ".pa"
4110 DATA ".h2 First Time Usage - All Systems"
4120 DATA ".h3 Formatting the Data Files"
4130 DATA "Each of the Data Files which you will"
4140 DATA "be using must be formatted (created)"
4150 DATA "initially, before you can enter any"
4160 DATA "genealogical information. This will"
4170 DATA "mean bringing up BASIC, running the"
4180 DATA "MENU Program, and selecting options"
4190 DATA "1 and 2 (and 3 if you want an LDS"
4200 DATA "Ordinance File)."
4210 DATA ".sp"
4220 DATA "Refer to the next section, 'HOW TO"
4230 DATA "OPERATE'."
4240 DATA ".h3 Caution
4250 DATA "A word of extreme caution: Once you"
4260 DATA "have run the CREATPER Program, the"
4270 DATA "CREATMAR Program, and the CREATORD"
4280 DATA "Programs, you do NOT, repeat NOT, want"
4290 DATA "to run them again (at least not"
4300 DATA "against the same files)."
4310 DATA ".sp"
4320 DATA "To do so would mean that you would"
4330 DATA "wipe-out any previous data that was in"
4340 DATA "the files at the time that you ran the"
4350 DATA "programs again."
4360 DATA ".pa"
4370 DATA ".h2 HOW TO OPERATE."
4380 DATA "Operation is slightly different, de-"
4390 DATA "pending upon the hardware that you"
4400 DATA "are using."
4410 DATA ".sp"
4420 DATA "Essentially, it is necessary to turn"
4430 DATA "on your computer, bring up DOS,"
4440 DATA "establish the date and time (if you"
4450 DATA "do not already have that as part of"
4460 DATA "your system), bring up BASIC, and"
4470 DATA "RUN the MENU.BAS Program."
4480 DATA ".sp"
4490 DATA ".h2 How to Operate - One-Drive System"
4500 DATA "With your DOS System in your Diskette"
4510 DATA "Drive, turn on your system."
4520 DATA ".sp"
4530 DATA "Respond to any messages about date"
4540 DATA "and time that may occur."
4550 DATA ".sp"
4560 DATA "Next, bring up BASIC by typing:"
4570 DATA ".sp"
4580 DATA " basic/s:256 (and press 'enter')"
4590 DATA ".sp~
4600 DATA "Now, place your Genealogy ON DISPLAY"
4610 DATA "Program Diskette in your Diskette"
4620 DATA "Drive, and type:"
4630 DATA ".sp"
4640 DATA " run ~menu~"
4650 DATA ".sp"
4660 DATA "Follow any directions that appear at"
4670 DATA "the bottom of the display screen."
4680 DATA ".pa"
4690 DATA ".h2 How to Operate - Two-Drive System"
4700 DATA "With your DOS System in your a: Disk-"
4710 DATA "ette Drive, turn on your system."
4720 DATA ".sp"
4730 DATA "Respond to any messages about date"
4740 DATA "and time that may occur."
4750 DATA ".sp"
4760 DATA "Next, bring up BASIC by typing:"
4770 DATA ".sp"
4780 DATA " basic/s:256 (and press 'enter')"
4790 DATA ".sp~
4800 DATA "Now, place your Genealogy ON DISPLAY"
4810 DATA "Program Diskette in your a: Diskette"
4820 DATA "Drive, and your Data Diskette in your"
4830 DATA "b: Diskette Drive. Then type:"
4840 DATA ".sp"
4850 DATA " run ~menu~ (and press 'enter')"
4860 DATA ".sp"
4870 DATA "Follow any directions that appear at"
4880 DATA "the bottom of the display screen."
4890 DATA ".pa"
4900 DATA ".h2 How to Operate - Hard-Disk System"
4910 DATA "Turn on your system."
4920 DATA ".sp"
4930 DATA "Change to the Genealogy ON DISPLAY"
4940 DATA "Sub-directory. Type:"
4950 DATA ".sp"
4960 DATA " cd\genondis (and press 'enter')"
4970 DATA ".sp"
4980 DATA "Now, bring up BASIC and start the"
4990 DATA "MENU Program. Type:"
5000 DATA ".sp"
5010 DATA " basic menu/s:256"
5020 DATA " (and press 'enter')"
5030 DATA ".sp"
5040 DATA "Follow any directions that appear at"
5050 DATA "the bottom of the display screen."
5060 DATA ".pa"
5070 DATA ".h3 Operating the CREATPER Program.
5080 DATA "After selecting the CREATPER Program,"
5090 DATA "the user sees the program Title and"
5100 DATA "Copyright displayed on the screen."
5110 DATA "He should then press any key to cause"
5120 DATA "the program to continue."
5130 DATA ".sp"
5140 DATA "The record numbers of the records to"
5150 DATA "be written are controlled by the"
5160 DATA "contents of lines 610 and 630 in the"
5170 DATA "MENU Program. Initially these are"
5180 DATA "set to 500 and 0 respectively. This"
5190 DATA "means that records from 1 through 500"
5200 DATA "will be written, if the user chooses"
5210 DATA "to do so."
5220 DATA ".sp"
5230 DATA "A second screen is displayed, to give"
5240 DATA "the user a chance to change his mind."
5250 DATA "If he REALLY wants to format these"
5260 DATA "records, he replies by typing:"
5270 DATA ".sp"
5280 DATA " yes (and presses 'enter')"
5290 DATA ".sp"
5300 DATA "and the records are written to the"
5310 DATA "Persons File."
5320 DATA ".pa"
5330 DATA ".h3 Operating the CREATMAR Program.
5340 DATA "After selecting the CREATMAR Program,"
5350 DATA "the user sees the program Title and"
5360 DATA "Copyright displayed on the screen."
5370 DATA "He should then press any key to cause"
5380 DATA "the program to continue."
5390 DATA ".sp"
5400 DATA "The record numbers of the records to"
5410 DATA "be written are controlled by the"
5420 DATA "contents of lines 620 and 640 in the"
5430 DATA "MENU Program. Initially these are"
5440 DATA "set to 200 and 0 respectively. This"
5450 DATA "means that records from 1 through 200"
5460 DATA "will be written, if the user chooses"
5470 DATA "to do so."
5480 DATA ".sp"
5490 DATA "A second screen is displayed, to give"
5500 DATA "the user a chance to change his mind."
5510 DATA "If he REALLY wants to format these"
5520 DATA "records, he replies by typing:"
5530 DATA ".sp"
5540 DATA " yes (and presses 'enter')"
5550 DATA ".sp"
5560 DATA "and the records are written to the"
5570 DATA "Marriages File."
5580 DATA ".pa"
5590 DATA ".h3 Operating the CREATORD Program.
5600 DATA "After selecting the CREATORD Program,"
5610 DATA "the user sees the program Title and"
5620 DATA "Copyright displayed on the screen."
5630 DATA "He should then press any key to cause"
5640 DATA "the program to continue."
5650 DATA ".sp"
5660 DATA "The record numbers of the records to"
5670 DATA "be written are controlled by the"
5680 DATA "contents of lines 610 and 630 in the"
5690 DATA "MENU Program. Initially these are"
5700 DATA "set to 500 and 0 respectively. This"
5710 DATA "means that records from 1 through 500"
5720 DATA "will be written, if the user chooses"
5730 DATA "to do so."
5740 DATA ".sp"
5750 DATA "A second screen is displayed, to give"
5760 DATA "the user a chance to change his mind."
5770 DATA "If he REALLY wants to format these"
5780 DATA "records, he replies by typing:"
5790 DATA ".sp"
5800 DATA " yes (and presses 'enter')"
5810 DATA ".sp"
5820 DATA "and the records are written to the"
5830 DATA "Ordinances File."
5840 DATA ".pa"
5850 DATA ".h3 Operating the UPDATPER Program."
5860 DATA "After selecting the UPDATPER Program,"
5870 DATA "the user sees the program Title and"
5880 DATA "Copyright on the screen. He should"
5890 DATA "then press any key to continue."
5900 DATA ".sp"
5910 DATA "After the logo is displayed, the user"
5920 DATA "is asked which record he wants to up-"
5930 DATA "date. He should respond with a valid"
5940 DATA "number in the range of 1 to 500."
5950 DATA ".sp"
5960 DATA "(Note: If you just want to find an"
5970 DATA "unused record, you may type a question-"
5980 DATA "mark. A search will be made from the"
5990 DATA "the beginning of the file, or from the"
6000 DATA "last record which you referenced, until"
6010 DATA "an unused record is found, or the top"
6020 DATA "of the file is reached.)"
6030 DATA ".sp"
6040 DATA "The current content of the record is"
6050 DATA "shown. If the record has never been"
6060 DATA "used, the record-number shown will be"
6070 DATA "negative. As long as this number is"
6080 DATA "negative, it will be bypassed for any"
6090 DATA "further processing. The user should"
6100 DATA "enter the record-number."
6110 DATA ".sp"
6120 DATA "The user is prompted for input. He may"
6130 DATA "bypass any field by pressing the enter"
6140 DATA "key. He may also bypass all remaining"
6150 DATA "fields by typing / and then pressing"
6160 DATA "the enter key."
6170 DATA ".sp"
6180 DATA "Note: Dates should be entered as:"
6190 DATA "dd Mmm yyyy, such as: 16 Jan 1943."
6200 DATA ".pa"
6210 DATA "When finished with his updating, he is"
6220 DATA "asked to indicate what he wants to do"
6230 DATA "with the record. He may either 'save'"
6240 DATA "it, he may 'forget' it, or he may make"
6250 DATA "'more' changes to the record. As soon"
6260 DATA "as he says 'save', the record is saved"
6270 DATA "and he is once more prompted about the"
6280 DATA "next record to update."
6290 DATA ".sp"
6300 DATA "When he is through, he should indicate"
6310 DATA "that he wants to update record 0."
6320 DATA ".pa"
6330 DATA ".h3 Operating the UPDATMAR Program."
6340 DATA "After selecting the UPDATMAR Program,"
6350 DATA "the user sees the Program Title and"
6360 DATA "Copyright on the screen. He should"
6370 DATA "then press any key to continue."
6380 DATA ".sp"
6390 DATA "After the logo is displayed, the user"
6400 DATA "is asked which record he wants to up-"
6410 DATA "date. He should respond with a valid"
6420 DATA "number in the range of 1 to 200."
6430 DATA ".sp"
6440 DATA "(Note: If you just want to find an"
6450 DATA "unused record, you may type a question-"
6460 DATA "mark. A search will be made from the"
6470 DATA "the beginning of the file, or from the"
6480 DATA "last record which you referenced, until"
6490 DATA "an unused record is found, or the top"
6500 DATA "of the file is reached.)"
6510 DATA ".sp"
6520 DATA "The current content of the record is"
6530 DATA "shown. If the record has never been"
6540 DATA "used, the record-number shown will be"
6550 DATA "negative. As long as this number is"
6560 DATA "negative, it will be bypassed for any"
6570 DATA "further processing. The user should"
6580 DATA "enter the record-number."
6590 DATA ".sp"
6600 DATA "The user is prompted for input. He may"
6610 DATA "bypass any field by pressing the enter"
6620 DATA "key. He may also bypass all remaining"
6630 DATA "fields by typing / and then pressing"
6640 DATA "the enter key."
6650 DATA ".pa"
6660 DATA "When finished with his updating, he is"
6670 DATA "asked to indicate what he wants to do"
6680 DATA "with the record. He may either 'save'"
6690 DATA "it, he may 'forget' it, or he may make"
6700 DATA "'more' changes to the record. As soon"
6710 DATA "as he says 'save', the record is saved"
6720 DATA "and he is once more prompted about the"
6730 DATA "next record to update."
6740 DATA ".sp"
6750 DATA "When he is through, he should indicate"
6760 DATA "that he wants to update record 0."
6770 DATA ".pa"
6780 DATA ".h2 Operating the UPDATORD Program."
6790 DATA "After selecting the UPDATORD Program,"
6800 DATA "the user sees the Program Title and"
6810 DATA "Copyright on the screen. He should"
6820 DATA "then press any key to continue."
6830 DATA ".sp"
6840 DATA "After the logo is displayed, the user"
6850 DATA "is asked which record he wants to up-"
6860 DATA "date. He should respond with a valid"
6870 DATA "number in the range of 1 to 500."
6880 DATA ".sp"
6890 DATA "(Note: You cannot search for an unused"
6900 DATA "ordinances record, since it is always"
6910 DATA "associated with a person's record.)"
6920 DATA ".sp"
6930 DATA "The user is prompted for input. He may"
6940 DATA "bypass any field by pressing the enter"
6950 DATA "key. He may also bypass all remaining"
6960 DATA "fields by typing / and then pressing"
6970 DATA "the enter key."
6980 DATA ".sp"
6990 DATA "Dates should be entered as: dd Mmm yyyy,"
7000 DATA "such as: 22 Aug 1922."
7010 DATA ".sp"
7020 DATA "When finished with his updating, he is"
7030 DATA "asked to indicate what he wants to do"
7040 DATA "with the record. He may either 'save'"
7050 DATA "it, he may 'forget' it, or he may make"
7060 DATA "'more' changes to the record. As soon"
7070 DATA "as he says 'save', the record is saved"
7080 DATA "and he is once more prompted about the"
7090 DATA "next record to update."
7100 DATA ".sp"
7110 DATA "When he is through, he should indicate"
7120 DATA "that he wants to update record 0."
7130 DATA ".pa"
7140 DATA ".h3 Operating the INDEXPC Program."
7150 DATA "The INDEXPC Program is fundamental to"
7160 DATA "the preparation of a parent/child index,"
7170 DATA "which associates parents with their"
7180 DATA "children."
7190 DATA ".sp"
7200 DATA "It should be run after any additions"
7210 DATA "of persons to the Persons File, when-"
7220 DATA "ever birthdates are added or changed,"
7230 DATA "or when identification of parents have"
7240 DATA "been added or changed."
7250 DATA ".sp"
7260 DATA "After selecting the INDEXPC Program,"
7270 DATA "the user sees the Program Title and"
7280 DATA "Copyright on the screen. He should"
7290 DATA "then press any key to continue."
7300 DATA ".sp"
7310 DATA "A data file named PCINDEX will be"
7320 DATA "created."
7330 DATA ".pa"
7340 DATA ".h3 Operating the INDEXMAR Program."
7350 DATA "The INDEXMAR program is fundamental to"
7360 DATA "the preparation of a marriages index,"
7370 DATA "which associates spouses with each"
7380 DATA "other."
7390 DATA ".sp"
7400 DATA "It should be run after marriages are"
7410 DATA "added to the Marriages File, whenever"
7420 DATA "marriage-dates are added or changed,"
7430 DATA "or whenever changes are made which re-"
7440 DATA "identify spouses."
7450 DATA ".sp"
7460 DATA "After selecting the INDEXMAR Program,"
7470 DATA "the user sees the Program Title and"
7480 DATA "Copyright on the screen. He should"
7490 DATA "then press any key to continue."
7500 DATA ".sp"
7510 DATA "A data file named MINDEX will be"
7520 DATA "created."
7530 DATA ".pa"
7540 DATA ".h3 Operating the DISPLAY Program."
7550 DATA "Before running the DISPLAY Program,"
7560 DATA "the user should know that any changes"
7570 DATA "that he has made to the data files may"
7580 DATA "have made his indexes out-of-date."
7590 DATA "This will have happened if the user"
7600 DATA "has entered a new person, a new"
7610 DATA "marriage, a new relationship (such as"
7620 DATA "a reference to a parent), a new"
7630 DATA "birth-date, a new marriage-date, or"
7640 DATA "a new Name."
7650 DATA ".sp"
7660 DATA "The indexes are still correct if the"
7670 DATA "user has entered new death-dates,"
7680 DATA "burial-dates, or any information about"
7690 DATA "locations (cities, counties, states)"
7700 DATA "of births, deaths, ordinances, etc."
7710 DATA ".sp"
7720 DATA "If the indexes are out-of-date, the"
7730 DATA "user should update them before running"
7740 DATA "the DISPLAY Program, by running the"
7750 DATA "INDEXPER and INDEXMAR Programs."
7760 DATA ".sp"
7770 DATA "After selecting the DISPLAY Program,"
7780 DATA "the user sees the Program Title and"
7790 DATA "Copyright on the screen. He should"
7800 DATA "then press any key to continue."
7810 DATA ".sp"
7820 DATA "After the logo is displayed, the user"
7830 DATA "is asked for the record-number of the"
7840 DATA "person that he wants to locate. He"
7850 DATA "should enter a number which he knows to"
7860 DATA "be valid."
7870 DATA ".pa"
7880 DATA "The personal information about that"
7890 DATA "person will then be shown on the display."
7900 DATA ".sp"
7910 DATA "The user may then enter 'ps' (print"
7920 DATA "the screen), he may enter 'an' (for an"
7930 DATA "ancestor chart), he may enter 'fg' (for"
7940 DATA "a family group), he may enter 'o' (for"
7950 DATA "ordinance information), he may enter 'p'"
7960 DATA "followed by a valid number (requesting"
7970 DATA "information about a person), he may enter"
7980 DATA "'m' followed by a valid number (requesting"
7990 DATA "information about a marriage), or he may"
8000 DATA "enter 'q' (asking to quit)."
8010 DATA ".sp"
8020 DATA "When the ancestor information appears,"
8030 DATA "the user may then enter 'ps' (print the"
8040 DATA "screen, he may enter 'fg' (requesting"
8050 DATA "a family group), he may enter 'o' (for"
8060 DATA "ordinance information), He may enter 'an'"
8070 DATA "(asking that the chart of ancestors be"
8080 DATA "re-drawn), he may enter 'l' followed by"
8090 DATA "a valid number (requesting personal"
8100 DATA "information about a person on the stated"
8110 DATA "line), he may enter 'm' followed by a"
8120 DATA "valid number (requesting information"
8130 DATA "about a marriage), or he may enter 'q'"
8140 DATA "(asking to quit)."
8150 DATA ".pa"
8160 DATA "When the family group information appears,"
8170 DATA "the user may enter 'ps' (print the"
8180 DATA "screen), he may enter 'f' (asking for the"
8190 DATA "father), he may enter 'm' (asking for the"
8200 DATA "mother), he may enter 'p' followed by a"
8210 DATA "valid number (asking for about a person),"
8220 DATA "he may enter 'c' followed by a valid"
8230 DATA "number (asking for information about a"
8240 DATA "child), he may enter 'm' followed by a"
8250 DATA "valid number (requesting information"
8260 DATA "about a marriage, or he may enter 'q'"
8270 DATA "(asking to quit)."
8280 DATA ".sp"
8290 DATA "When the ordinance information appears,"
8300 DATA "The user may then enter 'ps' (print"
8310 DATA "the screen), he may enter 'an' (for an"
8320 DATA "ancestor chart), he may enter 'fg' (for"
8330 DATA "a family group), he may enter 'o' (for"
8340 DATA "ordinance information), he may enter 'p'"
8350 DATA "followed by a valid number (requesting"
8360 DATA "information about a person), he may enter"
8370 DATA "'m' followed by a valid number (request-"
8380 DATA "ing information about a marriage), or he"
8390 DATA "may enter 'q' (asking to quit)."
8400 DATA ".pa"
8410 DATA ".h2 Operating the ANCESTOR Program"
8420 DATA "After selecting the ANCESTOR Program,"
8430 DATA "the user sees the Program Title and"
8440 DATA "Copyright on the screen. He should"
8450 DATA "then press any key to continue."
8460 DATA ".sp"
8470 DATA "He should then follow any instructions"
8480 DATA "which appear at the bottom of the screen,"
8490 DATA "specifying the person-number of the per-"
8500 DATA "son whose Chart of Ancestors is desired."
8510 DATA "(Note: If the record selected is empty,"
8520 DATA "a blank ancestor chart will be printed.)"
8530 DATA ".sp"
8540 DATA "Note: Any available printer paper which"
8550 DATA "fits your printer may be used."
8560 DATA ".pa"
8570 DATA ".h2 Operating the FAMILY Program"
8580 DATA "After selecting the FAMILY Program,"
8590 DATA "the user sees the Program Title and"
8600 DATA "Copyright on the screen. He should"
8610 DATA "then press any key to continue."
8620 DATA ".sp"
8630 DATA "He should then follow any instructions"
8640 DATA "which appear at the bottom of the screen,"
8650 DATA "specifying the marriage-number of the"
8660 DATA "marriage whose Chart of Family is de-"
8670 DATA "sired. (Note: If the record selected"
8680 DATA "is empty, a blank Chart of Family will"
8690 DATA "be be printed.)"
8700 DATA ".sp"
8710 DATA "Note: Any available printer paper which"
8720 DATA "fits your printer may be used."
8730 DATA ".pa"
8740 DATA ".h3 Operating the DESCEND Program"
8750 DATA "After selecting the DESCEND Program,"
8760 DATA "the user sees the Program Title and"
8770 DATA "Copyright on the screen. He should"
8780 DATA "then press any key to continue."
8790 DATA ".sp"
8800 DATA "He should then follow any instructions"
8810 DATA "which appear at the bottom of the screen,"
8820 DATA "specifying the person-number of the"
8830 DATA "person whose Chart of Descendants is"
8840 DATA "desired."
8850 DATA ".h3 Operating the Other Programs."
8860 DATA "After selecting one of the other pro-"
8870 DATA "grams, the user sees the Program Title"
8880 DATA "and Copyright on the screen. He should"
8890 DATA "then press any key to continue."
8900 DATA ".sp"
8910 DATA "Note: See the Summary (in Appendix B)"
8920 DATA "for the names of the other programs."
8930 DATA ".sp"
8940 DATA "After the logo is displayed, the user"
8950 DATA "observes the information that is being"
8960 DATA "shown on the display screen, and waits"
8970 DATA "for the program to complete."
8980 DATA ".pa"
8990 DATA ".h2 HOW TO STOP."
9000 DATA "The user may stop at any time, by"
9010 DATA "pressing (and holding down) the Function"
9020 DATA "(FN) key, and then pressing the Break"
9030 DATA "(B) key on the PCjr."
9040 DATA ".sp"
9050 DATA "The user may stop at any time, by"
9060 DATA "pressing (and holding down) the control"
9070 DATA "(Ctrl) key, and then pressing the Break"
9080 DATA "key on the other members of the IBM PC"
9090 DATA "Family of Computers."
9100 DATA ".sp"
9110 DATA ".h3 Stopping the Update Programs."
9120 DATA "The user may stop one of the update"
9130 DATA "programs (UPDATPER, UPDATMAR, or"
9140 DATA "UPDATORD) by requesting an update of"
9150 DATA "record 0."
9160 DATA ".h3 Stopping the DISPLAY Program."
9170 DATA "The user may stop the DISPLAY Program"
9180 DATA "by typing 'q' or 'quit' when he is asked"
9190 DATA "for his next action, or he may type"
9200 DATA "'p0', to request person-number 0."
9210 DATA ".h3 Stopping the ANCESTOR Program."
9220 DATA "The user may stop the ANCESTOR Program"
9230 DATA "by asking for a printout of the ances-"
9240 DATA "tors of person-number 0."
9250 DATA ".pa"
9260 DATA ".h3 Stopping the FAMILY Program."
9270 DATA "The user may stop the FAMILY Program"
9280 DATA "by asking for a printout of the family"
9290 DATA "whose marriage-number is 0."
9300 DATA ".h3 Stopping the DESCEND Program."
9310 DATA "The user may stop the DESCEND Program"
9320 DATA "by asking for the display or printout"
9330 DATA "of the descendants of the person whose"
9340 DATA "person-number is 0."
9350 DATA ".h3 Stopping the Other Programs."
9360 DATA "The other programs may only be stopped"
9370 DATA "with the 'function-break' or the"
9380 DATA "'control-break' sequence, as indicated"
9390 DATA "above. However, the user is cautioned"
9400 DATA "that if he does this while writing new"
9410 DATA "indexes to the diskette (during the"
9420 DATA "running of the INDEXPC or INDEXMAR"
9430 DATA "programs), the index that is currently"
9440 DATA "being written may be destroyed, and"
9450 DATA "will have to be re-built before the"
9460 DATA "DISPLAY, PEDIGREE, FAMILY and ALPHAMAR"
9470 DATA "programs are run."
9480 DATA ".sp"
9490 DATA "The damaged index can be re-built by"
9500 DATA "re-running the INDEXPC or INDEXMAR"
9510 DATA "program which was stopped with the"
9520 DATA "'function-break' or 'control-break'"
9530 DATA "sequence."
9540 DATA ".pa"
9550 DATA ".eof"
9560 END
Directory of PC-SIG Library Disk #0090
Volume in drive A has no label
Directory of A:\
ALPHAMAR BAS 4680 1-30-89 5:36p
ALPHAPER BAS 4926 1-30-89 5:36p
ANCESTOR BAS 24262 1-30-89 5:36p
APPENDIX BAS 28960 1-30-89 5:34p
CREATMAR BAS 2333 1-30-89 5:34p
CREATORD BAS 3128 1-30-89 5:34p
CREATPER BAS 2864 1-30-89 5:34p
DESCEND BAS 13432 1-30-89 5:37p
DIRECTOR BAS 16085 1-30-89 8:16p
DISPLAY BAS 24489 1-30-89 5:36p
FAMILY BAS 22630 1-30-89 5:37p
FILES90 TXT 2490 2-17-89 3:55p
GENERAL BAS 18845 1-30-89 5:33p
INDEXMAR BAS 5229 1-30-89 5:35p
INDEXPC BAS 5321 1-30-89 5:35p
INTRODUC BAS 12583 1-30-89 5:33p
LISTMAR BAS 3494 1-30-89 5:36p
LISTPCI BAS 3267 1-30-89 5:36p
LISTPER BAS 2835 1-30-89 5:36p
MENU BAS 13006 2-05-89 9:33a
OVERVIEW BAS 13113 1-30-89 5:33p
PRINTERS BAS 1352 1-30-89 5:33p
PRINTMAR BAS 3811 1-30-89 5:35p
PRINTPER BAS 6499 1-30-89 5:35p
READ ME 1082 10-08-88 7:19a
REFERENC BAS 17893 2-05-89 9:30a
TABLEOFC BAS 13343 1-30-89 8:15p
UPDATMAR BAS 11292 1-30-89 5:35p
UPDATORD BAS 16226 1-30-89 5:35p
UPDATPER BAS 14442 1-30-89 5:35p
USINGTHE BAS 29379 1-30-89 5:34p
VERIFILE 256 1-15-86 9:22a
32 file(s) 343547 bytes
0 bytes free