home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / mbrsv13.bas < prev    next >
Encoding:
BASIC Source File  |  1984-03-30  |  28.3 KB  |  628 lines
  1. 10 ' FILE NAME:  MBRS.BAS - Creates, lists, adds to, corrects, and queries
  2. 20 ' church member personal information and donation files.
  3. 30 ESC$=CHR$(27):CLR$=ESC$+"*"
  4. 40 DEF FNCTR$(A$)=SPACE$(40-(LEN(A$)/2))+A$
  5. 50 DEF FNAT$(V,H)=ESC$+"="+CHR$(31+V)+CHR$(31+H)
  6. 60 RET$=FNAT$(24,1)+FNCTR$("Hit RETURN to continue:  "):BTM$=FNAT$(24,1)
  7. 70 HT$="Home Town":ST$="NC":YR$="1984"
  8. 80 OPTION BASE 1
  9. 90 DATA "ATTENTION, PROGRAMMERS AND USERS",""
  10. 100 DATA "For distribution purposes, the World Famous Toad Hall"
  11. 110 DATA "Church Membership Record Program (Public Domain)"
  12. 120 DATA "needs a few patches to tailor it to YOUR environment and use.",""
  13. 130 DATA "Change the name of the program itself from MBRSV13.BAS to MBRS.BAS."
  14. 140 DATA "(V13 is to tell apart the versions, but the program itself needs"
  15. 150 DATA "the program name to be MBRS.BAS (for file existence checking).",""
  16. 160 DATA "At the very beginning of the code, change HT$ and ST$ to your own"
  17. 170 DATA "local city/town and state.  Change YR$ to keep up to date."
  18. 180 DATA "Change MY CHURCH right below this in code to your own church name."
  19. 190 DATA "If you'd like to add your own letterhead to the donation reports,"
  20. 200 DATA "fill in the appropriate lines down in the code printing to"
  21. 210 DATA "#5 - that's the printout.  You'll see the 'blanks'."
  22. 220 DATA "Enjoy it -- just a gesture in the spirit of Public Domain Software."
  23. 230 DATA "","(Oh, yeah -- peel out all this stuff too!"
  24. 240 DATA "The Author, Toad Hall, March 1984",*
  25. 250 PRINT CLR$:RESTORE 90:GOSUB 390:STOP
  26. 260 DATA "MY CHURCH Member Records",""
  27. 270 DATA "Courtesy of Toad Hall","Home of Bionic Toad Software"
  28. 280 DATA "David P Kirschbaum, Author","Version 1.3, 29 Mar 84"
  29. 290 DATA "(C) 1983 All rights reserved.",""
  30. 300 DATA "Please contact the author for comments, bugs, recommendations.",""
  31. 310 DATA "Also, any church group using this software:"
  32. 320 DATA "Please drop me a card or call with your name, tel #, and address."
  33. 330 DATA "It gives me great personal satisfaction to know people are using"
  34. 340 DATA "this program of mine, (my resume could use the references!),"
  35. 350 DATA "and I can provide you with updates (my software never stays static!)"
  36. 360 DATA "","My address is","Toad Hall","7573 Jennings Lane"
  37. 370 DATA "Fayetteville NC  28303","tel (919) 868-3471",***
  38. 380 PRINT CLR$:RESTORE 260:GOSUB 390:GOTO 470
  39. 390 READ T$
  40. 400   IF T$="*" THEN RETURN ELSE IF T$="**" OR T$="***" THEN 420
  41. 410 PRINT FNCTR$(T$):GOTO 390
  42. 420   IF T$="***" THEN PRINT BTM$;
  43. 430 PRINT RET$;
  44. 440 INPUT "",T1$:IF T$="***" THEN PRINT CLR$;
  45. 450 T$="":RETURN
  46. 460 '== Program Start ==
  47. 470 DEFINT A-C,E-Z:DEFSNG D:MAX=200
  48. 480 DIM MNR(MAX+2),P(MAX+2),FSKIL$(4),FCOMM$(4),SKIL$(4),COMM$(4),F$(4)
  49. 490 FOR I=1 TO 3:F$(I)="MBRS-"+MID$(STR$(I),2,1)+".DAT":NEXT I
  50. 500   IF F$(4)="" OR QTR$="" OR OPT=9 THEN GOSUB 5720
  51. 510 GOSUB 820:GOSUB 920
  52. 520 DATA "==== Church Membership Program Menu ====",""
  53. 530 DATA "The following options are available:",""
  54. 540 DATA "1  - Membership List (with record numbers)"
  55. 550 DATA "2  - Add new members.                     "
  56. 560 DATA "3  - Correct member information.          "
  57. 570 DATA "4  - Query member record.                 "
  58. 580 DATA "5  - Enter Weekly Donation.               "
  59. 590 DATA "6  - Review Quarterly Donations.          "
  60. 600 DATA "7  - Create Formatted Donation Report File"
  61. 610 DATA "8  - Set Quarter.                         "
  62. 620 DATA "Q  - Return to System.                    ","",*
  63. 630 PRINT CLR$:RESTORE 520:GOSUB 390
  64. 640   IF QTR$="" THEN 660
  65. 650 PRINT FNCTR$("Current Quarter is "+QTR$+" Quarter."):GOTO 670
  66. 660 PRINT FNCTR$("No current Quarter initialized.")
  67. 670 PRINT:PRINT FNCTR$("Enter option desired:  ");
  68. 680 T$=INKEY$:IF LEN(T$)<1 THEN 680 ELSE PRINT T$;
  69. 690   IF T$="Q" OR T$="q" THEN PRINT "uit":GOTO 800 ELSE 750
  70. 700   IF OPT=6 THEN FLAG=2    'needed in GOSUB
  71. 710   IF OPT=8 THEN F$(4)=""
  72. 720 ON OPT GOSUB 2490,1300,2700,2200,4510,4510,4510,500:GOTO 630
  73. 730 PRINT FNCTR$("Do you wish to continue?  (Y/N):  ");
  74. 740 T$=INKEY$:IF LEN(T$)<1 THEN 740 ELSE PRINT T$
  75. 750 OPT=INSTR("12345678YyNn",T$)
  76. 760   IF OPT=9 OR OPT=10 THEN 670  'get menu selection
  77. 770   IF OPT=11 OR OPT=12 THEN 800  'endit
  78. 780   IF OPT>0 AND OPT<9 THEN 700 ELSE 730  'make sure in range 1-9
  79. 790 DATA "","","Processing complete","","Bye...",*
  80. 800 RESTORE 790:GOSUB 390:END
  81. 810 '== Open and define files ==
  82. 820 RESET:OPEN "R",#1,F$(1)
  83. 830 FIELD #1,2 AS FZ1$,2 AS FXNR1$,30 AS FXN$,30 AS FA1$,30 AS FA2$,15 AS FA3$,
  84.      2 AS FA4$,5 AS FA5$,7 AS FTEL$
  85. 840 OPEN "R",#2,F$(2)
  86. 850 FIELD #2,2 AS FZ1$,2 AS FXNR1$,6 AS FANNIV$,6 AS FTDJN$,10 AS FPSN$,
  87.      4 AS FXREF$,6 AS FBDAY$,10 AS FSKIL$(1), 10 AS FSKIL$(2),10 AS FSKIL$(3),
  88.      10 AS FSKIL$(4), 10 AS FCOMM$(1),10 AS FCOMM$(2),10 AS FCOMM$(3),
  89.      10 AS FCOMM$(4)
  90. 860 OPEN "R",#3,F$(3)
  91. 870 FIELD #3,2 AS FZ1$,2 AS FXNR1$,120 AS FCMT$
  92. 880 OPEN "R",#4,F$(4)
  93. 890 FIELD #4,2 AS FZ1$,2 AS FXNR1$,2 AS FWK$,52 AS FTD$,15 AS FSP1N$,
  94.      52 AS FSP1D$
  95. 900 RETURN
  96. 910 '== Table Build ==
  97. 920 FOR REC=1 TO MAX
  98. 930   GET #1,REC:IF LEFT$(FXN$,1)="Z" THEN MNR(REC)=0 ELSE MNR(REC)=REC
  99. 940 GET #1,REC:X$=FXN$:IF LEFT$(X$,1)="Z" THEN MNR(REC)=0:GOTO 950
  100. 950 NEXT REC
  101. 960 RETURN
  102. 970 '== Find Member Record ==
  103. 980 FOR N=1 TO MAX
  104. 990   IF REC=MNR(N) THEN 1030  'found it; return
  105. 1000 NEXT N:IF FLAG=5 THEN REC=0:GOTO 1030  'special use
  106. 1010 PRINT:PRINT FNCTR$("Member # "+STR$(REC)+" not presently in use."):PRINT
  107. 1020 FOR N=1 TO 500:REC=0:NEXT
  108. 1030 RETURN
  109. 1040 '== File Write ==
  110. 1050 LSET FZ1$="**"
  111. 1060 LSET FXNR1$=MKI$(REC)
  112. 1070 LSET FXN$=NAM$
  113. 1080 LSET FA1$=T1$
  114. 1090 LSET FA2$=T2$
  115. 1100 LSET FA3$=T3$
  116. 1110 LSET FA4$=T4$
  117. 1120 LSET FA5$=T5$
  118. 1130 LSET FTEL$=TEL$
  119. 1140 LSET FANNIV$=ANNIV$
  120. 1150 LSET FTDJN$=DTJN$
  121. 1160 LSET FPSN$=PSN$
  122. 1170 LSET FXREF$=XREF$
  123. 1180 LSET FBDAY$=BDAY$
  124. 1190 FOR I=1 TO 4:LSET FSKIL$(I)=SKIL$(I):NEXT I
  125. 1200 FOR I=1 TO 4:LSET FCOMM$(I)=COMM$(I):NEXT I
  126. 1210 LSET FCMT$=CMT$
  127. 1220 '== File Rewrite Entry Point ==
  128. 1230 PUT #1,REC
  129. 1240 PUT #2,REC
  130. 1250 PUT #3,REC
  131. 1260 PUT #4,REC
  132. 1270 '
  133. 1280 RETURN
  134. 1290 '== Add New Member(s) ==
  135. 1300 DATA "== Entering New Members ==",""
  136. 1310 DATA "Enter new Member Number (up to 4 digits), RETURN to quit,"
  137. 1320 DATA "or ? for me to find an unused Member number.","",*
  138. 1330 PRINT CLR$:RESTORE 1300:GOSUB 390
  139. 1340 PRINT FNCTR$("Enter selection (# or ? and RETURN) or RETURN to quit:  ");
  140. 1350   INPUT "",A$:IF A$="" THEN 2030  'return
  141. 1360   IF A$="?" THEN FLAG=1 ELSE FLAG=0  'find next avail mbr #
  142. 1370 GOSUB 2060        'find member #
  143. 1380   IF FLAG=1 THEN FLAG=0:GOTO 2030  'a problem - gotta quit.
  144. 1390 PRINT FNCTR$("Family Head Member # (1-3 digits) or RETURN if Head:  ");
  145. 1400 INPUT "",XREF$:IF XREF$="" OR XREF$=STR$(REC) THEN XREF=0:GOTO 1560
  146. 1410 XREF=VAL(XREF$)
  147. 1420 TEMP=REC:REC=XREF:GOSUB 980:XREF=RC=TEMP
  148. 1430 IF XREF>0 THEN 1540
  149. 1440 DATA "ERROR!  The Family Head Member # is not on file!"
  150. 1450 DATA "Enter the correct number, or this member # for now.","",*
  151. 1460 RESTORE 1440:GOSUB 390:GOTO 1390
  152. 1470 DATA "","Because you've cross-referenced this member to another member,"
  153. 1480 DATA "you may use the 'Head of Family' (HOF) information for addresses,"
  154. 1490 DATA "telephone numbers, date joined church, anniversary, etc."
  155. 1500 DATA "(Fields that will accept a HOF default are marked with an *."
  156. 1510 DATA "Just hit RETURN to use the HOF data.)",""
  157. 1520 DATA "This does NOT work for church position, skills, and those personal"
  158. 1530 DATA "things not shared with a Head of Family.","",*
  159. 1540 RESTORE 1470:GOSUB 390
  160. 1550 GET #1,XREF:GET #2,XREF:GET #3,XREF
  161. 1560 PRINT TAB(10);:LINE INPUT "Member name (L<sp>,F<sp>MI):  ",NAM$
  162. 1570   IF NAM$="Q" THEN MNR(REC)=0:GOTO 1330
  163. 1580   IF LEN(NAM$)>1 THEN 1610
  164. 1590 PRINT FNCTR$("You really must enter a name, you know, or Q to quit.")
  165. 1600 GOTO 1560
  166. 1610 PRINT TAB(10);:INPUT "First address line:  *",T1$
  167. 1620   IF T1$<>"" THEN 1640 ELSE IF XREF<=0 THEN T1$="~":GOTO 1640
  168. 1630   T1$=FA1$:T2$=FA2$:T3$=FA3$:T4$=FA4$:T5$=FA5$:GOTO 1720    'Use HOF data
  169. 1640 PRINT TAB(10);:INPUT "Second address line:  *",T2$:IF T2$="" THEN T2$="~"
  170. 1650 PRINT TAB(10);"City (if ";HT$;", enter H):  *";:INPUT "",T3$
  171. 1660   IF T3$="H" THEN T3$=HT$:T4$=ST$:GOTO 1710
  172. 1670   IF T3$<>"" THEN 1690 ELSE IF XREF<=0 THEN T3$="~":GOTO 1690
  173. 1680   T3$=FA3$:T4$=FA4$:T5$=FA5$:GOTO 1720    'Use HOF data
  174. 1690 PRINT TAB(10);"State (2-char, if ";ST$;" hit RETURN):  ";:INPUT "",T4$
  175. 1700   IF T4$="" THEN T4$=ST$
  176. 1710 PRINT TAB(10);:INPUT "ZIP code (5 digits):  ",T5$
  177. 1720 PRINT TAB(10);:INPUT "Telephone number (7 digits, no dash):  *",TEL$
  178. 1730   IF TEL$="" THEN IF XREF>0 THEN TEL$=FTEL$ ELSE TEL$="~"
  179. 1740   IF LEN(TEL$)<=7 THEN 1760
  180. 1750 PRINT FNCTR$("ERROR!  7 numbers only, please."):GOTO 1720
  181. 1760 PRINT TAB(10);:INPUT "Date joined church (YYMMDD):  *",DTJN$
  182. 1770   IF DTJN$="" THEN IF XREF>0 THEN DTJN$=FDTJN$ ELSE DTJN$="~"
  183. 1780 PRINT TAB(10);:INPUT "Anniversary date (YYMMDD):  *",ANNIV$
  184. 1790   IF ANNIV$="" THEN IF XREF>0 THEN ANNIV$=FANNIV$ ELSE ANNIV$="~"
  185. 1800 PRINT TAB(10);:INPUT "Church Position (max 10 chars):  ",PSN$
  186. 1810   IF PSN$="" THEN PSN$="~"
  187. 1820 PRINT TAB(10);:INPUT "Birth Date (YYMMDD):  ",BDAY$
  188. 1830   IF BDAY$="" THEN BDAY$="~"
  189. 1840 PRINT "Enter up to 4 Special Skills (max 10 chars, RETURN to stop):"
  190. 1850 FLAG=0
  191. 1860 FOR I=1 TO 4
  192. 1870     IF FLAG=1 THEN SKIL$(I)="~":GOTO 1900
  193. 1880   PRINT TAB(10);"Skill";I;:INPUT ":  ",SKIL$(I)
  194. 1890     IF SKIL$(I)="" THEN SKIL$(I)="~":FLAG=1
  195. 1900 NEXT I:FLAG=0
  196. 1910 PRINT "Enter up to 4 Committee memberships (present and past;"
  197. 1920 PRINT "put past ones in parentheses, e.g., '(Building)')."
  198. 1930 PRINT "(max 10 characters, RETURN to stop):"
  199. 1940 FOR I=1 TO 4
  200. 1950     IF FLAG=1 THEN COMM$(I)="~":GOTO 1980
  201. 1960   PRINT TAB(10);"Committee";I;:INPUT ":  ",COMM$(I)
  202. 1970     IF COMM$(I)="" THEN COMM$(I)="~":FLAG=1
  203. 1980 NEXT I:FLAG=0
  204. 1990 PRINT "Enter other desired information or comments (up to 1 line):"
  205. 2000 PRINT:LINE INPUT "",CMT$:IF CMT$="" THEN CMT$="None"
  206. 2010 GOSUB 1050:GOSUB 820
  207. 2020 GOTO 1300
  208. 2030 RETURN
  209. 2040 '== Find Record Number for New Member ==
  210. 2050 ' Must bring in A$
  211. 2060   IF A$="?" THEN 2130 ELSE IF A$="" THEN FLAG=1:GOTO 2180
  212. 2070 REC=VAL(A$)
  213. 2080     IF MNR(REC)=0 THEN 2160
  214. 2090 PRINT "ERROR!  Duplicate Member Number.  Select another, please,"
  215. 2100 PRINT "? for next available number, or RETURN to quit."
  216. 2110 INPUT "Enter selection ( # or ? ) or RETURN to quit:  ",A$
  217. 2120 GOTO 2060
  218. 2130   FOR REC=1 TO MAX:IF MNR(REC)=0 THEN 2160:NEXT REC
  219. 2140 PRINT FNCTR$("Sorry - no more records are available.")
  220. 2150 FLAG=1:REC=0:GOTO 2180
  221. 2160   FLAG=0:MNR(REC)=REC
  222. 2170 PRINT FNCTR$("Confirming Member Record #"+STR$(REC))
  223. 2180 RETURN
  224. 2190 '== Query Member Record ==
  225. 2200 REC=0:PRINT CLR$;FNCTR$("== Query Member Record =="):PRINT
  226. 2210 PRINT FNCTR$("Enter Member Number (#, ?-Listing, A-All, Q-Quit):  ");
  227. 2220 INPUT; "",A$:IF A$="Q" OR A$="q" THEN PRINT "uit":GOTO 2300
  228. 2230 PRINT:IF A$="?" THEN GOSUB 2490:GOTO 2200
  229. 2240   IF A$<>"A" AND A$<>"a" THEN 2270 
  230. 2250 IF REC<MAX THEN   REC=REC+1:IF MNR(REC)>0 THEN GOSUB 2330:GOTO 2280
  231. 2260   IF REC>=MAX THEN 2200 ELSE 2250
  232. 2270 REC=VAL(A$):GOSUB 980:IF REC=0 THEN 2200 ELSE GOSUB 2330:REC=0
  233. 2280   IF T$="Q" OR T$="q" THEN PRINT "uitting...":GOTO 2300
  234. 2290   IF REC=0 THEN 2200 ELSE 2250
  235. 2300 RETURN
  236. 2310 PRINT FNCTR$("Getting Member #");REC:GOTO 2250
  237. 2320 '-- gosub to show member rec --
  238. 2330 GET #1,REC:GET #2,REC:GET #3,REC
  239. 2340 T7$=MID$(FTEL$,1,3):T8$=MID$(FTEL$,4,4)
  240. 2350 PRINT CLR$;"MBR #";TAB(12);"NAME";TAB(40);"ADDRESS":PRINT
  241. 2360 PRINT REC;TAB(10);FXN$;TAB(40);FA1$
  242. 2370   IF ASC(FA2$)>32 THEN PRINT TAB(40);FA2$
  243. 2380 PRINT TAB(40);FA3$;FA4$;"  ";FA5$:PRINT
  244. 2390 PRINT "Position:       ";FPSN$;TAB(40);"Tel #:        ";T7$;"-";T8$
  245. 2400 PRINT "Joined:         ";FTDJN$;TAB(40);"Birth Date:   ";FBDAY$
  246. 2410 PRINT "Family Head #:  ";FXREF$;TAB(40);"Anniversary:  ";FANNIV$
  247. 2420 PRINT:PRINT TAB(15);"Skills";TAB(40);"Committees ('(past)')"
  248. 2430 FOR I=1 TO 4:PRINT TAB(15);FSKIL$(I);TAB(40);FCOMM$(I):NEXT I
  249. 2440 PRINT:PRINT:PRINT FCMT$
  250. 2450 PRINT FNCTR$("Hit RETURN to continue, or Q to quit:  ");
  251. 2460 T$=INKEY$:IF LEN(T$)<1 THEN 2460
  252. 2470 RETURN
  253. 2480 '== Print Member Numbers ==
  254. 2490 GOSUB 2500:GOTO 2540
  255. 2500 PRINT CLR$;FNCTR$("== Member Number List =="):PRINT
  256. 2510 PRINT "NBR";TAB(5);"NAME";TAB(35);"XREF";
  257. 2520 PRINT TAB(40);"NBR";TAB(45);"NAME";TAB(75);"XREF"
  258. 2530 RETURN
  259. 2540 T=MAX/2        '2 columns
  260. 2550 FOR REC=1 TO T
  261. 2560   T0=0:T1=REC:T2=0
  262. 2570     IF MNR(T1)=0 THEN 2620
  263. 2580   GET #1,T1:GET #2,T1
  264. 2590   PRINT TAB(T2);:PRINT USING "###";REC;
  265. 2600   PRINT TAB(T2+5);FXN$;TAB(T2+35);FXREF$;
  266. 2610   IF T2=0 THEN PRINT "|"; ELSE PRINT
  267. 2620   IF T2>0 THEN 2650
  268. 2630   IF T2=0 THEN T1=T+REC:T2=40:GOTO 2570
  269. 2640   IF REC MOD 20=0 AND REC<T THEN GOSUB 2660:GOSUB 2500
  270. 2650 NEXT REC
  271. 2660 PRINT RET$;
  272. 2670 T$=INKEY$:IF LEN(T$)<1 THEN 2670
  273. 2680 RETURN
  274. 2690 '== Correct Member Information ==
  275. 2700 PRINT CLR$;FNCTR$("== Member Record Corrections =="):PRINT
  276. 2710 PRINT FNCTR$("Enter Member Number, ? for a Listing, or RETURN to quit:  ");
  277. 2720 INPUT; "",A$:IF A$="" THEN PRINT "Quit.":GOTO 2900 'return
  278. 2730   IF A$="?" THEN PRINT:GOSUB 2490:GOTO 2700
  279. 2740   REC=VAL(A$):PRINT CLR$:GOSUB 980
  280. 2750   IF REC=0 THEN 2900    'return
  281. 2760 GET #1,REC:GET #2,REC:GET #3,REC:GET #4,REC
  282. 2770 PRINT REC,FXN$:PRINT
  283. 2780 GOTO 2920
  284. 2790 '-- Delete record --
  285. 2800 PRINT FNCTR$("Delete this Member Record?  ('DELETE' or RETURN for No):  ");
  286. 2810 INPUT "",T$:IF T$<>"DELETE" THEN 2900 ELSE IF FLAG=1 THEN 2890
  287. 2820 DATA "","WARNING!    If you delete this record, ALL record of ALL data"
  288. 2830 DATA "on this member is PERMANENTLY and FOREVER destroyed in this file."
  289. 2840 DATA "There are other options available:  Change the member's number;"
  290. 2850 DATA "Move the member to an inactive file."
  291. 2860 DATA "Consider these, and be ABSOLUTELY sure you want to delete this!"
  292. 2870 DATA "If you do not, enter ANYTHING but 'DELETE' to abort.","",*
  293. 2880 RESTORE 2820:GOSUB 390:IF FLAG=1 THEN FLAG=0 ELSE FLAG=1:GOTO 2800
  294. 2890 TEMP=REC:GOSUB 3770    'delete rec
  295. 2900 FLAG=0:RETURN
  296. 2910 '== Regular member data change ==
  297. 2920 PRINT FNCTR$("== Member Record Correction =="):PRINT
  298. 2930 PRINT "Enter the information to be changed (only one at a time, please):"
  299. 2940 DATA "Member Number:","#","Member Name:","N","Position:","P"
  300. 2950 DATA "Telephone:","T","Address:","A","Birth Date:","B"
  301. 2960 DATA "Date Joined:","J","Anniversary:","M","Skill(s):","S"
  302. 2970 DATA "Committee(s):","C","Family Head:","H","Other Comments:","O"
  303. 2980 DATA "Delete Member:","D"
  304. 2990 RESTORE 2940:FOR N=1 TO 13:READ A$,B$:PRINT,A$;TAB(30);B$:NEXT N
  305. 3000 PRINT:PRINT FNCTR$("(#,N,P,T,A,B,J,M,S,C,H,O,D, or ESC to quit):  ");
  306. 3010 A$=INKEY$:IF LEN(A$)<1 THEN 3010 ELSE IF ASC(A$)=11 OR ASC(A$)=17 THEN 3010
  307. 3020   IF A$=ESC$ THEN PRINT "ESC" ELSE PRINT A$:GOTO 3050
  308. 3030     PRINT FNCTR$("Now updating all changes to files...")
  309. 3040     GOSUB 1230:PRINT CLR$:GOTO 2700
  310. 3050 T=INSTR("#NPTABJMSCHOD",A$)
  311. 3060  IF T<1 THEN PRINT FNCTR$("ERROR!  Try again, please."):PRINT:GOTO 3000
  312. 3070 DATA "Remember, use RETURN to accept Present data, 'ERASE' to erase"
  313. 3080 DATA "an entry, or enter new data as desired.  DO NOT use this utility"
  314. 3090 DATA "to go right back and check a new entry (and then hit RETURN to"
  315. 3100 DATA "accept that new entry) -- the new data is not actually written"
  316. 3110 DATA "to the disk yet, and your RETURN will erase it!","",*
  317. 3120 PRINT CLR$:RESTORE 3070:GOSUB 390
  318. 3130 ON T GOSUB 3600,3170,4030,3260,3330,3890,3820,3960,4280,4390,4100,4170,2800
  319. 3140   IF T=1 THEN 3030 ELSE IF T=13 THEN 2700
  320. 3150 PRINT:PRINT:PRINT FNCTR$("Change posted."):FOR I=1 TO 500:NEXT:GOTO 2920
  321. 3160 '== Change Name ==
  322. 3170 PRINT "Present Name:  ";FXN$
  323. 3180 LINE INPUT; "Enter corrected name (max 30 char):  ",A$
  324. 3190   IF A$="" THEN PRINT FXN$:GOTO 3240 ELSE PRINT
  325. 3200   IF A$<>"ERASE" THEN  3230
  326. 3210 PRINT FNCTR$("ERROR!  You cannot ERASE a name field, only change.")
  327. 3220 PRINT:GOTO 3170
  328. 3230 LSET FXN$=A$
  329. 3240 RETURN
  330. 3250 '== Change Telephone Number ==
  331. 3260 PRINT "Present Telephone Number:  ";FTEL$
  332. 3270 INPUT; "Enter new telephone number (max 7 characters, no dashes):  ",A$
  333. 3280   IF A$="" THEN PRINT FTEL$:GOTO 3310
  334. 3290   IF A$="ERASE" THEN A$="~"
  335. 3300 PRINT:LSET FTEL$=A$
  336. 3310 RETURN
  337. 3320 '== Change Address ==
  338. 3330 PRINT "Present Address:  ";TAB(20);FA1$
  339. 3340 PRINT TAB(20);FA2$:PRINT TAB(20);FA3$
  340. 3350 PRINT TAB(20);FA4$:PRINT TAB(20);FA5$
  341. 3360 PRINT:PRINT FNCTR$("Enter new information, or RETURN to accept the old:")
  342. 3370 PRINT:INPUT; "Enter first address line:  ",A$
  343. 3380   IF A$="" THEN PRINT FA1$:GOTO 3410
  344. 3390   IF A$="ERASE" THEN A$="~":PRINT A$
  345. 3400 LSET FA1$=A$
  346. 3410 PRINT:INPUT; "Enter second address line:  ",A$
  347. 3420   IF A$="" THEN PRINT FA2$:GOTO 3450
  348. 3430   IF A$="ERASE" THEN A$="~":PRINT A$
  349. 3440 LSET FA2$=A$
  350. 3450 PRINT:INPUT; "Enter City (20 char):  ",A$
  351. 3460   IF A$<>"" THEN 3480
  352. 3470 PRINT "City & State:  ";FA3$;"  ";FA4$:GOTO 3540
  353. 3480   IF A$="ERASE" THEN A$="~":PRINT A$
  354. 3490 LSET FA3$=A$
  355. 3500 PRINT:INPUT; "Enter State (2 char abbrev.):  ",A$
  356. 3510   IF A$="" THEN PRINT FA4$:GOTO 3540
  357. 3520   IF A$="ERASE" THEN A$="~":PRINT A$
  358. 3530 LSET FA4$=A$
  359. 3540 PRINT:INPUT; "Enter ZIP code (5 char):  ",A$
  360. 3550   IF A$="" THEN PRINT FA5$:GOTO 3580
  361. 3560   IF A$="ERASE" THEN A$="~":PRINT A$
  362. 3570 LSET FA5$=A$
  363. 3580 PRINT:RETURN
  364. 3590 '== Change Member Number ==
  365. 3600 DATA "== Changing Member Numbers ==",""
  366. 3610 DATA "You may assign a member a new number.  However it CANNOT be one"
  367. 3620 DATA "already assigned.  You must first Delete that other member"
  368. 3630 DATA "from the files, COMPLETELY and FOREVER erasing all data you have"
  369. 3640 DATA "on that person -- and that's pretty drastic!",""
  370. 3650 DATA "I recommend you change the old member's number to a high unused"
  371. 3660 DATA "number, and then assign the vacant number as you desire.","",***
  372. 3670 PRINT CLR$:RESTORE 3600:GOSUB 390:TEMP=REC
  373. 3680 FOR I=1 TO 4:GET #I,REC:NEXT
  374. 3690 PRINT:PRINT FNCTR$("Present Member's Number:  "+STR$(REC))
  375. 3700 PRINT FNCTR$("Enter new desired number (4 digits, or RETURN to quit):  ");
  376. 3710 INPUT "",A$:IF A$="" THEN 3800
  377. 3720   IF A$="ERASE" THEN PRINT "ERROR!":GOTO 3690
  378. 3730 GOSUB 2060:IF REC=0 OR FLAG=1 THEN 3800
  379. 3740 '-- OK to use new number --
  380. 3750 LSET FXNR1$=MKI$(REC):MNR(REC)=REC:GOSUB 1230    'post new data
  381. 3760 LSET FZ1$="ZZ":LSET FXNR1$=MKI$(0):LSET FXN$=""
  382. 3770 REC=TEMP:MNR(REC)=0:GOSUB 1230    'purge old
  383. 3780 PRINT FNCTR$("Deletion Posted"):PRINT RET$;
  384. 3790 A$=INKEY$:IF LEN(A$)<1 THEN 3790
  385. 3800 RETURN
  386. 3810 '== Change Date Joined ==
  387. 3820 PRINT "Present Date Joined:  ";FTDJN$
  388. 3830 INPUT; "Enter new Date Joined (YYMMDD):  ",A$
  389. 3840   IF A$="" THEN PRINT FTDJN$:GOTO 3870
  390. 3850   IF A$="ERASE" THEN A$="~":PRINT A$
  391. 3860 LSET FTDJN$=A$
  392. 3870 RETURN  'to member field change
  393. 3880 '== Change Birth Date ==
  394. 3890 PRINT "Present Birth Date:  ";FBDAY$
  395. 3900 INPUT; "Enter new Birth Date (YYMMDD):  ",A$
  396. 3910   IF A$="" THEN PRINT FBDAY$:GOTO 3940
  397. 3920   IF A$="ERASE" THEN A$="~":PRINT A$
  398. 3930 LSET FBDAY$=A$
  399. 3940 RETURN
  400. 3950 '== Change Anniversary ==
  401. 3960 PRINT "Present Anniversary:  ";FANNIV$
  402. 3970 INPUT; "Enter new Anniversary (YYMMDD):  ",A$
  403. 3980   IF A$="" THEN PRINT FANNIV$:GOTO 4010
  404. 3990   IF A$="ERASE" THEN A$="~":PRINT A$
  405. 4000 LSET FANNIV$=A$
  406. 4010 RETURN
  407. 4020 '== Change Church Position ==
  408. 4030 PRINT "Present Church Position:  ";FPSN$
  409. 4040 INPUT; "Enter new Church Position (10 char):  ",A$
  410. 4050   IF A$="" THEN PRINT FPSN$:GOTO 4080
  411. 4060   IF A$="ERASE" THEN A$="~":PRINT A$
  412. 4070 LSET FPSN$=A$
  413. 4080 RETURN
  414. 4090 '== Change Family Head # ==
  415. 4100 PRINT "Present Family Head Member #:  ",FXREF$
  416. 4110 INPUT; "Enter new Family Head Member #:  ",A$
  417. 4120   IF A$="" THEN PRINT FXREF$:GOTO 4150
  418. 4130   IF A$="ERASE" THEN A$="~":PRINT A$
  419. 4140 LSET FXREF$=A$
  420. 4150 RETURN  'to member field change
  421. 4160 '== Change Other Comments ==
  422. 4170 PRINT "Present Comment Line:":PRINT:PRINT FCMT$:PRINT:T$=FCMT$
  423. 4180 PRINT "Enter new Comment Line:":LINE INPUT; "*",A$
  424. 4190   IF A$="" THEN PRINT T$:A$=T$:GOTO 4250
  425. 4200   IF A$="ERASE" THEN A$="None.":GOTO 4250
  426. 4210 PRINT "A double-check ... here's your new line.  If OK, hit RETURN."
  427. 4220 PRINT "If you don't like it, do it again."
  428. 4230 PRINT:PRINT A$:PRINT:T$=A$
  429. 4240 GOTO 4180
  430. 4250 LSET FCMT$=A$
  431. 4260 RETURN
  432. 4270 '== Change Skills ==
  433. 4280 PRINT "Present Skills:"
  434. 4290 FOR I=1 TO 4:PRINT USING "#. ";I;
  435. 4300   PRINT FSKIL$(I);:IF I<>4 THEN PRINT ", ";
  436. 4310 NEXT I:PRINT
  437. 4320 PRINT "Enter new skills (10 chars):"
  438. 4330 FOR I=1 TO 4:PRINT USING "#. ";I;:INPUT; "",A$
  439. 4340     IF A$="" THEN PRINT FSKIL$(I):GOTO 4360 ELSE IF A$="ERASE" THEN A$="~"
  440. 4350   LSET FSKIL$(I)=A$
  441. 4360 PRINT:NEXT I
  442. 4370 RETURN
  443. 4380 '== Change Committee Membership ==
  444. 4390 PRINT "Present Committee Membership:"
  445. 4400 FOR I=1 TO 4:PRINT USING "#. ";I;
  446. 4410   PRINT FCOMM$(I);:IF I<>4 THEN PRINT ", ";
  447. 4420 NEXT I:PRINT
  448. 4430 PRINT "Enter new Committee Membership(s) (10 chars):"
  449. 4440 FOR I=1 TO 4:PRINT USING "#. ";I;:INPUT; "",A$
  450. 4450     IF A$="" THEN PRINT FCOMM$(I):GOTO 4480
  451. 4460     IF A$="ERASE" THEN A$="~":PRINT A$
  452. 4470   LSET FCOMM$(I)=A$
  453. 4480 PRINT:NEXT I
  454. 4490 RETURN  'to member field change
  455. 4500 '== Actual Donation Posting/Listing ==
  456. 4510 PRINT CLR$;FNCTR$("== Donation Posting/Listing ==")
  457. 4520 PRINT FNCTR$("Current Quarter:  "+QTR$+" Quarter"):PRINT
  458. 4530 REC=1:IF OPT=7 THEN OPEN "O",#5,"MBRS-DON.RPT"
  459. 4540 LSET FSP1N$=""
  460. 4550 PRINT FNCTR$("Enter Member Number (or ?-Listing, A-All, RETURN-quit):  ");
  461. 4560 INPUT "",A$:REC=1
  462. 4570   IF A$="A" OR A$="a" THEN FLAG=1:GOTO 4610
  463. 4580   IF A$="" THEN IF OPT=7 THEN CLOSE #5:RETURN ELSE RETURN
  464. 4590   IF A$="?" THEN GOSUB 2490:GOTO 4510
  465. 4600 REC=VAL(A$):FLAG=0:GOSUB 980:IF REC=0 THEN 4550
  466. 4610   IF MNR(REC)=0 THEN 4720
  467. 4620 GET #1,REC:GET #2,REC:GET #4,REC
  468. 4630 A=CVI(FXNR1$):IF ASC(FSP1N$)>32 THEN L=1 ELSE LSET FSP1N$="None":L=0
  469. 4640   IF LEN(FWK$)=0 THEN WK=0:TD$="":SP1D$="":GOTO 4680
  470. 4650 T=CVI(FWK$):WK=T
  471. 4660 TD$=LEFT$(FTD$,T*4)
  472. 4670 SP1D$=LEFT$(FSP1D$,T*4)
  473. 4680 WK=WK+1:LSET FWK$=MKI$(WK)
  474. 4690   IF OPT=5 THEN GOSUB 4740
  475. 4700   IF OPT=6 THEN GOSUB 4980:IF T$="Q" THEN A$="":GOTO 4580
  476. 4710   IF OPT=7 THEN GOSUB 5340
  477. 4720   IF FLAG=0 OR REC>MAX THEN 4550 ELSE REC=REC+1:GOTO 4610
  478. 4730 '-- Donation Entry --
  479. 4740 LSET FZ1$="**":LSET FSP1D$="":LSET FTD$=""
  480. 4750 PRINT CLR$;"Donation for Member ";FXN$
  481. 4760 PRINT "Type Donation (S - Special, RETURN - Sunday, ESC - Next Mbr):  ";
  482. 4770 TYP$=INKEY$:IF LEN(TYP$)<1 THEN 4770
  483. 4780   IF TYP$=ESC$ THEN PRINT "Next Member...":GOTO 4960  'return
  484. 4790   IF TYP$="S" OR TYP$="s" THEN TYP=1:TYP$="Special":GOTO 4810
  485. 4800   TYP$="Regular":TYP=0
  486. 4810 PRINT:PRINT:PRINT "Now posting ";TYP$;" Donation, Week #";WK
  487. 4820   IF TYP=0 THEN 4890
  488. 4830 PRINT FNCTR$("The Special Donation name is "+FSP1N$)
  489. 4840 PRINT FNCTR$("Enter name of new Special Donation (max 15 chars),")
  490. 4850 PRINT FNCTR$("or RETURN for no change/none:  ");:LINE INPUT;"",A$
  491. 4860   IF L=1 AND LEN(A$)=0 THEN PRINT "Accepted.":GOTO 4890
  492. 4870   IF L=0 AND LEN(A$)=0 THEN A$="None":PRINT A$
  493. 4880 LSET FSP1N$=A$:GOTO 4830
  494. 4890 PRINT "Enter ";TYP$;" Donation Amount (no $ or ,):  ";:INPUT "",DNEW
  495. 4900 PRINT "The amount entered is ";:PRINT USING "$###.##";DNEW
  496. 4910 PRINT "Hit RETURN to accept, or enter corrected donation amount:  ";
  497. 4920 INPUT "",A:IF A<>0 THEN DNEW=A:GOTO 4900
  498. 4930 DNEW$=MKS$(DNEW)
  499. 4940   IF TYP=1 THEN LSET FSP1D$=SP1D$+DNEW$ ELSE LSET FTD$=TD$+DNEW$
  500. 4950 PUT #4,REC:GOTO 4760
  501. 4960 CLOSE #4:GOSUB 880:RETURN
  502. 4970 '== Screen Donation Report ==
  503. 4980 PRINT CLR$;FNCTR$("DONATIONS")
  504. 4990 PRINT TAB(30);FXN$;TAB(70);FXNR1$
  505. 5000 PRINT TAB(30);FA1$
  506. 5010   IF ASC(FA2$)<>32 AND ASC(FA2$)<>126 THEN PRINT TAB(30);FA2$
  507. 5020 PRINT TAB(30);FA3$;FA4$;"  ";FA5$
  508. 5030 PRINT FNCTR$(QTR$+" Quarter "+YR$):PRINT
  509. 5040 PRINT TAB(20);"Sunday";TAB(50);"Special"
  510. 5050 PRINT TAB(10);"Week";TAB(20);"Donation";TAB(50);"Donation";
  511. 5060 PRINT TAB(60);"Purpose"
  512. 5070 PRINT TAB(10);"----";TAB(20);"--------";TAB(50);"--------";
  513. 5080 PRINT TAB(60);"-------"
  514. 5090 DT=0:DSP1T=0
  515. 5100 FOR I=1 TO 13
  516. 5110   IF WK=1 THEN PRINT:PRINT FNCTR$("No donations entered."):GOTO 5280
  517. 5120   IF I=WK THEN 5220
  518. 5130   D$=MID$(FTD$,((I-1)*4)+1,4)
  519. 5140   SP1D$=MID$(FSP1D$,((I-1)*4)+1,4)
  520. 5150   D=CVS(D$):DSP1=CVS(SP1D$)
  521. 5160   PRINT TAB(10);:PRINT USING "###";I;
  522. 5170     PRINT TAB(20);:PRINT USING "  ###.##";D;
  523. 5180     PRINT TAB(50);:PRINT USING "  ###.##";DSP1;
  524. 5190     PRINT TAB(60);:IF I=WK-1 THEN PRINT FSP1N$ ELSE PRINT
  525. 5200   DT=DT+D:DSP1T=DSP1T+DSP1
  526. 5210 NEXT I
  527. 5220 DAV=DT/(I-1)
  528. 5230 PRINT TAB(20);"---------";TAB(50);"---------":PRINT
  529. 5240 PRINT TAB(10);"Total:";TAB(20);:PRINT USING " $###.##";DT;
  530. 5250 PRINT TAB(50);:PRINT USING " $###.##";DSP1T
  531. 5260 PRINT "Weekly average:";TAB(20);:PRINT USING " $###.##";DAV;
  532. 5270 PRINT TAB(35);"Comb. Total:";TAB(50);:PRINT USING " $###.##";DT+DSP1T
  533. 5280 PRINT BTM$;FNCTR$("Hit RETURN to continue or Q to quit:  ");
  534. 5290 T$=INKEY$:IF LEN(T$)<1 THEN 5290 ELSE PRINT CLR$:RETURN
  535. 5300 '== Print Formatted Donation Report to File ==
  536. 5310 PRINT #5,CLR$;    'FNCTR$("MY CHURCH")
  537. 5320 'PRINT #5,FNCTR$("100 Sanctity Lane")
  538. 5330 'PRINT #5,FNCTR$(HT$+" "+ST$+"  28303"):PRINT #5,""
  539. 5340 PRINT #5,FNCTR$("DONATIONS"):PRINT #5,""
  540. 5350 PRINT #5,TAB(30);FXN$;TAB(70);FXNR1$
  541. 5360 PRINT #5,TAB(30);FA1$
  542. 5370   IF ASC(FA2$)<>32 AND ASC(FA2$)<>126 THEN PRINT #5,TAB(30);FA2$
  543. 5380 PRINT #5,TAB(30);FA3$;FA4$;"  ";FA5$:PRINT #5,""
  544. 5390 PRINT #5,FNCTR$(QTR$+" Quarter +YR$):PRINT #5,""
  545. 5400 PRINT #5,TAB(20);"Sunday";TAB(50);"Special"
  546. 5410 PRINT #5,TAB(10);"Week";TAB(20);"Donation";TAB(50);"Donation";
  547. 5420 PRINT #5,TAB(60);"Purpose"
  548. 5430 PRINT #5,TAB(10);"----";TAB(20);"--------";TAB(50);"--------";
  549. 5440 PRINT #5,TAB(60);"-------"
  550. 5450 DT=0:DSP1T=0
  551. 5460 FOR I=1 TO 13:IF WK<>1 THEN 5480
  552. 5470   PRINT #5,"":PRINT #5,FNCTR$("No donations entered."):GOTO 5580
  553. 5480     IF I=WK THEN 5580
  554. 5490   FD$=MID$(FTD$,(I-1)*4+1,4)
  555. 5500   SP1D$=MID$(FSP1D$,(I-1)*4+1,4)
  556. 5510   D=CVS(FD$):DSP1=CVS(SP1D$)
  557. 5520   PRINT #5,TAB(10);:PRINT #5,USING "###";I;
  558. 5530     PRINT #5,TAB(20);:PRINT #5,USING "  ###.##";D;
  559. 5540     PRINT #5,TAB(50);:PRINT #5,USING "  ###.##";DSP1;
  560. 5550     PRINT #5,TAB(60);:IF I=WK-1 THEN PRINT #5,FSP1N$ ELSE PRINT #5
  561. 5560   DT=DT+D:DSP1T=DSP1T+DSP1
  562. 5570 NEXT I
  563. 5580 DAV=DT/I
  564. 5590 PRINT #5,TAB(20);"---------";TAB(50);"---------":PRINT #5,""
  565. 5600 PRINT #5,TAB(10);"Total:";TAB(20);:PRINT #5,USING " $###.##";DT;
  566. 5610 PRINT #5,TAB(50);:PRINT #5,USING " $###.##";DSP1T
  567. 5620 PRINT #5,"":PRINT #5,"Weekly average:";TAB(20);
  568. 5630 PRINT #5,USING " $###.##";DAV;:PRINT #5,TAB(35);"Comb. Total:";
  569. 5640 PRINT #5,TAB(50);:PRINT #5,USING " $###.##";DT+DSP1T;:PRINT #5,CHR$(12)
  570. 5650 RETURN
  571. 5660 '-- Small Gosub to field all files --
  572. 5670 FOR I=1 TO 4
  573. 5680   OPEN "R",#I,F$(I):FIELD #I,126 AS FA$
  574. 5690 PRINT FNCTR$("Now opening and fielding "+F$(I)+" (File #"+STR$(I)+").")
  575. 5700 NEXT I:RETURN
  576. 5710 '== Quarter File Init==
  577. 5720 DATA "== Quarter Initialization ==",""
  578. 5730 DATA "You may now set the present Quarter to access current Quarterly"
  579. 5740 DATA "Donation Files.  If this is a new Quarter, that file will be"
  580. 5750 DATA "created automatically.","",*
  581. 5760 PRINT CLR$:RESTORE 5720:GOSUB 390
  582. 5770 GOSUB 6150:IF T$<>"Q" THEN 5820
  583. 5780   IF LEN(F$(4))>0 THEN 6120
  584. 5790 PRINT FNCTR$("Your file names are NOT initialized, and you cannot access")
  585. 5800 PRINT FNCTR$("your files until that is done!  Please select a Quarter.")
  586. 5810 GOTO 5770
  587. 5820 QTR$=MID$("1st2nd3rd4th",(VAL(T$)-1)*3+1,3)
  588. 5830 PRINT:PRINT FNCTR$("Here are your file names for the "+QTR$+" Quarter:")
  589. 5840 PRINT:PRINT TAB(20);
  590. 5850 FOR I=1 TO 4:PRINT F$(I);"  ";:NEXT I:PRINT
  591. 5860 RESET:ON ERROR GOTO 5940
  592. 5870 ' The following file test requires that MBRS.BAS exist on this disk.
  593. 5880 ' So DON'T change MBRS.BAS to anything else, or change these names.
  594. 5890 NAME "MBRS.BAS" AS F$(1)
  595. 5900 NAME F$(1) AS "MBRS.BAS":ON ERROR GOTO 0
  596. 5910 GOTO 6050
  597. 5920 NAME "MBRS.BAS" AS F$(4)
  598. 5930 NAME F$(4) AS "MBRS.BAS":GOTO 5980
  599. 5940   IF ERR=58 AND ERL=5890 THEN RESUME 5920
  600. 5950   IF ERR=58 AND ERL=5920 THEN RESUME 6120
  601. 5960 PRINT "Untrapped ERR=";ERR;"at Line ";ERL:STOP
  602. 5970 '--Quarter files do not exist - initialize them.--
  603. 5980 ON ERROR GOTO 0
  604. 5990 PRINT FNCTR$("Creating new "+QTR$+" Quarter Donation File "+F$(4)+"...")
  605. 6000 OPEN "R",#4,F$(4):FIELD #4,2 AS FZ1$,2 AS FXNR1$,2 AS FWK$,120 AS FA$
  606. 6010 LSET FZ1$="ZZ":LSET FXNR1$=MKI$(0):LSET FWK$=MKI$(0)
  607. 6020 FOR REC=1 TO MAX:PUT #4,REC:NEXT REC:CLOSE #4
  608. 6030 GOTO 6120
  609. 6040 '-- Initialize All Files --
  610. 6050 FOR I=1 TO 3
  611. 6060   PRINT FNCTR$("Creating File "+F$(I))
  612. 6070   OPEN "R",#I,F$(I):FIELD #I,2 AS FZ1$,2 AS FXNR1$,122 AS FA$
  613. 6080   LSET FZ1$="ZZ":LSET FXNR1$=MKI$(0)
  614. 6090   FOR REC=1 TO MAX:PUT #I,REC:NEXT REC:CLOSE #I
  615. 6100 NEXT I:GOTO 5980
  616. 6110 '-- End of All File Initialization --
  617. 6120 ON ERROR GOTO 0
  618. 6130 RETURN
  619. 6140 '-- Prompt for and Get Quarter Data --
  620. 6150 IF QTR$="" THEN T$="No Quarter Initialized" ELSE T$=QTR$+" Quarter"
  621. 6160 PRINT FNCTR$("Current Quarter:  "+T$):PRINT
  622. 6170 PRINT FNCTR$("Enter Quarter desired (1,2,3,4) or ESC or RET to quit:  ");
  623. 6180 T$=INKEY$:IF LEN(T$)<1 THEN 6180
  624. 6190   IF T$=ESC$ OR T$="" THEN T$="Q":PRINT "Quit":GOTO 6220
  625. 6200 F$(4)="DONQTR"+T$+".DAT"
  626. 6210   IF INSTR("1234",T$)<1 THEN PRINT FNCTR$("ERROR!  Try again."):GOTO 6170
  627. 6220 RETURN
  628.