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 / UPDATORD.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  16KB  |  488 lines
  1. 100 TITLE$ = "Update the Ordinances File 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. 170 REM Produce the first screen
  12. 175 KEY OFF : CLS
  13. 180 REM Draw the outer double box
  14. 185 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  15. 190 REM Find the title location
  16. 195 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  17. 200 REM Draw the title box
  18. 205 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  19. 210 REM Print the title
  20. 215 LOCATE 4,TITLE.POS : PRINT TITLE$
  21. 220 LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  22. 225 REM Draw the Contribution box
  23. 230 R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  24. 235 REM Request the Contribution
  25. 240 LOCATE 9,23 : PRINT "If you are using these programs, and"
  26. 245 LOCATE 10,21 : PRINT "finding them of value, your contribution"
  27. 250 LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be appreciated."
  28. 255 REM Draw the Mailing Label
  29. 260 R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  30. 265 REM Print the Name and Address
  31. 270 LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  32. 275 LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  33. 280 LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  34. 285 REM Draw the Copyright box
  35. 290 R1 = 19 : C1 = 27 : R2 = 22 : C2 = 53 : GOSUB 400
  36. 295 REM Print the Copyright
  37. 300 LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  38. 305 LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  39. 310 GOTO 740
  40. 400 REM subroutine to print a double box
  41. 410 FOR I = R1 + 1 TO R2 - 1
  42. 420  LOCATE I, C1 : PRINT CHR$(186);
  43. 430  LOCATE I, C2 : PRINT CHR$(186);
  44. 440 NEXT I
  45. 450 FOR J = C1 + 1 TO C2 - 1
  46. 460  LOCATE R1, J : PRINT CHR$(205);
  47. 470  LOCATE R2, J : PRINT CHR$(205);
  48. 480 NEXT J
  49. 490  LOCATE R1, C1 : PRINT CHR$(201);
  50. 500  LOCATE R1, C2 : PRINT CHR$(187);
  51. 510  LOCATE R2, C1 : PRINT CHR$(200);
  52. 520  LOCATE R2, C2 : PRINT CHR$(188);
  53. 530 RETURN
  54. 600 REM subroutine to print a single box
  55. 610 FOR I = R1 + 1 TO R2 - 1
  56. 620  LOCATE I, C1 : PRINT CHR$(179);
  57. 630  LOCATE I, C2 : PRINT CHR$(179);
  58. 640 NEXT I
  59. 650 FOR J = C1 + 1 TO C2 - 1
  60. 660  LOCATE R1, J : PRINT CHR$(196);
  61. 670  LOCATE R2, J : PRINT CHR$(196);
  62. 680 NEXT J
  63. 690  LOCATE R1, C1 : PRINT CHR$(218);
  64. 700  LOCATE R1, C2 : PRINT CHR$(191);
  65. 710  LOCATE R2, C1 : PRINT CHR$(192);
  66. 720  LOCATE R2, C2 : PRINT CHR$(217);
  67. 730 RETURN
  68. 740 REM ask user to press a key to continue
  69. 750 LOCATE 25,1
  70. 760 PRINT "Press any key to continue";
  71. 770 K$ = INKEY$ : IF K$ = "" THEN 770
  72. 780 CLS
  73. 840 CLS
  74. 1000 REM Update the Ordinances File Program.
  75. 1010 REM By:  Melvin O. Duke.  Updated 26 June, 1983.
  76. 1020 OPEN "b:ordfile" AS #2 LEN = 256
  77. 1030 FIELD 2,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
  78. 1040 REM
  79. 1050 OPEN "a:persfile" AS #1 LEN = 256
  80. 1060 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$
  81. 1070 REM ask the user for input
  82. 1080 LOCATE 22,1
  83. 1090 PRINT SPACE$(79) : LOCATE 22,1
  84. 1100 INPUT "Enter Record Number of Person to Update"; REC.NO
  85. 1110 IF REC.NO = 0 THEN 5070
  86. 1120 IF REC.NO < 1 OR REC.NO > 400 THEN 1070
  87. 1130 SEX$ = "U"
  88. 1140 GET #1, REC.NO
  89. 1150 GET #2, REC.NO
  90. 1160 GOSUB 1200  'Person Extract
  91. 1170 GOSUB 1490  'Ordinance Extract
  92. 1180 SEX$ = LEFT$(T4$,1)
  93. 1190 GOTO 1750  'to Print
  94. 1200 REM Extract information from the file for use
  95. 1210 T1 = CVS(F1$)
  96. 1220 T2$ = F2$
  97. 1230 FOR J = 1 TO LEN(F2$)-1
  98. 1240  IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
  99. 1250 NEXT J
  100. 1260 T3$ = F3$
  101. 1270 FOR J = 1 TO LEN(F3$)-1
  102. 1280  IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  103. 1290 NEXT J
  104. 1300 T4$ = F4$
  105. 1310 IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  106. 1320 IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  107. 1330 T5 = CVS(F5$)
  108. 1340 T6 = CVS(F6$)
  109. 1350 T7 = CVS(F7$)
  110. 1360 T8$ = F8$
  111. 1370 T9$ = F9$
  112. 1380 T10$ = F10$
  113. 1390 T11$ = F11$
  114. 1400 T12$ = F12$
  115. 1410 T13$ = F13$
  116. 1420 T14$ = F14$
  117. 1430 T15$ = F15$
  118. 1440 T16$ = F16$
  119. 1450 T17$ = F17$
  120. 1460 T18$ = F18$
  121. 1470 T19$ = F19$
  122. 1480 RETURN
  123. 1490 REM extract the Ordinances Information
  124. 1500 U1 = CVS(O1$)
  125. 1510 U2$ = O2$
  126. 1520 U3$ = O3$
  127. 1530 U4$ = O4$
  128. 1540 U5 = CVS(O5$)
  129. 1550 U6 = CVS(O6$)
  130. 1560 U7$ = O7$
  131. 1570 U8$ = O8$
  132. 1580 U9$ = O9$
  133. 1590 U10$ = O10$
  134. 1600 U11$ = O11$
  135. 1610 U12 = CVS(O12$)
  136. 1620 U13$ = O13$
  137. 1630 U14$ = O14$
  138. 1640 U15$ = O15$
  139. 1650 U16$ = O16$
  140. 1660 U17$ = O17$
  141. 1670 U18$ = O18$
  142. 1680 U19$ = O19$
  143. 1690 U20$ = O20$
  144. 1700 U21$ = O21$
  145. 1710 U22$ = O22$
  146. 1720 U23$ = O23$
  147. 1730 U24$ = O24$
  148. 1740 RETURN
  149. 1750 CLS
  150. 1760 R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  151. 1770 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2780  'Horizontal double
  152. 1780 R1 =19 : C1 = 1 : R2 =19 : C2 = 79 : GOSUB 2780  'Horizontal double
  153. 1790 LOCATE 2,3 : PRINT "Ordinance Information for:"
  154. 1800 LOCATE 4,7 : COLOR 1 : PRINT "Personal Record"; : COLOR 7
  155. 1810 LOCATE 5,3 : PRINT "Christening:";
  156. 1820 LOCATE 6,3 : PRINT "Blessing:";
  157. 1830 LOCATE 7,3 : PRINT "Sealed to Parents:";
  158. 1840 LOCATE 8,5 : PRINT "Father's Id:";
  159. 1850 LOCATE 9,6 : PRINT "Name:";
  160. 1860 LOCATE 10,5 : PRINT "Mother's ID:";
  161. 1870 LOCATE 11,6 : PRINT "Name:";
  162. 1880 LOCATE 12,3 : PRINT "Baptism:";
  163. 1890 LOCATE 13,3 : PRINT "Confirmation:";
  164. 1900 LOCATE 14,3 : PRINT "Patriarchical Blessing:";
  165. 1910 LOCATE 15,3 : PRINT "Endowment:";
  166. 1920 LOCATE 16,3 : PRINT "Sealed to Spouse:";
  167. 1930 LOCATE 17,5 : PRINT "Spouse's Id:";
  168. 1940 LOCATE 18,6 : PRINT "Name:";
  169. 1950 REM test for male.  Skip if not.
  170. 1960 IF SEX$ <> "M" THEN 2100
  171. 1970 R1 = 3 : R2 = 19 : C1 = 40 : C2 = 40 : GOSUB 2920 'Vertical Double
  172. 1980 LOCATE 4,46 : COLOR 1 : PRINT "Priesthood Record"; : COLOR 7
  173. 1990 LOCATE 5,42 : PRINT "Aaronic Priesthood:";
  174. 2000 LOCATE 6,44 : PRINT "Deacon:";
  175. 2010 LOCATE 7,44 : PRINT "Teacher:";
  176. 2020 LOCATE 8,44 : PRINT "Priest:";
  177. 2030 LOCATE 10,42 : PRINT "Melchizedek Priesthood:";
  178. 2040 LOCATE 11,44 : PRINT "Elder:";
  179. 2050 LOCATE 12,44 : PRINT "Seventy:";
  180. 2060 LOCATE 13,44 : PRINT "High Priest:";
  181. 2070 LOCATE 15,42 : PRINT "Bishop:";
  182. 2080 LOCATE 16,42 : PRINT "Patriarch:";
  183. 2090 LOCATE 17,42 : PRINT "Apostle:";
  184. 2100 LOCATE 20,3 : PRINT "Occupation:";
  185. 2110 GOSUB 2130  'Print current information
  186. 2120 GOTO 3060  'For user input
  187. 2130 REM Print the Information Currently Present
  188. 2140 LOCATE 2,30 : PRINT SPACE$(48);
  189. 2150 LOCATE 2,30 : PRINT T3$ + " " + T2$;
  190. 2160 LOCATE 2,68 : PRINT SPACE$(11);
  191. 2170 LOCATE 2,68 : PRINT T8$;
  192. 2180 LOCATE 5,29 : PRINT SPACE$(11);
  193. 2190 LOCATE 5,29 : PRINT U2$;
  194. 2200 LOCATE 6,29 : PRINT SPACE$(11);
  195. 2210 LOCATE 6,29 : PRINT U3$;
  196. 2220 LOCATE 7,29 : PRINT SPACE$(11);
  197. 2230 LOCATE 7,29 : PRINT U4$;
  198. 2240 LOCATE 8,18 : PRINT SPACE$(5);
  199. 2250 LOCATE 8,18 : PRINT U5;
  200. 2260 IF U5 = 0 THEN 2300
  201. 2270 GET #1, U5 : GOSUB 1200
  202. 2280 LOCATE 9,12 : PRINT SPACE$(27);
  203. 2290 LOCATE 9,12 : PRINT T3$ + " " + T2$;
  204. 2300 LOCATE 10,18 : PRINT SPACE$(5);
  205. 2310 LOCATE 10,18 : PRINT U6;
  206. 2320 IF U6 = 0 THEN 2360
  207. 2330 GET #1, U6 : GOSUB 1200
  208. 2340 LOCATE 11,12 : PRINT SPACE$(27);
  209. 2350 LOCATE 11,12 : PRINT T3$ + " " + T2$;
  210. 2360 LOCATE 12,29 : PRINT SPACE$(11);
  211. 2370 LOCATE 12,29 : PRINT U7$;
  212. 2380 LOCATE 13,29 : PRINT SPACE$(11);
  213. 2390 LOCATE 13,29 : PRINT U8$;
  214. 2400 LOCATE 14,29 : PRINT SPACE$(11);
  215. 2410 LOCATE 14,29 : PRINT U9$;
  216. 2420 LOCATE 15,29 : PRINT SPACE$(11);
  217. 2430 LOCATE 15,29 : PRINT U10$;
  218. 2440 LOCATE 16,29 : PRINT SPACE$(11);
  219. 2450 LOCATE 16,29 : PRINT U11$;
  220. 2460 LOCATE 17,18 : PRINT SPACE$(5);
  221. 2470 LOCATE 17,18 : PRINT U12;
  222. 2480 IF U12 = 0 THEN 2510
  223. 2490 GET #1, U12 : GOSUB 1200
  224. 2500 LOCATE 18,12 : PRINT T3$ + " " + T2$;
  225. 2510 REM test for male; bypass if not.
  226. 2520 IF SEX$ <> "M" THEN 2750
  227. 2530 LOCATE 5,68 : PRINT SPACE$(11);
  228. 2540 LOCATE 5,68 : PRINT U13$;
  229. 2550 LOCATE 6,68 : PRINT SPACE$(11);
  230. 2560 LOCATE 6,68 : PRINT U14$;
  231. 2570 LOCATE 7,68 : PRINT SPACE$(11);
  232. 2580 LOCATE 7,68 : PRINT U15$;
  233. 2590 LOCATE 8,68 : PRINT SPACE$(11);
  234. 2600 LOCATE 8,68 : PRINT U16$;
  235. 2610 LOCATE 10,68 : PRINT SPACE$(11);
  236. 2620 LOCATE 10,68 : PRINT U17$;
  237. 2630 LOCATE 11,68 : PRINT SPACE$(11);
  238. 2640 LOCATE 11,68 : PRINT U18$;
  239. 2650 LOCATE 12,68 : PRINT SPACE$(11);
  240. 2660 LOCATE 12,68 : PRINT U19$;
  241. 2670 LOCATE 13,68 : PRINT SPACE$(11);
  242. 2680 LOCATE 13,68 : PRINT U20$;
  243. 2690 LOCATE 15,68 : PRINT SPACE$(11);
  244. 2700 LOCATE 15,68 : PRINT U21$;
  245. 2710 LOCATE 16,68 : PRINT SPACE$(11);
  246. 2720 LOCATE 16,68 : PRINT U22$;
  247. 2730 LOCATE 17,68 : PRINT SPACE$(11);
  248. 2740 LOCATE 17,68 : PRINT U23$;
  249. 2750 LOCATE 20,15 : PRINT SPACE$(26);
  250. 2760 LOCATE 20,15 : PRINT U24$;
  251. 2770 RETURN
  252. 2780 REM Subroutine to draw a double horizontal line.  Attach to double.
  253. 2790 FOR J = C1 + 1 TO C2 - 1
  254. 2800  LOCATE R1,J : PRINT CHR$(205);
  255. 2810 NEXT J
  256. 2820 LOCATE R1,C1 : PRINT CHR$(204);
  257. 2830 LOCATE R1,C2 : PRINT CHR$(185);
  258. 2840 RETURN
  259. 2850 REM Subroutine to draw a single horizontal line.  Attach to double.
  260. 2860 FOR J = C1 + 1 TO C2 - 1
  261. 2870  LOCATE R1,J : PRINT CHR$(196);
  262. 2880 NEXT J
  263. 2890 LOCATE R1,C1 : PRINT CHR$(199);
  264. 2900 LOCATE R1,C2 : PRINT CHR$(182);
  265. 2910 RETURN
  266. 2920 REM Subroutine to draw a double vertical line.  Attach to double.
  267. 2930 FOR I = R1 + 1 TO R2 - 1
  268. 2940  LOCATE I,C1 : PRINT CHR$(186);
  269. 2950 NEXT I
  270. 2960 LOCATE R1,C1 : PRINT CHR$(203);
  271. 2970 LOCATE R2,C1 : PRINT CHR$(202);
  272. 2980 RETURN
  273. 2990 REM Subroutine to draw a single vertical line.  Attach to double.
  274. 3000 FOR I = R1 + 1 TO R2 - 1
  275. 3010  LOCATE I,C1 : PRINT CHR$(179);
  276. 3020 NEXT I
  277. 3030 LOCATE R1,C1 : PRINT CHR$(209);
  278. 3040 LOCATE R2,C1 : PRINT CHR$(207);
  279. 3050 RETURN
  280. 3060 REM Routines to Obtain information from the User
  281. 3070 LOCATE 22,1 : PRINT "'enter' to leave alone, '/ enter' to end record, or reply as shown"
  282. 3080 LOCATE 23,1
  283. 3090 INPUT "Enter the Christening Date as: dd Mmm yyyy";REPLY$
  284. 3100 IF REPLY$ = "/" THEN 4690
  285. 3110 IF REPLY$ = "" THEN 3140
  286. 3120 U2$ = REPLY$
  287. 3130 GOSUB 2180
  288. 3140 LOCATE 23,1 : PRINT SPACE$(79);
  289. 3150 LOCATE 23,1
  290. 3160 INPUT "Enter the Blessing Date as: dd Mmm yyyy";REPLY$
  291. 3170 IF REPLY$ = "/" THEN 4690
  292. 3180 IF REPLY$ = "" THEN 3210
  293. 3190 U3$ = REPLY$
  294. 3200 GOSUB 2200
  295. 3210 LOCATE 23,1 : PRINT SPACE$(79);
  296. 3220 LOCATE 23,1
  297. 3230 INPUT "Enter the Date of Sealing to the Parents as: dd Mmm yyyy";REPLY$
  298. 3240 IF REPLY$ = "/" THEN 4690
  299. 3250 IF REPLY$ = "" THEN 3280
  300. 3260 U4$ = REPLY$
  301. 3270 GOSUB 2220
  302. 3280 LOCATE 23,1 : PRINT SPACE$(79);
  303. 3290 LOCATE 23,1
  304. 3300 INPUT "Enter the Father's Record Number";REPLY$
  305. 3310 IF REPLY$ = "/" THEN 4690
  306. 3320 IF REPLY$ = "" THEN 3350
  307. 3330 U5 = VAL(REPLY$)
  308. 3340 GOSUB 2240
  309. 3350 LOCATE 23,1 : PRINT SPACE$(79);
  310. 3360 LOCATE 23,1
  311. 3370 INPUT "Enter the Mother's Record Number";REPLY$
  312. 3380 IF REPLY$ = "/" THEN 4690
  313. 3390 IF REPLY$ = "" THEN 3420
  314. 3400 U6 = VAL(REPLY$)
  315. 3410 GOSUB 2300
  316. 3420 LOCATE 23,1 : PRINT SPACE$(79);
  317. 3430 LOCATE 23,1
  318. 3440 INPUT "Enter the Baptism Date as: dd Mmm yyyy";REPLY$
  319. 3450 IF REPLY$ = "/" THEN 4690
  320. 3460 IF REPLY$ = "" THEN 3490
  321. 3470 U7$= REPLY$
  322. 3480 GOSUB 2360
  323. 3490 LOCATE 23,1 : PRINT SPACE$(79);
  324. 3500 LOCATE 23,1
  325. 3510 INPUT "Enter the Confirmation Date as: dd Mmm yyyy";REPLY$
  326. 3520 IF REPLY$ = "/" THEN 4690
  327. 3530 IF REPLY$ = "" THEN 3560
  328. 3540 U8$ = REPLY$
  329. 3550 GOSUB 2380
  330. 3560 LOCATE 23,1 : PRINT SPACE$(79);
  331. 3570 LOCATE 23,1
  332. 3580 INPUT "Enter the Patriarchical Blessing Date as: dd Mmm yyyy";REPLY$
  333. 3590 IF REPLY$ = "/" THEN 4690
  334. 3600 IF REPLY$ = "" THEN 3630
  335. 3610 U9$ = REPLY$
  336. 3620 GOSUB 2400
  337. 3630 LOCATE 23,1 : PRINT SPACE$(79);
  338. 3640 LOCATE 23,1
  339. 3650 INPUT "Enter the Endowment Date as: dd Mmm yyyy";REPLY$
  340. 3660 IF REPLY$ = "/" THEN 4690
  341. 3670 IF REPLY$ = "" THEN 3700
  342. 3680 U10$ = REPLY$
  343. 3690 GOSUB 2420
  344. 3700 LOCATE 23,1 : PRINT SPACE$(79);
  345. 3710 LOCATE 23,1
  346. 3720 INPUT "Enter the Date of Sealing to Spouse as: dd Mmm yyyy";REPLY$
  347. 3730 IF REPLY$ = "/" THEN 4690
  348. 3740 IF REPLY$ = "" THEN 3770
  349. 3750 U11$ = REPLY$
  350. 3760 GOSUB 2440
  351. 3770 LOCATE 23,1 : PRINT SPACE$(79);
  352. 3780 LOCATE 23,1
  353. 3790 INPUT "Enter the Spouse's Record Number";REPLY$
  354. 3800 IF REPLY$ = "/" THEN 4690
  355. 3810 IF REPLY$ = "" THEN 3840
  356. 3820 U12 = VAL(REPLY$)
  357. 3830 GOSUB 2460
  358. 3840 IF SEX$ <> "M" THEN 4620
  359. 3850 LOCATE 23,1 : PRINT SPACE$(79);
  360. 3860 LOCATE 23,1
  361. 3870 INPUT "Enter the Aaronic Priesthood Date as: dd Mmm yyyy";REPLY$
  362. 3880 IF REPLY$ = "/" THEN 4690
  363. 3890 IF REPLY$ = "" THEN 3920
  364. 3900 U13$ = REPLY$
  365. 3910 GOSUB 2530
  366. 3920 LOCATE 23,1 : PRINT SPACE$(79);
  367. 3930 LOCATE 23,1
  368. 3940 INPUT "Enter the Deacon Date as: dd Mmm yyyy";REPLY$
  369. 3950 IF REPLY$ = "/" THEN 4690
  370. 3960 IF REPLY$ = "" THEN 3990
  371. 3970 U14$ = REPLY$
  372. 3980 GOSUB 2550
  373. 3990 LOCATE 23,1 : PRINT SPACE$(79);
  374. 4000 LOCATE 23,1
  375. 4010 INPUT "Enter the Teacher Date as: dd Mmm yyyy";REPLY$
  376. 4020 IF REPLY$ = "/" THEN 4690
  377. 4030 IF REPLY$ = "" THEN 4060
  378. 4040 U15$ = REPLY$
  379. 4050 GOSUB 2570
  380. 4060 LOCATE 23,1 : PRINT SPACE$(79);
  381. 4070 LOCATE 23,1
  382. 4080 INPUT "Enter the Priest Date as: dd Mmm yyyy";REPLY$
  383. 4090 IF REPLY$ = "/" THEN 4690
  384. 4100 IF REPLY$ = "" THEN 4130
  385. 4110 U16$ = REPLY$
  386. 4120 GOSUB 2590
  387. 4130 LOCATE 23,1 : PRINT SPACE$(79);
  388. 4140 LOCATE 23,1
  389. 4150 INPUT "Enter the Melchizedek Priesthood Date as: dd Mmm yyyy";REPLY$
  390. 4160 IF REPLY$ = "/" THEN 4690
  391. 4170 IF REPLY$ = "" THEN 4200
  392. 4180 U17$ = REPLY$
  393. 4190 GOSUB 2610
  394. 4200 LOCATE 23,1 : PRINT SPACE$(79);
  395. 4210 LOCATE 23,1
  396. 4220 INPUT "Enter the Elder Date as: dd Mmm yyyy";REPLY$
  397. 4230 IF REPLY$ = "/" THEN 4690
  398. 4240 IF REPLY$ = "" THEN 4270
  399. 4250 U18$ = REPLY$
  400. 4260 GOSUB 2630
  401. 4270 LOCATE 23,1 : PRINT SPACE$(79);
  402. 4280 LOCATE 23,1
  403. 4290 INPUT "Enter the Seventy Date as: dd Mmm yyyy";REPLY$
  404. 4300 IF REPLY$ = "/" THEN 4690
  405. 4310 IF REPLY$ = "" THEN 4340
  406. 4320 U19$ = REPLY$
  407. 4330 GOSUB 2650
  408. 4340 LOCATE 23,1 : PRINT SPACE$(79);
  409. 4350 LOCATE 23,1
  410. 4360 INPUT "Enter the High Priest Date as: dd Mmm yyyy";REPLY$
  411. 4370 IF REPLY$ = "/" THEN 4690
  412. 4380 IF REPLY$ = "" THEN 4410
  413. 4390 U20$ = REPLY$
  414. 4400 GOSUB 2670
  415. 4410 LOCATE 23,1 : PRINT SPACE$(79);
  416. 4420 LOCATE 23,1
  417. 4430 INPUT "Enter the Bishop Date as: dd Mmm yyyy";REPLY$
  418. 4440 IF REPLY$ = "/" THEN 4690
  419. 4450 IF REPLY$ = "" THEN 4480
  420. 4460 U21$ = REPLY$
  421. 4470 GOSUB 2690
  422. 4480 LOCATE 23,1 : PRINT SPACE$(79);
  423. 4490 LOCATE 23,1
  424. 4500 INPUT "Enter the Patriarch Date as: dd Mmm yyyy";REPLY$
  425. 4510 IF REPLY$ = "/" THEN 4690
  426. 4520 IF REPLY$ = "" THEN 4550
  427. 4530 U22$ = REPLY$
  428. 4540 GOSUB 2710
  429. 4550 LOCATE 23,1 : PRINT SPACE$(79);
  430. 4560 LOCATE 23,1
  431. 4570 INPUT "Enter the Apostle Date as: dd Mmm yyyy";REPLY$
  432. 4580 IF REPLY$ = "/" THEN 4690
  433. 4590 IF REPLY$ = "" THEN 4620
  434. 4600 U23$ = REPLY$
  435. 4610 GOSUB 2730
  436. 4620 LOCATE 23,1 : PRINT SPACE$(79);
  437. 4630 LOCATE 23,1
  438. 4640 INPUT "Enter the Person's Occupation";REPLY$
  439. 4650 IF REPLY$ = "/" THEN 4690
  440. 4660 IF REPLY$ = "" THEN 4690
  441. 4670 U24$ = REPLY$
  442. 4680 GOSUB 2750
  443. 4690 REM Input is complete, now see if user wants to save the data
  444. 4700 LOCATE 22,1 : PRINT SPACE$(79);
  445. 4710 LOCATE 23,1 : PRINT SPACE$(79);
  446. 4720 LOCATE 23,1
  447. 4730 INPUT "Type 'save', 'more', or 'forget'";REPLY$
  448. 4740 IF REPLY$ = "more" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3060
  449. 4750 IF REPLY$ = "forget" THEN CLS : GOTO 1070
  450. 4760 IF REPLY$ = "save" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 4790
  451. 4770 LOCATE 22,1 : PRINT "Error in reply";
  452. 4780 GOTO 4710
  453. 4790 REM Routine to SAVE the newly updated record
  454. 4800 LSET O1$  = MKS$(U1)
  455. 4810 LSET O2$  = U2$
  456. 4820 LSET O3$  = U3$
  457. 4830 LSET O4$  = U4$
  458. 4840 LSET O5$  = MKS$(U5)
  459. 4850 LSET O6$  = MKS$(U6)
  460. 4860 LSET O7$  = U7$
  461. 4870 LSET O8$  = U8$
  462. 4880 LSET O9$  = U9$
  463. 4890 LSET O10$  = U10$
  464. 4900 LSET O11$  = U11$
  465. 4910 LSET O12$  = MKS$(U12)
  466. 4920 LSET O13$  = U13$
  467. 4930 LSET O14$  = U14$
  468. 4940 LSET O15$  = U15$
  469. 4950 LSET O16$  = U16$
  470. 4960 LSET O17$  = U17$
  471. 4970 LSET O18$  = U18$
  472. 4980 LSET O19$  = U19$
  473. 4990 LSET O20$ = U20$
  474. 5000 LSET O21$ = U21$
  475. 5010 LSET O22$ = U22$
  476. 5020 LSET O23$ = U23$
  477. 5030 LSET O24$ = U24$
  478. 5040 PUT #2, REC.NO
  479. 5050 CLS
  480. 5060 GOTO 1070
  481. 5070 CLOSE #1
  482. 5080 CLOSE #2
  483. 5090 CLS : LOCATE 21,1
  484. 5100 PRINT "End of Program"
  485. 5110 END
  486. 
  487. 4740 IF T13$ = " " AND T15$ = " " THEN 4760
  488. 4750 ROW=