1 '**************************************************************************
2 '*                       ADDED A ROUTINE TO ENTER DATA                    *
3 '*                              MARCH 26, 1983                            *
4 '*                            PAT KING - KATY, TX                         * 
5 '**************************************************************************
10 REM  --FAMILY TREE PROGRAM--  JOHN J. ARMSTRONG - MOBILE, AL
20 REM  COMPUTER SYSTEM:  CROMEMCO Z-2  64K RAM DISK PRINTER
21 DEFINT A-Z:CLEAR 8000:B1$=" ":B2$="  "
22 INPUT "WHICH FAMILY TREE (3 CHARACTERS)";TR$
23 OPEN "R",#1,"FAMILY  ."+TR$
24 OPEN "R",#2,"FAMILY2 ."+TR$
40 DEF FN D$(B$)=LEFT$(B$,2)+"-"+MID$(B$,3,2)+"-"+MID$(B$,5)
50 DIM NL$(LOF(1)),NF$(LOF(1)),NM$(LOF(1)),C$(13),C(13),CI(28)
55 DIM C0(13),C1(13),C2(13),C3(13),C4(13),C5(13),C6(13),C7(13),C8(13),C9(13),CA(13),CB(13)
56 PRINT LOF(1),LOF(2)
60 FOR X=1 TO LOF(1)
70 FIELD #1,126 AS DU$:FIELD #2,56 AS D$,16 AS NL$,24 AS NF$,16 AS NM$
80 GET #1,X:Z=X:GET #2,Z
90 Y=INSTR(NL$,B1$):GOSUB 3350:NL$(X)=LEFT$(NL$,Y):Y=INSTR(NF$,B2$):GOSUB 3350:NF$(X)=LEFT$(NF$,Y)
100 Y=INSTR(NM$,B1$):GOSUB 3350:NM$(X)=LEFT$(NM$,Y)
110 PRINT X;" ";NF$(X);" ";NL$(X);" ";NM$(X)
120 NEXT X
130 H$(1)="EDIT":H$(2)="DISPLAY ON VIDEO":H$(3)="PRINT ON PRINTER"
140 H$(4)="PRINT FAMILY TREE":H$(5)="EXIT PROGRAM":H$(6)="ENTER DATA"
150 H1$(1)="LAST NAME AT BIRTH":H1$(2)="FIRST OR MIDDLE NAME OR INITIAL"
160 H1$(3)="MARRIED LAST NAME":H1$(4)="ALL ENTRIES"
170 H1$(5)="LIVING IN YEAR...":H1$(6)="ALL MENTIONS OF PERSON"
180 C1=0:C2=0:C3=0:PRINT CHR$(12):FOR X=1 TO 6:PRINT "(";X;")";H$(X):NEXT X
190 INPUT "CHOICE";C1:IF C1<1 OR C1>6 THEN 190
195 IF C1=6 THEN 8000
200 IF C1=5 THEN GOTO 3400 ELSE IF C1=4 OR C1=1 THEN 220
210 GOSUB 3300
220 PRINT H$(C1);" BY:"
230 FOR X=1 TO 6:PRINT "(";X;")";H1$(X): NEXT X
240 INPUT "CHOICE";C3: IF C3<1 OR C3>6 THEN 240 ELSE 250
250 ON C3 GOSUB 270, 350, 430, 510, 580, 680: GOTO 180
260 REM
270 REM   SUBROUTINE--LAST NAME AT BIRTH
280 REM
290 PRINT CHR$(12):L=0:PRINT H$(C1):PRINT TAB(5) H1$(1):INPUT NL$:T$=H1$(1)+": '"+NL$+"'"
300 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT CHR$(12): PRINT T$
310 FOR X1=1 TO LOF(1)
311 IF NL$=NL$(X1) THEN X=X1
312 GOSUB 1970
313 GOSUB 2020
314 ELSE 330
320 ON C1 GOSUB 830,1440,1680,2110
321 IF L>13 THEN L=0
322 INPUT "CONTINUE";YN$
323 PRINT T$
330 IF X1<LOF(1) THEN NEXT ELSE INPUT "CONTINUE";YN$:RETURN
340 REM
350 REM   SUBROUTINE--FIRST OR MIDDLE NAME OR INITIAL
360 REM
370 PRINT CHR$(12):L=0:PRINT H$(C1):PRINT TAB(5) H1$(2): INPUT NF$:T$=H1$(2)+": '"+NF$+"'"
380 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT CHR$(12):PRINT T$
390 FOR X1=1 TO LOF(1):Y=INSTR(NF$(X1),NF$):IF Y<>0 THEN X=X1:GOSUB 1970:GOSUB 2020 ELSE 410
400 ON C1 GOSUB 830,1440,1680,2110: IF L>13 THEN L=0: INPUT "CONTINUE";YN$: PRINT T$
410 IF X1<LOF(1) THEN 411 ELSE INPUT "CONTINUE";YN$:RETURN
411 NEXT X1
412 RETURN
420 REM
430 REM   SUBROUTINE--MARRIED LAST NAME
440 REM
450 PRINT CHR$(12):L=0:PRINT H$(C1):PRINT TAB(5) H1$(3): INPUT NM$: T$=H1$(3)+": '"+NM$+"'"
460 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT CHR$(12): PRINT T$
470 FOR X1=1 TO LOF(1): IF NM$=NM$(X1) THEN X=X1: GOSUB 1970: GOSUB 2020 ELSE 490
480 ON C1 GOSUB 830,1440,1680,2110: IF L>13 THEN L=0: INPUT "CONTINUE";YN$: PRINT T$
490 IF X1<LOF(1) THEN NEXT X1 ELSE INPUT "CONTINUE";YN$: RETURN
500 REM
510 REM   SUBROUTINE--ALL ENTRIES
520 REM
530 PRINT CHR$(12):L=0:T$=H1$(4)+": ": IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT T$
540 FOR X1=1 TO LOF(1):X=X1:GOSUB 1970:GOSUB 2020
550 ON C1 GOSUB 830, 1440, 1680, 2110: IF L>13 THEN L=0: INPUT "CONTINUE";YN$: PRINT T$
560 IF X1<LOF(1) THEN NEXT X1 ELSE INPUT "CONTINUE";YN$:RETURN
570 REM
580 REM   SUBROUTINE--LIVING IN YEAR...
590 REM
600 PRINT CHR$(12):L=0:PRINT H$(C1): PRINT TAB(5) H1$(5):INPUT "YYYY";YD$:T$=H1$(5)+": '"+YD$+"'"
610 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT T$
620 FOR X1=1 TO LOF(1):X=X1:GOSUB 1970:GOSUB 2020
630 IF VAL(MID$(BD$,5,4))>1500 AND (VAL(MID$(DD$,5,4))>1500 OR LEFT$(DD$,6)="LIVING") THEN 640 ELSE 660
640 IF YD$>=MID$(BD$,5,4) AND (YD$<=MID$(DD$,5,4) OR LEFT$(DD$,6)="LIVING") THEN 650 ELSE 660
650 ON C1 GOSUB 830, 1440, 1680, 2110:IF L>13 THEN L=0: INPUT "CONTINUE";YN$: PRINT T$
660 IF X1<LOF(1) THEN NEXT ELSE INPUT "CONTINUE";YN$:RETURN
670 REM
680 REM   SUBROUTINE--ALL MENTIONS OF A PERSON
690 REM
700 PRINT CHR$(12):PRINT H$(C1):X5=0:PRINT H1$(1):PRINT TAB(5)"OR":PRINT H1$(3):INPUT NL$
710 PRINT H1$(2):INPUT NF$:PRINT CHR$(12):FOR X1=1 TO LOF(1):IF NL$(X1)=NL$ OR NM$(X1)=NL$ THEN 720 ELSE 730
720 Y=INSTR(NF$(X1),NF$):IF Y<>0 THEN GOSUB 740
730 IF X1<LOF(1) THEN NEXT X1:GOTO 810 ELSE 810
740 FOR X2=1 TO LOF(1): X=X2
750 IF X1<>X5 THEN 760 ELSE 770
760 T$="'"+NF$(X1)+" "+NL$(X1)+" "+NM$(X1)+"' IS LISTED UNDER:": IF C1=3 OR C1=4 THEN GOSUB 3340: X5=X1 ELSE PRINT T$:X5=X1
770 GOSUB 1970: GOSUB 2020
780 IF X1=SP(1) OR X1=SP(2) OR X1=C(1) OR X1=C(2) OR X1=C(3) OR X1=C(4) OR X1=C(5) OR X1=C(6) OR X1=C(7) OR X1=C(8) OR X1=C(9) OR X1=C(10) OR X1=C(11) OR X1=C(12) OR X1=C(13) OR X1=M OR X1=F THEN 790 ELSE 800
790 ON C1 GOSUB 830, 1440, 1680, 2110:IF L>13 THEN L=0: PRINT T$
800 IF X2<LOF(1) THEN NEXT X2 ELSE INPUT "CONTINUE";YN$
810 INPUT "CONTINUE";YN$:RETURN
820 REM
830 REM   SUBROUTINE--EDIT SELECTION
840 REM
850 PRINT CHR$(12):PRINT X;" ";NF$(X);" ";NL$(X);" "NM$(X)
860 PRINT "1) BORN: ";BD$;:PRINT TAB(36)" 2) AT ";PB$
870 PRINT "3) MARRIED: ";MD$(1);:PRINT TAB(36)" 4) TO: ";NF$(SP(1));" ";NL$(SP(1))
880 PRINT "5) AT ";PM$(1);:PRINT TAB(36)" 6) MARITAL STATUS: ";MS$(1)
890 PRINT "7) REMARRIED: "MD$(2);:PRINT TAB(36)" 8) TO: ";NF$(SP(2));" ";NL$(SP(2))
900 PRINT "9) AT ";PM$(2);:PRINT TAB(36)" 10) MARITAL STATUS: ";MS$(2)
910 PRINT "11) DIED/LIVING: ";DD$;:PRINT TAB(36)" 12) AT ";PD$
920 PRINT "13) # CHILDREN ";CN;
930 IF CN=0 THEN 950 ELSE FOR X2=1 TO CN:X4=C(X2):U=X2MOD2:IF U=1 THEN L1=36 ELSE L1=0: PRINT CHR$(13)
940 PRINT TAB(L1) MID$(STR$(X2+13),2);") ";NF$(X4);" ";NL$(X4);:NEXT X2:PRINT CHR$(13)
950 PRINT TAB(0)"27) MOTHER: ";NF$(M);" ";NL$(M);:PRINT TAB(36)" 28) FATHER: ";NF$(F);" ";NL$(F)
960 INPUT "ANY CHANGES TO BE MADE HERE (Y/N)";YN$: GOSUB 1370
970 IF LEFT$(YN$,1)="Y" THEN GOSUB 1370: GOSUB 990: RETURN ELSE PRINT CHR$(12): RETURN
980 REM
990 REM   SUBROUTINE--EDIT DATA
1000 REM
1010 GOSUB 1370:INPUT "HOW MANY CHANGES";CH:IF CH=0 THEN RETURN
1020 IF CH<1 OR CH>28 THEN PRINT CH; " IS AN INCORRECT NUMBER OF CHANGES";:GOTO 1010
1030 GOSUB 1370:FOR X3=1 TO CH
1040 INPUT "CHANGE ITEM # ";CI(X3):IF CI(X3)<1 OR CI(X3)>28 THEN 1045 ELSE 1050
1045 PRINT CI(X3);" IS AN INVALID ITEM # ";:GOSUB 1370:GOTO 1040
1050 GOSUB 1370:NEXT X3:GOSUB 1370
1060 FOR X3=1 TO CH
1070 ON CI(X3) GOSUB 1090,1100,1110,1120,1130,1140,1150,1160,1170,1180,1190,1200,1210,1220,1230,1240,1250,1260,1270,1280,1290,1300,1310,1320,1330,1340,1350,1360
1080 NEXT X3:RETURN
1090 GOSUB 1970:INPUT "BIRTH DATE (MMDDYYYY)";A$:LSET BD$=A$:PUT #1,X:GOTO 1370
1100 GOSUB 1970:LINE INPUT "BIRTH PLACE ";A$:LSET PB$=A$:PUT #1,X:GOTO 1370
1110 GOSUB 1970:INPUT "DATE OF MARRIAGE (MMDDYYYY)";A$:LSET MD$(1)=A$:PUT #1,X:GOTO 1370
1120 GOSUB 1970:PRINT "SPOUSE ID NUMBER ";:GOSUB 1380:LSET S1$=MKI$(A):PUT #1,X:GOTO 1370
1130 GOSUB 1970:LINE INPUT "MARRIED AT ";A$:LSET PM$(1)=A$:PUT #1,X:GOTO 1370
1140 GOSUB 1970:INPUT "MARITAL STATUS ";A$:LSET MS$(1)=A$:PUT #1,X:GOTO 1370
1150 GOSUB 1970:INPUT "DATE OF SECOND MARRIAGE (MMDDYYYY) ";A$:LSET MD$(2)=A$:PUT #1,X:GOTO 1370
1160 GOSUB 1970:PRINT "SECOND SPOUSE ID NUMBER ":GOSUB 1380:LSET S2$=MKI$(A):PUT #1,X:GOTO 1370
1170 GOSUB 1970:LINE INPUT "REMARRIED AT ";A$:LSET PM$(2)=A$:PUT #1,X:GOTO 1370
1180 GOSUB 1970:INPUT "MARITAL STATUS ";A$:LSET MS$(2)=A$:PUT #1,X:GOTO 1370
1190 GOSUB 1970:INPUT "'LIVING' OR DATE OF DEATH (MMDDYYYY)";A$:LSET DD$=A$:PUT #1,X:GOTO 1370
1200 GOSUB 2020:LINE INPUT "PLACE OF DEATH OR 'LIVING' ";A$:LSET PD$=A$:PUT #2,Z:GOTO 1370
1210 GOSUB 2020:INPUT "NUMBER OF CHILDREN ";CN:LSET CN$=MKI$(CN):PUT #2,Z:GOTO 1370
1220 GOSUB 2020:PRINT "CHILD #1 ID NUMBER ";:GOSUB 1380:LSET C$(1)=MKI$(A):PUT #2,Z:GOTO 1370
1230 GOSUB 2020:PRINT "CHILD #2 ID NUMBER ";:GOSUB 1380:LSET C$(2)=MKI$(A):PUT #2,Z:GOTO 1370
1240 GOSUB 2020:PRINT "CHILD #3 ID NUMBER ";:GOSUB 1380:LSET C$(3)=MKI$(A):PUT #2,Z:GOTO 1370
1250 GOSUB 2020:PRINT "CHILD #4 ID NUMBER ";:GOSUB 1380:LSET C$(4)=MKI$(A):PUT #2,Z:GOTO 1370
1260 GOSUB 2020:PRINT "CHILD #5 ID NUMBER ";:GOSUB 1380:LSET C$(5)=MKI$(A):PUT #2,Z:GOTO 1370
1270 GOSUB 2020:PRINT "CHILD #6 ID NUMBER ";:GOSUB 1380:LSET C$(6)=MKI$(A):PUT #2,Z:GOTO 1370
1280 GOSUB 2020:PRINT "CHILD #7 ID NUMBER ";:GOSUB 1380:LSET C$(7)=MKI$(A):PUT #2,Z:GOTO 1370
1290 GOSUB 2020:PRINT "CHILD #8 ID NUMBER ";:GOSUB 1380:LSET C$(8)=MKI$(A):PUT #2,Z:GOTO 1370
1300 GOSUB 2020:PRINT "CHILD #9 ID NUMBER ";:GOSUB 1380:LSET C$(9)=MKI$(A):PUT #2,Z:GOTO 1370
1310 GOSUB 2020:PRINT "CHILD #10 ID NUMBER ";:GOSUB 1380:LSET C$(10)=MKI$(A):PUT #2,Z:GOTO 1370
1320 GOSUB 2020:PRINT "CHILD #11 ID NUMBER ";:GOSUB 1380:LSET C$(11)=MKI$(A):PUT #2,Z:GOTO 1370
1330 GOSUB 2020:PRINT "CHILD #12 ID NUMBER ";:GOSUB 1380:LSET C$(12)=MKI$(A):PUT #2,Z:GOTO 1370
1340 GOSUB 2020:PRINT "CHILD #13 ID NUMBER ";:GOSUB 1380:LSET C$(13)=MKI$(A):PUT #2,Z:GOTO 1370
1350 GOSUB 2020:PRINT "MOTHER'S ID NUMBER ";:GOSUB 1380:LSET M$=MKI$(A):PUT #2,Z:GOTO 1370
1360 GOSUB 2020:PRINT "FATHER'S ID NUMBER ";:GOSUB 1380:LSET F$=MKI$(A):PUT #2,Z:GOTO 1370
1370 A=0:A$="":PRINT CHR$(20);CHR$(21);CHR$(0);:PRINT CHR$(30);:RETURN
1380 Y=POS(0)
1390 INPUT A
1400 IF A>=0 AND A<=LOF(1) THEN RETURN
1410 PRINT A;" IS AN INVALID PERSON ID # ";
1420 PRINT CHR$(20);CHR$(21);CHR$(0);:PRINT CHR$(30);:GOTO 1070
1430 REM
1440 REM   SUBROUTINE---OPTION TO DISPLAY ON VIDEO
1450 REM
1455 GOSUB 3380
1460 ON C2 GOSUB 1480,1520:RETURN
1470 REM
1480 REM   SUBROUTINE--DISPLAY NAMES ONLY
1490 REM
1500 PRINT TAB(5) X;" ";NF$(X);" "NL$(X);" ";NM$(X):L=L+1:RETURN
1510 REM
1520 REM   SUBROUTINE--DISPLAY WHOLE ENTRY
1530 REM
1540 PRINT X;" ";NF$(X);" ";NL$(X);" ";NM$(X):GOSUB 3300
1550 PRINT "B.: ";DATE$;:PRINT TAB(36)" AT ";PB$:GOSUB 3310
1560 PRINT "M.: ";DATE$;:PRINT TAB(36)" TO ";NF$(SP(1));" ";NL$(SP(1))
1570 PRINT "AT ";PM$(1);:PRINT TAB(36) MS$(1):GOSUB 3320
1580 PRINT "RM.: ";DATE$;:PRINT TAB(36)" TO ";NF$(SP(2));" ";NL$(SP(2))
1590 PRINT "AT ";PM$(2);:PRINT TAB(36) MS$(2)
1600 IF LEFT$(DD$,6)="LIVING" THEN PRINT DD$;:PRINT TAB(36) " AT ";PD$:GOTO 1620
1610 GOSUB 3330:PRINT "D.: ";DATE$;:PRINT TAB(36)" AT ";PD$
1620 PRINT "# CHILDREN:";CN;
1630 IF CN=0 THEN 1645 ELSE FOR X3=1 TO CN:X4=C(X3):U=X3 MOD 2:IF U=1 THEN L1=37 ELSE L1=0
1640 PRINT TAB(L1 * 1)MID$(STR$(X3),2);")";NF$(X4);" ";NL$(X4);:NEXT X3
1645 PRINT " "
1650 PRINT TAB(0)" MOTHER: ";NF$(M);" ";NL$(M);:PRINT TAB(36)" FATHER: ";NF$(F);" ";NL$(F)
1660 PRINT CHR$(20);CHR$(21);CHR$(0);:INPUT "CONTINUE";YN$:PRINT CHR$(12):RETURN
1670 REM
1680 REM   SUBROUTINE--OPTION TO PRINT ON PRINTER
1690 REM
1695 GOSUB 3380
1700 ON C2 GOSUB 1720, 1760:RETURN
1710 REM
1720 REM   SUBROUTINE--PRINT NAMES ONLY
1730 REM
1740 LPRINT X;" ";NF$(X);" ";NL$(X);" "NM$(X):RETURN
1750 REM
1760 REM   SUBROUTINE--PRINT WHOLE ENTRY
1770 REM
1780 LPRINT X;" "NF$(X);" ";NL$(X);" ";NM$(X):TP$=PB$:GOSUB 3360:PB$=TP$
1790 GOSUB 3300:LPRINT TAB(5)"B.: ";DATE$;" AT ";PB$
1800 TP$=PM$(1):GOSUB 3360:PM$(1)=TP$
1810 IF VAL(MD$(1))>0 OR LEFT$(MD$(1),1)="?" THEN GOSUB 3310:GOTO 1830
1820 LPRINT TAB(5) MS$(1):GOTO 1870
1830 LPRINT TAB(5)"M.: ";DATE$;" TO ";NF$(SP(1));" ";NL$(SP(1));" AT ";PM$(1);" ";MS$(1)
1840 TP$=PM$(2):GOSUB 3360:PM$(2)=TP$
1850 IF VAL(MD$(2))>0 OR LEFT$(MD$(2),1)="?" THEN GOSUB 3320 ELSE 1870
1860 LPRINT TAB(5)"RM.: ";DATE$;" TO ";NF$(SP(2));" ";NL$(SP(2));" AT ";PM$(2);" ";MS$(2)
1870 TP$=PD$:GOSUB 3360:PD$=TP$
1880 IF LEFT$(DD$,6)="LIVING" THEN LPRINT TAB(5)DD$;" AT ";PD$:GOTO 1900
1890 GOSUB 3330:LPRINT TAB(5)"D.: ";DATE$;" AT ";PD$
1900 IF CN=0 THEN 1930
1910 LPRINT TAB(5)"# CHILDREN: ";CN
1920 FOR X3=1 TO CN:X4=C(X3):LPRINT TAB(10)X3;")";NF$(X4);" "NL$(X4):NEXT X3
1930 LPRINT TAB(5)"MOTHER: ";NF$(M);" ";NL$(M)
1940 LPRINT TAB(5)"FATHER: ";NF$(F);" "NL$(F)
1950 LPRINT " ":RETURN
1960 REM
1970 REM   SUBROUTINE--FIELD DATA BUFFER 1
1980 REM
1990 FIELD #1,8 AS BD$,24 AS PB$,8 AS MD$(1),2 AS S1$,24 AS PM$(1),9 AS MS$(1),8 AS MD$(2),2 AS S2$,24 AS PM$(2),9 AS MS$(2),8 AS DD$
2000 Z=X:GET #1,X
2010 SP(1)=CVI(S1$):SP(2)=CVI(S2$):RETURN
2020 FIELD #2,24 AS PD$,2 AS CN$,2 AS C$(1),2 AS C$(2),2 AS C$(3),2 AS C$(4),2 AS C$(5),2 AS C$(6),2 AS C$(7),2 AS C$(8),2 AS C$(9),2 AS C$(10),2 AS C$(11),2 AS C$(12),2 AS C$(13),2 AS M$,2 AS F$
2030 GET #2,Z
2040 CN=CVI(CN$):C(1)=CVI(C$(1)):C(2)=CVI(C$(2)):C(3)=CVI(C$(3)):C(4)=CVI(C$(4)):C(5)=CVI(C$(5)):C(6)=CVI(C$(6)):C(7)=CVI(C$(7)):C(8)=CVI(C$(8)):C(9)=CVI(C$(9)):C(10)=CVI(C$(10)):C(11)=CVI(C$(11)):C(12)=CVI(C$(12)):C(13)=CVI(C$(13)):M=CVI(M$):F=CVI(F$)
2050 RETURN
2100 REM
2110 REM   SUBROUTINE--START/END TREE
2120 REM
2130 PRINT CHR$(12):PRINT X;" ";NF$(X);" ";NL$(X);" ";NM$(X)
2140 PRINT "1) DESCENDENTS     2) PREDECESSORS":INPUT "CHOICE";DP:IF DP <>1 AND DP<>2 THEN 2140
2150 GOSUB 3380
2160 IF DP=1 THEN DP$="DESCENDENTS OF ":CP$="CHILDREN" ELSE DP$="PREDECESSORS OF ":CP$="PARENTS"
2170 LPRINT TAB(15) DP$;NF$(X);" ";NL$(X);" ";NM$(X):LPRINT " ":LPRINT " "
2180 FOR X7=60 TO 30 STEP -10
2190 FOR X8=X7 TO 60 STEP 10
2200 LPRINT TAB(X8)"GREAT";
2210 NEXT X8:LPRINT" ":NEXT X7
2220 FOR X7=20 TO 60 STEP 10:LPRINT TAB(X7)"GRAND";:NEXT X7:LPRINT" "
2230 LPRINT TAB(0)"PERSON";
2240 FOR X7=10 TO 60 STEP 10:LPRINT TAB(X7) CP$;:NEXT X7:LPRINT" "
2250 T=60:GOSUB 3080:LPRINT " "
2260 ON DP GOSUB 2320,3120
2270 INPUT "CONTINUE";YN$
2280 RETURN
2310 REM
2320 REM   SUBROUTINE--COLLECT INFO FOR DESCENDENTS TREE
2330 REM
2340 GOSUB 1970:GOSUB 2020:T=0:GOSUB 2830:S(1)=SP(1):S(2)=SP(2):OA=CN:FOR AA=1 TO OA:C0(AA)=C(AA):NEXT AA
2350 FOR S=1 TO 2:T=0:X=S(S): IF X>0 THEN GOSUB 2370
2360 NEXT S:RETURN
2370 GOSUB 1970:GOSUB 2020:T=T+5:GOSUB 2830:OB=CN:FOR AB=1 TO OB:C1(AB)=C(AB):NEXT AB:GOSUB 2380:RETURN
2380 IF OB=0 THEN T=0:RETURN
2390 FOR AA=1 TO OA: FOR AB=1 TO OB: IF C0(AA)=C1(AB) AND C0(AA)>0 THEN X=C0(AA):GOSUB 2410
2400 NEXT AB:NEXT AA:RETURN
2410 GOSUB 1970:GOSUB 2020:T=10:GOSUB 2830:S1(1)=SP(1):S1(2)=SP(2):OC=CN:FOR AC=1 TO OC:C2(AC)=C(AC):NEXT AC
2420 GOSUB 2430:RETURN
2430 FOR S1=1 TO 2:X=S1(S1):IF X>0 THEN GOSUB 2450
2440 NEXT S1:RETURN
2450 GOSUB 1970:GOSUB 2020:T=T+5:GOSUB 2830:OD=CN:FOR AD=1 TO OD:C3(AD)=C(AD):NEXT AD:GOSUB 2460:RETURN
2460 IF OD=0 THEN T=10:RETURN
2470 FOR AC=1 TO OC:FOR AD=1 TO OD:IF C2(AC)=C3(AD) AND C2(AC)>0 THEN X=C2(AC):GOSUB 2490
2480 NEXT AD:NEXT AC:T=10:RETURN
2490 GOSUB 1970:GOSUB 2020:T=20:GOSUB 2830:S2(1)=SP(1):S2(2)=SP(2):OE=CN:FOR AE=1 TO OE:C4(AE)=C(AE):NEXT AE
2500 GOSUB 2510:RETURN
2510 FOR S2=1 TO 2:X=S2(S2):IF X>0 THEN GOSUB 2530
2520 NEXT S2:RETURN
2530 GOSUB 1970:GOSUB 2020:T=T+5:GOSUB 2830:OF=CN:FOR AF=1 TO OF:C5(AF)=C(AF):NEXT AF:GOSUB 2540:RETURN
2540 IF OF=0 THEN T=20:RETURN
2550 FOR AE=1 TO OE:FOR AF=1 TO OF:IF C4(AE)=C5(AF) AND C4(AE)>0 THEN X=C4(AE):GOSUB 2570
2560 NEXT AF:NEXT AE:T=20:RETURN
2570 GOSUB 1970:GOSUB 2020:T=30:GOSUB 2830:S3(1)=SP(1):S3(2)=SP(2):OG=CN:FOR AG=1 TO OG:C6(AG)=C(AG):NEXT AG
2580 GOSUB 2590:RETURN
2590 FOR S3=1 TO 2:X=S3(S3):IF X>0 THEN GOSUB 2610
2600 NEXT S3:RETURN
2610 GOSUB 1970:GOSUB 2020:T=T+5:GOSUB 2830:OH=CN:FOR AH=1 TO OH:C7(AH)=C(AH):NEXT AH:GOSUB 2620:RETURN
2620 IF OH=0 THEN T=30:RETURN
2630 FOR AG=1 TO OG:FOR AH=1 TO OH:IF C6(AG)=C7(AH) AND C6(AG)>0 THEN X=C6(AG):GOSUB 2650
2640 NEXT AH:NEXT AG:T=30:RETURN
2650 GOSUB 1970:GOSUB 2020:T=40:GOSUB 2830:S4(1)=SP(1):S4(2)=SP(2):OI=CN:FOR AI=1 TO OI:C8(AI)=C(AI):NEXT AI
2660 GOSUB 2670:RETURN
2670 FOR S4=1 TO 2:X=S4(S4):IF X>0 THEN GOSUB 2690
2680 NEXT S4:RETURN
2690 GOSUB 1970:GOSUB 2020:T=T+5:GOSUB 2830:OJ=CN:FOR AJ=1 TO OJ:C9(AJ)=C(AJ):NEXT AJ:GOSUB 2700:RETURN
2700 IF OJ=0 THEN T=40:RETURN
2710 FOR AI=1 TO OI:FOR AJ=1 TO OJ:IF C8(AI)=C9(AJ) AND C8(AI)>0 THEN X=C8(AI):GOSUB 2730
2720 NEXT AJ:NEXT AI:T=40:RETURN
2730 GOSUB 1970:GOSUB 2020:T=50:GOSUB 2830:S5(1)=SP(1):S5(2)=SP(2):OK=CN:FOR AK=1 TO OK:CA(AK)=C(AK):NEXT AK
2740 GOSUB 2750:RETURN
2750 FOR S5=1 TO 2:X=S5(S5):IF X>0 THEN GOSUB 2770
2760 NEXT S5:RETURN
2770 GOSUB 1970:GOSUB 2020:T=T+5:GOSUB 2830:OL=CN:FOR AL=1 TO OL:CB(AL)=C(AL):NEXT AL:GOSUB 2780:RETURN
2780 IF OL=0 THEN T=50 : RETURN
2790 FOR AK=1 TO OK:FOR AL=1 TO OL:IF CA(AK)=CB(AL) AND CA(AK)>0 THEN X=CA(AK):GOSUB 2810
2800 NEXT AL:NEXT AK:T=50:RETURN
2810 GOSUB 1970:GOSUB 2020:T=60:GOSUB 2830:RETURN
2820 REM
2830 REM   SUBROUTINE--PRINT TREE
2840 REM
2850 ON C2 GOSUB 2870,2910:RETURN
2860 REM
2870 REM   SUBROUTINE--PRINT NAMES ONLY IN TREE FORM
2880 REM
2890 GOSUB 3080:LPRINT TAB(T)NF$(X);" "NL$(X):RETURN
2900 REM
2910 REM   SUBROUTINE--PRINT WHOLE ENTRY IN TREE FORM
2920 REM
2930 GOSUB 3080:LPRINT TAB(T)NF$(X);" ";NL$(X):TP$=PB$:GOSUB 3360:PB$=TP$:GOSUB 3300
2940 GOSUB 3080:LPRINT STRING$(5,32)"B.: ";DATE$;" AT ";PB$
2950 IF VAL(MD$(1))>0 OR LEFT$(MD$(1),1)="?" THEN GOSUB 3310:GOTO 2960 ELSE 2980
2960 TP$=PM$(1):GOSUB 3360:PM$(1)=TP$
2970 GOSUB 3080:LPRINT STRING$(5,32)"M.: ";DATE$;" TO ";NF$(SP(1));" ";NL$(SP(1));" AT ";PM$(1)
2980 GOSUB 3080:LPRINT STRING$(5,32)MS$(1)
2990 IF VAL(MD$(2))>0 OR LEFT$(MD$(2),1)="?" THEN GOSUB 3320:GOTO 3000 ELSE 3030
3000 TP$=PM$(2):GOSUB 3360:PM$(2)=TP$
3010 GOSUB 3080:LPRINT STRING$(5,32)"RM.: ";DATE$;" TO ";NF$(SP(2));" ";NL$(SP(2));" AT ";PM$(2)
3020 GOSUB 3080:LPRINT STRING$(5,32)MS$(2)
3030 TP$=PD$:GOSUB 3360:PD$=TP$
3040 GOSUB 3080:IF LEFT$(DD$,6)="LIVING" THEN LPRINT STRING$(5,32)DD$;" AT ";PD$:GOTO 3060
3050 GOSUB 3330:LPRINT STRING$(5,32)"D.: ";DATE$;" AT ";PD$
3060 RETURN
3070 REM
3080 REM   SUBROUTINE--PRINT EXCLAMATION POINTS
3090 REM
3100 FOR E=0 TO T STEP 10:LPRINT TAB(E)"!";:NEXT E:RETURN
3110 REM
3120 REM   SUBROUTINE--COLLECT INFO FOR PREDECESSORS TREE
3130 REM
3140 GOSUB 1970:GOSUB 2020:X1=X:GOSUB 3150:RETURN
3150 P0(1)=F:P0(2)=M:FOR P0=1 TO 2:X=P0(P0):IF X>0 THEN GOSUB 3170
3160 T=0:X=X1:IF P0=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P0:RETURN ELSE RETURN
3170 GOSUB 1970:GOSUB 2020:P1(1)=F:P1(2)=M:FOR P1=1 TO 2:X=P1(P1):IF X>0 THEN GOSUB 3190
3180 T=10:X=P0(P0):IF P1=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P1:RETURN ELSE RETURN
3190 GOSUB 1970:GOSUB 2020:P2(1)=F:P2(2)=M:FOR P2=1 TO 2:X=P2(P2):IF X>0 THEN GOSUB 3210
3200 T=20:X=P1(P1):IF P2=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P2:RETURN ELSE RETURN
3210 GOSUB 1970:GOSUB 2020:P3(1)=F:P3(2)=M:FOR P3=1 TO 2:X=P3(P3):IF X>0 THEN GOSUB 3230
3220 T=30:X=P2(P2):IF P3=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P3:RETURN ELSE RETURN
3230 GOSUB 1970:GOSUB 2020:P4(1)=F:P4(2)=M:FOR P4=1 TO 2:X=P4(P4):IF X>0 THEN GOSUB 3250
3240 T=40:X=P3(P3):IF P4=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P4:RETURN ELSE RETURN
3250 GOSUB 1970:GOSUB 2020:P5(1)=F:P5(2)=M:FOR P5=1 TO 2:X=P5(P5):IF X>0 THEN GOSUB 3270
3260 T=50:X=P4(P4):IF P5=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P5:RETURN ELSE RETURN
3270 GOSUB 1970:GOSUB 2020:P6(1)=F:P6(2)=M:FOR P6=1 TO 2:X=P6(P6):IF X>0 THEN GOSUB 3290
3280 T=60:X=P5(P5):IF P6=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P6:RETURN ELSE RETURN
3290 RETURN
3300 DATE$=FND$(BD$):RETURN
3310 DATE$=FND$(MD$(1)):RETURN
3320 DATE$=FND$(MD$(2)):RETURN
3330 DATE$=FND$(DD$):RETURN
3340 LPRINT " ":LPRINT T$:LPRINT " ":RETURN
3350 IF Y>=1 THEN Y=Y-1: RETURN ELSE RETURN
3360 Y=INSTR(TP$,B2$):IF Y=0 THEN Y=24
3370 TP$=LEFT$(TP$,Y):RETURN
3380 PRINT "(1) NAMES ONLY     (2) WHOLE ENTRY":INPUT "CHOICE";C2
3390 IF C2=1 OR C2=2 THEN RETURN ELSE 3380
3400 CLOSE:PRINT CHR$(12): PRINT "FILES HAVE BEEN CLOSED AND PROGRAM ENDED.":END
8000 REM
8010 X=LOF(1) + 1
8020 Z=X
8030 GOSUB 8520
8040 FIELD #1,126 AS DU$:FIELD #2,56 AS D$,16 AS NL$,24 AS NF$,16 AS NM$
8050 LSET DU$=" ":LSET D$=" ":LSET NL$=" ":LSET NF$=" ":LSET NM$=" "
8060 FOR X7=1 TO 13:LSET C$(X7)=MKI$(0):NEXT X7
8070 LSET M$=MKI$(0):LSET F$=MKI$(0)
8080 LSET S1$=MKI$(0):LSET S2$=MKI$(0):LSET CN$=MKI$(0)
8090 INPUT "LAST NAME {OR 'END' TO STOP}  AT BIRTH";A$:LSET NL$=A$
8100 IF A$="END" OR A$= " " THEN PRINT CHR$(12):GOTO 60
8110 INPUT "MARRIED LAST NAME";A$:LSET NM$=A$
8120 INPUT "FIRST (AND MIDDLE) NAME";A$:LSET NF$=A$:PUT 2,X
8130 GOSUB 8510:INPUT "BIRTH DATE (MMDDYYYY)";A$:LSET BD$=A$:PUT #1,X          
8140 GOSUB 8510:LINE INPUT "BIRTH PLACE ";A$:LSET PB$=A$:PUT #1,X          
8150 GOSUB 8510:INPUT "DATE OF MARRIAGE (MMDDYYYY)";A$:LSET MD$(1)=A$:PUT #1,X    
8160 GOSUB 8510:PRINT "SPOUSE ID NUMBER ";:GOSUB 8430:LSET S1$=MKI$(A):PUT #1,X
8170 GOSUB 8510:LINE INPUT "MARRIED AT ";A$:LSET PM$(1)=A$:PUT #1,X          
8180 GOSUB 8510:INPUT "MARITAL STATUS ";A$:LSET MS$(1)=A$:PUT #1,X          
8190 IF LEFT$(A$,3)="MAR" THEN 8240 
8200 GOSUB 8510:INPUT "DATE OF SECOND MARRIAGE (MMDDYYYY) ";A$:LSET MD$(2)=A$:PUT #1,X            
8210 GOSUB 8510:PRINT "SECOND SPOUSE ID NUMBER ":GOSUB 8430:LSET S2$=MKI$(A):PUT #1,X          
8220 GOSUB 8510:LINE INPUT "REMARRIED AT ";A$:LSET PM$(2)=A$:PUT #1,X
8230 GOSUB 8510:INPUT "MARITAL STATUS ";A$:LSET MS$(2)=A$:PUT #1,X          
8240 GOSUB 8510:INPUT "'LIVING' OR DATE OF DEATH (MMDDYYYY)";A$:LSET DD$=A$:PUT #1,X          
8250 GOSUB 8560:LINE INPUT "PLACE OF DEATH OR 'LIVING' ";A$:LSET PD$=A$:PUT #2,Z            
8260 GOSUB 8560:INPUT "NUMBER OF CHILDREN ";CN:LSET CN$=MKI$(CN):PUT #2,Z
8270 GOSUB 8560:PRINT "CHILD #1 ID NUMBER ";:GOSUB 8430:LSET C$(1)=MKI$(A):PUT #2,Z           
8280 GOSUB 8560:PRINT "CHILD #2 ID NUMBER ";:GOSUB 8430:LSET C$(2)=MKI$(A):PUT #2,Z               
8290 GOSUB 8560:PRINT "CHILD #3 ID NUMBER ";:GOSUB 8430:LSET C$(3)=MKI$(A):PUT #2,Z              
8300 GOSUB 8560:PRINT "CHILD #4 ID NUMBER ";:GOSUB 8430:LSET C$(4)=MKI$(A):PUT #2,Z            
8310 GOSUB 8560:PRINT "CHILD #5 ID NUMBER ";:GOSUB 8430:LSET C$(5)=MKI$(A):PUT #2,Z             
8320 GOSUB 8560:PRINT "CHILD #6 ID NUMBER ";:GOSUB 8430:LSET C$(6)=MKI$(A):PUT #2,Z             
8330 GOSUB 8560:PRINT "CHILD #7 ID NUMBER ";:GOSUB 8430:LSET C$(7)=MKI$(A):PUT #2,Z                 
8340 GOSUB 8560:PRINT "CHILD #8 ID NUMBER ";:GOSUB 8430:LSET C$(8)=MKI$(A):PUT #2,Z              
8350 GOSUB 8560:PRINT "CHILD #9 ID NUMBER ";:GOSUB 8430:LSET C$(9)=MKI$(A):PUT #2,Z               
8360 GOSUB 8560:PRINT "CHILD #10 ID NUMBER ";:GOSUB 8430:LSET C$(10)=MKI$(A):PUT #2,Z             
8370 GOSUB 8560:PRINT "CHILD #11 ID NUMBER ";:GOSUB 8430:LSET C$(11)=MKI$(A):PUT #2,Z               
8380 GOSUB 8560:PRINT "CHILD #12 ID NUMBER ";:GOSUB 8430:LSET C$(12)=MKI$(A):PUT #2,Z                 
8390 GOSUB 8560:PRINT "CHILD #13 ID NUMBER ";:GOSUB 8430:LSET C$(13)=MKI$(A):PUT #2,Z              
8400 GOSUB 8560:PRINT "MOTHER'S ID NUMBER ";:GOSUB 8430:LSET M$=MKI$(A):PUT #2,Z                
8410 GOSUB 8560:PRINT "FATHER'S ID NUMBER ";:GOSUB 8430:LSET F$=MKI$(A):PUT #2,Z             
8415 X=X+1:Z=Z+1
8420 GOTO 8050
8430 REM
8440 INPUT A
8450 IF A>=0 AND A<=LOF(1) THEN RETURN
8460 PRINT A;" IS AN INVALID PERSON ID # "
8470 INPUT "WILL YOU ADD HIM LATER <Y OR N>";A8$
8480 IF A8$="Y" THEN RETURN
8490 PRINT "ID NUMBER = ":GOTO 8440
8500 RETURN
8510 REM   SUBROUTINE--FIELD DATA BUFFER 1
8520 REM
8530 FIELD #1,8 AS BD$,24 AS PB$,8 AS MD$(1),2 AS S1$,24 AS PM$(1),9 AS MS$(1),8 AS MD$(2),2 AS S2$,24 AS PM$(2),9 AS MS$(2),8 AS DD$
8540 Z=X:GET #1,X
8550 SP(1)=CVI(S1$):SP(2)=CVI(S2$):RETURN
8560 FIELD #2,24 AS PD$,2 AS CN$,2 AS C$(1),2 AS C$(2),2 AS C$(3),2 AS C$(4),2 AS C$(5),2 AS C$(6),2 AS C$(7),2 AS C$(8),2 AS C$(9),2 AS C$(10),2 AS C$(11),2 AS C$(12),2 AS C$(13),2 AS M$,2 AS F$
8570 RETURN
$(5)