home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / FMLYTRE2.LBR / TREE.BQS / TREE.BAS
BASIC Source File  |  2000-06-30  |  19KB  |  360 lines
  1. 10 REM  --FAMILY TREE PROGRAM--  JOHN J. ARMSTRONG - MOBILE, AL
  2. 20 REM  COMPUTER SYSTEM:  CROMEMCO Z-2  64K RAM DISK PRINTER
  3. 21 DEFINT A-Z:CLEAR 8000:B1$=" ":B2$="  "
  4. 22 INPUT "WHICH FAMILY TREE (3 CHARACTERS)";TR$
  5. 23 OPEN "R",#1,"FAMILY  ."+TR$
  6. 24 OPEN "R",#2,"FAMILY2 ."+TR$
  7. 40 DEF FN D$(B$)=LEFT$(B$,2)+"-"+MID$(B$,3,2)+"-"+MID$(B$,5)
  8. 50 DIM NL$(LOF(1)),NF$(LOF(1)),NM$(LOF(1)),C$(13),C(13),CI(28)
  9. 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)
  10. 60 FOR X=1 TO LOF(1)
  11. 70 FIELD #1,126 AS DU$:FIELD #2,56 AS D$,16 AS NL$,24 AS NF$,16 AS NM$
  12. 80 GET #1,X:Z=X:GET #2,Z
  13. 90 Y=INSTR(NL$,B1$):GOSUB 3350:NL$(X)=LEFT$(NL$,Y):Y=INSTR(NF$,B2$):GOSUB 3350:NF$(X)=LEFT$(NF$,Y)
  14. 100 Y=INSTR(NM$,B1$):GOSUB 3350:NM$(X)=LEFT$(NM$,Y)
  15. 110 PRINT X;" ";NF$(X);" ";NL$(X);" ";NM$(X)
  16. 120 NEXT X
  17. 130 H$(1)="EDIT":H$(2)="DISPLAY ON VIDEO":H$(3)="PRINT ON PRINTER"
  18. 140 H$(4)="PRINT FAMILY TREE":H$(5)="EXIT PROGRAM"
  19. 150 H1$(1)="LAST NAME AT BIRTH":H1$(2)="FIRST OR MIDDLE NAME OR INITIAL"
  20. 160 H1$(3)="MARRIED LAST NAME":H1$(4)="ALL ENTRIES"
  21. 170 H1$(5)="LIVING IN YEAR...":H1$(6)="ALL MENTIONS OF PERSON"
  22. 180 C1=0:C2=0:C3=0:PRINT CHR$(12):FOR X=1 TO 5:PRINT "(";X;")";H$(X):NEXT X
  23. 190 INPUT "CHOICE";C1:IF C1<1 OR C1>5 THEN 190
  24. 200 IF C1=5 THEN GOTO 3400 ELSE IF C1=4 OR C1=1 THEN 220
  25. 210 GOSUB 3300
  26. 220 PRINT H$(C1);" BY:"
  27. 230 FOR X=1 TO 6:PRINT "(";X;")";H1$(X): NEXT X
  28. 240 INPUT "CHOICE";C3: IF C3<1 OR C3>6 THEN 240 ELSE 250
  29. 250 ON C3 GOSUB 270, 350, 430, 510, 580, 680: GOTO 180
  30. 260 REM
  31. 270 REM   SUBROUTINE--LAST NAME AT BIRTH
  32. 280 REM
  33. 290 PRINT CHR$(26):L=0:PRINT H$(C1):PRINT TAB(5) H1$(1):INPUT NL$:T$=H1$(1)+": '"+NL$+"'"
  34. 300 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT CHR$(26): PRINT T$
  35. 310 FOR X1=1 TO LOF(1)
  36. 311 IF NL$=NL$(X1) THEN X=X1
  37. 312 GOSUB 1970
  38. 313 GOSUB 2020
  39. 314 IF NL$<>NL$(X1) THEN 330
  40. 320 ON C1 GOSUB 830,1440,1680,2110
  41. 321 IF L>13 THEN L=0
  42. 322 GOSUB 3500
  43. 323 PRINT T$
  44. 330 IF X1<LOF(1) THEN NEXT ELSE GOSUB 3500:RETURN
  45. 340 REM
  46. 350 REM   SUBROUTINE--FIRST OR MIDDLE NAME OR INITIAL
  47.  
  48. 360 REM
  49. 370 PRINT CHR$(26):L=0:PRINT H$(C1):PRINT TAB(5) H1$(2): INPUT NF$:T$=H1$(2)+": '"+NF$+"'"
  50. 380 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT CHR$(26):PRINT T$
  51. 390 FOR X1=1 TO LOF(1):Y=INSTR(NF$(X1),NF$):IF Y<>0 THEN X=X1:GOSUB 1970:GOSUB 2020 ELSE 410
  52. 400 ON C1 GOSUB 830,1440,1680,2110: IF L>13 THEN L=0: GOSUB 3500: PRINT T$
  53. 410 IF X1<LOF(1) THEN 411 ELSE GOSUB 3500:RETURN
  54. 411 NEXT X1
  55. 412 RETURN
  56. 420 REM
  57. 430 REM   SUBROUTINE--MARRIED LAST NAME
  58. 440 REM
  59. 450 PRINT CHR$(26):L=0:PRINT H$(C1):PRINT TAB(5) H1$(3): INPUT NM$: T$=H1$(3)+": '"+NM$+"'"
  60. 460 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT CHR$(26): PRINT T$
  61. 470 FOR X1=1 TO LOF(1): IF NM$=NM$(X1) THEN X=X1: GOSUB 1970: GOSUB 2020 ELSE 490
  62. 480 ON C1 GOSUB 830,1440,1680,2110: IF L>13 THEN L=0: GOSUB 3500: PRINT T$
  63. 490 IF X1<LOF(1) THEN NEXT X1 ELSE INPUT "CONTINUE";YN$: RETURN
  64. 500 REM
  65. 510 REM   SUBROUTINE--ALL ENTRIES
  66. 520 REM
  67. 530 PRINT CHR$(26):L=0:T$=H1$(4)+": ": IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT T$
  68. 540 FOR X1=1 TO LOF(1):X=X1:GOSUB 1970:GOSUB 2020
  69. 550 ON C1 GOSUB 830, 1440, 1680, 2110: IF L>13 THEN L=0: GOSUB 3500: PRINT T$
  70. 560 IF X1<LOF(1) THEN NEXT X1 ELSE GOSUB 3500:RETURN
  71. 570 REM
  72. 580 REM   SUBROUTINE--LIVING IN YEAR...
  73. 590 REM
  74. 600 PRINT CHR$(26):L=0:PRINT H$(C1): PRINT TAB(5) H1$(5):INPUT "YYYY";YD$:T$=H1$(5)+": '"+YD$+"'"
  75. 610 IF C1=3 OR C1=4 THEN GOSUB 3340 ELSE PRINT T$
  76. 620 FOR X1=1 TO LOF(1):X=X1:GOSUB 1970:GOSUB 2020
  77. 630 IF VAL(MID$(BD$,5,4))>1500 AND (VAL(MID$(DD$,5,4))>1500 OR LEFT$(DD$,6)="LIVING") THEN 640 ELSE 660
  78. 640 IF YD$>=MID$(BD$,5,4) AND (YD$<=MID$(DD$,5,4) OR LEFT$(DD$,6)="LIVING") THEN 650 ELSE 660
  79. 650 ON C1 GOSUB 830, 1440, 1680, 2110:IF L>13 THEN L=0: INPUT "CONTINUE";YN$: PRINT T$
  80. 660 IF X1<LOF(1) THEN NEXT ELSE GOSUB 3500:RETURN
  81. 670 REM
  82. 680 REM   SUBROUTINE--ALL MENTIONS OF A PERSON
  83. 690 REM
  84. 700 PRINT CHR$(26):PRINT H$(C1):X5=0:PRINT H1$(1):PRINT TAB(5)"OR":PRINT H1$(3):INPUT NL$
  85. 710 PRINT H1$(2):INPUT NF$:PRINT CHR$(26):FOR X1=1 TO LOF(1):IF NL$(X1)=NL$ OR NM$(X1)=NL$ THEN 720 ELSE 730
  86. 720 Y=INSTR(NF$(X1),NF$):IF Y<>0 THEN GOSUB 740
  87. 730 IF X1<LOF(1) THEN NEXT X1:GOTO 810 ELSE 810
  88. 740 FOR X2=1 TO LOF(1): X=X2
  89. 750 IF X1<>X5 THEN 760 ELSE 770
  90. 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
  91. 770 GOSUB 1970: GOSUB 2020
  92. 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
  93. 790 ON C1 GOSUB 830, 1440, 1680, 2110:IF L>13 THEN L=0: PRINT T$
  94. 800 IF X2<LOF(1) THEN NEXT X2 ELSE GOSUB 3500
  95. 810 GOSUB 3500:RETURN
  96. 820 REM
  97. 830 REM   SUBROUTINE--EDIT SELECTION
  98. 840 REM
  99. 850 PRINT CHR$(26):PRINT X;" ";NF$(X);" ";NL$(X);" "NM$(X)
  100. 860 PRINT "1) BORN: ";BD$;:PRINT TAB(36)" 2) AT ";PB$
  101. 870 PRINT "3) MARRIED: ";MD$(1);:PRINT TAB(36)" 4) TO: ";NF$(SP(1));" ";NL$(SP(1))
  102. 880 PRINT "5) AT ";PM$(1);:PRINT TAB(36)" 6) MARITAL STATUS: ";MS$(1)
  103. 890 PRINT "7) REMARRIED: "MD$(2);:PRINT TAB(36)" 8) TO: ";NF$(SP(2));" ";NL$(SP(2))
  104. 900 PRINT "9) AT ";PM$(2);:PRINT TAB(36)" 10) MARITAL STATUS: ";MS$(2)
  105. 910 PRINT "11) DIED/LIVING: ";DD$;:PRINT TAB(36)" 12) AT ";PD$
  106. 920 PRINT "13) # CHILDREN ";CN;
  107. 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)
  108. 940 PRINT TAB(L1) MID$(STR$(X2+13),2);") ";NF$(X4);" ";NL$(X4);:NEXT X2:PRINT CHR$(13)
  109. 950 PRINT TAB(0)"27) MOTHER: ";NF$(M);" ";NL$(M);:PRINT TAB(36)" 28) FATHER: ";NF$(F);" ";NL$(F)
  110. 960 INPUT "ANY CHANGES TO BE MADE HERE (Y/N)";YN$: GOSUB 1370
  111. 970 IF LEFT$(YN$,1)="Y" THEN GOSUB 1370: GOSUB 990: RETURN ELSE PRINT CHR$(26): RETURN
  112. 980 REM
  113. 990 REM   SUBROUTINE--EDIT DATA
  114. 1000 REM
  115. 1010 GOSUB 1370:INPUT "HOW MANY CHANGES";CH:IF CH=0 THEN RETURN
  116. 1020 IF CH<1 OR CH>28 THEN PRINT CH; " IS AN INCORRECT NUMBER OF CHANGES";:GOTO 1010
  117. 1030 GOSUB 1370:FOR X3=1 TO CH
  118. 1040 INPUT "CHANGE ITEM # ";CI(X3):IF CI(X3)<1 OR CI(X3)>28 THEN 1045 ELSE 1050
  119. 1045 PRINT CI(X3);" IS AN INVALID ITEM # ";:GOSUB 1370:GOTO 1040
  120. 1050 GOSUB 1370
  121. 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
  122. 1080 NEXT X3:RETURN
  123. 1090 GOSUB 1970:INPUT "BIRTH DATE (MMDDYYYY)";A$:LSET BD$=A$:PUT #1,X:GOTO 1370
  124. 1100 GOSUB 1970:LINE INPUT "BIRTH PLACE ";A$:LSET PB$=A$:PUT #1,X:GOTO 1370
  125. 1110 GOSUB 1970:INPUT "DATE OF MARRIAGE (MMDDYYYY)";A$:LSET MD$(1)=A$:PUT #1,X:GOTO 1370
  126. 1120 GOSUB 1970:PRINT "SPOUSE ID NUMBER ";:GOSUB 1380:LSET S1$=MKI$(A):PUT #1,X:GOTO 1370
  127. 1130 GOSUB 1970:LINE INPUT "MARRIED AT ";A$:LSET PM$(1)=A$:PUT #1,X:GOTO 1370
  128. 1140 GOSUB 1970:INPUT "MARITAL STATUS ";A$:LSET MS$(1)=A$:PUT #1,X:GOTO 1370
  129. 1150 GOSUB 1970:INPUT "DATE OF SECOND MARRIAGE (MMDDYYYY) ";A$:LSET MD$(2)=A$:PUT #1,X:GOTO 1370
  130. 1160 GOSUB 1970:PRINT "SECOND SPOUSE ID NUMBER ":GOSUB 1380:LSET S2$=MKI$(A):PUT #1,X:GOTO 1370
  131. 1170 GOSUB 1970:LINE INPUT "REMARRIED AT ";A$:LSET PM$(2)=A$:PUT #1,X:GOTO 1370
  132. 1180 GOSUB 1970:INPUT "MARITAL STATUS ";A$:LSET MS$(2)=A$:PUT #1,X:GOTO 1370
  133. 1190 GOSUB 1970:INPUT "'LIVING' OR DATE OF DEATH (MMDDYYYY)";A$:LSET DD$=A$:PUT #1,X:GOTO 1370
  134. 1200 GOSUB 2020:LINE INPUT "PLACE OF DEATH OR 'LIVING' ";A$:LSET PD$=A$:PUT #2,Z:GOTO 1370
  135. 1210 GOSUB 2020:INPUT "NUMBER OF CHILDREN ";CN:LSET CN$=MKI$(CN):PUT #2,Z:GOTO 1370
  136. 1220 GOSUB 2020:PRINT "CHILD #1 ID NUMBER ";:GOSUB 1380:LSET C$(1)=MKI$(A):PUT #2,Z:GOTO 1370
  137. 1230 GOSUB 2020:PRINT "CHILD #2 ID NUMBER ";:GOSUB 1380:LSET C$(2)=MKI$(A):PUT #2,Z:GOTO 1370
  138. 1240 GOSUB 2020:PRINT "CHILD #3 ID NUMBER ";:GOSUB 1380:LSET C$(3)=MKI$(A):PUT #2,Z:GOTO 1370
  139. 1250 GOSUB 2020:PRINT "CHILD #4 ID NUMBER ";:GOSUB 1380:LSET C$(4)=MKI$(A):PUT #2,Z:GOTO 1370
  140. 1260 GOSUB 2020:PRINT "CHILD #5 ID NUMBER ";:GOSUB 1380:LSET C$(5)=MKI$(A):PUT #2,Z:GOTO 1370
  141. 1270 GOSUB 2020:PRINT "CHILD #6 ID NUMBER ";:GOSUB 1380:LSET C$(6)=MKI$(A):PUT #2,Z:GOTO 1370
  142. 1280 GOSUB 2020:PRINT "CHILD #7 ID NUMBER ";:GOSUB 1380:LSET C$(7)=MKI$(A):PUT #2,Z:GOTO 1370
  143. 1290 GOSUB 2020:PRINT "CHILD #8 ID NUMBER ";:GOSUB 1380:LSET C$(8)=MKI$(A):PUT #2,Z:GOTO 1370
  144. 1300 GOSUB 2020:PRINT "CHILD #9 ID NUMBER ";:GOSUB 1380:LSET C$(9)=MKI$(A):PUT #2,Z:GOTO 1370
  145. 1310 GOSUB 2020:PRINT "CHILD #10 ID NUMBER ";:GOSUB 1380:LSET C$(10)=MKI$(A):PUT #2,Z:GOTO 1370
  146. 1320 GOSUB 2020:PRINT "CHILD #11 ID NUMBER ";:GOSUB 1380:LSET C$(11)=MKI$(A):PUT #2,Z:GOTO 1370
  147. 1330 GOSUB 2020:PRINT "CHILD #12 ID NUMBER ";:GOSUB 1380:LSET C$(12)=MKI$(A):PUT #2,Z:GOTO 1370
  148. 1340 GOSUB 2020:PRINT "CHILD #13 ID NUMBER ";:GOSUB 1380:LSET C$(13)=MKI$(A):PUT #2,Z:GOTO 1370
  149. 1350 GOSUB 2020:PRINT "MOTHER'S ID NUMBER ";:GOSUB 1380:LSET M$=MKI$(A):PUT #2,Z:GOTO 1370
  150. 1360 GOSUB 2020:PRINT "FATHER'S ID NUMBER ";:GOSUB 1380:LSET F$=MKI$(A):PUT #2,Z:GOTO 1370
  151. 1370 A=0:A$="":PRINT CHR$(20);CHR$(21);CHR$(0);:PRINT CHR$(30);:RETURN
  152. 1380 Y=POS(0)
  153. 1390 INPUT A
  154. 1400 IF A>=0 AND A<=LOF(1) THEN RETURN
  155. 1410 PRINT A;" IS AN INVALID PERSON ID # ";
  156. 1420 PRINT CHR$(20);CHR$(21);CHR$(0);:PRINT CHR$(30);:GOTO 1070
  157. 1430 REM
  158. 1440 REM   SUBROUTINE---OPTION TO DISPLAY ON VIDEO
  159. 1450 REM
  160. 1455 GOSUB 3380
  161. 1460 ON C2 GOSUB 1480,1520:RETURN
  162. 1470 REM
  163. 1480 REM   SUBROUTINE--DISPLAY NAMES ONLY
  164. 1490 REM
  165. 1500 PRINT TAB(5) X;" ";NF$(X);" "NL$(X);" ";NM$(X):L=L+1:RETURN
  166. 1510 REM
  167. 1520 REM   SUBROUTINE--DISPLAY WHOLE ENTRY
  168. 1530 REM
  169. 1540 PRINT X;" ";NF$(X);" ";NL$(X);" ";NM$(X):GOSUB 3300
  170. 1550 PRINT "B.: ";DATE$;:PRINT TAB(36)" AT ";PB$:GOSUB 3310
  171. 1560 PRINT "M.: ";DATE$;:PRINT TAB(36)" TO ";NF$(SP(1));" ";NL$(SP(1))
  172. 1570 PRINT "AT ";PM$(1);:PRINT TAB(36) MS$(1):GOSUB 3320
  173. 1580 PRINT "RM.: ";DATE$;:PRINT TAB(36)" TO ";NF$(SP(2));" ";NL$(SP(2))
  174. 1590 PRINT "AT ";PM$(2);:PRINT TAB(36) MS$(2)
  175. 1600 IF LEFT$(DD$,6)="LIVING" THEN PRINT DD$;:PRINT TAB(36) " AT ";PD$:GOTO 1620
  176. 1610 GOSUB 3330:PRINT "D.: ";DATE$;:PRINT TAB(36)" AT ";PD$
  177. 1620 PRINT "# CHILDREN:";CN;
  178. 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
  179. 1640 PRINT TAB(L1 * 1)MID$(STR$(X3),2);")";NF$(X4);" ";NL$(X4);:NEXT X3
  180. 1645 PRINT " "
  181. 1650 PRINT TAB(0)" MOTHER: ";NF$(M);" ";NL$(M);:PRINT TAB(36)" FATHER: ";NF$(F);" ";NL$(F)
  182. 1660 PRINT CHR$(20);CHR$(21);CHR$(0);:GOSUB 3500:PRINT CHR$(26):RETURN
  183. 1670 REM
  184. 1680 REM   SUBROUTINE--OPTION TO PRINT ON PRINTER
  185. 1690 REM
  186. 1695 GOSUB 3380
  187. 1700 ON C2 GOSUB 1720, 1760:RETURN
  188. 1710 REM
  189. 1720 REM   SUBROUTINE--PRINT NAMES ONLY
  190. 1730 REM
  191. 1740 LPRINT X;" ";NF$(X);" ";NL$(X);" "NM$(X):RETURN
  192. 1750 REM
  193. 1760 REM   SUBROUTINE--PRINT WHOLE ENTRY
  194. 1770 REM
  195. 1780 LPRINT X;" "NF$(X);" ";NL$(X);" ";NM$(X):TP$=PB$:GOSUB 3360:PB$=TP$
  196. 1790 GOSUB 3300:LPRINT TAB(5)"B.: ";DATE$;" AT ";PB$
  197. 1800 TP$=PM$(1):GOSUB 3360:PM$(1)=TP$
  198. 1810 IF VAL(MD$(1))>0 OR LEFT$(MD$(1),1)="?" THEN GOSUB 3310:GOTO 1830
  199. 1820 LPRINT TAB(5) MS$(1):GOTO 1870
  200. 1830 LPRINT TAB(5)"M.: ";DATE$;" TO ";NF$(SP(1));" ";NL$(SP(1));" AT ";PM$(1);" ";MS$(1)
  201. 1840 TP$=PM$(2):GOSUB 3360:PM$(2)=TP$
  202. 1850 IF VAL(MD$(2))>0 OR LEFT$(MD$(2),1)="?" THEN GOSUB 3320 ELSE 1870
  203. 1860 LPRINT TAB(5)"RM.: ";DATE$;" TO ";NF$(SP(2));" ";NL$(SP(2));" AT ";PM$(2);" ";MS$(2)
  204. 1870 TP$=PD$:GOSUB 3360:PD$=TP$
  205. 1880 IF LEFT$(DD$,6)="LIVING" THEN LPRINT TAB(5)DD$;" AT ";PD$:GOTO 1900
  206. 1890 GOSUB 3330:LPRINT TAB(5)"D.: ";DATE$;" AT ";PD$
  207. 1900 IF CN=0 THEN 1930
  208. 1910 LPRINT TAB(5)"# CHILDREN: ";CN
  209. 1920 FOR X3=1 TO CN:X4=C(X3):LPRINT TAB(10)X3;")";NF$(X4);" "NL$(X4):NEXT X3
  210. 1930 LPRINT TAB(5)"MOTHER: ";NF$(M);" ";NL$(M)
  211. 1940 LPRINT TAB(5)"FATHER: ";NF$(F);" "NL$(F)
  212. 1950 LPRINT " ":RETURN
  213. 1960 REM
  214. 1970 REM   SUBROUTINE--FIELD DATA BUFFER 1
  215. 1980 REM
  216. 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$
  217. 2000 Z=X:GET #1,X
  218. 2010 SP(1)=CVI(S1$):SP(2)=CVI(S2$):RETURN
  219. 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$
  220. 2030 GET #2,Z
  221. 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$)
  222. 2050 RETURN
  223. 2100 REM
  224. 2110 REM   SUBROUTINE--START/END TREE
  225. 2120 REM
  226. 2130 PRINT CHR$(26):PRINT X;" ";NF$(X);" ";NL$(X);" ";NM$(X)
  227. 2140 PRINT "1) DESCENDENTS     2) PREDECESSORS":INPUT "CHOICE";DP:IF DP <>1 AND DP<>2 THEN 2140
  228. 2150 GOSUB 3380
  229. 2160 IF DP=1 THEN DP$="DESCENDENTS OF ":CP$="CHILDREN" ELSE DP$="PREDECESSORS OF ":CP$="PARENTS"
  230. 2170 LPRINT TAB(15) DP$;NF$(X);" ";NL$(X);" ";NM$(X):LPRINT " ":LPRINT " "
  231. 2180 FOR X7=60 TO 30 STEP -10
  232. 2190 FOR X8=X7 TO 60 STEP 10
  233. 2200 LPRINT TAB(X8)"GREAT";
  234. 2210 NEXT X8:LPRINT" ":NEXT X7
  235. 2220 FOR X7=20 TO 60 STEP 10:LPRINT TAB(X7)"GRAND";:NEXT X7:LPRINT" "
  236. 2230 LPRINT TAB(0)"PERSON";
  237. 2240 FOR X7=10 TO 60 STEP 10:LPRINT TAB(X7) CP$;:NEXT X7:LPRINT" "
  238. 2250 T=60:GOSUB 3080:LPRINT " "
  239. 2260 ON DP GOSUB 2320,3120
  240. 2270 GOSUB 3500
  241. 2280 RETURN
  242. 2310 REM
  243. 2320 REM   SUBROUTINE--COLLECT INFO FOR DESCENDENTS TREE
  244. 2330 REM
  245. 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
  246. 2350 FOR S=1 TO 2:T=0:X=S(S): IF X>0 THEN GOSUB 2370
  247. 2360 NEXT S:RETURN
  248. 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
  249. 2380 IF OB=0 THEN T=0:RETURN
  250. 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
  251. 2400 NEXT AB:NEXT AA:RETURN
  252. 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
  253. 2420 GOSUB 2430:RETURN
  254. 2430 FOR S1=1 TO 2:X=S1(S1):IF X>0 THEN GOSUB 2450
  255. 2440 NEXT S1:RETURN
  256. 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
  257. 2460 IF OD=0 THEN T=10:RETURN
  258. 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
  259. 2480 NEXT AD:NEXT AC:T=10:RETURN
  260. 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
  261. 2500 GOSUB 2510:RETURN
  262. 2510 FOR S2=1 TO 2:X=S2(S2):IF X>0 THEN GOSUB 2530
  263. 2520 NEXT S2:RETURN
  264. 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
  265. 2540 IF OF=0 THEN T=20:RETURN
  266. 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
  267. 2560 NEXT AF:NEXT AE:T=20:RETURN
  268. 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
  269. 2580 GOSUB 2590:RETURN
  270. 2590 FOR S3=1 TO 2:X=S3(S3):IF X>0 THEN GOSUB 2610
  271. 2600 NEXT S3:RETURN
  272. 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
  273. 2620 IF OH=0 THEN T=30:RETURN
  274. 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
  275. 2640 NEXT AH:NEXT AG:T=30:RETURN
  276. 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
  277. 2660 GOSUB 2670:RETURN
  278. 2670 FOR S4=1 TO 2:X=S4(S4):IF X>0 THEN GOSUB 2690
  279. 2680 NEXT S4:RETURN
  280. 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
  281. 2700 IF OJ=0 THEN T=40:RETURN
  282. 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
  283. 2720 NEXT AJ:NEXT AI:T=40:RETURN
  284. 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
  285. 2740 GOSUB 2750:RETURN
  286. 2750 FOR S5=1 TO 2:X=S5(S5):IF X>0 THEN GOSUB 2770
  287. 2760 NEXT S5:RETURN
  288. 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
  289. 2780 IF OL=0 THEN T=50 : RETURN
  290. 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
  291. 2800 NEXT AL:NEXT AK:T=50:RETURN
  292. 2810 GOSUB 1970:GOSUB 2020:T=60:GOSUB 2830:RETURN
  293. 2820 REM
  294. 2830 REM   SUBROUTINE--PRINT TREE
  295. 2840 REM
  296. 2850 ON C2 GOSUB 2870,2910:RETURN
  297. 2860 REM
  298. 2870 REM   SUBROUTINE--PRINT NAMES ONLY IN TREE FORM
  299. 2880 REM
  300. 2890 GOSUB 3080:LPRINT TAB(T)NF$(X);" "NL$(X):RETURN
  301. 2900 REM
  302. 2910 REM   SUBROUTINE--PRINT WHOLE ENTRY IN TREE FORM
  303. 2920 REM
  304. 2930 GOSUB 3080:LPRINT TAB(T)NF$(X);" ";NL$(X):TP$=PB$:GOSUB 3360:PB$=TP$:GOSUB 3300
  305. 2940 GOSUB 3080:LPRINT STRING$(5,32)"B.: ";DATE$;" AT ";PB$
  306. 2950 IF VAL(MD$(1))>0 OR LEFT$(MD$(1),1)="?" THEN GOSUB 3310:GOTO 2960 ELSE 2980
  307. 2960 TP$=PM$(1):GOSUB 3360:PM$(1)=TP$
  308. 2970 GOSUB 3080:LPRINT STRING$(5,32)"M.: ";DATE$;" TO ";NF$(SP(1));" ";NL$(SP(1));" AT ";PM$(1)
  309. 2980 GOSUB 3080:LPRINT STRING$(5,32)MS$(1)
  310. 2990 IF VAL(MD$(2))>0 OR LEFT$(MD$(2),1)="?" THEN GOSUB 3320:GOTO 3000 ELSE 3030
  311. 3000 TP$=PM$(2):GOSUB 3360:PM$(2)=TP$
  312. 3010 GOSUB 3080:LPRINT STRING$(5,32)"RM.: ";DATE$;" TO ";NF$(SP(2));" ";NL$(SP(2));" AT ";PM$(2)
  313. 3020 GOSUB 3080:LPRINT STRING$(5,32)MS$(2)
  314. 3030 TP$=PD$:GOSUB 3360:PD$=TP$
  315. 3040 GOSUB 3080:IF LEFT$(DD$,6)="LIVING" THEN LPRINT STRING$(5,32)DD$;" AT ";PD$:GOTO 3060
  316. 3050 GOSUB 3330:LPRINT STRING$(5,32)"D.: ";DATE$;" AT ";PD$
  317. 3060 RETURN
  318. 3070 REM
  319. 3080 REM   SUBROUTINE--PRINT EXCLAMATION POINTS
  320. 3090 REM
  321. 3100 FOR E=0 TO T STEP 10:LPRINT TAB(E)"!";:NEXT E:RETURN
  322. 3110 REM
  323. 3120 REM   SUBROUTINE--COLLECT INFO FOR PREDECESSORS TREE
  324. 3130 REM
  325. 3140 GOSUB 1970:GOSUB 2020:X1=X:GOSUB 3150:RETURN
  326. 3150 P0(1)=F:P0(2)=M:FOR P0=1 TO 2:X=P0(P0):IF X>0 THEN GOSUB 3170
  327. 3160 T=0:X=X1:IF P0=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P0:RETURN ELSE RETURN
  328. 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
  329. 3180 T=10:X=P0(P0):IF P1=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P1:RETURN ELSE RETURN
  330. 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
  331. 3200 T=20:X=P1(P1):IF P2=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P2:RETURN ELSE RETURN
  332. 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
  333. 3220 T=30:X=P2(P2):IF P3=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P3:RETURN ELSE RETURN
  334. 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
  335. 3240 T=40:X=P3(P3):IF P4=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P4:RETURN ELSE RETURN
  336. 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
  337. 3260 T=50:X=P4(P4):IF P5=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P5:RETURN ELSE RETURN
  338. 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
  339. 3280 T=60:X=P5(P5):IF P6=1 THEN GOSUB 1970:GOSUB 2020:GOSUB 2830:NEXT P6:RETURN ELSE RETURN
  340. 3290 RETURN
  341. 3300 DATE$=FND$(BD$):RETURN
  342. 3310 DATE$=FND$(MD$(1)):RETURN
  343. 3320 DATE$=FND$(MD$(2)):RETURN
  344. 3330 DATE$=FND$(DD$):RETURN
  345. 3340 LPRINT " ":LPRINT T$:LPRINT " ":RETURN
  346. 3350 IF Y>=1 THEN Y=Y-1: RETURN ELSE RETURN
  347. 3360 Y=INSTR(TP$,B2$):IF Y=0 THEN Y=24
  348. 3370 TP$=LEFT$(TP$,Y):RETURN
  349. 3380 PRINT "(1) NAMES ONLY     (2) WHOLE ENTRY":INPUT "CHOICE";C2
  350. 3390 IF C2=1 OR C2=2 THEN RETURN ELSE 3380
  351. 3400 CLOSE:PRINT CHR$(26): PRINT "FILES HAVE BEEN CLOSED AND PROGRAM ENDED.":END
  352. 3500 PRINT"CONTINUE (Y/N)?
  353. 3505 YN$=INKEY$
  354. 3510 IF YN$="" THEN 3505
  355. 3520 IF YN$<>"Y" THEN 130
  356. 3530 RETURN
  357. AM ENDED.":END
  358. 3500 PRINT"CONTINUE (Y/N)?
  359. 3505 YN$=INKEY$
  360. 3510 IF YN$