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 / MBUG / MBUG059.ARC / DISPLAY.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  27KB  |  724 lines
  1. 100 TITLE$ = "Display Program"
  2. 105 TITLE$ = TITLE$ + " ON DISPLAY"
  3. 110 VERSION$ = "Version 1.3"
  4. 115 COPY1$ = "Copyright (c) 1983, by:"
  5. 120 COPY2$ = "Melvin O. Duke"
  6. 125 PRICE$ = "$35"
  7. 130 ADDR1$ = "Melvin O. Duke"
  8. 135 ADDR2$ = "P. O. Box 20836"
  9. 140 ADDR3$ = "San Jose, CA  95160"
  10. 145 REM Dimension Statements go here
  11. 150 DIM PA.ID(800), CH.ID(800), PERS.NO(400), M.NO(400)
  12. 160 DIM PERS(15), CH(55)
  13. 170 REM Produce the first screen
  14. 175 KEY OFF : CLS
  15. 180 REM Draw the outer double box
  16. 185 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  17. 190 REM Find the title location
  18. 195 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  19. 200 REM Draw the title box
  20. 205 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  21. 210 REM Print the title
  22. 215 LOCATE 4,TITLE.POS : PRINT TITLE$
  23. 220 LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  24. 225 REM Draw the Contribution box
  25. 230 R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  26. 235 REM Request the Contribution
  27. 240 LOCATE 9,23 : PRINT "If you are using these programs, and"
  28. 245 LOCATE 10,21 : PRINT "finding them of value, your contribution"
  29. 250 LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be appreciated."
  30. 255 REM Draw the Mailing Label
  31. 260 R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  32. 265 REM Print the Name and Address
  33. 270 LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  34. 275 LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  35. 280 LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  36. 285 REM Draw the Copyright box
  37. 290 R1 = 19 : C1 = 27 : R2 = 22 : C2 = 53 : GOSUB 400
  38. 295 REM Print the Copyright
  39. 300 LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  40. 305 LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  41. 310 GOTO 740
  42. 400 REM subroutine to print a double box
  43. 410 FOR I = R1 + 1 TO R2 - 1
  44. 420  LOCATE I, C1 : PRINT CHR$(186);
  45. 430  LOCATE I, C2 : PRINT CHR$(186);
  46. 440 NEXT I
  47. 450 FOR J = C1 + 1 TO C2 - 1
  48. 460  LOCATE R1, J : PRINT CHR$(205);
  49. 470  LOCATE R2, J : PRINT CHR$(205);
  50. 480 NEXT J
  51. 490  LOCATE R1, C1 : PRINT CHR$(201);
  52. 500  LOCATE R1, C2 : PRINT CHR$(187);
  53. 510  LOCATE R2, C1 : PRINT CHR$(200);
  54. 520  LOCATE R2, C2 : PRINT CHR$(188);
  55. 530 RETURN
  56. 600 REM subroutine to print a single box
  57. 610 FOR I = R1 + 1 TO R2 - 1
  58. 620  LOCATE I, C1 : PRINT CHR$(179);
  59. 630  LOCATE I, C2 : PRINT CHR$(179);
  60. 640 NEXT I
  61. 650 FOR J = C1 + 1 TO C2 - 1
  62. 660  LOCATE R1, J : PRINT CHR$(196);
  63. 670  LOCATE R2, J : PRINT CHR$(196);
  64. 680 NEXT J
  65. 690  LOCATE R1, C1 : PRINT CHR$(218);
  66. 700  LOCATE R1, C2 : PRINT CHR$(191);
  67. 710  LOCATE R2, C1 : PRINT CHR$(192);
  68. 720  LOCATE R2, C2 : PRINT CHR$(217);
  69. 730 RETURN
  70. 740 REM ask user to press a key to continue
  71. 750 LOCATE 25,1
  72. 760 PRINT "Press any key to continue";
  73. 770 K$ = INKEY$ : IF K$ = "" THEN 770
  74. 780 CLS
  75. 840 CLS
  76. 850 GOTO 2450
  77. 1000 REM Display (showgene) Program.
  78. 1010 REM By:  Melvin O. Duke.  Updated 26 June, 1983.
  79. 1020 REM Draw the form on the display
  80. 1030 R1= 1 : C1= 1 : R2=21 : C2=79: GOSUB 400 'Double box
  81. 1040 R1= 3 : C1= 1 : R2= 3 : C2=79: GOSUB 2170 'Horizontal Double
  82. 1050 LOCATE 2,3 : PRINT "Pedigree Chart for:"
  83. 1060 LOCATE 4,68 : COLOR 1 : PRINT "Birthdate:" : COLOR 7
  84. 1070 LOCATE 12, 3 : I = 1 : GOSUB 1470
  85. 1080 LOCATE  8,11 : PRINT CHR$(218)+CHR$(196);
  86. 1090 LOCATE  9,11 : PRINT CHR$(179);
  87. 1100 LOCATE 10,11 : PRINT CHR$(179);
  88. 1110 LOCATE 11,11 : PRINT CHR$(179);
  89. 1120 LOCATE  8,13 : I = 2 : GOSUB 1510
  90. 1130 LOCATE 16,11 : PRINT CHR$(192)+CHR$(196);
  91. 1140 LOCATE 13,11 : PRINT CHR$(179);
  92. 1150 LOCATE 14,11 : PRINT CHR$(179);
  93. 1160 LOCATE 15,11 : PRINT CHR$(179);
  94. 1170 LOCATE 16,13 : I = 3 : GOSUB 1510
  95. 1180 LOCATE  6,21 : PRINT CHR$(218)+CHR$(196);
  96. 1190 LOCATE  7,21 : PRINT CHR$(179);
  97. 1200 LOCATE  6,23 : I = 4 : GOSUB 1540
  98. 1210 LOCATE 10,21 : PRINT CHR$(192)+CHR$(196);
  99. 1220 LOCATE  9,21 : PRINT CHR$(179);
  100. 1230 LOCATE 10,23 : I = 5 : GOSUB 1540
  101. 1240 LOCATE 14,21 : PRINT CHR$(218)+CHR$(196);
  102. 1250 LOCATE 15,21 : PRINT CHR$(179);
  103. 1260 LOCATE 14,23 : I = 6 : GOSUB 1540
  104. 1270 LOCATE 18,21 : PRINT CHR$(192)+CHR$(196);
  105. 1280 LOCATE 17,21 : PRINT CHR$(179);
  106. 1290 LOCATE 18,23 : I = 7 : GOSUB 1540
  107. 1300 LOCATE  5,31 : PRINT CHR$(218)+CHR$(196);
  108. 1310 LOCATE  5,33 : I = 8 : GOSUB 1570
  109. 1320 LOCATE  7,31 : PRINT CHR$(192)+CHR$(196);
  110. 1330 LOCATE  7,33 : I = 9 : GOSUB 1570
  111. 1340 LOCATE  9,31 : PRINT CHR$(218)+CHR$(196);
  112. 1350 LOCATE  9,33 : I = 10 : GOSUB 1570
  113. 1360 LOCATE 11,31 : PRINT CHR$(192)+CHR$(196);
  114. 1370 LOCATE 11,33 : I = 11 : GOSUB 1570
  115. 1380 LOCATE 13,31 : PRINT CHR$(218)+CHR$(196);
  116. 1390 LOCATE 13,33 : I = 12 : GOSUB 1570
  117. 1400 LOCATE 15,31 : PRINT CHR$(192)+CHR$(196);
  118. 1410 LOCATE 15,33 : I = 13 : GOSUB 1570
  119. 1420 LOCATE 17,31 : PRINT CHR$(218)+CHR$(196);
  120. 1430 LOCATE 17,33 : I = 14 : GOSUB 1570
  121. 1440 LOCATE 19,31 : PRINT CHR$(192)+CHR$(196);
  122. 1450 LOCATE 19,33 : I = 15 : GOSUB 1570
  123. 1460 RETURN
  124. 1470 REM Routine to print the lines
  125. 1480 COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  126. 1490 COLOR 1,0 : PRINT SPACE$(62); : COLOR 7
  127. 1500 RETURN
  128. 1510 COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  129. 1520 COLOR 1,0 : PRINT SPACE$(52); : COLOR 7
  130. 1530 RETURN
  131. 1540 COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  132. 1550 COLOR 1,0 : PRINT SPACE$(42); : COLOR 7
  133. 1560 RETURN
  134. 1570 COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  135. 1580 COLOR 1,0 : PRINT SPACE$(32); : COLOR 7
  136. 1590 RETURN
  137. 1600 REM Draw the Personal Information Chart
  138. 1610 CLS
  139. 1620 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  140. 1630 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Horizontal double
  141. 1640 LOCATE 2,3 : PRINT "Personal Information for:"
  142. 1650 R1 = 3 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2310  'Vertical Double
  143. 1660 LOCATE 4,3 : PRINT "Person:";
  144. 1670 LOCATE 6,3 : PRINT "Surname:";
  145. 1680 LOCATE 7,3 : PRINT "Given-names:";
  146. 1690 LOCATE 8,3 : PRINT "Sex:";
  147. 1700 R1 = 9 : C1 = 1 : R2 =11 : C2 = 40 : GOSUB 2170  'Horizontal Double
  148. 1710 LOCATE 10,3 : PRINT "Person's Father:";
  149. 1720 LOCATE 12,3 : PRINT "Surname:";
  150. 1730 LOCATE 13,3 : PRINT "Given-names:";
  151. 1740 LOCATE 14,3 : PRINT "Birth-date:";
  152. 1750 R1 = 15 : C1 = 1 : R2 = 15 : C2 = 40 : GOSUB 2240  'Horizontal Single
  153. 1760 LOCATE 16,3 : PRINT "Person's Mother:";
  154. 1770 LOCATE 18,3 : PRINT "Surname:";
  155. 1780 LOCATE 19,3 : PRINT "Given-names:";
  156. 1790 LOCATE 20,3 : PRINT "Birth-date:";
  157. 1800 LOCATE 4,42 : PRINT "Person's Vital Statistics:";
  158. 1810 LOCATE 6,42 : PRINT "Birth-date:";
  159. 1820 LOCATE 7,42 : PRINT "Birth-city:";
  160. 1830 LOCATE 8,42 : PRINT "Birth-county:";
  161. 1840 LOCATE 9,42 : PRINT "Birth-state:";
  162. 1850 LOCATE 11,42 : PRINT "Death-date:";
  163. 1860 LOCATE 12,42 : PRINT "Death-city:";
  164. 1870 LOCATE 13,42 : PRINT "Death-county:";
  165. 1880 LOCATE 14,42 : PRINT "Death-state:";
  166. 1890 LOCATE 16,42 : PRINT "Burial-date:";
  167. 1900 LOCATE 17,42 : PRINT "Burial-city:";
  168. 1910 LOCATE 18,42 : PRINT "Burial-county:";
  169. 1920 LOCATE 19,42 : PRINT "Burial-state:";
  170. 1930 RETURN
  171. 1940 REM draw a Family Group Sheet
  172. 1950 CLS
  173. 1960 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  174. 1970 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Double Horizontal
  175. 1980 LOCATE 2,31 : PRINT "Family Group Record";
  176. 1990 LOCATE 4,3 : COLOR 1 : PRINT "Father"; : COLOR 7 : PRINT ":";
  177. 2000 LOCATE 4,56 : PRINT "Birthdate:";
  178. 2010 LOCATE 5,3 : COLOR 1 : PRINT "Mother"; : COLOR 7 : PRINT ":";
  179. 2020 LOCATE 5,56 : PRINT "Birthdate:";
  180. 2030 R1 = 6 : C1 = 1 : R2 = 6 : C2 = 79 : GOSUB 2240  'Single Horizontal
  181. 2040 LOCATE 7,3 : PRINT "Marriage Date:";
  182. 2050 LOCATE 7,35 : PRINT "Location:";
  183. 2060 R1 = 8 : C1 = 1 : R2 = 8 : C2 = 79 : GOSUB 2170  'Double Horizontal
  184. 2070 R1 = 8 : C1 = 4 : R2 = 21 : C2 = 4 : GOSUB 2380  'Single Vertical
  185. 2080 R1 = 8 : C1 = 6 : R2 = 21 : C2 = 6 : GOSUB 2380  'Single Vertical
  186. 2090 R1 = 8 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2380  'Single Vertical
  187. 2100 LOCATE 9,2 : COLOR 1 : PRINT "NO"; : COLOR 7
  188. 2110 LOCATE 9,5 : COLOR 1 : PRINT "S"; : COLOR 7
  189. 2120 LOCATE 9,7 : COLOR 1 : PRINT "Children:"; : COLOR 7
  190. 2130 LOCATE 9,41 : COLOR 1 : PRINT "Birthdate:"; : COLOR 7
  191. 2140 R1 = 8 : C1 = 52 : R2 = 21 : C2 = 52 : GOSUB 2380  'Single Vertical
  192. 2150 LOCATE 9,53 : COLOR 1 : PRINT "Birth Location:"; : COLOR 7
  193. 2160 RETURN
  194. 2170 REM Subroutine to draw a double horizontal line.  Attach to double.
  195. 2180 FOR J = C1 + 1 TO C2 - 1
  196. 2190  LOCATE R1,J : PRINT CHR$(205);
  197. 2200 NEXT J
  198. 2210 LOCATE R1,C1 : PRINT CHR$(204);
  199. 2220 LOCATE R1,C2 : PRINT CHR$(185);
  200. 2230 RETURN
  201. 2240 REM Subroutine to draw a single horizontal line.  Attach to double.
  202. 2250 FOR J = C1 + 1 TO C2 - 1
  203. 2260  LOCATE R1,J : PRINT CHR$(196);
  204. 2270 NEXT J
  205. 2280 LOCATE R1,C1 : PRINT CHR$(199);
  206. 2290 LOCATE R1,C2 : PRINT CHR$(182);
  207. 2300 RETURN
  208. 2310 REM Subroutine to draw a double vertical line.  Attach to double.
  209. 2320 FOR I = R1 + 1 TO R2 - 1
  210. 2330  LOCATE I,C1 : PRINT CHR$(186);
  211. 2340 NEXT I
  212. 2350 LOCATE R1,C1 : PRINT CHR$(203);
  213. 2360 LOCATE R2,C1 : PRINT CHR$(202);
  214. 2370 RETURN
  215. 2380 REM Subroutine to draw a single vertical line.  Attach to double.
  216. 2390 FOR I = R1 + 1 TO R2 - 1
  217. 2400  LOCATE I,C1 : PRINT CHR$(179);
  218. 2410 NEXT I
  219. 2420 LOCATE R1,C1 : PRINT CHR$(209);
  220. 2430 LOCATE R2,C1 : PRINT CHR$(207);
  221. 2440 RETURN
  222. 2450 REM Program begins here
  223. 2460 REM By:  Melvin O. Duke.   Updated December 1982
  224. 2470 REM Read the Parent/Child Index
  225. 2480 OPEN "a:pcindex" FOR INPUT AS #1
  226. 2490 LOCATE 4,1 : PRINT "Open the Parent/Child Index";
  227. 2500 INPUT #1, PC.COUNT
  228. 2510 FOR I = 1 TO PC.COUNT
  229. 2520 LOCATE 5,1 : PRINT "Reading Index Record #:";I;
  230. 2530  INPUT #1, PA.ID(I), CH.ID(I)
  231. 2540 NEXT I
  232. 2550 CLOSE #1
  233. 2560 REM Read the Marriage Index
  234. 2570 LOCATE 7,1 : PRINT "Open the Marriage Index";
  235. 2580 OPEN "a:mindex" FOR INPUT AS #2
  236. 2590 INPUT #2, M.COUNT
  237. 2600 FOR I = 1 TO M.COUNT
  238. 2610 LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
  239. 2620  INPUT #2,PERS.NO(I), M.NO(I)
  240. 2630 NEXT I
  241. 2640 CLOSE #2
  242. 2650 REM Open the Persons File
  243. 2660 LOCATE 10,1 : PRINT "Open the Persons File"
  244. 2670 OPEN "a:persfile" AS #1 LEN = 256
  245. 2680 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$
  246. 2690 REM open the Marriages File
  247. 2700 LOCATE 12,1 : PRINT "Open the Marriage File"
  248. 2710 OPEN "a:marrfile" AS #2 LEN = 128
  249. 2720 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$
  250. 2730 REM Open the Ordinance File
  251. 2740 LOCATE 14,1 : PRINT "Open the Ordinances File";
  252. 2750 OPEN "b:ordfile" AS #3 LEN = 256
  253. 2760 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$
  254. 2770 REM Obtain a Person Record from the User
  255. 2780 LOCATE 20,1 : PRINT SPACE$(79);
  256. 2790 LOCATE 20,1 : INPUT "Enter the Record-number of a Person";PERS(1)
  257. 2800 IF PERS(1) < 1 OR PERS(1) > 400 THEN CLS: GOTO 2770
  258. 2810 REM Obtain the information about a person
  259. 2820 GET #1, PERS(1)
  260. 2830 GOSUB 3300  'Extract Personal Information
  261. 2840 GOSUB 1600
  262. 2850 LOCATE 2,30 : PRINT T3$ + " " + T2$;
  263. 2860 LOCATE 6,16 : PRINT T2$;
  264. 2870 LOCATE 7,16 : PRINT T3$;
  265. 2880 LOCATE 8,16 : PRINT T4$;
  266. 2890 LOCATE 6,57 : PRINT T8$;
  267. 2900 LOCATE 7,57 : PRINT T9$;
  268. 2910 LOCATE 8,57 : PRINT T10$;
  269. 2920 LOCATE 9,57 : PRINT T11$;
  270. 2930 LOCATE 11,57 : PRINT T12$;
  271. 2940 LOCATE 12,57 : PRINT T13$;
  272. 2950 LOCATE 13,57 : PRINT T14$;
  273. 2960 LOCATE 14,57 : PRINT T15$;
  274. 2970 LOCATE 16,57 : PRINT T16$;
  275. 2980 LOCATE 17,57 : PRINT T17$;
  276. 2990 LOCATE 18,57 : PRINT T18$;
  277. 3000 LOCATE 19,57 : PRINT T19$;
  278. 3010 PERS(2) = T6
  279. 3020 PERS(3) = T7
  280. 3030 REM Check if Father is known
  281. 3040 IF PERS(2) = 0 THEN GOSUB 3590 : GOTO 3070
  282. 3050 GET #1, PERS(2)
  283. 3060 GOSUB 3300  'Extract
  284. 3070 LOCATE 12,16 : PRINT T2$;
  285. 3080 LOCATE 13,16 : PRINT T3$;
  286. 3090 LOCATE 14,16 : PRINT T8$;
  287. 3100 REM Check if Mother is known
  288. 3110 IF PERS(3) = 0 THEN GOSUB 3590 : GOTO 3140
  289. 3120 GET #1, PERS(3)
  290. 3130 GOSUB 3300  'Extract
  291. 3140 LOCATE 18,16 : PRINT T2$;
  292. 3150 LOCATE 19,16 : PRINT T3$;
  293. 3160 LOCATE 20,16 : PRINT T8$;
  294. 3170 LOCATE 23,1 : PRINT SPACE$(79);
  295. 3180 LOCATE 24,1 : PRINT SPACE$(79);
  296. 3190 LOCATE 24,1 : PRINT "(Possible Actions:  ps, pc, fg, o, p1...pn, m1...mn, q)";
  297. 3200 LOCATE 23,1 : INPUT "Next Action"; REPLY$
  298. 3210 IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 3170
  299. 3220 IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 3170
  300. 3230 IF REPLY$ = "pc" THEN 3800  'Pedigree Chart
  301. 3240 IF REPLY$ = "fg" THEN 5070  'Family Group
  302. 3250 IF REPLY$ = "o" THEN 6220  'Ordinances
  303. 3260 IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : CLS : GOTO 2800
  304. 3270 IF LEFT$(REPLY$,1) = "m" THEN 7260
  305. 3280 IF LEFT$(REPLY$,1) = "q" THEN 7390
  306. 3290 LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 3170
  307. 3300 REM Routine to Extract Personal Information
  308. 3310 T1 = CVS(F1$)
  309. 3320 T2$ = F2$
  310. 3330 FOR J = 1 TO LEN(F2$) -1
  311. 3340  IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
  312. 3350 NEXT J
  313. 3360 T3$ = F3$
  314. 3370 FOR J = 1 TO LEN(F3$) -1
  315. 3380  IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  316. 3390 NEXT J
  317. 3400 T4$ = F4$
  318. 3410 IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  319. 3420 IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  320. 3430 T5 = CVS(F5$)
  321. 3440 T6 = CVS(F6$)
  322. 3450 T7 = CVS(F7$)
  323. 3460 T8$ = F8$
  324. 3470 T9$ = F9$
  325. 3480 T10$ = F10$
  326. 3490 T11$ = F11$
  327. 3500 T12$ = F12$
  328. 3510 T13$ = F13$
  329. 3520 T14$ = F14$
  330. 3530 T15$ = F15$
  331. 3540 T16$ = F16$
  332. 3550 T17$ = F17$
  333. 3560 T18$ = F18$
  334. 3570 T19$ = F19$
  335. 3580 RETURN
  336. 3590 REM Blank out a Record
  337. 3600 T1 = 0
  338. 3610 T2$ = ""
  339. 3620 T3$ = ""
  340. 3630 T4$ = ""
  341. 3640 T5 = 0
  342. 3650 T6 = 0
  343. 3660 T7 = 0
  344. 3670 T8$ = ""
  345. 3680 T9$ = ""
  346. 3690 T10$ = ""
  347. 3700 T11$ = ""
  348. 3710 T12$ = ""
  349. 3720 T13$ = ""
  350. 3730 T14$ = ""
  351. 3740 T15$ = ""
  352. 3750 T16$ = ""
  353. 3760 T17$ = ""
  354. 3770 T18$ = ""
  355. 3780 T19$ = ""
  356. 3790 RETURN
  357. 3800 REM Routine to Produce a Pedigree Chart
  358. 3810 CLS
  359. 3820 GOSUB 1000 'Draw the Chart
  360. 3830 GET #1, PERS(1)
  361. 3840 GOSUB 3300  'Extract the Person
  362. 3850 LOCATE 2,23 : PRINT T3$ + " " + T2$;
  363. 3860 LOCATE 12,6 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  364. 3870 LOCATE 12,68 : PRINT T8$;
  365. 3880 PERS(2) = T6
  366. 3890 PERS(3) = T7
  367. 3900 REM Get 11
  368. 3910 IF PERS(2) = 0 THEN GOSUB 3590 : GOTO 3960
  369. 3920 GET #1, PERS(2)
  370. 3930 GOSUB 3300  'Extract
  371. 3940 LOCATE 8,16 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  372. 3950 LOCATE 8,68 : PRINT T8$;
  373. 3960 PERS(4) = T6
  374. 3970 PERS(5) = T7
  375. 3980 REM Get 10
  376. 3990 IF PERS(3) = 0 THEN GOSUB 3590 : GOTO 4040
  377. 4000 GET #1, PERS(3)
  378. 4010 GOSUB 3300  'Extract
  379. 4020 LOCATE 16,16 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  380. 4030 LOCATE 16,68 : PRINT T8$;
  381. 4040 PERS(6) = T6
  382. 4050 PERS(7) = T7
  383. 4060 REM Get 111
  384. 4070 IF PERS(4) = 0 THEN GOSUB 3590 : GOTO 4120
  385. 4080 GET #1, PERS(4)
  386. 4090 GOSUB 3300  'Extract
  387. 4100 LOCATE 6,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  388. 4110 LOCATE 6,68 : PRINT T8$;
  389. 4120 PERS(8) = T6
  390. 4130 PERS(9) = T7
  391. 4140 REM Get 110
  392. 4150 IF PERS(5) = 0 THEN GOSUB 3590 : GOTO 4200
  393. 4160 GET #1, PERS(5)
  394. 4170 GOSUB 3300  'Extract
  395. 4180 LOCATE 10,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  396. 4190 LOCATE 10,68 : PRINT T8$;
  397. 4200 PERS(10) = T6
  398. 4210 PERS(11) = T7
  399. 4220 REM Get 101
  400. 4230 IF PERS(6) = 0 THEN GOSUB 3590 : GOTO 4280
  401. 4240 GET #1, PERS(6)
  402. 4250 GOSUB 3300  'Extract
  403. 4260 LOCATE 14,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  404. 4270 LOCATE 14,68 : PRINT T8$;
  405. 4280 PERS(12) = T6
  406. 4290 PERS(13) = T7
  407. 4300 REM Get 100
  408. 4310 IF PERS(7) = 0 THEN GOSUB 3590 : GOTO 4360
  409. 4320 GET #1, PERS(7)
  410. 4330 GOSUB 3300  'Extract
  411. 4340 LOCATE 18,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  412. 4350 LOCATE 18,68 : PRINT T8$;
  413. 4360 PERS(14) = T6
  414. 4370 PERS(15) = T7
  415. 4380 REM Get 1111
  416. 4390 IF PERS(8) = 0 THEN GOSUB 3590 : GOTO 4440
  417. 4400 GET #1, PERS(8)
  418. 4410 GOSUB 3300  'Extract
  419. 4420 LOCATE  5,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  420. 4430 LOCATE  5,68 : PRINT T8$;
  421. 4440 REM
  422. 4450 REM Get 1110
  423. 4460 IF PERS(9) = 0 THEN GOSUB 3590 : GOTO 4510
  424. 4470 GET #1, PERS(9)
  425. 4480 GOSUB 3300  'Extract
  426. 4490 LOCATE  7,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  427. 4500 LOCATE  7,68 : PRINT T8$;
  428. 4510 REM
  429. 4520 REM Get 1101
  430. 4530 IF PERS(10) = 0 THEN GOSUB 3590 : GOTO 4580
  431. 4540 GET #1, PERS(10)
  432. 4550 GOSUB 3300  'Extract
  433. 4560 LOCATE  9,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  434. 4570 LOCATE  9,68 : PRINT T8$;
  435. 4580 REM
  436. 4590 REM Get 1100
  437. 4600 IF PERS(11) = 0 THEN GOSUB 3590 : GOTO 4650
  438. 4610 GET #1, PERS(11)
  439. 4620 GOSUB 3300  'Extract
  440. 4630 LOCATE 11,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  441. 4640 LOCATE 11,68 : PRINT T8$;
  442. 4650 REM
  443. 4660 REM Get 1011
  444. 4670 IF PERS(12) = 0 THEN GOSUB 3590 : GOTO 4720
  445. 4680 GET #1, PERS(12)
  446. 4690 GOSUB 3300  'Extract
  447. 4700 LOCATE 13,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  448. 4710 LOCATE 13,68 : PRINT T8$;
  449. 4720 REM
  450. 4730 REM Get 1010
  451. 4740 IF PERS(13) = 0 THEN GOSUB 3590 : GOTO 4790
  452. 4750 GET #1, PERS(13)
  453. 4760 GOSUB 3300  'Extract
  454. 4770 LOCATE 15,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  455. 4780 LOCATE 15,68 : PRINT T8$;
  456. 4790 REM
  457. 4800 REM Get 1001
  458. 4810 IF PERS(14) = 0 THEN GOSUB 3590 : GOTO 4860
  459. 4820 GET #1, PERS(14)
  460. 4830 GOSUB 3300  'Extract
  461. 4840 LOCATE 17,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  462. 4850 LOCATE 17,68 : PRINT T8$;
  463. 4860 REM
  464. 4870 REM Get 1000
  465. 4880 IF PERS(15) = 0 THEN GOSUB 3590 : GOTO 4930
  466. 4890 GET #1, PERS(15)
  467. 4900 GOSUB 3300  'Extract
  468. 4910 LOCATE 19,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  469. 4920 LOCATE 19,68 : PRINT T8$;
  470. 4930 REM
  471. 4940 LOCATE 23,1 : PRINT SPACE$(79);
  472. 4950 LOCATE 24,1 : PRINT SPACE$(79);
  473. 4960 LOCATE 24,1 : PRINT "(Possible Actions:  ps, fg, pc, l1...ln, p1...pn, m1...mn, q)";
  474. 4970 LOCATE 23,1 : INPUT "Next Action"; REPLY$
  475. 4980 IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 4940
  476. 4990 IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 4940
  477. 5000 IF REPLY$ = "pc" THEN 3800
  478. 5010 IF REPLY$ = "fg" THEN 5070
  479. 5020 IF LEFT$(REPLY$,1) = "l" THEN PERS(1) = PERS(VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))) : GOTO 2810
  480. 5030 IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 2800
  481. 5040 IF LEFT$(REPLY$,1) = "m" THEN 7260
  482. 5050 IF LEFT$(REPLY$,1) = "q" THEN 7390
  483. 5060 LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 4940
  484. 5070 REM Routine to Produce a Family Group Record
  485. 5080 CLS
  486. 5090 GOSUB 1940  'Draw the form
  487. 5100 REM search the marriage index for the Person's Marriage
  488. 5110 FOUND = 0
  489. 5120 FOR L = 1 TO M.COUNT
  490. 5130  IF PERS(1) > PERS.NO(L) THEN 5190
  491. 5140  IF PERS(1) < PERS.NO(L) THEN L = M.COUNT : GOTO 5190
  492. 5150  REM found a Marriage
  493. 5160  FOUND = 1
  494. 5170  GET #2, M.NO(L)
  495. 5180  L = M.COUNT
  496. 5190 NEXT L
  497. 5200 IF FOUND = 1 THEN 5260
  498. 5210 REM No marriage found
  499. 5220 LOCATE 22,1 : PRINT "No Marriage Found";
  500. 5230 LOCATE 23,1 : PRINT "Press any key to continue";
  501. 5240 A$ = INKEY$ : IF A$ = "" THEN 5240
  502. 5250 CLS : GOTO 2810
  503. 5260 REM extract Information from the Marriage Record
  504. 5270 TT1 = CVS(M1$)
  505. 5280 TT2 = CVS(M2$)
  506. 5290 TT3 = CVS(M3$)
  507. 5300 TT4 = CVS(M4$)
  508. 5310 TT5$ = M5$
  509. 5320 TT6$ = M6$
  510. 5330 TT7$ = M7$
  511. 5340 TT8$ = M8$
  512. 5350 TT9$ = M9$
  513. 5360 REM print the Marriage Information
  514. 5370 LOCATE 7,18 : PRINT TT5$
  515. 5380 LOCATE 7,45 : PRINT TT6$
  516. 5390 REM get the Husband's Record
  517. 5400 GET #1, TT2
  518. 5410 GOSUB 3300  'Extract
  519. 5420 LOCATE 4,11 : PRINT T2$+", "+T3$;
  520. 5430 LOCATE 4,67 : PRINT T8$;
  521. 5440 REM get the Wife's Record
  522. 5450 GET #1, TT3
  523. 5460 GOSUB 3300  'Extract
  524. 5470 LOCATE 5,11 : PRINT T2$+", "+T3$;
  525. 5480 LOCATE 5,67 : PRINT T8$;
  526. 5490 REM now find the children
  527. 5500 CHILD.COUNT = 0
  528. 5510 FOR IC = 1 TO 55
  529. 5520  CH(IC) = 0
  530. 5530 NEXT IC
  531. 5540 REM search the parent/child index
  532. 5550 FOR LL = 1 TO PC.COUNT
  533. 5560  IF TT2 > PA.ID(LL) THEN 5890
  534. 5570  IF TT2 < PA.ID(LL) THEN LL = PC.COUNT : GOTO 5890
  535. 5580  REM found a child
  536. 5590  GET #1, CH.ID(LL)
  537. 5600  GOSUB 3300  'Extract
  538. 5610  REM verify that Mother is the same
  539. 5620  IF TT3 <> T7 THEN 5890
  540. 5630  REM Found a valid child
  541. 5640  CHILD.COUNT = CHILD.COUNT + 1
  542. 5650  SHOW.COUNT = CHILD.COUNT
  543. 5660  IF CHILD.COUNT = 1 THEN 5820
  544. 5670  IF CHILD.COUNT > 11 THEN SHOW.COUNT = CHILD.COUNT - 11
  545. 5680  IF CHILD.COUNT > 22 THEN SHOW.COUNT = CHILD.COUNT - 22
  546. 5690  IF CHILD.COUNT > 33 THEN SHOW.COUNT = CHILD.COUNT - 33
  547. 5700  IF CHILD.COUNT > 44 THEN SHOW.COUNT = CHILD.COUNT - 44
  548. 5710  IF (CHILD.COUNT-1) MOD 11 = 0 THEN 5720 ELSE 5820
  549. 5720  LOCATE 23,1 : PRINT SPACE$(79);
  550. 5730  LOCATE 23,1 : PRINT "Press any key to continue"
  551. 5740  A$ = INKEY$ : IF A$ = "" THEN 5740
  552. 5750  REM blank the previous children
  553. 5760  FOR ROW = 9 TO 20
  554. 5770   LOCATE ROW,2 : PRINT SPACE$(77);
  555. 5780  NEXT ROW
  556. 5790  REM restore the rest of the display
  557. 5800  GOSUB 2070
  558. 5810  LOCATE 23,1 : PRINT SPACE$(79)
  559. 5820  CH(CHILD.COUNT) = CH.ID(LL)
  560. 5830  LOCATE 9+SHOW.COUNT,2 : COLOR 0,7
  561. 5840  PRINT RIGHT$(STR$(CHILD.COUNT),2); : COLOR 7,0
  562. 5850  LOCATE 9+SHOW.COUNT,5 : PRINT LEFT$(F4$,1);  'Sex
  563. 5860  LOCATE 9+SHOW.COUNT,7 : PRINT T2$+", "+T3$;
  564. 5870  LOCATE 9+SHOW.COUNT,41 : PRINT T8$;
  565. 5880  LOCATE 9+SHOW.COUNT,53 : PRINT T9$;
  566. 5890 NEXT LL
  567. 5900 LOCATE 23,1 : PRINT SPACE$(79);
  568. 5910 LOCATE 24,1 : PRINT SPACE$(79);
  569. 5920 LOCATE 24,1 : PRINT "(Possible Actions: ps, f, m, p1...pn, c1...cn, m1...mn, q)";
  570. 5930 LOCATE 23,1 : INPUT "Next Action";REPLY$
  571. 5940 IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 5900
  572. 5950 IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 5900
  573. 5960 IF REPLY$ = "pc" THEN LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 5900
  574. 5970 IF REPLY$ = "f" THEN PERS(1) = TT2 : GOTO 2810
  575. 5980 IF REPLY$ = "m" THEN PERS(1) = TT3 : GOTO 2810
  576. 5990 IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 2800
  577. 6000 IF LEFT$(REPLY$,1) = "c" THEN 6010 ELSE 6050
  578. 6010 CHLD = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
  579. 6020 IF CHLD < 1 OR CHLD > CHILD.COUNT THEN 6070
  580. 6030 PERS(1) = CH(CHLD)
  581. 6040 GOTO 2810  'for personal
  582. 6050 IF LEFT$(REPLY$,1) = "m" THEN 7260 'marriage
  583. 6060 IF LEFT$(REPLY$,1) = "q" THEN 7390
  584. 6070 LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 5900
  585. 6080 REM Routine to Print the Screen
  586. 6090 REM Accessed by users 'ps' reply
  587. 6100 FOR ROW = 1 TO 20
  588. 6110  THIS$ = SPACE$(80)
  589. 6120  FOR COL = 1 TO 80
  590. 6130   X = SCREEN(ROW,COL)
  591. 6140   IF X > 125 THEN X = 32
  592. 6150   IF X < 32 THEN X = 32
  593. 6160   MID$(THIS$,COL,1) = CHR$(X)
  594. 6170  NEXT COL
  595. 6180  LPRINT THIS$
  596. 6190 NEXT ROW
  597. 6200 LPRINT CHR$(12);
  598. 6210 RETURN
  599. 6220 REM Routine to Display the Ordinances
  600. 6230 GET #1, PERS(1) : GOSUB 3300
  601. 6240 GET #3, PERS(1)
  602. 6250 SEX$ = LEFT$(T4$,1)
  603. 6260 REM Extract the Ordinance Information
  604. 6270 U1 = CVS(O1$)
  605. 6280 U2$ = O2$
  606. 6290 U3$ = O3$
  607. 6300 U4$ = O4$
  608. 6310 U5  = CVS(O5$)
  609. 6320 U6  = CVS(O6$)
  610. 6330 U7$ = O7$
  611. 6340 U8$ = O8$
  612. 6350 U9$ = O9$
  613. 6360 U10$ = O10$
  614. 6370 U11$ = O11$
  615. 6380 U12  = CVS(O12$)
  616. 6390 U13$ = O13$
  617. 6400 U14$ = O14$
  618. 6410 U15$ = O15$
  619. 6420 U16$ = O16$
  620. 6430 U17$ = O17$
  621. 6440 U18$ = O18$
  622. 6450 U19$ = O19$
  623. 6460 U20$ = O20$
  624. 6470 U21$ = O21$
  625. 6480 U22$ = O22$
  626. 6490 U23$ = O23$
  627. 6500 U24$ = O24$
  628. 6510 CLS
  629. 6520 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double Box
  630. 6530 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Horizontal Double
  631. 6540 R1 = 19 : C1 = 1 : R2 = 19 : C2 = 79 : GOSUB 2170  'Horizontal Double
  632. 6550 LOCATE 2,3 : PRINT "Ordinance Information for:";
  633. 6560 LOCATE 4,7 : COLOR 1 : PRINT "Personal Record"; : COLOR 7
  634. 6570 LOCATE 5,3 : PRINT "Christening:";
  635. 6580 LOCATE 6,3 : PRINT "Blessing:";
  636. 6590 LOCATE 7,3 : PRINT "Sealed to Parents:";
  637. 6600 LOCATE 8,5 : PRINT "Father's Id:";
  638. 6610 LOCATE 9,6 : PRINT "Name:";
  639. 6620 LOCATE 10,5 : PRINT "Mother's Id:";
  640. 6630 LOCATE 11,6 : PRINT "Name:";
  641. 6640 LOCATE 12,3 : PRINT "Baptism:";
  642. 6650 LOCATE 13,3 : PRINT "Confirmation:";
  643. 6660 LOCATE 14,3 : PRINT "Patriarchical Blessing:";
  644. 6670 LOCATE 15,3 : PRINT "Endowment:";
  645. 6680 LOCATE 16,4 : PRINT "Sealed to Spouse:";
  646. 6690 LOCATE 17,5 : PRINT "Spouse's Id.:";
  647. 6700 LOCATE 18,6 : PRINT "Name:";
  648. 6710 REM Test for Male.  Skip if not
  649. 6720 IF SEX$ <> "M" THEN 6860
  650. 6730 R1 = 3 : R2 = 19 : C1 = 40 : C2 = 40 : GOSUB 2310  "Vertical Double
  651. 6740 LOCATE 4,46 : COLOR 1 : PRINT "Priesthood Record"; : COLOR 7
  652. 6750 LOCATE 5,42 : PRINT "Aaronic Priesthood:";
  653. 6760 LOCATE 6,44 : PRINT "Deacon:";
  654. 6770 LOCATE 7,44 : PRINT "Teacher:";
  655. 6780 LOCATE 8,44 : PRINT "Priest:";
  656. 6790 LOCATE 10,42 : PRINT "Melchizedek Priesthood:";
  657. 6800 LOCATE 11,44 : PRINT "Elder:";
  658. 6810 LOCATE 12,44 : PRINT "Seventy:";
  659. 6820 LOCATE 13,44 : PRINT "High Priest:";
  660. 6830 LOCATE 15,42 : PRINT "Bishop:";
  661. 6840 LOCATE 16,42 : PRINT "Patriarch:";
  662. 6850 LOCATE 17,42 : PRINT "Apostle:";
  663. 6860 LOCATE 20,3  : PRINT "Occupation:";
  664. 6870 REM Print the Information Currently Present
  665. 6880 LOCATE 2,30 : PRINT T3$ + " " + T2$;
  666. 6890 LOCATE 2,67 : PRINT T8$;
  667. 6900 LOCATE 5,28 : PRINT U2$;
  668. 6910 LOCATE 6,28 : PRINT U3$;
  669. 6920 LOCATE 7,28 : PRINT U4$;
  670. 6930 IF LEFT$(U4$,3) = "BIC" THEN U5 = T6 : U6 = T7
  671. 6940 LOCATE 8,18 : PRINT U5;
  672. 6950 IF U5 = 0 THEN 6980
  673. 6960 GET #1, U5 : GOSUB 3300  'Extract Father Information
  674. 6970 LOCATE 9,12 : PRINT T3$ + " " + T2$;
  675. 6980 LOCATE 10,18 : PRINT U6;
  676. 6990 IF U6 = 0 THEN 7020
  677. 7000 GET #1, U6 : GOSUB 3300  'Extract Mother Information
  678. 7010 LOCATE 11,12 : PRINT T3$ + " " + T2$;
  679. 7020 LOCATE 12,28 : PRINT U7$;
  680. 7030 LOCATE 13,28 : PRINT U8$;
  681. 7040 LOCATE 14,28 : PRINT U9$;
  682. 7050 LOCATE 15,28 : PRINT U10$;
  683. 7060 LOCATE 16,28 : PRINT U11$;
  684. 7070 LOCATE 17,18 : PRINT U12;
  685. 7080 IF U12 = 0 THEN 7110
  686. 7090 GET #1, U12 : GOSUB 3300  'Extract Spouse Information
  687. 7100 LOCATE 18,12 : PRINT T3$ + " " + T2$;
  688. 7110 REM Test for Male.  Bypass if not.
  689. 7120 IF SEX$ <> "M" THEN 7240
  690. 7130 LOCATE 5,67 : PRINT U13$;
  691. 7140 LOCATE 6,67 : PRINT U14$;
  692. 7150 LOCATE 7,67 : PRINT U15$;
  693. 7160 LOCATE 8,67 : PRINT U16$;
  694. 7170 LOCATE 10,67 : PRINT U17$;
  695. 7180 LOCATE 11,67 : PRINT U18$;
  696. 7190 LOCATE 12,67 : PRINT U19$;
  697. 7200 LOCATE 13,67 : PRINT U20$;
  698. 7210 LOCATE 14,67 : PRINT U21$;
  699. 7220 LOCATE 15,67 : PRINT U22$;
  700. 7230 LOCATE 16,67 : PRINT U23$;
  701. 7240 LOCATE 20,15 : PRINT U24$;
  702. 7250 GOTO 3170  'For User Action
  703. 7260 REM Marriage was requested by Number
  704. 7270 MARRIAGE = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
  705. 7280 CLS
  706. 7290 IF MARRIAGE > 0 AND MARRIAGE <= 200 THEN 7360
  707. 7300 LOCATE 22,1 : PRINT SPACE$(79);
  708. 7310 LOCATE 22,1 : PRINT "Invalid Marriage Number";
  709. 7320 LOCATE 23,1 : PRINT SPACE$(79);
  710. 7330 LOCATE 23,1 : PRINT "Press any key to continue."
  711. 7340 A$ = INKEY$ : IF A$ = "" THEN 7340
  712. 7350 GOTO 2810
  713. 7360 GOSUB 1940  'Print the form
  714. 7370 GET #2, MARRIAGE
  715. 7380 GOTO 5260
  716. 7390 REM Wrapup
  717. 7400 CLOSE #1
  718. 7410 CLOSE #2
  719. 7420 CLOSE #3
  720. 7430 CLS : LOCATE 21,1
  721. 7440 PRINT "End of Program"
  722. 7450 END
  723.  "a:marrfile" AS #2 LEN = 128
  724. 2720 FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$