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 / PRINTPER.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  7KB  |  217 lines
  1. 100 TITLE$ = "Print the Persons and 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. 1000 REM Print the Persons and Ordinances File Program.
  74. 1010 REM By:  Melvin O. Duke.  Updated 26 June, 1983.
  75. 1020 OPEN "b:ordfile" AS #2 LEN = 256
  76. 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$
  77. 1040 REM
  78. 1050 OPEN "a:persfile" AS #1 LEN = 256
  79. 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$
  80. 1070 REM Read all records, and print the actual ones
  81. 1080 CLS
  82. 1090 LOCATE 23,1
  83. 1100 INPUT "Enter the Record Number to be Printed or 'all'";REPLY$
  84. 1110 IF REPLY$ = "all" THEN 1160
  85. 1120 I = VAL(REPLY$)
  86. 1130 IF I = 0 THEN 2360
  87. 1140 GOSUB 1190  'to print
  88. 1150 GOTO 1080
  89. 1160 FOR I = 1 TO 400
  90. 1170 GOSUB 1190
  91. 1180 GOTO 2350
  92. 1190 GET #1, I
  93. 1200 CLS
  94. 1210 LOCATE 23,1 : PRINT "Processing Record #";I
  95. 1220 REM Print a Title on Each Page
  96. 1230 LPRINT ,"Content of the Persons and Ordinances Files"
  97. 1240 LPRINT ,DATE$, TIME$
  98. 1250 LPRINT
  99. 1260 REM Extract information from the file for use
  100. 1270 T1 = CVS(F1$)
  101. 1280 IF T1 < 1 THEN 2340  'return
  102. 1290 T2$ = F2$
  103. 1300 T3$ = F3$
  104. 1310 FOR J = 1 TO LEN(F3$)-1
  105. 1320  IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  106. 1330 NEXT J
  107. 1340 T4$ = F4$
  108. 1350 IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  109. 1360 IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  110. 1370 T5 = CVS(F5$)
  111. 1380 T6 = CVS(F6$)
  112. 1390 T7 = CVS(F7$)
  113. 1400 T8$ = F8$
  114. 1410 T9$ = F9$
  115. 1420 T10$ = F10$
  116. 1430 T11$ = F11$
  117. 1440 T12$ = F12$
  118. 1450 T13$ = F13$
  119. 1460 T14$ = F14$
  120. 1470 T15$ = F15$
  121. 1480 T16$ = F16$
  122. 1490 T17$ = F17$
  123. 1500 T18$ = F18$
  124. 1510 T19$ = F19$
  125. 1520 REM Extract Ordinance Information
  126. 1530 GET #2, I
  127. 1540 U1 = CVS(O1$)
  128. 1550 U2$ = O2$
  129. 1560 U3$ = O3$
  130. 1570 U4$ = O4$
  131. 1580 U5 = CVS(O5$)
  132. 1590 U6 = CVS(O6$)
  133. 1600 U7$ = O7$
  134. 1610 U8$ = O8$
  135. 1620 U9$ = O9$
  136. 1630 U10$ = O10$
  137. 1640 U11$ = O11$
  138. 1650 U12 = CVS(O12$)
  139. 1660 U13$ = O13$
  140. 1670 U14$ = O14$
  141. 1680 U15$ = O15$
  142. 1690 U16$ = O16$
  143. 1700 U17$ = O17$
  144. 1710 U18$ = O18$
  145. 1720 U19$ = O19$
  146. 1730 U20$ = O20$
  147. 1740 U21$ = O21$
  148. 1750 U22$ = O22$
  149. 1760 U23$ = O23$
  150. 1770 U24$ = O24$
  151. 1780 REM Print out of Personal Information
  152. 1790 LPRINT CHR$(27);"E";
  153. 1800 LPRINT ,"Personal Information"
  154. 1810 LPRINT CHR$(27);"F";
  155. 1820 LPRINT
  156. 1830 LPRINT ,"Record-Number:",T1
  157. 1840 LPRINT ,"Surname:",,T2$
  158. 1850 LPRINT ,"Given-names:",,T3$
  159. 1860 LPRINT ,"Sex:",,T4$
  160. 1870 LPRINT ,"Code:",,T5
  161. 1880 LPRINT ,"Father's Record-number:",T6
  162. 1890 LPRINT ,"Mother's Record-number:",T7
  163. 1900 LPRINT ,"Birth-date:",,T8$
  164. 1910 LPRINT ,"Birth-city:",,T9$
  165. 1920 LPRINT ,"Birth-county:",,T10$
  166. 1930 LPRINT ,"Birth-state:",,T11$
  167. 1940 LPRINT ,"Death-date:",,T12$
  168. 1950 LPRINT ,"Death-city:",,T13$
  169. 1960 LPRINT ,"Death-county:",,T14$
  170. 1970 LPRINT ,"Death-state:",,T15$
  171. 1980 LPRINT ,"Burial-date:",,T16$
  172. 1990 LPRINT ,"Burial-city:",,T17$
  173. 2000 LPRINT ,"Burial-county:",T18$
  174. 2010 LPRINT ,"Burial-state:",,T19$
  175. 2020 LPRINT : LPRINT : LPRINT
  176. 2030 LPRINT CHR$(27);"E";
  177. 2040 LPRINT ,"Ordinance Information"
  178. 2050 LPRINT CHR$(27);"F";
  179. 2060 LPRINT
  180. 2070 REM Print the Ordinance Information
  181. 2080 LPRINT ,"Christening Date:",U2$
  182. 2090 LPRINT ,"Blessing Date:",U3$
  183. 2100 LPRINT ,"Sealed to Parents:",U4$
  184. 2110 LPRINT ,"Father's Id.:",,U5
  185. 2120 LPRINT ,"Mother's Id.:",,U6
  186. 2130 LPRINT ,"Baptism Date:",,U7$
  187. 2140 LPRINT ,"Confirmation Date:",U8$
  188. 2150 LPRINT ,"Patriarchical Blessing:",U9$
  189. 2160 LPRINT ,"Endowment Date:",U10$
  190. 2170 IF LEFT$(T4$,1) = "M" THEN 2210
  191. 2180 LPRINT ,"Sealed to Spouse Date:",U11$
  192. 2190 LPRINT ,"Spouse Id.:",,U12
  193. 2200 IF LEFT$(T4$,1) <> "M" THEN 2320
  194. 2210 LPRINT ,"Aaronic Priesthood Date:",U13$
  195. 2220 LPRINT ,"Deacon Date:",,U14$
  196. 2230 LPRINT ,"Teacher Date:",,U15$
  197. 2240 LPRINT ,"Priest Date:",,U16$
  198. 2250 LPRINT ,"Melchizedek Priesthood:",U17$
  199. 2260 LPRINT ,"Elder Date:",,U18$
  200. 2270 LPRINT ,"Seventy Date:",,U19$
  201. 2280 LPRINT ,"High Priest Date:",U20$
  202. 2290 LPRINT ,"Bishop Date:",,U21$
  203. 2300 LPRINT ,"Patriarch Date:",U22$
  204. 2310 LPRINT ,"Apostle Date:",,U23$
  205. 2320 LPRINT ,"Occupation:",,U24$
  206. 2330 LPRINT CHR$(12);
  207. 2340 RETURN
  208. 2350 NEXT I
  209. 2360 CLOSE #1
  210. 2370 CLOSE #2
  211. 2380 CLS : LOCATE 21,1
  212. 2390 PRINT "End of Program"
  213. 2400 LPRINT CHR$(12);
  214. 2410 END
  215. SPACE$(79);
  216. 2210 LOCATE 23,1
  217. 2220 INPUT "Enter the Marriage-Date as: dd Mmm yyyy";