90 WIDTH "scrn:", 80
95 SCREEN 0,1,0,0
100 TITLE$ = "Pedigree Program"
105 TITLE$ = TITLE$ + " ON DISPLAY"
110 VERSION$ = "Version 2.0"
115 COPY1$ = "Copyright (c) 1983, 1984, by:"
120 COPY2$ = "Melvin O. Duke"
125 PRICE$ = "$35"
130 ADDR1$ = "Melvin O. Duke"
135 ADDR2$ = "P. O. Box 20836"
140 ADDR3$ = "San Jose, CA  95160"
145 REM Dimension Statements go here
150 DIM PA.ID(1000), CH.ID(1000), PERS.NO(400), M.NO(400)
160 DIM PERS(31), FORM$(49)
170 REM Produce the first screen
175 KEY OFF : CLS
180 REM Draw the outer double box
185 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
190 REM Find the title location
195 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
200 REM Draw the title box
205 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
210 REM Print the title
215 LOCATE 4,TITLE.POS : PRINT TITLE$
220 LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
225 REM Draw the Contribution box
230 R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
235 REM Request the Contribution
240 LOCATE 9,23 : PRINT "If you are using these programs, and"
245 LOCATE 10,21 : PRINT "finding them of value, your contribution"
250 LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
255 REM Draw the Mailing Label
260 R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
265 REM Print the Name and Address
270 LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
275 LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
280 LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
285 REM Draw the Copyright box
290 R1 = 19 : C1 = 24 : R2 = 22 : C2 = 56 : GOSUB 400
295 REM Print the Copyright
300 LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
305 LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
310 GOTO 740
400 REM subroutine to print a double box
410 FOR I = R1 + 1 TO R2 - 1
420  LOCATE I, C1 : PRINT CHR$(186);
430  LOCATE I, C2 : PRINT CHR$(186);
440 NEXT I
450 FOR J = C1 + 1 TO C2 - 1
460  LOCATE R1, J : PRINT CHR$(205);
470  LOCATE R2, J : PRINT CHR$(205);
480 NEXT J
490  LOCATE R1, C1 : PRINT CHR$(201);
500  LOCATE R1, C2 : PRINT CHR$(187);
510  LOCATE R2, C1 : PRINT CHR$(200);
520  LOCATE R2, C2 : PRINT CHR$(188);
530 RETURN
600 REM subroutine to print a single box
610 FOR I = R1 + 1 TO R2 - 1
620  LOCATE I, C1 : PRINT CHR$(179);
630  LOCATE I, C2 : PRINT CHR$(179);
640 NEXT I
650 FOR J = C1 + 1 TO C2 - 1
660  LOCATE R1, J : PRINT CHR$(196);
670  LOCATE R2, J : PRINT CHR$(196);
680 NEXT J
690  LOCATE R1, C1 : PRINT CHR$(218);
700  LOCATE R1, C2 : PRINT CHR$(191);
710  LOCATE R2, C1 : PRINT CHR$(192);
720  LOCATE R2, C2 : PRINT CHR$(217);
730 RETURN
740 REM ask user to press a key to continue
750 LOCATE 25,1
760 PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
770 K$ = INKEY$ : IF K$ = "" THEN 770
780 CLS
840 CLS
1000 REM Pedigree Program.
1010 REM By:  Melvin O. Duke.  Last Updated:  02 December 1983.
1020 REM Routine to obtain Printer Information
1030 LOCATE 21,1 : PRINT "Make sure that the Printer is on and Ready"
1040 LOCATE 22,1 : PRINT "Make sure that the correct Diskette(s) are in place."
1050 LOCATE 23,1 : PRINT "Then press any key"
1060 A$ = INKEY$ : IF A$ = "" THEN 1060
1070 CLS
1080 REM reset all Printer Defaults
1090 'LPRINT CHR$(18); 'Normal Printing
1100 'LPRINT CHR$(27)"9";  'Paper Sensing ON
1110 WIDTH "lpt1:", 132  'For printing Genealogy Forms
1120 REM Ask User about his Printer
1130 LOCATE 20,1 : PRINT "How Wide is the Paper";
1140 LOCATE 21,3 : COLOR 0,7 : PRINT "1"; : COLOR 7,0
1150 LOCATE 21,6 : PRINT "8 - 1/2 inches";
1160 LOCATE 22,3 : COLOR 0,7 : PRINT "2"; : COLOR 7,0
1170 LOCATE 22,6 : PRINT "14 inches";
1180 LOCATE 23,1 : PRINT SPACE$(79);
1190 LOCATE 23,1 : INPUT "Enter 1 or 2"; REPLY$
1200 REM verify input
1210 IF VAL(REPLY$) = 1 OR VAL(REPLY$) = 2 THEN 1240
1220 LOCATE 19,1 : PRINT "Error in Previous Reply";
1230 GOTO 1130
1240 LOCATE 19,1 : PRINT SPACE$(79);
1250 LOCATE 20,1 : PRINT SPACE$(79);
1260 LOCATE 21,1 : PRINT SPACE$(79);
1270 LOCATE 22,1 : PRINT SPACE$(79);
1280 LOCATE 23,1 : PRINT SPACE$(79);
1290 WIDE = VAL(REPLY$)
1300 LOCATE 3,1
1310 IF WIDE = 1 THEN PRINT "Using 8-1/2 inch width paper"; : GOTO 1330
1320 PRINT "Using 14 inch width paper";
1330 LOCATE 20,1 : PRINT "How Long is the Paper";
1340 LOCATE 21,3 : COLOR 0,7 : PRINT "1"; : COLOR 7,0
1350 LOCATE 21,6 : PRINT "8 - 1/2 inches";
1360 LOCATE 22,3 : COLOR 0,7 : PRINT "2"; : COLOR 7,0
1370 LOCATE 22,6 : PRINT "11 inches";
1380 LOCATE 23,1 : PRINT SPACE$(79);
1390 LOCATE 23,1 : INPUT "Enter 1 or 2"; REPLY$
1400 REM verify input
1410 IF VAL(REPLY$) = 1 OR VAL(REPLY$) = 2 THEN 1440
1420 LOCATE 19,1 : PRINT "Error in Previous Reply";
1430 GOTO 1330
1440 LOCATE 19,1 : PRINT SPACE$(79);
1450 LOCATE 20,1 : PRINT SPACE$(79);
1460 LOCATE 21,1 : PRINT SPACE$(79);
1470 LOCATE 22,1 : PRINT SPACE$(79);
1480 LOCATE 23,1 : PRINT SPACE$(79);
1490 LENGTH = VAL(REPLY$)
1500 LOCATE 5,1
1510 IF LENGTH = 1 THEN PRINT "Using 8-1/2 inch length paper"; : GOTO 1530
1520 PRINT "Using 11 inch length paper";
1530 LOCATE 20,1 : PRINT "Describe the Forms to be Used";
1540 LOCATE 21,3 : COLOR 0,7 : PRINT "1"; : COLOR 7,0
1550 LOCATE 21,6 : PRINT "Continuous";
1560 LOCATE 22,3 : COLOR 0,7 : PRINT "2"; : COLOR 7,0
1570 LOCATE 22,6 : PRINT "Single Sheets";
1580 LOCATE 23,1 : PRINT SPACE$(79);
1590 LOCATE 23,1 : INPUT "Enter 1 or 2"; REPLY$
1600 REM verify input
1610 IF VAL(REPLY$) = 1 OR VAL(REPLY$) = 2 THEN 1640
1620 LOCATE 19,1 : PRINT "Error in Previous Reply";
1630 GOTO 1530
1640 LOCATE 19,1 : PRINT SPACE$(79);
1650 LOCATE 20,1 : PRINT SPACE$(79);
1660 LOCATE 21,1 : PRINT SPACE$(79);
1670 LOCATE 22,1 : PRINT SPACE$(79);
1680 LOCATE 23,1 : PRINT SPACE$(79);
1690 FORMS = VAL(REPLY$)
1700 LOCATE 7,1
1710 IF FORMS = 1 THEN PRINT "Using Continuous Forms"; : GOTO 1730
1720 PRINT "Using Single Sheets";
1730 LOCATE 20,1 : PRINT "Is the above information correct?"
1740 LOCATE 21,1 : INPUT "Enter 'y' or 'n' for 'yes' or 'no'"; REPLY$
1750 IF LEFT$(REPLY$,1) = "y" OR LEFT$(REPLY$,1) = "Y" THEN 1760 ELSE 1070
1760 CLS
1770 REM By:  Melvin O. Duke.
1780 REM Read the Marriage Index
1790 LOCATE 7,1 : PRINT "Open the Marriage Index";
1800 OPEN "a:mindex" FOR INPUT AS #2
1810 INPUT #2, M.COUNT
1820 FOR I = 1 TO M.COUNT
1830 LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
1840  INPUT #2,PERS.NO(I), M.NO(I)
1850 NEXT I
1860 CLOSE #2
1870 REM Open the Persons File
1880 LOCATE 10,1 : PRINT "Open the Persons File"
1890 OPEN "a:persfile" AS #1 LEN = 256
1900 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$
1910 REM open the Marriages File
1920 LOCATE 12,1 : PRINT "Open the Marriage File"
1930 OPEN "a:marrfile" AS #2 LEN = 128
1940 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$
1950 REM Obtain a Person Record from the User
1960 LOCATE 20,1 : INPUT "Enter the Record-number of a Person (0 to quit)";PERS(1)
1970 IF PERS(1) = 0 THEN 6570
1980 IF PERS(1) < 1 OR PERS(1) > 500 THEN CLS: GOTO 1950
1990 REM
2000 REM Reset the Printer characteristics for next page if required.
2010 IF FORMS = 1 THEN 2050  'Don't stop if forms are continuous
2020 REM process single sheets
2030 PRINT "Press any key when next form is ready"
2040 A$ = INKEY$ : IF A$ = "" THEN 2040
2050 REM Reset paper sensing if required
2060 IF FORMS = 2 THEN LPRINT CHR$(27)"8";
2070 REM Reset paper length if required
2080 IF LENGTH = 1 THEN LPRINT CHR$(27)"C51";
2090 REM Reset Condensed printing if required
2100 IF WIDE = 1 THEN LPRINT CHR$(15);
2110 CLS
2120 GOTO 2770
2130 REM Routine to Extract Personal Information
2140 T1 = CVS(F1$)
2150 TEMP1$ = F2$ : TEMP2$ = F2$ : GOSUB 2420  'Rtrim
2160 T2$ = TEMP2$
2170 TEMP1$ = F3$ : TEMP2$ = F3$ : GOSUB 2420  'Rtrim
2180 T3$ = TEMP2$
2190 T4$ = F4$
2200 IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
2210 IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
2220 T5 = CVS(F5$)
2230 T6 = CVS(F6$)
2240 T7 = CVS(F7$)
2250 T8$ = F8$
2260 TEMP1$ = F9$ : TEMP2$ = F9$ : GOSUB 2420  'Rtrim
2270 T9$ = TEMP2$
2280 T10$ = F10$
2290 TEMP1$ = F11$ : TEMP2$ = F11$ : GOSUB 2420  'Rtrim
2300 T11$ = TEMP2$
2310 T12$ = F12$
2320 TEMP1$ = F13$ : TEMP2$ = F13$ : GOSUB 2420  'Rtrim
2330 T13$ = TEMP2$
2340 T14$ = F14$
2350 TEMP1$ = F15$ : TEMP2$ = F15$ : GOSUB 2420  'Rtrim
2360 T15$ = TEMP2$
2370 T16$ = F16$
2380 T17$ = F17$
2390 T18$ = F18$
2400 T19$ = F19$
2410 RETURN
2420 REM General RTRIM$ Routine
2430 FOR J = 1 TO LEN(TEMP1$)-1
2440  IF RIGHT$(TEMP2$,1) = " " THEN TEMP2$ = LEFT$(TEMP2$,LEN(TEMP2$)-1) ELSE J = LEN(TEMP1$)-1
2450 NEXT J
2460 RETURN
2470 REM Blank out a Person Record
2480 T1 = 0
2490 T2$ = ""
2500 T3$ = ""
2510 T4$ = ""
2520 T5 = 0
2530 T6 = 0
2540 T7 = 0
2550 T8$ = ""
2560 T9$ = ""
2570 T10$ = ""
2580 T11$ = ""
2590 T12$ = ""
2600 T13$ = ""
2610 T14$ = ""
2620 T15$ = ""
2630 T16$ = ""
2640 T17$ = ""
2650 T18$ = ""
2660 T19$ = ""
2670 RETURN
2680 REM Routine to extract a name
2690 MID$(FORM$(ROW),COL,LEN(T2$+T3$)+2)=T2$+", "+T3$
2700 RETURN
2710 REM Routine to extract a birth-location
2720 MID$(FORM$(ROW),COL,LEN(T9$+T11$)+2)=T9$+", "+T11$
2730 RETURN
2740 REM Routine to extract a death-location
2750 MID$(FORM$(ROW),COL,LEN(T13$+T15$)+2)=T13$+", "+T15$
2760 RETURN
2770 REM Routine to Produce a Pedigree Chart
2780 REM Start with all Spaces
2790 FOR I = 1 TO 49
2800  FORM$(I) = SPACE$(131)
2810 NEXT I
2812 IF WIDE = 1 THEN GOSUB 7000
2820 REM get 1
2830 LOCATE 20,1 : PRINT "Processing Person # 1 on the Chart"
2840 IF PERS(1) = 0 THEN GOSUB 2470 : GOTO 2940
2850 GET #1, PERS(1) : GOSUB 2130  'Extract 1
2860 IF T2$ = " " AND T3$ = " " THEN 2880
2870 ROW=23: COL=1: GOSUB 2680
2875 MID$(FORM$(2),1,LEN(T2$+T3$)+1) = T3$+" "+T2$
2880 MID$(FORM$(24),3,11) = T8$
2890 IF T9$ = " " AND T11$ = " " THEN 2910
2900 ROW=25: COL=3: GOSUB 2710
2910 MID$(FORM$(27),3,11) = T12$
2920 IF T13$ = " " AND T15$ = " " THEN 2940
2930 ROW=28: COL=3: GOSUB 2740
2940 PERS(2) = T6
2950 PERS(3) = T7
2960 REM get 11
2970 LOCATE 20,20: PRINT " 2";
2980 IF PERS(2) = 0 THEN GOSUB 2470 : GOTO 3080
2990 GET #1, PERS(2) : GOSUB 2130  'Extract 11
3000 IF T2$ = " " AND T3$ = " " THEN 3020
3010 ROW=12: COL=24: GOSUB 2680
3020 MID$(FORM$(13),27,11) = T8$
3030 IF T9$ = " " AND T11$ = " " THEN 3050
3040 ROW=14: COL=27: GOSUB 2710
3050 MID$(FORM$(16),27,11) = T12$
3060 IF T13$ = " " AND T15$ = " " THEN 3080
3070 ROW=17: COL=27: GOSUB 2740
3080 PERS(4) = T6
3090 PERS(5) = T7
3100 REM get 10
3110 LOCATE 20,20: PRINT " 3";
3120 IF PERS(3) = 0 THEN GOSUB 2470 : GOTO 3220
3130 GET #1, PERS(3) : GOSUB 2130  'Extract 10
3140 IF T2$ = " " AND T3$ = " " THEN 3160
3150 ROW=36: COL=24: GOSUB 2680
3160 MID$(FORM$(37),27,11) = T8$
3170 IF T9$ = " " AND T11$ = " " THEN 3190
3180 ROW=38: COL=27: GOSUB 2710
3190 MID$(FORM$(39),27,11) = T12$
3200 IF T13$ = " " AND T15$ = " " THEN 3220
3210 ROW=40: COL=27: GOSUB 2740
3220 PERS(6) = T6
3230 PERS(7) = T7
3240 REM get 111
3250 LOCATE 20,20: PRINT " 4";
3260 IF PERS(4) = 0 THEN GOSUB 2470 : GOTO 3360
3270 GET #1, PERS(4) : GOSUB 2130  'Extract 111
3280 IF T2$ = " " AND T3$ = " " THEN 3300
3290 ROW=6: COL=49: GOSUB 2680
3300 MID$(FORM$(7),52,11) = T8$
3310 IF T9$ = " " AND T11$ = " " THEN 3330
3320 ROW=8: COL=52: GOSUB 2710
3330 MID$(FORM$(10),52,11) = T12$
3340 IF T13$ = " " AND T15$ = " " THEN 3360
3350 ROW=11: COL=52: GOSUB 2740
3360 PERS(8) = T6
3370 PERS(9) = T7
3380 REM get 110
3390 LOCATE 20,20: PRINT " 5";
3400 IF PERS(5) = 0 THEN GOSUB 2470 : GOTO 3500
3410 GET #1, PERS(5) : GOSUB 2130  'Extract 110
3420 IF T2$ = " " AND T3$ = " " THEN 3440
3430 ROW=18: COL=49: GOSUB 2680
3440 MID$(FORM$(19),52,11) = T8$
3450 IF T9$ = " " AND T11$ = " " THEN 3470
3460 ROW=20: COL=52: GOSUB 2710
3470 MID$(FORM$(21),52,11) = T12$
3480 IF T13$ = " " AND T15$ = " " THEN 3500
3490 ROW=22: COL=52: GOSUB 2740
3500 PERS(10) = T6
3510 PERS(11) = T7
3520 REM get 101
3530 LOCATE 20,20: PRINT " 6";
3540 IF PERS(6) = 0 THEN GOSUB 2470 : GOTO 3640
3550 GET #1, PERS(6) : GOSUB 2130  'Extract 101
3560 IF T2$ = " " AND T3$ = " " THEN 3580
3570 ROW=30: COL=49: GOSUB 2680
3580 MID$(FORM$(31),52,11) = T8$
3590 IF T9$ = " " AND T11$ = " " THEN 3610
3600 ROW=32: COL=52: GOSUB 2710
3610 MID$(FORM$(34),52,11) = T12$
3620 IF T13$ = " " AND T15$ = " " THEN 3640
3630 ROW=35: COL=52: GOSUB 2740
3640 PERS(12) = T6
3650 PERS(13) = T7
3660 REM get 100
3670 LOCATE 20,20: PRINT " 7";
3680 IF PERS(7) = 0 THEN GOSUB 2470 : GOTO 3780
3690 GET #1, PERS(7) : GOSUB 2130  'Extract 100
3700 IF T2$ = " " AND T3$ = " " THEN 3720
3710 ROW=42: COL=49: GOSUB 2680
3720 MID$(FORM$(43),52,11) = T8$
3730 IF T9$ = " " AND T11$ = " " THEN 3750
3740 ROW=44: COL=52: GOSUB 2710
3750 MID$(FORM$(45),52,11) = T12$
3760 IF T13$ = " " AND T15$ = " " THEN 3780
3770 ROW=46: COL=52: GOSUB 2740
3780 PERS(14) = T6
3790 PERS(15) = T7
3800 REM get 1111
3810 LOCATE 20,20: PRINT " 8";
3820 IF PERS(8) = 0 THEN GOSUB 2470 : GOTO 3920
3830 GET #1, PERS(8) : GOSUB 2130  'Extract 1111
3840 IF T2$ = " " AND T3$ = " " THEN 3860
3850 ROW=3: COL=74: GOSUB 2680
3860 MID$(FORM$(4),77,11) = T8$
3870 IF T9$ = " " AND T11$ = " " THEN 3890
3880 ROW=5: COL=77: GOSUB 2710
3890 MID$(FORM$(7),77,11) = T12$
3900 IF T13$ = " " AND T15$ = " " THEN 3920
3910 ROW=8: COL=77: GOSUB 2740
3920 PERS(16) = T6
3930 PERS(17) = T7
3940 REM get 1110
3950 LOCATE 20,20: PRINT " 9";
3960 IF PERS(9) = 0 THEN GOSUB 2470 : GOTO 4060
3970 GET #1, PERS(9) : GOSUB 2130  'Extract 1110
3980 IF T2$ = " " AND T3$ = " " THEN 4000
3990 ROW=9: COL=74: GOSUB 2680
4000 MID$(FORM$(10),77,11) = T8$
4010 IF T9$ = " " AND T11$ = " " THEN 4030
4020 ROW=11: COL=77: GOSUB 2710
4030 MID$(FORM$(12),77,11) = T12$
4040 IF T13$ = " " AND T15$ = " " THEN 4060
4050 ROW=13: COL=77: GOSUB 2740
4060 PERS(18) = T6
4070 PERS(19) = T7
4080 REM get 1101
4090 LOCATE 20,20: PRINT "10";
4100 IF PERS(10) = 0 THEN GOSUB 2470 : GOTO 4200
4110 GET #1, PERS(10) : GOSUB 2130  'Extract 1101
4120 IF T2$ = " " AND T3$ = " " THEN 4140
4130 ROW=15: COL=74: GOSUB 2680
4140 MID$(FORM$(16),77,11) = T8$
4150 IF T9$ = " " AND T11$ = " " THEN 4170
4160 ROW=17: COL=77: GOSUB 2710
4170 MID$(FORM$(19),77,11) = T12$
4180 IF T13$ = " " AND T15$ = " " THEN 4200
4190 ROW=20: COL=77: GOSUB 2740
4200 PERS(20) = T6
4210 PERS(21) = T7
4220 REM get 1100
4230 LOCATE 20,20: PRINT "11";
4240 IF PERS(11) = 0 THEN GOSUB 2470 : GOTO 4340
4250 GET #1, PERS(11) : GOSUB 2130  'Extract 1100
4260 IF T2$ = " " AND T3$ = " " THEN 4280
4270 ROW=21: COL=74: GOSUB 2680
4280 MID$(FORM$(22),77,11) = T8$
4290 IF T9$ = " " AND T11$ = " " THEN 4310
4300 ROW=23: COL=77: GOSUB 2710
4310 MID$(FORM$(24),77,11) = T12$
4320 IF T13$ = " " AND T15$ = " " THEN 4340
4330 ROW=25: COL=77: GOSUB 2740
4340 PERS(22) = T6
4350 PERS(23) = T7
4360 REM get 1011
4370 LOCATE 20,20: PRINT "12";
4380 IF PERS(12) = 0 THEN GOSUB 2470 : GOTO 4480
4390 GET #1, PERS(12) : GOSUB 2130  'Extract 1010
4400 IF T2$ = " " AND T3$ = " " THEN 4420
4410 ROW=27: COL=74: GOSUB 2680
4420 MID$(FORM$(28),77,11) = T8$
4430 IF T9$ = " " AND T11$ = " " THEN 4450
4440 ROW=29: COL=77: GOSUB 2710
4450 MID$(FORM$(31),77,11) = T12$
4460 IF T13$ = " " AND T15$ = " " THEN 4480
4470 ROW=32: COL=77: GOSUB 2740
4480 PERS(24) = T6
4490 PERS(25) = T7
4500 REM get 1010
4510 LOCATE 20,20: PRINT "13";
4520 IF PERS(13) = 0 THEN GOSUB 2470 : GOTO 4620
4530 GET #1, PERS(13) : GOSUB 2130  'Extract 1010
4540 IF T2$ = " " AND T3$ = " " THEN 4560
4550 ROW=33: COL=74: GOSUB 2680
4560 MID$(FORM$(34),77,11) = T8$
4570 IF T9$ = " " AND T11$ = " " THEN 4590
4580 ROW=35: COL=77: GOSUB 2710
4590 MID$(FORM$(36),77,11) = T12$
4600 IF T13$ = " " AND T15$ = " " THEN 4620
4610 ROW=37: COL=77: GOSUB 2740
4620 PERS(26) = T6
4630 PERS(27) = T7
4640 REM get 1001
4650 LOCATE 20,20: PRINT "14";
4660 IF PERS(14) = 0 THEN GOSUB 2470 : GOTO 4760
4670 GET #1, PERS(14) : GOSUB 2130  'Extract 1001
4680 IF T2$ = " " AND T3$ = " " THEN 4700
4690 ROW=39: COL=74: GOSUB 2680
4700 MID$(FORM$(40),77,11) = T8$
4710 IF T9$ = " " AND T11$ = " " THEN 4730
4720 ROW=41: COL=77: GOSUB 2710
4730 MID$(FORM$(43),77,11) = T12$
4740 IF T13$ = " " AND T15$ = " " THEN 4760
4750 ROW=44: COL=77: GOSUB 2740
4760 PERS(28) = T6
4770 PERS(29) = T7
4780 REM get 1001
4790 LOCATE 20,20: PRINT "15";
4800 IF PERS(15) = 0 THEN GOSUB 2470 : GOTO 4900
4810 GET #1, PERS(15) : GOSUB 2130  'Extract 1000
4820 IF T2$ = " " AND T3$ = " " THEN 4840
4830 ROW=45: COL=74: GOSUB 2680
4840 MID$(FORM$(46),77,11) = T8$
4850 IF T9$ = " " AND T11$ = " " THEN 4870
4860 ROW=47: COL=77: GOSUB 2710
4870 MID$(FORM$(48),77,11) = T12$
4880 IF T13$ = " " AND T15$ = " " THEN 4900
4890 ROW=49: COL=77: GOSUB 2740
4900 PERS(30) = T6
4910 PERS(31) = T7
4920 REM get 11111
4930 LOCATE 20,20: PRINT "16";
4940 IF PERS(16) = 0 THEN GOSUB 2470 : GOTO 4970
4950 GET #1, PERS(16) : GOSUB 2130  'Extract 11111
4960 ROW=1: COL=98: GOSUB 2680
4970 REM get 11110
4980 LOCATE 20,20: PRINT "17";
4990 IF PERS(17) = 0 THEN GOSUB 2470 : GOTO 5020
5000 GET #1, PERS(17) : GOSUB 2130  'Extract 11110
5010 ROW=4: COL=98: GOSUB 2680
5020 REM get 11101
5030 LOCATE 20,20: PRINT "18";
5040 IF PERS(18) = 0 THEN GOSUB 2470 : GOTO 5070
5050 GET #1, PERS(18) : GOSUB 2130  'Extract 11101
5060 ROW=7: COL=98: GOSUB 2680
5070 REM get 11100
5080 LOCATE 20,20: PRINT "19";
5090 IF PERS(19) = 0 THEN GOSUB 2470 : GOTO 5120
5100 GET #1, PERS(19) : GOSUB 2130  'Extract 11100
5110 ROW=10: COL=98: GOSUB 2680
5120 REM get 11011
5130 LOCATE 20,20: PRINT "20";
5140 IF PERS(20) = 0 THEN GOSUB 2470 : GOTO 5170
5150 GET #1, PERS(20) : GOSUB 2130  'Extract 11011
5160 ROW=13: COL=98: GOSUB 2680
5170 REM get 11010
5180 LOCATE 20,20: PRINT "21";
5190 IF PERS(21) = 0 THEN GOSUB 2470 : GOTO 5220
5200 GET #1, PERS(21) : GOSUB 2130  'Extract 11010
5210 ROW=16: COL=98: GOSUB 2680
5220 REM get 11001
5230 LOCATE 20,20: PRINT "22";
5240 IF PERS(22) = 0 THEN GOSUB 2470 : GOTO 5270
5250 GET #1, PERS(22) : GOSUB 2130  'Extract 11001
5260 ROW=19: COL=98: GOSUB 2680
5270 REM get 11000
5280 LOCATE 20,20: PRINT "23";
5290 IF PERS(23) = 0 THEN GOSUB 2470 : GOTO 5320
5300 GET #1, PERS(23) : GOSUB 2130  'Extract 11000
5310 ROW=22: COL=98: GOSUB 2680
5320 REM get 10111
5330 LOCATE 20,20: PRINT "24";
5340 IF PERS(24) = 0 THEN GOSUB 2470 : GOTO 5370
5350 GET #1, PERS(24) : GOSUB 2130  'Extract 10111
5360 ROW=25: COL=98: GOSUB 2680
5370 REM get 10110
5380 LOCATE 20,20: PRINT "25";
5390 IF PERS(25) = 0 THEN GOSUB 2470 : GOTO 5420
5400 GET #1, PERS(25) : GOSUB 2130  'Extract 10110
5410 ROW=28: COL=98: GOSUB 2680T3$)+2) = T2$+", "+T3$
5420 REM get 10101
5430 LOCATE 20,20: PRINT "26";
5440 IF PERS(26) = 0 THEN GOSUB 2470 : GOTO 5470
5450 GET #1, PERS(26) : GOSUB 2130  'Extract 10101
5460 ROW=31: COL=98: GOSUB 2680
5470 REM get 10100
5480 LOCATE 20,20: PRINT "27";
5490 IF PERS(27) = 0 THEN GOSUB 2470 : GOTO 5520
5500 GET #1, PERS(27) : GOSUB 2130  'Extract 10100
5510 ROW=34: COL=98: GOSUB 2680
5520 REM get 10011
5530 LOCATE 20,20: PRINT "28";
5540 IF PERS(28) = 0 THEN GOSUB 2470 : GOTO 5570
5550 GET #1, PERS(28) : GOSUB 2130  'Extract 10011
5560 ROW=37: COL=98: GOSUB 2680
5570 REM get 10010
5580 LOCATE 20,20: PRINT "29";
5590 IF PERS(29) = 0 THEN GOSUB 2470 : GOTO 5620
5600 GET #1, PERS(29) : GOSUB 2130  'Extract 10010
5610 ROW=40: COL=98: GOSUB 2680
5620 REM get 10001
5630 LOCATE 20,20: PRINT "30";
5640 IF PERS(30) = 0 THEN GOSUB 2470 : GOTO 5670
5650 GET #1, PERS(30) : GOSUB 2130  'Extract 10001
5660 ROW=43: COL=98: GOSUB 2680
5670 REM get 10000
5680 LOCATE 20,20: PRINT "31";
5690 IF PERS(31) = 0 THEN GOSUB 2470 : GOTO 5720
5700 GET #1, PERS(31) : GOSUB 2130  'Extract 10000
5710 ROW=46: COL=98: GOSUB 2680
5720 GOTO 5780
5730 REM Extract Marriage Information
5740 TT2 = CVS(M2$)  'Husband
5750 TT3 = CVS(M3$)  'Wife
5760 TT5$ = M5$      'Marriage date
5770 RETURN
5780 REM Find Marriage of Person (1)
5790 CLS
5800 LOCATE 20,1 : PRINT "Processing Marriage of # 1 on Chart"
5810 FOUND = 0
5820 FOR L = 1 TO M.COUNT
5830  IF PERS(1) > PERS.NO(L) THEN 5890
5840  IF PERS(1) < PERS.NO(L) THEN L = M.COUNT : GOTO 5890
5850  REM found the marriage
5860  FOUND = 1
5870  GET #2, M.NO(L)
5880  L = M.COUNT
5890 NEXT L
5900 IF FOUND = 0 THEN 6000
5910 REM extract marriage information
5920 GOSUB 5730  'extract
5930 MID$(FORM$(26),12,11) = TT5$
5940 REM identify the spouse
5950 IF TT2 = PERS(1) THEN SPOUSE = TT3
5960 IF TT3 = PERS(1) THEN SPOUSE = TT2
5970 GET #1, SPOUSE
5980 GOSUB 2130  'Extract Person Info
5990 MID$(FORM$(29),1,LEN(T2$+T3$)+2) = T2$ + ", " + T3$
6000 GOTO 6150
6010 REM find a marriage
6020 FOUND = 0
6030 IF HUSB = 0 THEN 6140  'return
6040 FOR L = 1 TO M.COUNT
6050  IF HUSB > PERS.NO(L) THEN  6130  'next l
6060  IF HUSB < PERS.NO(L) THEN L = M.COUNT : GOTO 6130  'next l
6070  REM found one marriage
6080  GET #2, M.NO(L)
6090  GOSUB 5730  'Extract marriage info
6100  IF TT3 <> WIFE THEN 6130 'next l
6110  FOUND = 1
6120  L = M.COUNT
6130 NEXT L
6140 RETURN
6150 LOCATE 20,25: PRINT " 2";
6160 HUSB = PERS(2) : WIFE = PERS(3)
6170 GOSUB 6010  'Look for marriage
6180 IF FOUND = 0 THEN 6200
6190 MID$(FORM$(15),32,11) = TT5$
6200 LOCATE 20,25: PRINT " 4";
6210 HUSB = PERS(4) : WIFE = PERS(5)
6220 GOSUB 6010  'Look for marriage
6230 IF FOUND = 0 THEN 6250
6240 MID$(FORM$(9),57,11) = TT5$
6250 LOCATE 20,25: PRINT " 6";
6260 HUSB = PERS(6) : WIFE = PERS(7)
6270 GOSUB 6010  'Look for marriage
6280 IF FOUND = 0 THEN 6300
6290 MID$(FORM$(33),57,11) = TT5$
6300 LOCATE 20,25: PRINT " 8";
6310 HUSB = PERS(8) : WIFE = PERS(9)
6320 GOSUB 6010  'Look for marriage
6330 IF FOUND = 0 THEN 6350
6340 MID$(FORM$(6),82,11) = TT5$
6350 LOCATE 20,25: PRINT "10";
6360 HUSB = PERS(10) : WIFE = PERS(11)
6370 GOSUB 6010  'Look for marriage
6380 IF FOUND = 0 THEN 6400
6390 MID$(FORM$(18),82,11) = TT5$
6400 LOCATE 20,25: PRINT "12";
6410 HUSB = PERS(12) : WIFE = PERS(13)
6420 GOSUB 6010  'Look for marriage
6430 IF FOUND = 0 THEN 6450
6440 MID$(FORM$(30),82,11) = TT5$
6450 LOCATE 20,25: PRINT "14";
6460 HUSB = PERS(14) : WIFE = PERS(15)
6470 GOSUB 6010  'Look for marriage
6480 IF FOUND = 0 THEN 6500
6490 MID$(FORM$(42),82,11) = TT5$
6500 REM All Marriages found
6505 PRINT
6510 REM Print the Pedigree Chart
6520 FOR I = 1 TO 49
6525  PRINT "Printing Line: ";I
6530  LPRINT FORM$(I)
6540 NEXT I
6545 CLS
6550 LPRINT CHR$(12);
6560 GOTO 1950  'for next chart
6570 REM Wrapup
6580 LPRINT CHR$(18);     'Normal Printing
6590 LPRINT CHR$(27)"9";  'Paper Sensing ON
6600 LPRINT CHR$(27)"A";  'Normal Page of 66 Lines
6610 CLOSE #1
6620 CLOSE #2
6630 CLS : LOCATE 21,1
6640 PRINT "End of Program"
6650 LPRINT CHR$(12);  'Page Eject
6660 LPRINT CHR$(12);  'Page Eject
6670 RUN "a:menu"
7000 REM Create the Form
7010 REM Draw the Vertical Lines
7020 LOCATE 15,1 : PRINT "Drawing the Vertical Lines"
7030 FOR II = 13 TO 36
7040  MID$(FORM$(II),23,1) = CHR$(124)
7050 NEXT II
7060 FOR II = 7 TO 18
7070  MID$(FORM$(II),48,1) = CHR$(124)
7080  MID$(FORM$(II+24),48,1) = CHR$(124)
7090 NEXT II
7100 FOR II = 4 TO 9
7110  MID$(FORM$(II),73,1) = CHR$(124)
7120  MID$(FORM$(II+12),73,1) = CHR$(124)
7130  MID$(FORM$(II+24),73,1) = CHR$(124)
7140  MID$(FORM$(II+36),73,1) = CHR$(124)
7150 NEXT II
7160 FOR II = 2 TO 4
7170  MID$(FORM$(II),97,1) = CHR$(124)
7180  MID$(FORM$(II+6),97,1) = CHR$(124)
7190  MID$(FORM$(II+12),97,1) = CHR$(124)
7200  MID$(FORM$(II+18),97,1) = CHR$(124)
7210  MID$(FORM$(II+24),97,1) = CHR$(124)
7220  MID$(FORM$(II+30),97,1) = CHR$(124)
7230  MID$(FORM$(II+36),97,1) = CHR$(124)
7240  MID$(FORM$(II+42),97,1) = CHR$(124)
7250 NEXT II
7260 REM Draw the Horizontal Lines
7270 PRINT "Drawing the Horizontal Lines"
7280 FOR JJ = 1 TO 22
7290  MID$(FORM$(23),JJ,1) = CHR$(95)
7300  MID$(FORM$(29),JJ,1) = CHR$(95)
7310 NEXT JJ
7320 FOR JJ = 24 TO 47
7330  MID$(FORM$(12),JJ,1) = CHR$(95)
7340  MID$(FORM$(36),JJ,1) = CHR$(95)
7350 NEXT JJ
7360 FOR JJ = 49 TO 72
7370  MID$(FORM$(6),JJ,1) = CHR$(95)
7380  MID$(FORM$(18),JJ,1) = CHR$(95)
7390  MID$(FORM$(30),JJ,1) = CHR$(95)
7400  MID$(FORM$(42),JJ,1) = CHR$(95)
7410 NEXT JJ
7420 FOR JJ = 74 TO 96
7430  MID$(FORM$(3),JJ,1) = CHR$(95)
7440  MID$(FORM$(9),JJ,1) = CHR$(95)
7450  MID$(FORM$(15),JJ,1) = CHR$(95)
7460  MID$(FORM$(21),JJ,1) = CHR$(95)
7470  MID$(FORM$(27),JJ,1) = CHR$(95)
7480  MID$(FORM$(33),JJ,1) = CHR$(95)
7490  MID$(FORM$(39),JJ,1) = CHR$(95)
7500  MID$(FORM$(45),JJ,1) = CHR$(95)
7510 NEXT JJ
7520 FOR II = 1 TO 46 STEP 3
7530  FOR JJ = 98 TO 120
7540   MID$(FORM$(II),JJ,1) = CHR$(95)
7550  NEXT JJ
7560 NEXT II
7570 REM Prepare the Title Information
7580 PRINT "Preparing Titles and Numbers"
7590 MID$(FORM$( 1),1,18) = "PEDIGREE CHART of:"
7600 MID$(FORM$(49),1,43) = "Genealogy ON DISPLAY Computerized Data Base"
7610 MID$(FORM$( 3),1,15) = "Person Record: "
7620 P.NO$ = STR$(PERS(1))
7630 P.NO$ = RIGHT$(P.NO$,LEN(P.NO$)-1)
7640 MID$(FORM$( 3),16,LEN(P.NO$)) = P.NO$
7650 MID$(FORM$( 4),1,22) = "Prepared:  "+DATE$
7660 MID$(FORM$( 5),1,19) = "At (time): "+TIME$
7670 MID$(FORM$(22),1,1) = "1"
7680 MID$(FORM$(24),1,1) = "B"
7690 MID$(FORM$(25),1,1) = "W"
7700 MID$(FORM$(26),1,8) = "Married:"
7710 MID$(FORM$(27),1,1) = "D"
7720 MID$(FORM$(28),1,1) = "W"
7730 MID$(FORM$(12),21,2) = " 2"
7740 MID$(FORM$(13),24,2) = "B:"
7750 MID$(FORM$(14),24,2) = "W:"
7760 MID$(FORM$(15),24,5) = "Marr:"
7770 MID$(FORM$(16),24,2) = "D:"
7780 MID$(FORM$(17),24,2) = "W:"
7790 MID$(FORM$(36),21,2) = " 3"
7800 MID$(FORM$(37),24,2) = "B:"
7810 MID$(FORM$(38),24,2) = "W:"
7820 MID$(FORM$(39),24,2) = "D:"
7830 MID$(FORM$(40),24,2) = "W:"
7840 MID$(FORM$( 6),46,2) = " 4"
7850 MID$(FORM$( 7),49,2) = "B:"
7860 MID$(FORM$( 8),49,2) = "W:"
7870 MID$(FORM$( 9),49,5) = "Marr:"
7880 MID$(FORM$(10),49,2) = "D:"
7890 MID$(FORM$(11),49,2) = "W:"
7900 MID$(FORM$(18),46,2) = " 5"
7910 MID$(FORM$(19),49,2) = "B:"
7920 MID$(FORM$(20),49,2) = "W:"
7930 MID$(FORM$(21),49,2) = "D:"
7940 MID$(FORM$(22),49,2) = "W:"
7950 MID$(FORM$(30),46,2) = " 6"
7960 MID$(FORM$(31),49,2) = "B:"
7970 MID$(FORM$(32),49,2) = "W:"
7980 MID$(FORM$(33),49,5) = "Marr:"
7990 MID$(FORM$(34),49,2) = "D:"
8000 MID$(FORM$(35),49,2) = "W:"
8010 MID$(FORM$(42),46,2) = " 7"
8020 MID$(FORM$(43),49,2) = "B:"
8030 MID$(FORM$(44),49,2) = "W:"
8040 MID$(FORM$(45),49,2) = "D:"
8050 MID$(FORM$(46),49,2) = "W:"
8060 MID$(FORM$( 3),71,2) = " 8"
8070 MID$(FORM$( 4),74,2) = "B:"
8080 MID$(FORM$( 5),74,2) = "W:"
8090 MID$(FORM$( 6),74,5) = "Marr:"
8100 MID$(FORM$( 7),74,2) = "D:"
8110 MID$(FORM$( 8),74,2) = "W:"
8120 MID$(FORM$( 9),71,2) = " 9"
8130 MID$(FORM$(10),74,2) = "B:"
8140 MID$(FORM$(11),74,2) = "W:"
8150 MID$(FORM$(12),74,2) = "D:"
8160 MID$(FORM$(13),74,2) = "W:"
8170 MID$(FORM$(15),71,2) = "10"
8180 MID$(FORM$(16),74,2) = "B:"
8190 MID$(FORM$(17),74,2) = "W:"
8200 MID$(FORM$(18),74,5) = "Marr:"
8210 MID$(FORM$(19),74,2) = "D:"
8220 MID$(FORM$(20),74,2) = "W:"
8230 MID$(FORM$(21),71,2) = "11"
8240 MID$(FORM$(22),74,2) = "B:"
8250 MID$(FORM$(23),74,2) = "W:"
8260 MID$(FORM$(24),74,2) = "D:"
8270 MID$(FORM$(25),74,2) = "W:"
8280 MID$(FORM$(27),71,2) = "12"
8290 MID$(FORM$(28),74,2) = "B:"
8300 MID$(FORM$(29),74,2) = "W:"
8310 MID$(FORM$(30),74,5) = "Marr:"
8320 MID$(FORM$(31),74,2) = "D:"
8330 MID$(FORM$(32),74,2) = "W:"
8340 MID$(FORM$(33),71,2) = "13"
8350 MID$(FORM$(34),74,2) = "B:"
8360 MID$(FORM$(35),74,2) = "W:"
8370 MID$(FORM$(36),74,2) = "D:"
8380 MID$(FORM$(37),74,2) = "W:"
8390 MID$(FORM$(39),71,2) = "14"
8400 MID$(FORM$(40),74,2) = "B:"
8410 MID$(FORM$(41),74,2) = "W:"
8420 MID$(FORM$(42),74,5) = "Marr:"
8430 MID$(FORM$(43),74,2) = "D:"
8440 MID$(FORM$(44),74,2) = "W:"
8450 MID$(FORM$(45),71,2) = "15"
8460 MID$(FORM$(46),74,2) = "B:"
8470 MID$(FORM$(47),74,2) = "W:"
8480 MID$(FORM$(48),74,2) = "D:"
8490 MID$(FORM$(49),74,2) = "W:"
8500 MID$(FORM$( 1),95,2) = "16"
8510 MID$(FORM$( 4),95,2) = "17"
8520 MID$(FORM$( 7),95,2) = "18"
8530 MID$(FORM$(10),95,2) = "19"
8540 MID$(FORM$(13),95,2) = "20"
8550 MID$(FORM$(16),95,2) = "21"
8560 MID$(FORM$(19),95,2) = "22"
8570 MID$(FORM$(22),95,2) = "23"
8580 MID$(FORM$(25),95,2) = "24"
8590 MID$(FORM$(28),95,2) = "25"
8600 MID$(FORM$(31),95,2) = "26"
8610 MID$(FORM$(34),95,2) = "27"
8620 MID$(FORM$(37),95,2) = "28"
8630 MID$(FORM$(40),95,2) = "29"
8640 MID$(FORM$(43),95,2) = "30"
8650 MID$(FORM$(46),95,2) = "31"
8660 RETURN