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 / UPDATMAR.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  9KB  |  259 lines
  1. 100 TITLE$ = "Update the Marriages 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 Marriage File Program
  75. 1010 REM By:  Melvin O. Duke.  Updated 26 June, 1983.
  76. 1020 OPEN "a:marrfile" AS #2 LEN = 128
  77. 1030 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$
  78. 1040 REM ask the user for input
  79. 1050 LOCATE 22,1
  80. 1060 PRINT SPACE$(79) : LOCATE 22,1
  81. 1070 INPUT "Enter Record Number of Marriage to Update"; REC.NO
  82. 1080 IF REC.NO = 0 THEN 2790
  83. 1090 IF REC.NO < 1 OR REC.NO > 200 THEN 1040
  84. 1100 GET #2, REC.NO
  85. 1110 REM Extract information from the file for use
  86. 1120 T1 = CVS(M1$)
  87. 1130 T2 = CVS(M2$)
  88. 1140 T3 = CVS(M3$)
  89. 1150 T4 = CVS(M4$)
  90. 1160 T5$ = M5$
  91. 1170 T6$ = M6$
  92. 1180 T7$ = M7$
  93. 1190 T8$ = M8$
  94. 1200 T9$ = M9$
  95. 1210 CLS
  96. 1220 R1 = 1 : C1 = 1 : R2 = 16 : C2 = 79 : GOSUB 400  'Double box
  97. 1230 R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 1620  'Horizontal double
  98. 1240 R1 = 14 : C1 = 1 : R2 = 14 : C2 = 79 : GOSUB 1620  'Horizontal double
  99. 1250 LOCATE 2,33 : PRINT "Marriage Record"
  100. 1260 R1 = 3 : C1 = 40 : R2 = 14 : C2 = 40 : GOSUB 1760  'Vertical Double
  101. 1270 LOCATE 5,3 : PRINT "Marriage";
  102. 1280 LOCATE 6,3 : PRINT "Record-Number:";
  103. 1290 LOCATE 8,3 : PRINT "Husband's";
  104. 1300 LOCATE 9,3 : PRINT "Record-number:";
  105. 1310 LOCATE 11,3 : PRINT "Wife's";
  106. 1320 LOCATE 12,3 : PRINT "Record-number:";
  107. 1330 LOCATE 15,3 : PRINT "Comments:";
  108. 1340 LOCATE 5,42 : PRINT "Marriage Code:";
  109. 1350 LOCATE 7,42 : COLOR 1 : PRINT "Marriage Statistics:"; : COLOR 7
  110. 1360 LOCATE 9,42 : PRINT "Marr.-date:";
  111. 1370 LOCATE 10,42 : PRINT "Marr.-city:";
  112. 1380 LOCATE 11,42 : PRINT "Marr.-county:";
  113. 1390 LOCATE 12,42 : PRINT "State/Country:";
  114. 1400 GOSUB 1420 'To print the current information
  115. 1410 GOTO 1900 'For User Input
  116. 1420 REM Print the Information Currently Present
  117. 1430 LOCATE 6,18 : PRINT SPACE$(5);
  118. 1440 LOCATE 6,18 : PRINT T1;
  119. 1450 LOCATE 9,18 : PRINT SPACE$(5);
  120. 1460 LOCATE 9,18 : PRINT T2;
  121. 1470 LOCATE 12,18 : PRINT SPACE$(5);
  122. 1480 LOCATE 12,18 : PRINT T3;
  123. 1490 LOCATE 5,57 : PRINT SPACE$(5);
  124. 1500 LOCATE 5,57 : PRINT T4;
  125. 1510 LOCATE 9,57 : PRINT SPACE$(11);
  126. 1520 LOCATE 9,57 : PRINT T5$;
  127. 1530 LOCATE 10,57 : PRINT SPACE$(18);
  128. 1540 LOCATE 10,57 : PRINT T6$;
  129. 1550 LOCATE 11,57 : PRINT SPACE$(16);
  130. 1560 LOCATE 11,57 : PRINT T7$;
  131. 1570 LOCATE 12,57 : PRINT SPACE$(16);
  132. 1580 LOCATE 12,57 : PRINT T8$;
  133. 1590 LOCATE 15,20 : PRINT SPACE$(45);
  134. 1600 LOCATE 15,20 : PRINT T9$;
  135. 1610 RETURN
  136. 1620 REM Subroutine to draw a double horizontal line.  Attach to double.
  137. 1630 FOR J = C1 + 1 TO C2 - 1
  138. 1640  LOCATE R1,J : PRINT CHR$(205);
  139. 1650 NEXT J
  140. 1660 LOCATE R1,C1 : PRINT CHR$(204);
  141. 1670 LOCATE R1,C2 : PRINT CHR$(185);
  142. 1680 RETURN
  143. 1690 REM Subroutine to draw a single horizontal line.  Attach to double.
  144. 1700 FOR J = C1 + 1 TO C2 - 1
  145. 1710  LOCATE R1,J : PRINT CHR$(196);
  146. 1720 NEXT J
  147. 1730 LOCATE R1,C1 : PRINT CHR$(199);
  148. 1740 LOCATE R1,C2 : PRINT CHR$(182);
  149. 1750 RETURN
  150. 1760 REM Subroutine to draw a double vertical line.  Attach to double.
  151. 1770 FOR I = R1 + 1 TO R2 - 1
  152. 1780  LOCATE I,C1 : PRINT CHR$(186);
  153. 1790 NEXT I
  154. 1800 LOCATE R1,C1 : PRINT CHR$(203);
  155. 1810 LOCATE R2,C1 : PRINT CHR$(202);
  156. 1820 RETURN
  157. 1830 REM Subroutine to draw a single vertical line.  Attach to double.
  158. 1840 FOR I = R1 + 1 TO R2 - 1
  159. 1850  LOCATE I,C1 : PRINT CHR$(179);
  160. 1860 NEXT I
  161. 1870 LOCATE R1,C1 : PRINT CHR$(209);
  162. 1880 LOCATE R2,C1 : PRINT CHR$(207);
  163. 1890 RETURN
  164. 1900 REM Routines to Obtain information from the User
  165. 1910 LOCATE 21,1 : PRINT "'enter' to leave alone, '/ enter' to end record, or reply as shown"
  166. 1920 LOCATE 23,1
  167. 1930 INPUT "Enter the Record Number";REPLY$
  168. 1940 IF REPLY$ = "/" THEN 2560
  169. 1950 IF REPLY$ = "" THEN 1990
  170. 1960 IF ABS(VAL(REPLY$)) = ABS(T1) THEN 1970 ELSE 1980
  171. 1970 T1 = VAL(REPLY$)
  172. 1980 GOSUB 1420
  173. 1990 LOCATE 23,1 : PRINT SPACE$(79);
  174. 2000 LOCATE 23,1
  175. 2010 INPUT "Enter the Husband's Persons Record-Number";REPLY$
  176. 2020 IF REPLY$ = "/" THEN 2560
  177. 2030 IF REPLY$ = "" THEN 2060
  178. 2040 T2 = VAL(REPLY$)
  179. 2050 GOSUB 1420
  180. 2060 LOCATE 23,1 : PRINT SPACE$(79);
  181. 2070 LOCATE 23,1
  182. 2080 INPUT "Enter the Wife's Persons Record-Number";REPLY$
  183. 2090 IF REPLY$ = "/" THEN 2560
  184. 2100 IF REPLY$ = "" THEN 2130
  185. 2110 T3 = VAL(REPLY$)
  186. 2120 GOSUB 1420
  187. 2130 LOCATE 23,1 : PRINT SPACE$(79);
  188. 2140 LOCATE 23,1
  189. 2150 INPUT "Enter the Marriage Code";REPLY$
  190. 2160 IF REPLY$ = "/" THEN 2560
  191. 2170 IF REPLY$ = "" THEN 2200
  192. 2180 T4 = VAL(REPLY$)
  193. 2190 GOSUB 1420
  194. 2200 LOCATE 23,1 : PRINT SPACE$(79);
  195. 2210 LOCATE 23,1
  196. 2220 INPUT "Enter the Marriage-Date as: dd Mmm yyyy";REPLY$
  197. 2230 IF REPLY$ = "/" THEN 2560
  198. 2240 IF REPLY$ = "" THEN 2270
  199. 2250 T5$ = REPLY$
  200. 2260 GOSUB 1420
  201. 2270 LOCATE 23,1 : PRINT SPACE$(79);
  202. 2280 LOCATE 23,1
  203. 2290 INPUT "Enter the Marriage-city";REPLY$
  204. 2300 IF REPLY$ = "/" THEN 2560
  205. 2310 IF REPLY$ = "" THEN 2340
  206. 2320 T6$ = REPLY$
  207. 2330 GOSUB 1420
  208. 2340 LOCATE 23,1 : PRINT SPACE$(79);
  209. 2350 LOCATE 23,1
  210. 2360 INPUT "Enter the Marriage-county";REPLY$
  211. 2370 IF REPLY$ = "/" THEN 2560
  212. 2380 IF REPLY$ = "" THEN 2410
  213. 2390 T7$ = REPLY$
  214. 2400 GOSUB 1420
  215. 2410 LOCATE 23,1 : PRINT SPACE$(79);
  216. 2420 LOCATE 23,1
  217. 2430 INPUT "Enter the Marriage-State or Country:";REPLY$
  218. 2440 IF REPLY$ = "/" THEN 2560
  219. 2450 IF REPLY$ = "" THEN 2480
  220. 2460 T8$ = REPLY$
  221. 2470 GOSUB 1420
  222. 2480 LOCATE 23,1 : PRINT SPACE$(79);
  223. 2490 LOCATE 23,1
  224. 2500 INPUT "Enter any Comments";REPLY$
  225. 2510 IF REPLY$ = "/" THEN 2560
  226. 2520 IF REPLY$ = "" THEN 2550
  227. 2530 T9$ = REPLY$
  228. 2540 GOSUB 1420
  229. 2550 REM GOTO 9980
  230. 2560 REM
  231. 2570 LOCATE 21,1 : PRINT SPACE$(79);
  232. 2580 LOCATE 23,1 : PRINT SPACE$(79);
  233. 2590 LOCATE 23,1
  234. 2600 INPUT "Type 'save', 'more', or 'forget'";REPLY$
  235. 2610 IF REPLY$ = "more" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 1900
  236. 2620 IF REPLY$ = "forget" THEN CLS : GOTO 1040
  237. 2630 IF REPLY$ = "save" THEN LOCATE 21,1 : PRINT SPACE$(79); : GOTO 2660
  238. 2640 LOCATE 22,1 : PRINT "Error in reply";
  239. 2650 GOTO 2580
  240. 2660 REM Routine to SAVE the newly updated record
  241. 2670 LSET M1$  = MKS$(T1)
  242. 2680 LSET M2$  = MKS$(T2)
  243. 2690 LSET M3$  = MKS$(T3)
  244. 2700 LSET M4$  = MKS$(T4)
  245. 2710 LSET M5$  = T5$
  246. 2720 LSET M6$  = T6$
  247. 2730 LSET M7$  = T7$
  248. 2740 LSET M8$  = T8$
  249. 2750 LSET M9$  = T9$
  250. 2760 PUT #2, REC.NO
  251. 2770 CLS
  252. 2780 GOTO 1040
  253. 2790 CLOSE #2
  254. 2800 CLS : LOCATE 21,1
  255. 2810 PRINT "End of Program"
  256. 2820 END
  257. ΘF±;╙s[≈≤û3└πï·ï╞≈ß≈╪·ï╫sN┴╙s∙├X
  258.  x ╤Γ╤╙
  259.