home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib37b.dsk / DCK.bas < prev    next >
BASIC Source File  |  2023-02-26  |  42KB  |  603 lines
  1. 10  REM *************************
  2. 20  REM * DCK                   *
  3. 30  REM * BY LES STEWART        *
  4. 40  REM * COPYRIGHT (C) 1989    *
  5. 50  REM * MINDCRAFT PUBL. CORP. *
  6. 60  REM * CONCORD, MA 01742     *
  7. 70  REM *************************
  8. 80  REM - INITIALIZE 
  9. 90  REM 
  10. 100  HIMEM: 36608:J$ =  CHR$(27) + CHR$(17) + CHR$(24): PRINT J$:DE$ = "THE FILE DCK.SORT MUST BE ON THIS DISK":PD = ( PEEK(48896) = 76)
  11. 110  HOME : VTAB 2: HTAB 10: PRINT "DB CONSTRUCTION KIT"
  12. 120  PRINT : HTAB 18: PRINT "BY": PRINT : HTAB 14: PRINT "LES STEWART"
  13. 130  VTAB 12: HTAB 10: PRINT "COPYRIGHT (C) 1989": PRINT : HTAB 10: PRINT "MINDCRAFT PUBL. CORP."
  14. 140  PRINT : HTAB 10: PRINT "CONCORD, MA 01742"
  15. 150  VTAB 22: HTAB 14: PRINT "PRESS RETURN";: GOSUB 5790
  16. 160 D$ =  CHR$(4):S = 4:J = 38144:Q$ =  CHR$(34)
  17. 170  DIM A$(15),L(15),C$(15),A(15),B$(15),E$(15),M(15),F$(65)
  18. 180  FOR X = 0 TO 15:A(X) = 1:L(X) = 1: NEXT :W = 1:F = 1: ONERR  GOTO 1700
  19. 190  HOME : PRINT : PRINT D$"BLOAD DCK.INPUT": POKE 216,0
  20. 200  HOME : VTAB 5: HTAB 9: PRINT "** CREATE.SCREEN **": PRINT : POKE 34,5
  21. 210  REM - GET 40/80 COLUMN INFO
  22. 220  HOME : IF ( PEEK(64435) + PEEK(64448) <241)  AND PD  THEN K$ = "PR #3": GOTO 270
  23. 230 K$ = "": GOTO 340
  24. 240  REM 
  25. 250  REM 
  26. 260  REM - GET SCREEN WIDTH
  27. 270  HOME : HTAB 5: VTAB 11: PRINT "SCREEN DISPLAY" SPC( 7)"COLUMNS": GOSUB 2530: VTAB 21: HTAB 8: PRINT "QUIT" SPC( 3): IF S = 8  THEN 290
  28. 280  VTAB 11: HTAB 20: INVERSE : PRINT "40";: NORMAL : PRINT "/80": GOTO 300
  29. 290  VTAB 11: HTAB 20: PRINT "40/";: INVERSE : PRINT "80": NORMAL 
  30. 300  GOSUB 5790: IF Z < >8  AND Z < >21  AND Z < >13  AND Z < >27  THEN 300
  31. 310  IF Z = 27  THEN  HOME : END 
  32. 320  IF Z < >13  THEN S = 4 *( ABS(S/4 -2) +1):B = 20 *(S = 8): ON (S = 4) +1 GOTO 290,280
  33. 330  REM - GET FILE NAMES
  34. 340  POKE 34,0: HOME : GOSUB 2500: PRINT : VTAB 1: PRINT  SPC( 13)"FILE NAMES": PRINT  SPC( 13)"**********": PRINT : REM  - 10 *'S
  35. 350  REM 
  36. 360  VTAB 10: PRINT "  INPUT SCREEN:": PRINT : PRINT : PRINT : PRINT : PRINT "  DATA FILE:"
  37. 370  PRINT : VTAB 7: PRINT  SPC( 4)"DO YOU WANT A CATALOG? Y/N  ";: HTAB 32: GET ZA$: IF ZA$ < >"N"  AND ZA$ < > CHR$(110)  AND ZA$ < >"Y"  AND ZA$ < > CHR$(121)  AND ZA$ < > CHR$(27)  THEN 370
  38. 380  IF ZA$ =  CHR$(27)  THEN 200
  39. 390  PRINT ZA$: IF ZA$ = "Y"  OR ZA$ =  CHR$(121)  THEN  GOSUB 5400: GOTO 340
  40. 400 Z$ = A$:H = 0:V = 10:M = 64: POKE 255,0: GOSUB 1630: IF A GOTO 370
  41. 410  HTAB 1: VTAB 19: PRINT "PLEASE WAIT";
  42. 420  GOSUB 5610:A$ = Z$: IF E < >0  THEN 400
  43. 430  HTAB 1: VTAB 19: PRINT  SPC( 13);:Z$ = B$
  44. 440 Z$ = B$:H = 0:V = 15:M = 61: GOSUB 1630: IF A GOTO 400
  45. 450  HTAB 1: VTAB 19: PRINT "PLEASE WAIT";: GOSUB 5610:B$ = Z$: IF E < >0  THEN 440
  46. 460  IF B$ = A$  THEN E = 1: GOSUB 5700: GOTO 440
  47. 470  REM - GET # OF FIELDS
  48. 480  HOME : GOSUB 2500: VTAB 10: HTAB 5: PRINT "HOW MANY FIELDS? (MAX 12) "F:H = 30:V = 9:M = 2:Z$ =  STR$(F): GOSUB 1630: IF A GOTO 340
  49. 490 F =  VAL(Z$): IF F <1  OR F >12  THEN 480
  50. 500  REM - GET FIELD 'NAMES'
  51. 510  PRINT J$: HOME :M = 30 +(S = 8) *4: GOSUB 2500: PRINT : VTAB 2: HTAB 5: PRINT "FIELD NAMES ("M" CHARACTERS MAX)": PRINT : FOR X = 1 TO F: HTAB 2: VTAB 4 +X *(1 +(F <8)): PRINT  SPC( (X <10))X") "E$(X): NEXT 
  52. 520  FOR X = 1 TO F: IF S = 4  AND  LEN(A$(X)) >30  THEN A$(X) =  LEFT$(A$(X),30)
  53. 530 H = 5:V = 3 +X *(1 +(F <8)):Z$ = E$(X): POKE 255,1: GOSUB 1630
  54. 540 E$(X) = Z$:A$(X) =  STR$(X) +") " +Z$: IF F >9  AND X <10  THEN A$(X) =  CHR$(32) +A$(X)
  55. 550 M(X) =  LEN(A$(X)) +1: IF A  AND X = 1  THEN 480
  56. 560  IF (A)  THEN X = X -1: GOTO 530
  57. 570  NEXT 
  58. 580  REM - GET LENGTHS OF FIELDS
  59. 590  IF S = 8  THEN  PRINT D$K$: PRINT 
  60. 600  HOME : GOSUB 2500: PRINT : VTAB 2: HTAB 6 +B: PRINT "FIELD LENGTH - MAXIMUM:": FOR X = 1 TO F: IF S = 4  AND L(X) >39 -M(X)  THEN L(X) = 39 -M(X)
  61. 610  HTAB 2: VTAB 4 +X *(1 +(F <8)): PRINT A$(X)" "L(X): NEXT : FOR X = 1 TO F
  62. 620 Z = 39 -M(X):Z = Z *(S = 4) +40 *(S = 8): PRINT : HTAB 31 +B: VTAB 2: PRINT Z SPC( 3)
  63. 630 H = M(X) +1:V = 3 +X *(1 +(F <8)):M = 2:Z$ =  STR$(L(X)): POKE 255,0: GOSUB 1630
  64. 640  IF A  AND X = 1  THEN 510
  65. 650  IF (A)  THEN X = X -1: GOTO 620
  66. 660 L(X) =  VAL(Z$): IF L(X) <1  OR L(X) >Z  THEN  PRINT  CHR$(7);:L(X) = 0: GOTO 630
  67. 670  NEXT :L(0) = 4
  68. 680  REM - GET 'PROMPT' TEXT
  69. 690  IF S = 8  THEN  PRINT D$K$: PRINT 
  70. 700  HOME : GOSUB 2500: PRINT : VTAB 2: HTAB 6 +B: PRINT "INPUT PROMPTS ("20 +29 *(B >0)" CHAR MAX)"
  71. 710  FOR X = 1 TO F
  72. 720  FOR Y = 1 TO F: PRINT : VTAB 4 +Y *(1 +(F <8)): IF Y = X  THEN  INVERSE 
  73. 730  PRINT A$(Y): NORMAL : NEXT : VTAB 19: PRINT  SPC( 36)
  74. 740 H = 5:V = 18:M = 20 +29 *(B >0):Z$ = B$(X): POKE 255,1: GOSUB 1630
  75. 750 B$(X) = Z$: IF A  AND X = 1  THEN 590
  76. 760  IF (A)  THEN X = X -1: GOTO 720
  77. 770  NEXT 
  78. 780  REM - GET DEFAULT INPUT
  79. 790  HOME : GOSUB 2500: PRINT : VTAB 2: HTAB 15 +B: PRINT "DEFAULTS"
  80. 800  FOR X = 1 TO F: IF S = 4  AND  LEN(C$(X)) >L(X)  THEN C$(X) =  LEFT$(C$(X),L(X))
  81. 810  PRINT : VTAB 4 +X *(1 +(F <8)): PRINT A$(X)" "C$(X): NEXT : FOR X = 1 TO F
  82. 820 H = M(X):V = 3 +X *(1 +(F <8)):M = L(X):Z$ = C$(X): POKE 255,0: GOSUB 1630
  83. 830 C$(X) = Z$: IF A  AND X = 1  THEN 690
  84. 840  IF (A)  THEN X = X -1: GOTO 820
  85. 850  NEXT 
  86. 860  REM - GET REQUIRED/NOT REQUIRED INFO
  87. 870  HOME : GOSUB 2500: PRINT : VTAB 2: HTAB 9 +B: PRINT "INPUT MANDATORY? Y/N": FOR X = 1 TO F: HTAB 2: VTAB 4 +X *(1 +(F <8)): PRINT A$(X)" " CHR$(78 +(A(X) = 1) *11): NEXT 
  88. 880  FOR X = 1 TO F
  89. 890 H = M(X) +1:V = 3 +X *(1 +(F <8)):M = 1:Z$ =  CHR$(78 +11 *(A(X) = 1)): POKE 255,0: GOSUB 1630
  90. 900  IF A  AND X = 1  THEN 790
  91. 910  IF (A)  THEN X = X -1: GOTO 890
  92. 920  IF Z$ < >"Y"  AND Z$ < > CHR$(121)  AND Z$ < >"N"  AND Z$ < > CHR$(110)  THEN 890
  93. 930 A(X) = 0 +(Z$ = "Y") +(Z$ =  CHR$(121)): NEXT 
  94. 940  REM - GET RECORD LENGTH
  95. 950  IF S = 8  THEN  PRINT D$K$: PRINT 
  96. 960  HOME : GOSUB 2500: PRINT : VTAB 1: HTAB 12: PRINT "# OF CHARACTERS":Z = 0: FOR X = 1 TO F: HTAB 2: VTAB 1 +X *(1 +(F <8)): PRINT A$(X) SPC( 1 +(L(X) <10))L(X):Z = Z +L(X): NEXT 
  97. 970  PRINT : HTAB 2:Q = F +Z:Q1 = Q: PRINT "DELIMITERS: "F;: PRINT  SPC( 3)"TOTAL CHARACTERS: "Q
  98. 980  PRINT : HTAB 1: VTAB 19: PRINT  SPC( 35);: PRINT : HTAB 2: VTAB 19: PRINT "RECORD LENGTH "Q SPC( 3):H = 15:V = 18:M = 4:Z$ =  STR$(Q): POKE 255,0: GOSUB 1630
  99. 990  IF A GOTO 870
  100. 1000 Q =  VAL(Z$): IF (Q <2 *F)  OR Q >Z +F  THEN Q = Q1: GOTO 980
  101. 1010  REM - GET SCREEN TITLE
  102. 1020  PRINT J$: HOME : GOSUB 2500: PRINT : VTAB 2: HTAB 3: PRINT "SCREEN TITLE (25 CHARACTERS MAX)":Z$ = C$:H = 2: POKE 255,1:V = 7:M = 25: GOSUB 1630:C$ = Z$: IF A GOTO 950
  103. 1030  REM - GET FINAL INSTRUCTIONS
  104. 1040  HOME :Z$(1) = "CREATE THE SCREEN & DATA FILES":Z$(2) = "CREATE THE SCREEN FILE ONLY":Z$(3) = "REVIEW ENTRIES":Z$(4) = "PRINT DATA FIELD NUMBERS":Z$(5) = "QUIT"
  105. 1050  PRINT : HTAB 10: PRINT "*** CREATE SCREEN ***":M2 = 5:ZZ = 123: GOSUB 5290: HOME : IF Z = 27  THEN 1020
  106. 1060  ON M1 GOTO 1100,1200,200,6000,1070
  107. 1070  PRINT : HTAB 7: VTAB 10: PRINT  CHR$(7)"QUIT. ARE YOU SURE? Y/N ";: GET Z$: IF Z$ < >"Y"  AND Z$ < > CHR$(121)  THEN 1040
  108. 1080  HOME : END 
  109. 1090  REM - ESTABLISH DATA FILE
  110. 1100  VTAB 10: HTAB 8: PRINT  CHR$(7)"PLACE DATA DISK IN DRIVE": PRINT : HTAB 13: PRINT "AND PRESS RETURN";: GOSUB 5790: IF Z < >13  AND Z < >27  THEN 1100
  111. 1110  IF Z = 27  THEN 1040
  112. 1120  HOME :W = 2: ONERR  GOTO 1140
  113. 1130  PRINT D$"DELETE"B$: ONERR  GOTO 1700
  114. 1140  HOME : VTAB 10: PRINT  SPC( 11)"PREPARING DATA FILE": PRINT : IF  LEN(B$) <38  THEN  PRINT  SPC(  INT((37 - LEN(B$))/2));
  115. 1150  PRINT B$
  116. 1160  PRINT D$"OPEN "B$",L"Q: PRINT D$"WRITE"B$",R0": PRINT 0: PRINT D$"CLOSE"
  117. 1170  HOME : PRINT : IF  LEN(B$) <38  THEN  PRINT  SPC(  INT((37 - LEN(B$))/2));
  118. 1180  PRINT B$: PRINT : PRINT  SPC( 14)"IS COMPLETE"
  119. 1190  REM - PREPARE EXEC FILE 'SCREEN.E'
  120. 1210 X$ = "SCREEN.E"
  121. 1220  VTAB 10: HTAB 8: PRINT  CHR$(7)"PLACE MAIN DISK IN DRIVE": PRINT : HTAB 13: PRINT "AND PRESS RETURN";: GOSUB 5790: IF Z < >13  AND Z < >27  THEN 1220
  122. 1230  IF Z = 27  THEN 1040
  123. 1240  HOME :W = 3: ONERR  GOTO 1700
  124. 1250  REM 
  125. 1260  REM 
  126. 1270  REM 
  127. 1280  REM 
  128. 1290  REM 
  129. 1300  HOME : VTAB 10: PRINT  SPC( 10)"CREATING EXEC FILE": PRINT : IF  LEN(X$) <38  THEN  PRINT  SPC(  INT((37 - LEN(X$))/2));
  130. 1310  PRINT X$: PRINT D$"OPEN"X$: PRINT D$"CLOSE": PRINT D$"DELETE"X$: PRINT D$"OPEN"X$: PRINT D$"WRITE"X$: PRINT "NEW"
  131. 1320  LIST 1760,5790: REM - FIRST PORTION OF GENERATED PROGRAM
  132. 1330  GOTO 5810: REM - SECOND PORTION OF GENERATED PROGRAM
  133. 1340  PRINT "SAVE "A$: REM - SAVE GENERATED PROGRAM
  134. 1350  PRINT "NEW": REM - SHORT PROGRAM TO CLEANUP AFTER GENERATING PROGRAM
  135. 1360  PRINT "10 D$=CHR$(4):POKE34,0:HOME"
  136. 1370  PRINT "20 PRINTD$"Q$"CLOSE"X$Q$
  137. 1380  PRINT "30 VTAB10:PRINT"Q$"DELETING"Q$":PRINT:PRINT"Q$X$Q$
  138. 1390  PRINT "40 PRINTD$"Q$"DELETE"X$Q$
  139. 1400  PRINT "50 HOME:VTAB10:HTAB15:?CHR$(7)"Q$"ALL DONE"Q$":END"
  140. 1410  PRINT "RUN"
  141. 1420  PRINT D$"CLOSE"X$
  142. 1430  REM - ESTABLISH INPUT SCREEN PROGRAM BY EXECING SCREEN.E
  143. 1440  HOME : VTAB 8: PRINT  SPC( 14)"PREPARING": PRINT : IF  LEN(A$) <38  THEN  PRINT  SPC(  INT((37 - LEN(A$))/2));
  144. 1450  PRINT A$:W = 4: ONERR  GOTO 1700
  145. 1460  PRINT : PRINT  SPC( 7)"(TAKES ABOUT 3 MINUTES)": POKE 34,15: PRINT D$"EXEC"X$: POKE 216,0: END 
  146. 1470  REM - SUBROUTINE: CHECK DISK FILES
  147. 1480  REM 
  148. 1490  REM 
  149. 1500  REM 
  150. 1510  REM 
  151. 1520  REM 
  152. 1530  REM 
  153. 1540  REM 
  154. 1550  REM 
  155. 1560  REM 
  156. 1570  REM 
  157. 1580  REM 
  158. 1590  REM 
  159. 1600  REM 
  160. 1610  PRINT D$"DELETE"ZP$ +"/" +ZF$: RETURN 
  161. 1620  REM - SUBROUTINE: 'INPUT'
  162. 1630  CALL 37969: IF Z$ < >""  THEN YS = J: FOR XS = 1 TO  LEN(Z$): POKE YS, ASC( MID$ (Z$,XS,1)) +128:YS = YS +1: NEXT 
  163. 1640  POKE 249,H: POKE 250,V: POKE 251,M: CALL 37632
  164. 1650 A = 0: IF  PEEK(38142) = 27  THEN A = 1
  165. 1660 Z$ = "": IF  PEEK(252) = M  AND  PEEK(253) = 0  THEN 1680
  166. 1670  FOR XS = J + PEEK(252) TO J + PEEK(253):Z$ = Z$ + CHR$( PEEK(XS)): NEXT 
  167. 1680  PRINT : HTAB H +1: VTAB V +1: PRINT Z$ SPC( M - LEN(Z$)): RETURN 
  168. 1690  REM - ERROR MESSAGE
  169. 1700  HOME : POKE 216,0: CALL 62248: PRINT  CHR$(7): PRINT D$"CLOSE": HTAB 14: PRINT "I/O PROBLEM": PRINT 
  170. 1710  HTAB 9: PRINT "CHECK DISK & DRIVE AND": PRINT : HTAB 9: PRINT "PRESS RETURN TO RESTART": PRINT : HTAB 12: PRINT "OR ESC TO END";: GOSUB 5790
  171. 1720  IF Z = 27  THEN  HOME : END 
  172. 1730  IF Z < >13  THEN 1700
  173. 1740  HOME : ON W GOTO 180,1100,1220,1440
  174. 1750  REM *** GENERATED PROGRAM - INITIALIZATION & MENU ***
  175. 1760  HIMEM: 35840: HOME :J$ =  CHR$(27) + CHR$(17) + CHR$(24): GOSUB 5810: ONERR  GOTO 5970
  176. 1770 J = 38144:PA = 249:PB = 250:PC = 251:PD = 252:PE = 253:PF = 255:PG = 38142:PH = 38143:A$(0) = "RECORD #":AH = 38006:D$ =  CHR$(4): DIM F$(64): PRINT D$"VERIFY DCK.SORT"
  177. 1780  HOME : PRINT  SPC( 8)"CONSTRUCTED DATABASE": PRINT "COPYRIGHT(C) 1989 MINDCRAFT PUBL. CORP.": PRINT : PRINT  SPC( 2)"MAIN MENU: "C$
  178. 1790 ZZ = 124:Z$(1) = "ADD/MODIFY A RECORD":Z$(2) = "PRODUCE A REPORT":Z$(3) = "SEARCH":Z$(4) = "PURGE RECORDS":Z$(5) = "CHANGE DATA FILE NAME":Z$(6) = "CATALOG A DISK":Z$(7) = "QUIT":L(0) = 4:M2 = 7: GOSUB 5290:ZZ = 0
  179. 1800  IF M1 = 7  THEN  HOME : END 
  180. 1810 W = 1:ZF$ = "DCK.INPUT": ONERR  GOTO 5730
  181. 1820  HOME : IF  PEEK(37632) < >162  OR  PEEK(37634) < >142  THEN : PRINT D$"BLOAD DCK.INPUT"
  182. 1830  POKE 216,0: ON M1 GOTO 1860,2550,4860,5070,5240,5400
  183. 1840  REM *** GENERATED PROGRAM - INPUT SCREEN SECTION ***
  184. 1850  REM - PRINT SCREEN & GET # OF RECORDS
  185. 1860  PRINT : PRINT D$K1$: GOSUB 2430:ZF$ = B$:W = 2: ONERR  GOTO 5730
  186. 1870  PRINT D$"OPEN"ZF$",L"Q: PRINT D$"READ"ZF$",R0": INPUT S: PRINT D$"CLOSE ": POKE 216,0
  187. 1880  REM - CLEAR FIELDS & GET RECORD #
  188. 1890 AD = S +1: PRINT : FOR X = 1 TO F: VTAB X *1 +4: HTAB M(X) +1: PRINT  SPC( L(X)): NEXT 
  189. 1900  GOSUB 2490: PRINT  SPC( 3)"ESC = QUIT" SPC( 6)"RETURN = ACCEPT "AD: PRINT : PRINT  SPC( 3)"OR ENTER NUMBER FOR PREVIOUS RECORD"
  190. 1910 A% = 0:A$ =  STR$(AD):H = 10:V = 2:M = 4: GOSUB 5530: IF A >0  THEN  HOME : GOTO 1780
  191. 1920  IF A$ = ""  THEN Z = AD: GOTO 1940
  192. 1930 Z =  VAL(A$): IF Z <1  OR Z >AD  THEN 1910
  193. 1940 AD = Z: VTAB 3: HTAB 11: PRINT  SPC( 10);: HTAB 11: PRINT AD
  194. 1950  IF AD < >S +1  THEN 2040
  195. 1960  REM - GET DATA FOR NEW RECORD
  196. 1970  GOSUB 2500:A% = 1: FOR X = 1 TO F:D$(X) = C$(X): NEXT : FOR X = 1 TO F
  197. 1980  PRINT : VTAB 3: HTAB 18: PRINT  SPC( 20 +B *2): VTAB 3: HTAB 18: PRINT B$(X):A$ = D$(X):H = M(X):V = X *1 +3:M = L(X): GOSUB 5530
  198. 1990 D$(X) = A$: IF A$ = ""  AND A(X) = 1  AND A < >27  THEN  GOSUB 2460: GOTO 1980
  199. 2000  PRINT : VTAB 3: HTAB 18: PRINT  SPC( 20 +B *2): IF A >27  THEN 1980
  200. 2010  IF A = 27  THEN X = X -2: IF X <0  THEN X = F: GOTO 1890
  201. 2020  NEXT : GOTO 2100
  202. 2030  REM - GET DATA FOR EXISTING RECORD FROM FILE
  203. 2040  PRINT D$"OPEN"B$",L"Q: PRINT D$"READ"B$",R"AD: FOR X = 1 TO F: INPUT D$(X): NEXT : PRINT D$"CLOSE"
  204. 2050  FOR X = 1 TO F: IF D$(X) = ""  THEN 2070
  205. 2060 Z$ = "": FOR Y = 1 TO  LEN(D$(X)):ZB =  ASC( MID$ (D$(X),Y,1)):Z$ = Z$ + CHR$(ZB +43 *(ZB = 1) +56 *(ZB = 2)): NEXT :D$(X) = Z$
  206. 2070  VTAB X *1 +4: HTAB M(X) +1: PRINT D$(X);: NEXT 
  207. 2080  REM 
  208. 2090  REM - GET COMMAND
  209. 2100  GOSUB 2490: PRINT  SPC( 1)"P = PREV RECORD" SPC( 8)"N = NEXT RECORD"
  210. 2110  PRINT  SPC( 1)"Q = QUIT" SPC( 6)"F = FILE" SPC( 6)"C = CANCEL": PRINT  SPC( 1)"D = DELETE" SPC( 4)"# = MODIFY" SPC( 4)G$((S$ = ""))
  211. 2120 A$ = "":H = 3:V = 18:M = 2: GOSUB 5530:Z$ = A$: IF ((Z$ = "S"  OR Z$ =  CHR$(115))  AND S$ = "")  OR A$ = ""  THEN 2120
  212. 2130  IF (Z$ = "S"  OR Z$ =  CHR$(115))  AND AD = AF  THEN 5040
  213. 2140  IF ((Z$ = "P"  OR Z$ =  CHR$(112))  AND AD = 1)  OR ((Z$ = "N"  OR Z$ =  CHR$(110))  AND AD =  >S)  THEN 2120
  214. 2150 Z =  ASC(Z$): IF A% = 0  OR (Z$ < >"C"  AND Z < >99  AND Z$ < >"Q"  AND Z < >113  AND Z$ < >"P"  AND Z < >112  AND Z$ < >"N"  AND Z < >110  AND Z$ < >"S"  AND Z < >115)  THEN 2170
  215. 2160  GOSUB 2490: PRINT  CHR$(7): PRINT "ARE YOU SURE? Y/N": PRINT : PRINT "(RECORD HAS NOT BEEN FILED) ";: GET ZA$: IF ZA$ < >"Y"  AND ZA$ < > CHR$(121)  THEN 2100
  216. 2170  IF Z$ = "Q"  OR Z = 113  THEN  HOME : RUN 1760
  217. 2180  IF Z$ = "C"  OR Z = 99  THEN  GOSUB 2430: GOTO 1890
  218. 2190  IF Z$ < >"D"  AND Z < >100  THEN 2220
  219. 2200  GOSUB 2490: PRINT : PRINT  CHR$(7)" DELETE? ARE YOU SURE? Y/N ";: GET ZA$: IF ZA$ < >"Y"  AND ZA$ < > CHR$(121)  THEN 2100
  220. 2210  FOR X = 1 TO F:D$(X) = "": NEXT :D$(1) =  CHR$(5): GOTO 2380
  221. 2220  IF Z$ < >"P"  AND Z < >112  AND Z$ < >"N"  AND Z < >110  THEN 2240
  222. 2230 Z% = Z% +(Z = 110  OR Z$ = "N") -(Z = 112  OR Z$ = "P"):AD = AD +(Z = 110  OR Z$ = "N") -(Z = 112  OR Z$ = "P"): GOSUB 2430: VTAB 3: HTAB 11: PRINT  SPC( 10);: HTAB 11: PRINT AD:A% = 0: GOTO 2040
  223. 2240  IF (Z$ = "S"  OR Z = 115)  AND AD <AF +1  THEN Z% = Z% +(AD <AF +1): HOME : GOTO 4980
  224. 2250 X =  VAL(Z$): IF X = 0  OR X >F  THEN 2310
  225. 2260 A% = 1: GOSUB 2500: PRINT : VTAB 3: HTAB 18: PRINT  SPC( 20 +B *2): VTAB 3: HTAB 18: PRINT B$(X):A$ = D$(X):H = M(X):V = X *1 +3:M = L(X): GOSUB 5530
  226. 2270 D$(X) = A$: IF A$ = ""  AND A(X) = 1  AND A < >27  THEN  GOSUB 2460: GOTO 2260
  227. 2280  PRINT : VTAB 3: HTAB 18: PRINT  SPC( 20 +B *2): IF A >27  THEN 2260
  228. 2290  IF A = 27  THEN X = X -1 *(X >1): GOTO 2260
  229. 2300  GOTO 2100
  230. 2310  IF Z$ < >"F"  AND Z < >102  THEN 2120
  231. 2320 Z = 0: FOR X = 1 TO F:Z = Z + LEN(D$(X)): NEXT : IF Z <Q +1  THEN 2350
  232. 2330  PRINT  CHR$(7): VTAB 23: PRINT "TOO LONG. DELETE "Z -Q" CHARACTERS ";: GET Z$
  233. 2340  PRINT : VTAB 23: PRINT  SPC( 35);: GOTO 2120
  234. 2350  ONERR  GOTO 5980
  235. 2360  IF AD <S  THEN 2380
  236. 2370  PRINT D$"OPEN"B$",L"Q: PRINT D$"WRITE"B$",R0": PRINT AD: PRINT D$"CLOSE"
  237. 2380 A% = 0: PRINT : PRINT D$"OPEN"B$",L"Q: PRINT D$"WRITE"B$",R"AD
  238. 2390  FOR X = 1 TO F: IF D$(X) = ""  OR D$(X) =  CHR$(5)  THEN Z$ = D$(X): GOTO 2410
  239. 2400 Z$ = "": FOR Y = 1 TO  LEN(D$(X)):ZB =  ASC( MID$ (D$(X),Y,1)):Z$ = Z$ + CHR$(ZB -43 *(ZB = 44) -56 *(ZB = 58)): NEXT 
  240. 2410  PRINT Z$: NEXT : PRINT D$"CLOSE":S = S +(AD = S +1): GOTO 1890
  241. 2420  REM - SUBROUTINE: SET UP SCREEN
  242. 2430  PRINT : PRINT D$K1$: HOME : PRINT  SPC( 1)"ADD/MODIFY: "C$: PRINT : PRINT "RECORD #:"
  243. 2440  FOR X = 1 TO F: HTAB 1: VTAB X *1 +4: PRINT A$(X): NEXT : RETURN 
  244. 2450  REM - SUBROUTINE: MANDATORY INPUT
  245. 2460  PRINT : VTAB 19: PRINT  CHR$(7)"INPUT IS REQUIRED.  PRESS RETURN";: GOSUB 5790
  246. 2470  PRINT : VTAB 19: PRINT  SPC( 38);: RETURN 
  247. 2480  REM - SUBROUTINE: PREPARE LOWER SCREEN 
  248. 2490  POKE 34,18: HOME : FOR XM = 1488 TO 1527: POKE XM,173: NEXT : POKE 34,0: VTAB 21: RETURN 
  249. 2500  GOSUB 2490: PRINT  SPC( 4)"ESC = BACK UP" SPC( 2)"<-  -> = MOVE CURSOR": PRINT  SPC( 1)"RETURN = ACCEPT" SPC( 3)"CTRL T = TRUNCATE": PRINT  SPC( 1)"CTRL D = DELETE" SPC( 3)"CTRL I = INSERT";
  250. 2510  VTAB 18: PRINT : RETURN 
  251. 2520  GOSUB 2490: PRINT  SPC( 1)"ESC = BACK UP" SPC( 3)"RETURN = ACCEPT OPTION": PRINT : PRINT  SPC( 6)"<-- OR --> = TOGGLE OPTION";: VTAB 18: PRINT : RETURN 
  252. 2530  GOSUB 2490: PRINT  SPC( 1)"ESC = BACK UP" SPC( 10)"RETURN = ACCEPT": PRINT : PRINT  SPC( 8)"<-- OR --> = CHANGE";: VTAB 18: PRINT : RETURN 
  253. 2540  REM *** GENERATED PROGRAM - REPORT SECTION ***
  254. 2550  FOR X = 0 TO 9: FOR Y = 0 TO F:J(X,Y) = 1: NEXT Y,X
  255. 2560  REM - OBTAIN REPORT OPTIONS
  256. 2570  HOME : FOR X = 0 TO 9: READ R$(X): NEXT :Y = 0: FOR X = AH TO AH +9:G(Y) =  PEEK(X):Y = Y +1: NEXT 
  257. 2580  FOR X = 0 TO 6: READ Q$(X): NEXT :Y = 0: FOR X = AH +10 TO AH +16:F(Y) =  PEEK(X):Y = Y +1: NEXT 
  258. 2590  DATA OUTPUT,PRINTER START,PRINTER STOP,PRINTER WIDTH,SCREEN WIDTH
  259. 2600  DATA PAGE LENGTH,TEXT LENGTH,PAPER FEED,SORTING?,SELECTION?
  260. 2610  DATA # OF HEADING COLUMNS,# OF HEADING LINES,# OF BODY COLUMNS,# OF BODY LINES,# OF LINES BETWEEN BODY ITEMS,# OF TITLE LINES,REPEAT TITLE ON ALL PAGES?
  261. 2620 P$(0,0) = "PRINTER":P$(0,1) = "SCREEN ":P$(4,0) = "40":P$(4,1) = "80":P$(7,0) = "SINGLE    ":P$(7,1) = "CONTINUOUS":P$(8,0) = "Y":P$(8,1) = "N":P$(9,0) = "Y":P$(9,1) = "N"
  262. 2630  PRINT : PRINT : PRINT  SPC( 11)"REPORT OPTIONS": PRINT 
  263. 2640 D% = 0: GOSUB 2810: GOSUB 2520
  264. 2650  GOSUB 2840: GOSUB 5790: IF (Z < >27  AND Z < >13  AND Z < >8  AND Z < >21)  OR Z = 10  THEN 2650
  265. 2660 D% = D% +(Z = 13) -(Z = 27): IF D% =  -1  THEN  RUN 1760
  266. 2670  IF (D% = 3  OR D% = 5)  AND Z = 13  AND G(0)  THEN D% = D% +(D% = 3) +3 *(D% = 5)
  267. 2680  IF (D% = 3  OR D% = 7)  AND Z = 27  AND G(0)  THEN D% = D% -(D% = 3) -3 *(D% = 7)
  268. 2690  IF D% = 10  THEN 2900
  269. 2700  GOSUB 2810: IF Z = 13  OR Z = 27  THEN 2650
  270. 2710  ON D% +1 GOTO 2720,2740,2750,2760,2770,2780,2790,2730,2730,2730
  271. 2720 G(0) =  ABS(G(0) -1):G(5) = 24 *G(0) +66 *(G(0) = 0):G(6) = 24 *G(0) +55 *(G(0) = 0):G(7) = (G(0) = 0):G(3) = G(0) *(40 +40 *G(4)) +80 *(G(0) = 0): GOTO 2650
  272. 2730 G(D%) =  ABS(G(D%) -1): GOTO 2650
  273. 2740 G(1) = G(1) +(Z = 21) -(Z = 8) +4 *(G(1) = 1  AND Z = 8) -4 *(G(1) = 4  AND Z = 21): GOTO 2650
  274. 2750 G(2) = G(2) +(Z = 21) -(Z = 8) +4 *(G(2) = 0  AND Z = 8) -4 *(G(2) = 4  AND Z = 21): GOTO 2650
  275. 2760 G(3) = G(3) -((Z = 8) *(G(3) < >10)) +((Z = 21) *(G(3) < >150)): GOTO 2650
  276. 2770 G(4) =  ABS(G(4) -1):G(3) = G(3) *(G(0) = 0) +G(0) *40 +40 *G(4) *G(0): GOTO 2650
  277. 2780 G(5) = G(5) -((Z = 8) *(G(5) < >10)) +((Z = 21) *(G(5) < >150)):G(5) = G(5) +((G(6) >G(5)) *(G(6) -G(5))): GOTO 2650
  278. 2790 G(6) = G(6) -((Z = 8) *(G(6) < >10)) +((Z = 21) *(G(6) < >150)):G(6) = G(6) -((G(6) >G(5)) *(G(6) -G(5))): GOTO 2650
  279. 2800  REM - SUBROUTINE: PRINT REPORT OPTION NAMES
  280. 2810  PRINT : FOR XS = 0 TO 9: VTAB XS +5: PRINT  SPC( 3): IF XS = D%  THEN  INVERSE 
  281. 2820  PRINT R$(XS): NORMAL : NEXT : RETURN 
  282. 2830  REM - SUBROUTINE: PRINT REPORT OPTIONS
  283. 2840 N$(0) = P$(0,G(0)):N$(1) = "PR #" + STR$(G(1)):N$(2) = "PR #" + STR$(G(2)):N$(3) =  STR$(G(3)) +" ":N$(4) = P$(4,G(4))
  284. 2850 N$(5) =  STR$(G(5)) +" ":N$(6) =  STR$(G(6)) +" ":N$(7) = P$(7,G(7)):N$(8) = P$(8,G(8)):N$(9) = P$(9,G(9))
  285. 2860 F$ = "PR#" + STR$(G(1)):G$ = "PR#" + STR$(G(2)):S = 4 +4 *G(4)
  286. 2870 Y = 0: FOR X = AH TO AH +9: POKE X,G(Y):Y = Y +1: NEXT 
  287. 2880  FOR XS = 0 TO 9: VTAB XS +5: HTAB 25: PRINT N$(XS): NEXT : RETURN 
  288. 2890  REM  - GET FORMAT OPTIONS
  289. 2900  HOME : PRINT : PRINT  SPC( 10)"FORMAT OPTIONS":P$(6,0) = "N":P$(6,1) = "Y"
  290. 2910 D% = 0: GOSUB 3050: GOSUB 2520
  291. 2920  GOSUB 3080: VTAB 19: HTAB 2: GOSUB 5790: IF (Z < >27  AND Z < >13  AND Z < >8  AND Z < >21)  OR Z = 10  THEN 2920
  292. 2930 D% = D% +(Z = 13) -(Z = 27): IF D% =  -1  THEN  RESTORE : GOTO 2570
  293. 2940  IF D% = 7  THEN 3130
  294. 2950  GOSUB 3050: IF Z = 13  OR Z = 27  THEN 2920
  295. 2960  ON D% +1 GOTO 2970,2980,2990,3000,3010,3020,3030
  296. 2970 F(0) = F(0) -((Z = 8) *(F(0) < >0)) +((Z = 21) *(F(0) < >9)):F(1) = ((F(1) +((F(1) = 0)  AND (F(0) >0)))) *(F(0) >0): GOTO 2920
  297. 2980 F(1) = F(1) -((Z = 8) *(F(1) < >0)) +((Z = 21) *(F(1) < >5)):F(0) = ((F(0) +((F(0) = 0)  AND (F(1) >0)))) *(F(1) >0): GOTO 2920
  298. 2990 F(2) = F(2) -((Z = 8) *(F(2) < >1)) +((Z = 21) *(F(2) < >9)):: GOTO 2920
  299. 3000 F(3) = F(3) -((Z = 8) *(F(3) < >1)) +((Z = 21) *(F(3) < >F)): GOTO 2920
  300. 3010 F(4) = F(4) -((Z = 8) *(F(4) < >0)) +((Z = 21) *(F(4) < >5)): GOTO 2920
  301. 3020 F(5) = F(5) -((Z = 8) *(F(5) < >0)) +((Z = 21) *(F(5) < >8)): GOTO 2920
  302. 3030 F(6) =  ABS(F(6) -1): GOTO 2920
  303. 3040  REM - SUBROUTINE: PRINT FORMAT OPTION NAMES
  304. 3050  PRINT : FOR XS = 0 TO 6: VTAB 2 *XS +5: PRINT  SPC( 1): IF XS = D%  THEN  INVERSE 
  305. 3060  PRINT Q$(XS): NORMAL : NEXT : RETURN 
  306. 3070  REM - SUBROUTINE: PRINT FORMAT OPTIONS
  307. 3080 F(6) = F(6) *(F(5) < >0): FOR XS = 0 TO 5:N$(XS) =  STR$(F(XS)) +" ": NEXT :N$(6) = P$(6,F(6))
  308. 3090 Y = 0: FOR X = AH +10 TO AH +16: POKE X,F(Y):Y = Y +1: NEXT 
  309. 3100 F$ = "PR#" + STR$(G(1)):G$ = "PR#" + STR$(G(2)):S = 4 +4 *G(4)
  310. 3110  FOR XS = 0 TO 6: VTAB 2 *XS +5: HTAB 36: PRINT N$(XS): NEXT : RETURN 
  311. 3120  REM - GET HEADING TEXT
  312. 3130  IF F(0) = 0  THEN 3270
  313. 3140  FOR Y = 0 TO F(0) -1: HOME : GOSUB 2500: PRINT : VTAB 1: PRINT  SPC( 11)"HEADING COLUMN # "Y +1: PRINT : PRINT "COL":Z = 0: FOR X = 0 TO F(1) -1: PRINT : VTAB 2 +2 *(X +1): PRINT  SPC( 6)"LINE "X +1
  314. 3150  VTAB 19: PRINT  SPC( 2)"ENTER HORIZONTAL POSITION"
  315. 3160 Z = 0:Q(Y,X) = Z: IF Y >0  THEN Q(Y,X) = Q(Y -1,X) + LEN(J$(Y -1,X)):Z = Q(Y,X)
  316. 3170 A$ =  STR$(Q(Y,X)):H = 0:V = 2 +2 *(X +1):M =  LEN( STR$(G(3))): GOSUB 5530: IF A  AND X >0  THEN X = X -1: GOTO 3170
  317. 3180  IF A  AND Y >0  THEN Y = Y -2: GOTO 3250
  318. 3190  IF A GOTO 2900
  319. 3200 Q(Y,X) =  VAL(A$): IF (Q(Y,X) = 0  AND A$ < >"0")  OR Q(Y,X) >G(3) -1  OR Q(Y,X) <Z  THEN  PRINT  CHR$(7): GOTO 3160
  320. 3210  VTAB 19: PRINT  SPC( 2)"ENTER TEXT FOR HEADING" SPC( 3)
  321. 3220 A$ = J$(Y,X):H = 4:V = 2 +2 *(X +1):M = 30: GOSUB 5530: IF A GOTO 3170
  322. 3230 J$(Y,X) = A$: IF (Q(Y,X) + LEN(A$) >G(3))  THEN  PRINT  CHR$(7): VTAB 19: PRINT "TOO LONG.  PRESS RETURN" SPC( 6);: GOSUB 5790: PRINT : GOTO 3210
  323. 3240  NEXT X
  324. 3250  NEXT Y
  325. 3260  REM - GET BODY TEXT & FIELDS
  326. 3270  FOR Y = 0 TO F(2) -1: HOME : GOSUB 2530: PRINT : VTAB 1: PRINT " BODY: COLUMN "Y +1",": PRINT : PRINT " COL FIELD # OR TEXT.":Z = 0: FOR X = 0 TO F(3) -1
  327. 3280  GOSUB 2530: PRINT  SPC( 2)"SPECIFY FIELD DATA OR TEXT"
  328. 3290  VTAB 1: HTAB 18: IF J(Y,X) = 0  THEN 3310
  329. 3300  PRINT "LINE "X +1 SPC( 4);: INVERSE : PRINT "FIELD";: NORMAL : PRINT "/TEXT": GOTO 3320
  330. 3310  PRINT "LINE "X +1 SPC( 4);: PRINT "FIELD/";: INVERSE : PRINT "TEXT";: NORMAL 
  331. 3320  GOSUB 5790
  332. 3330  IF (Z < >8  AND Z < >21  AND Z < >13  AND Z < >27)  OR Z = 10  THEN 3320
  333. 3340  IF Z = 27  AND X >0  THEN X = X -1: GOTO 3290
  334. 3350  IF Z = 27  AND Y >0  THEN Y = Y -2: GOTO 3590
  335. 3360  IF Z = 27  AND X = 0  THEN  ON (F(0) = 0) +1 GOTO 3140,2900
  336. 3370  IF Z = 27  THEN 3270
  337. 3380  IF Z = 13  THEN 3400
  338. 3390 J(Y,X) =  ABS(J(Y,X) -1): GOTO 3290
  339. 3400 Z = 0:E(Y,X) = Z: IF Y >0  THEN E(Y,X) = E(Y -1,X) +L( VAL(K$(Y -1,X))) *J(Y -1,X) + LEN(K$(Y -1,X)) *(J(Y -1,X) = 0):Z = E(Y,X)
  340. 3410  GOSUB 2500: PRINT  SPC( 2)"ENTER HORIZONTAL POSITION"
  341. 3420 A$ =  STR$(E(Y,X)):H = 1:V = 4 +X +(X +1) *(F <8):M =  LEN( STR$(G(3))): GOSUB 5530: IF A >0  THEN 3280
  342. 3430 E(Y,X) =  VAL(A$): IF (E(Y,X) = 0  AND A$ < >"0")  OR E(Y,X) >G(3) -1  OR E(Y,X) <Z  THEN  PRINT  CHR$(7): GOTO 3400
  343. 3440  GOSUB 2500: PRINT  SPC( 2)"ENTER TEXT": IF J(Y,X)  THEN  PRINT : VTAB 19: PRINT  SPC( 20): PRINT : HTAB 6: VTAB 5 +X +(X +1) *(F <8): PRINT "FIELD #"
  344. 3450 A$ = K$(Y,X):H = 5 +8 *J(Y,X):V = 4 +X +(X +1) *(F <8):M = 30 -26 *J(Y,X): GOSUB 5530: IF A GOTO 3400
  345. 3460  IF J(Y,X) = 1  AND (( VAL(A$) = 0  AND A$ < >"0")  OR  VAL(A$) >F)  THEN  PRINT  CHR$(7);: GOTO 3440
  346. 3470 K$(Y,X) = A$:W =  VAL(A$) *J(Y,X):ZZ = E(Y,X) + LEN(A$) *(J(Y,X) = 0) +L(W) *J(Y,X)
  347. 3480  IF ZZ >G(3)  THEN  PRINT  CHR$(7): VTAB 19: PRINT "TOO LONG.  PRESS RETURN";: GET ZA$: PRINT : VTAB 19: PRINT  SPC( 23): GOTO 3440
  348. 3490  IF J(Y,X) = 0  THEN 3580
  349. 3500  GOSUB 2530: PRINT  SPC( 2)"SPECIFY LEFT OR RIGHT JUSTIFICATION"
  350. 3510  VTAB 3: HTAB 28: IF C( VAL(K$(Y,X))) = 1  THEN 3530
  351. 3520  INVERSE : PRINT "LEFT";: NORMAL : PRINT "/RIGHT": GOTO 3540
  352. 3530  PRINT "LEFT/";: INVERSE : PRINT "RIGHT": NORMAL 
  353. 3540  VTAB 19: GET Z$:Z =  ASC(Z$): IF Z = 27  THEN  VTAB 3: HTAB 28: PRINT  SPC( 10): GOTO 3280
  354. 3550  IF (Z < >8  AND Z < >21  AND Z < >13)  OR Z = 10  THEN 3540
  355. 3560  IF Z = 13  THEN  PRINT : VTAB 3: HTAB 28: PRINT  SPC( 10): GOTO 3580
  356. 3570 C( VAL(K$(Y,X))) =  ABS(C( VAL(K$(Y,X))) -1): GOTO 3510
  357. 3580  NEXT X
  358. 3590  NEXT Y
  359. 3600  IF F(5) = 0  THEN 3670
  360. 3610  REM - GET REPORT TITLE
  361. 3620  HOME : GOSUB 2500: VTAB 1: PRINT "REPORT TITLE": FOR X = 1 TO F(5): PRINT : PRINT "LINE "X: NEXT 
  362. 3630  FOR X = 1 TO F(5)
  363. 3640 A$ = H$(X):H = 0:V = 1 +2 *X:M = 40: GOSUB 5530: IF A  AND X = 1  THEN X = F(5): NEXT : GOTO 3270
  364. 3650  IF (A)  THEN X = X -1: GOTO 3640
  365. 3660 H$(X) = A$: NEXT 
  366. 3670  IF G(8) = 1  THEN 3830: REM - NO SORT REQUIRED
  367. 3680  REM - GET FIELD TO SORT BY
  368. 3690  HOME : PRINT : HTAB 3: PRINT "WHICH FIELD FOR SORTING?": GOSUB 2530
  369. 3700  FOR X = 0 TO F: PRINT : HTAB 2: VTAB 4 +X +X *(F <8): PRINT " ";: IF K = X  THEN  INVERSE 
  370. 3710  PRINT A$(X): NORMAL : NEXT 
  371. 3720  GOSUB 5790: IF Z = 13  OR Z = 27  THEN  ON 1 *(Z = 13) +2 *(Z = 27  AND F(5) >0) +3 *(Z = 27  AND F(5) = 0) GOTO 3770,3620,3270
  372. 3730  IF Z = 8  OR Z = 11  THEN K = K -1 +F *(K = 0) +(K = 0): GOTO 3700
  373. 3740  IF Z = 21  OR Z = 10  THEN K = K +1 -F *(K = F) -(K = F): GOTO 3700
  374. 3750  GOTO 3720
  375. 3760  REM - DETERMINE IF SORT TO BE ASCENDING OR DESCENDING
  376. 3770  HOME : GOSUB 2530: VTAB 3: HTAB 7: PRINT "RECORDS WILL BE SORTED BY": PRINT : HTAB  INT((39 - LEN(A$(K)))/2): PRINT A$(K)
  377. 3780  PRINT : VTAB 7: HTAB 5: PRINT "IN ";: INVERSE : PRINT "ASCENDING";: NORMAL : PRINT "/DESCENDING ORDER": IF L = 1  THEN 3820
  378. 3790  GOSUB 5790: IF (Z < >13  AND Z < >8  AND Z < >21  AND Z < >27)  OR Z = 10  THEN 3790
  379. 3800  IF Z = 13  OR Z = 27  THEN  ON (Z = 13) +1 GOTO 3690,3830
  380. 3810 L =  ABS(L -1): PRINT : VTAB 7: HTAB 8: IF L = 0  THEN 3780
  381. 3820  PRINT : VTAB 7: HTAB 5: PRINT "IN ASCENDING/";: INVERSE : PRINT "DESCENDING";: NORMAL : PRINT " ORDER": GOTO 3790
  382. 3830  IF G(9) = 1  THEN 4140: REM - SELECTION NOT REQUIRED
  383. 3840  REM - GET FIELD TO SELECT BY
  384. 3850  HOME : GOSUB 2530: VTAB 1: HTAB 1: PRINT "WHICH FIELD FOR SELECTION?"
  385. 3860  FOR X = 0 TO F: PRINT : HTAB 2: VTAB 4 +X +X *(F <8): PRINT " ";: IF K1 = X  THEN  INVERSE 
  386. 3870  PRINT A$(X): NORMAL : NEXT 
  387. 3880  GOSUB 5790: IF Z = 13  THEN 3940
  388. 3890  IF Z = 27  THEN  ON (G(8) = 0) +2 *(G(8) = 1  AND F(5) >0) +3 *(G(8) = 1  AND F(5) = 0) GOTO 3690,3620,3270
  389. 3900  IF Z = 8  OR Z = 11  THEN K1 = K1 -1 +F *(K1 = 0) +(K1 = 0): GOTO 3860
  390. 3910  IF Z = 21  OR Z = 10  THEN K1 = K1 +1 -F *(K1 = F) -(K1 = F): GOTO 3860
  391. 3920  GOTO 3880
  392. 3930  REM - GET SELECTION CRITERIA
  393. 3940  HOME : GOSUB 2530: VTAB 1: PRINT "SELECTION CRITERIA:": PRINT : PRINT "FIELD - "A$(K1):C1 = 1 +(C1 = 2): IF C1 = 2  THEN 3990
  394. 3950  VTAB 5: INVERSE : PRINT "ALPHA OR SINGLE VALUE";: NORMAL : PRINT "/RANGE OF VALUES": PRINT 
  395. 3960  GOSUB 5790: ON (Z = 27) +2 *(Z = 13) GOTO 3850,4000
  396. 3970  IF Z = 10  THEN 3960
  397. 3980  IF Z = 8  OR Z = 21  THEN C1 =  ABS(C1 -2) +1: IF C1 = 1  THEN 3950
  398. 3990  VTAB 5: PRINT "ALPHA OR SINGLE VALUE/";: INVERSE : PRINT "RANGE OF VALUES": NORMAL : GOTO 3960
  399. 4000  GOSUB 2500: IF C1 = 2  THEN 4090
  400. 4010  VTAB 11: PRINT "ALPHA STRING OR SINGLE VALUE:":H = 0:V = 12:M = 40:A$ = H$: GOSUB 5530
  401. 4020 H$ = A$: ON (A < >0) +2 *((A = 0)  AND (A$ = "")) GOTO 3940,4010
  402. 4030 Z$ = "": FOR Y = 1 TO  LEN(H$):ZB =  ASC( MID$ (H$,Y,1)):Z$ = Z$ + CHR$(ZB -32 *((ZB >96)  AND (ZB <123))): NEXT :H$ = Z$
  403. 4040 F1 = 0: PRINT : VTAB 15: INVERSE : PRINT "SELECT";: NORMAL : PRINT "/REJECT RECORD WITH STRING"
  404. 4050  PRINT : VTAB 17: PRINT "ARROWS TO SELECT": PRINT : PRINT "RETURN TO ACCEPT ";: GOSUB 5790: IF Z = 27  OR Z = 13  THEN  ON (Z = 27) +2 *(Z = 13) GOTO 3940,4140
  405. 4060  IF (Z < >8  AND Z < >21)  OR Z = 10  THEN 4050
  406. 4070  IF Z = 8  THEN 4040
  407. 4080  IF Z = 21  THEN F1 = 1: PRINT : VTAB 15: PRINT "SELECT/";: INVERSE : PRINT "REJECT";: NORMAL : PRINT " RECORD WITH STRING": GOTO 4050
  408. 4090  PRINT : VTAB 11: PRINT "HIGHEST VALUE TO ACCEPT: ":H = 25:V = 10:M = 15:A$ =  STR$(F1): GOSUB 5530
  409. 4100 F1 =  VAL(A$): ON (A < >0) +2 *((F1 = 0)  AND (A$ < >"0")) GOTO 3940,4090
  410. 4110  PRINT : VTAB 13: PRINT "LOWEST VALUE TO ACCEPT: ":H = 24:V = 12:M = 15:A$ =  STR$(G1): GOSUB 5530
  411. 4120 G1 =  VAL(A$): ON (A < >0) +2 *((G1 = 0)  AND (A$ < >"0")) GOTO 4090,4110
  412. 4130  REM - GET # OF RECORDS FROM FILE
  413. 4140  HOME :ZF$ = B$:W = 3: ONERR  GOTO 5730
  414. 4150  PRINT D$"OPEN"B$",L"Q: PRINT D$"READ"B$",R0": INPUT AF: PRINT D$"CLOSE": POKE 216,0: DIM AL(AF +(AF = 0)): FOR X = 1 TO AF:AL(X) = X: NEXT 
  415. 4160  IF AF = 0  THEN  HOME : PRINT  CHR$(7): HTAB 10: PRINT "NO RECORDS IN": PRINT : HTAB 10: PRINT B$: PRINT : PRINT "PRESS RETURN TO CONTINUE ";: GOSUB 5790: RUN 1760
  416. 4170  IF G(8) = 1  THEN 4300: REM - NO SORT REQUIRED
  417. 4180  REM - SORT RECORDS
  418. 4190  POKE 1013,76: POKE 1014,0: POKE 1015,144
  419. 4200 ZF$ = "DCK.SORT":W = 4: ONERR  GOTO 5730
  420. 4210  PRINT D$"BLOAD"ZF$
  421. 4220  POKE 216,0: HOME : PRINT : VTAB 10: PRINT  SPC( 6)"GETTING RECORDS FOR SORTING": PRINT : DIM M$(AF): IF K >0  THEN 4250
  422. 4230  FOR X = 1 TO AF:M$(X) = "": IF X <1000  THEN M$(X) = "0": IF X <100  THEN M$(X) = "00": IF X <10  THEN M$(X) = "000"
  423. 4240 M$(X) = M$(X) + STR$(AL(X)): NEXT : GOTO 4260
  424. 4250  PRINT : PRINT D$"OPEN"B$",L"Q: FOR X = 1 TO AF: PRINT D$"READ"B$",R"X: FOR Y = 1 TO K: INPUT M$(X): NEXT Y,X: PRINT D$"CLOSE"
  425. 4260  IF L = 1  THEN 4280
  426. 4270  & M$,1,AF,AL: GOTO 4300
  427. 4280  & M$,1,AF,AL/
  428. 4290  REM - PREPARE FOR PRINTING
  429. 4300  HOME : IF G(0) = 0  THEN  PRINT : VTAB 5: HTAB 5 +S: PRINT "PREPARE PRINTER & PRESS RETURN";: GOSUB 5790: IF Z < >13  AND Z < >27  THEN 4300
  430. 4310  IF Z = 27  THEN  RUN 1760
  431. 4320  IF G(4)  THEN  PRINT D$K$: PRINT 
  432. 4330  IF G(0) = 0  THEN  PRINT D$F$
  433. 4340  HOME :AE = F(5): IF F(5) >0  THEN  FOR X = 1 TO F(5): PRINT  SPC( ((G(3) -1) > LEN(H$(X))) * INT((G(3) - LEN(H$(X)))/2))H$(X) CHR$(13 *(  NOT G(0)  OR (G(0)  AND ( LEN(H$(X)) < >G(3)))));: NEXT 
  434. 4350  IF F(0) >0  THEN  GOSUB 4820
  435. 4360  IF G(0) = 0  THEN  PRINT D$G$
  436. 4370  REM - GET DATA FROM FILE
  437. 4380  PRINT D$"OPEN"B$",L"Q: IF G(0) = 0  THEN  PRINT D$F$
  438. 4390  FOR X = 1 TO AF:L$(0) =  STR$(AL(X)): PRINT D$"READ"B$",R"AL(X)
  439. 4400  FOR Y = 1 TO F: INPUT L$(Y): NEXT : IF L$(1) =  CHR$(5)  THEN 4710
  440. 4410  FOR Y = 1 TO F:Z$ = L$(Y): GOSUB 4790:L$(Y) = Z$: NEXT 
  441. 4420  IF G(9) = 1  THEN 4590: REM - SELECTION NOT REQUIRED
  442. 4430  REM - SELECT/REJECT RECORDS
  443. 4440 AG = 0
  444. 4450 Z$ = L$(K1): IF Z$ = ""  THEN 4470
  445. 4460 Z$ = "": FOR YS = 1 TO  LEN(L$(K1)):ZB =  ASC( MID$ (L$(K1),YS,1)):Z$ = Z$ + CHR$(ZB -32 *((ZB >96)  AND (ZB <123))): NEXT YS
  446. 4470  IF C1 < >1  OR F1 < >1  THEN 4510
  447. 4480  IF Z$ = H$  THEN AG = 1: GOTO 4570
  448. 4490  IF  LEN(Z$) =  < LEN(H$)  THEN 4570
  449. 4500  FOR ZS = 1 TO 1 + LEN(Z$) - LEN(H$):AG = AG +(H$ =  MID$ (Z$,ZS, LEN(H$))): NEXT : GOTO 4570
  450. 4510  IF C1 < >1  THEN 4550
  451. 4520  IF  LEN(Z$) =  < LEN(H$)  AND Z$ < >H$  THEN AG = 1: GOTO 4570
  452. 4530 AG = 1: FOR ZS = 1 TO 1 + LEN(Z$) - LEN(H$): IF H$ =  MID$ (Z$,ZS, LEN(H$))  THEN AG = 0:ZS = 1 + LEN(Z$) - LEN(H$)
  453. 4540  NEXT : GOTO 4570
  454. 4550 AG = 1: IF F1 >G1  AND  VAL(Z$) =  <F1  AND  VAL(Z$) =  >G1  THEN AG = 0: GOTO 4570
  455. 4560  IF ( VAL(Z$) =  >G1  OR  VAL(Z$) =  <F1)  AND F1 =  <G1  THEN AG = 0
  456. 4570  IF AG >0  THEN 4710
  457. 4580  REM - PRINT BODY ITEM
  458. 4590  FOR Y = 0 TO F(3) -1:ZH = 0: FOR Z = 0 TO F(2) -1: IF J(Z,Y) = 0  THEN  PRINT  SPC( E(Z,Y) -ZH)K$(Z,Y);:ZH = E(Z,Y) + LEN(K$(Z,Y)): GOTO 4620
  459. 4600 ZA =  VAL(K$(Z,Y)): IF C(ZA) = 0  THEN  PRINT  SPC( E(Z,Y) -ZH)L$(ZA);:ZH = E(Z,Y) + LEN(L$(ZA)): REM - LEFT JUSTIFY
  460. 4610  IF C(ZA) = 1  THEN  PRINT  SPC( E(Z,Y) -ZH +L(ZA) - LEN(L$(ZA)))L$(ZA);:ZH = E(Z,Y) +L(ZA): REM - RIGHT JUSTIFY
  461. 4620  NEXT : PRINT  CHR$(13 *(G(0) = 0) +13 *G(0) *(ZH <(40 +40 *G(4))));: NEXT :AE = AE +F(3) +F(4): IF F(4) >0  THEN  FOR Z = 1 TO F(4): PRINT : NEXT 
  462. 4630  IF AE +F(3) +F(4) <G(6)  THEN 4710
  463. 4640  IF AE <(G(5))  AND G(0) = 0  THEN  FOR Z = 1 TO G(5) -AE: PRINT : NEXT 
  464. 4650  IF G(7)  THEN 4690
  465. 4660  IF G(0) = 1  THEN  PRINT "PRESS RETURN"
  466. 4670  IF G(0) = 0  THEN  PRINT D$G$: HOME : PRINT "PREPARE PRINTER & PRESS RETURN"
  467. 4680  POKE 49168,0: WAIT 49152,128: POKE 49168,0: HOME : IF G(0) = 0  THEN  PRINT : PRINT D$F$
  468. 4690 AE = 0: IF F(6) = 1  AND F(5) >0  THEN  FOR XS = 1 TO F(5): PRINT  SPC( ((G(3) -1) > LEN(H$(XS))) * INT((G(3) - LEN(H$(XS)))/2))H$(XS) CHR$(13 *(  NOT G(0)  OR (G(0)  AND ( LEN(H$(XS)) < >G(3)))));: NEXT :AE = F(5)
  469. 4700  IF F(0)  THEN  GOSUB 4820
  470. 4710  NEXT : PRINT : PRINT D$"CLOSE": IF G(0) = 0  THEN  FOR X = 1 TO G(5) -AE: PRINT : NEXT : PRINT D$G$
  471. 4720  IF G(0) = 1  THEN  PRINT " PRESS RETURN";: GOSUB 5790
  472. 4730  HOME : IF G(8)  THEN 4770
  473. 4740 ZF$ = "DCK.INPUT":W = 7: ONERR  GOTO 5730
  474. 4750  PRINT D$"BLOAD"ZF$: POKE 216,0
  475. 4760 Y = 0: FOR X = AH TO AH +9: POKE X,G(Y):Y = Y +1: NEXT :Y = 0: FOR X = AH +10 TO AH +16: POKE X,F(Y):Y = Y +1: NEXT 
  476. 4770  RUN 1760
  477. 4780  REM - SUBROUTINE: RE-INSERT COMMAS & COLONS
  478. 4790  IF Z$ < >""  THEN ZB$ = "": FOR XS = 1 TO  LEN(Z$):ZB =  ASC( MID$ (Z$,XS,1)):ZB$ = ZB$ + CHR$(ZB +43 *(ZB = 1) +56 *(ZB = 2)): NEXT :Z$ = ZB$
  479. 4800  RETURN 
  480. 4810  REM - SUBROUTINE: PRINT COLUMN HEADINGS
  481. 4820 AE = AE +F(1): FOR YS = 0 TO F(1) -1:ZH = 0: FOR XS = 0 TO F(0) -1: PRINT  SPC( Q(XS,YS) -ZH)J$(XS,YS);
  482. 4830 ZH = Q(XS,YS) + LEN(J$(XS,YS)): NEXT : PRINT  CHR$(13 *(G(0) = 0) +13 *G(0) *(ZH <(40 +40 *G(4))));: NEXT : RETURN 
  483. 4840  REM *** GENERATED PROGRAM - SEARCH SECTION ***
  484. 4850  REM - CHECK DATA FILE AND DISPLAY MENU
  485. 4860  HOME :W = 5:ZF$ = B$: ONERR  GOTO 5730
  486. 4870  PRINT D$"OPEN"B$",L"Q: PRINT D$"READ"B$",R0": INPUT AF: PRINT D$"CLOSE": POKE 216,0
  487. 4880  IF AF = 0  THEN  HOME : PRINT  CHR$(7): HTAB 10: PRINT "NO RECORDS IN": PRINT : HTAB 10: PRINT B$: POKE 34,4: PRINT : PRINT "PRESS RETURN TO CONTINUE";: GOSUB 5790: POKE 34,0: RUN 1760
  488. 4890  REM - GET SEARCH CRITERIA
  489. 4900  HOME : GOSUB 2530:W = 1
  490. 4910  PRINT : VTAB 1: PRINT "SEARCH": PRINT : FOR X = 1 TO F: IF X = W  THEN  INVERSE 
  491. 4920  PRINT A$(X): NORMAL : NEXT : VTAB F +4: PRINT "WHICH FIELD FOR THE SEARCH?"
  492. 4930  GOSUB 5790: IF Z < >8  AND Z < >13  AND Z < >21  AND Z < >27  AND Z < >10  AND Z < >11  THEN 4930
  493. 4940  IF Z = 27  THEN  RUN 1760
  494. 4950  IF Z < >13  THEN W = W -(Z = 8  OR Z = 11) +(Z = 21  OR Z = 10):W = F *(W = 0) +W *(W <(F +1)  AND W < >0) +(W = (F +1)): GOTO 4910
  495. 4960  GOSUB 2500: VTAB 18: PRINT "WHAT STRING FOR THE SEARCH?":A$ = S$:H = 0:V = 18:M = L(W): GOSUB 5530:S$ = A$: IF S$ = ""  OR A >0  THEN  ON (A >0) +1 GOTO 4960,4900
  496. 4970 Z% = 1: HOME 
  497. 4980  GOSUB 2490: VTAB 4: PRINT J$ SPC( 15)"SEARCHING": VTAB 22: PRINT  SPC( 9)"PRESS ESC TO END SEARCH"
  498. 4990  PRINT D$"OPEN"B$",L"Q: PRINT D$"READ"B$",R"Z%: FOR XZ = 1 TO W: INPUT W$: NEXT : IF  LEN(W$) < LEN(S$)  THEN  PRINT D$"CLOSE": GOTO 5020
  499. 5000 ZA = 0: FOR Y = 1 TO  LEN(W$) - LEN(S$) +1: IF S$ =  MID$ (W$,Y, LEN(S$))  THEN ZA = 1
  500. 5010  NEXT Y: PRINT D$"CLOSE": IF ZA = 1  THEN  GOSUB 2430:AD = Z%: VTAB 3: HTAB 11: PRINT AD:S = AF: GOTO 2040
  501. 5020  IF  PEEK(49152) = 155  THEN Z% = AF
  502. 5030  POKE 49168,0:Z% = Z% +1: IF Z% <AF +1  THEN 4990
  503. 5040  HOME : PRINT : PRINT  CHR$(7)"END OF SEARCH": PRINT : PRINT "PRESS RETURN TO CONTINUE ";: GET ZA$: IF ZA$ < > CHR$(13)  THEN 5040
  504. 5050  RUN 1760
  505. 5060  REM *** GENERATED PROGRAM - PURGE FILE SECTION ***
  506. 5070  HOME : PRINT : PRINT "PURGING THE FILE WILL REMOVE ALL": PRINT : PRINT "EMPTY, (DELETED), RECORDS": PRINT 
  507. 5080  PRINT "AND RENUMBER THE REMAINING RECORDS": PRINT : PRINT 
  508. 5090  PRINT "PRESS RETURN TO PURGE THE FILE": PRINT : PRINT "OR ESC TO RETURN TO THE MENU ";: GOSUB 5790
  509. 5100  IF Z < >13  AND Z < >27  THEN 5070
  510. 5110  IF Z = 27  THEN  RUN 1760
  511. 5120  HOME :W = 6:ZF$ = B$: ONERR  GOTO 5730
  512. 5130  PRINT D$"OPEN"B$",L"Q: PRINT D$"READ"B$",R0": INPUT AF: PRINT D$"CLOSE": POKE 216,0
  513. 5140  PRINT : PRINT "PURGING THE FILE": PRINT : PRINT "DO NOT PRESS RESET"
  514. 5150 X =  -1:Y = X: PRINT D$"OPEN"B$",L"Q
  515. 5160 X = X +1:Y = Y +1: PRINT D$"READ"B$",R"X: FOR Z = 1 TO F: INPUT D$(Z): NEXT 
  516. 5170  IF D$(1) < > CHR$(5)  THEN  PRINT D$"WRITE"B$",R"Y: FOR Z = 1 TO F: PRINT D$(Z): NEXT : GOTO 5210
  517. 5180 X = X +1: IF X >AF  THEN Y = Y -1: GOTO 5210
  518. 5190  PRINT D$"READ"B$",R"X: FOR Z = 1 TO F: INPUT D$(Z): NEXT : IF D$(1) =  CHR$(5)  THEN 5180
  519. 5200  PRINT D$"WRITE"B$",R"Y: FOR Z = 1 TO F: PRINT D$(Z): NEXT 
  520. 5210  IF X > = AF  THEN  PRINT D$"WRITE"B$",R0": PRINT Y: PRINT D$"CLOSE": RUN 1760
  521. 5220  GOTO 5160
  522. 5230  REM *** GENERATED PROGRAM - CHANGE DATA FILE NAME ***
  523. 5240  HOME : PRINT : PRINT  SPC( 10)"CURRENT DATA FILE IS:": PRINT : PRINT B$: PRINT : PRINT 
  524. 5250  GOSUB 2500:A$ = B$:H = 0:V = 10:M = 64: POKE 255,0: GOSUB 5530: IF A GOTO 5270
  525. 5260  HTAB 1: VTAB 19: PRINT "PLEASE WAIT":Z$ = A$: GOSUB 5610:B$ = A$: IF E  THEN 5250
  526. 5270  HOME : GOTO 1780
  527. 5280  REM - SUBROUTINE: MENU
  528. 5290  PRINT J$: GOSUB 2490: VTAB 21: HTAB 3: PRINT "ARROW OR NUMBER TO SELECT": PRINT : HTAB 3: PRINT "RETURN TO ACCEPT";:M1 = 1
  529. 5300  FOR XS = 1 TO M2:Z(XS) = 0: NEXT :Z(M1) = 1
  530. 5310  FOR XS = 1 TO M2: PRINT : VTAB 4 +2 *XS: HTAB 3: PRINT XS") ";: IF Z(XS) = 1  THEN  INVERSE 
  531. 5320  PRINT Z$(XS): NORMAL : NEXT 
  532. 5330  VTAB 19: GOSUB 5790: IF Z = 13  OR (Z = 27  AND ZZ = 123)  THEN  RETURN 
  533. 5340  IF Z = 27  AND ZZ < >124  THEN  RUN 1760
  534. 5350  IF Z = 8  OR Z = 11  THEN M1 = M1 -1 +M2 *(M1 = 1): GOTO 5300
  535. 5360  IF Z = 21  OR Z = 10  THEN M1 = M1 +1 -M2 *(M1 = M2): GOTO 5300
  536. 5370  IF Z <49  OR Z >48 +M2  THEN 5330
  537. 5380 M1 = Z -48: GOTO 5300
  538. 5390  REM - SUBROUTINE: CATALOG DISK
  539. 5400  HOME : PRINT : PRINT  SPC( 10)"CATALOG DISK": PRINT : PRINT : PRINT  SPC( 4)"SLOT #": PRINT : PRINT  SPC( 3)"DRIVE #"
  540. 5410  PRINT : VTAB 5: HTAB 12: PRINT " ";: HTAB 12: GET ZA$
  541. 5420  IF ZA$ =  CHR$(27)  THEN 5480
  542. 5430  PRINT ZA$:ZA =  VAL(ZA$): IF ZA <1  OR ZA >7  THEN 5410
  543. 5440  PRINT : VTAB 7: HTAB 12: PRINT " ";: HTAB 12: GET ZA$: IF ZA$ =  CHR$(27)  THEN 5410
  544. 5450  PRINT ZA$:ZB =  VAL(ZA$): IF ZB <1  OR ZB >2  THEN 5440
  545. 5460  ONERR  GOTO 5490
  546. 5470  PRINT D$"CATALOG,D"ZB",S"ZA: POKE 49168,0: WAIT 49152,128: POKE 49168,0
  547. 5480  POKE 216,0: HOME : GOTO 340
  548. 5490  POKE 216,0: CALL 62248: HOME : PRINT : PRINT  SPC( 2)"UNABLE TO CATALOG SLOT "ZA", DRIVE "ZB
  549. 5500  VTAB 7: PRINT  SPC( 6)"PRESS RETURN TO RE-ENTER": PRINT : PRINT  SPC( 6)"OR ESC TO ABORT ";: GET ZA$: IF ZA$ < > CHR$(13)  AND ZA$ < > CHR$(27)  THEN 5490
  550. 5510  ON 1 *(ZA$ =  CHR$(13)) +2 *(ZA$ =  CHR$(27)) GOTO 5400,5480
  551. 5520  REM - SUBROUTINE: INPUT
  552. 5530  CALL 37969: IF A$ < >""  THEN YS = J: FOR XS = 1 TO  LEN(A$): POKE YS, ASC( MID$ (A$,XS,1)) +128:YS = YS +1: NEXT 
  553. 5540  POKE PA,H: POKE PB,V: POKE PC,M: POKE PF,1: CALL 37632
  554. 5550 A = 0: IF  PEEK(PG) = 27  THEN A = 27 + PEEK(PH)
  555. 5560 A$ = "": IF  PEEK(PD) = M  AND  PEEK(PE) = 0  THEN 5580
  556. 5570  FOR XS = J + PEEK(PD) TO J + PEEK(PE):A$ = A$ + CHR$( PEEK(XS)): NEXT 
  557. 5580  PRINT : HTAB H +1: VTAB V +1: PRINT A$ SPC( M - LEN(A$))
  558. 5590  RETURN 
  559. 5600  REM - SUBROUTINE: CHECK FOR VALID PRODOS NAME
  560. 5610 E = 1
  561. 5620  FOR XS = 1 TO  LEN(Z$):NA =  ASC( MID$ (Z$,XS,1)):E = ((NA >64  AND NA <91)  OR (NA = 46)  OR (NA >47  AND NA <58  AND XS >1))  AND E = 1: NEXT 
  562. 5640  IF  LEN(Z$) >15  OR E = 0  THEN E = 1: GOTO 5700
  563. 5650 E = 0: RETURN 
  564. 5660  REM 
  565. 5670  REM 
  566. 5680  REM 
  567. 5690  REM 
  568. 5700  VTAB 19: HTAB 1: PRINT  CHR$(7)"INVALID NAME. PRESS RETURN TO TRY AGAIN": GOSUB 5790: VTAB 19: HTAB 1: PRINT  SPC( 39);
  569. 5710  RETURN 
  570. 5720  REM - DISK ERROR MESSAGE
  571. 5730  POKE 216,0: CALL 62248: HOME : PRINT  CHR$(7): PRINT D$"CLOSE": HTAB 10: PRINT "UNABLE TO ACCESS"
  572. 5740  PRINT : HTAB 10: PRINT ZF$: PRINT : PRINT : HTAB 2: PRINT "CHECK DISK AND PRESS RETURN TO RESTART": PRINT 
  573. 5750  HTAB 12: PRINT "OR ESC FOR MENU": GOSUB 5790: IF Z < >13  AND Z < >27  THEN 5750
  574. 5760  IF Z = 13  THEN  ON W GOTO 1810,1860,4140,4200,4860,5070,4730
  575. 5770  RUN 1760
  576. 5780  REM - SUBROUTINE: WAIT
  577. 5790  WAIT 49152,128: POKE 49168,0:Z =  PEEK(49152): RETURN 
  578. 5800  REM *** GENERATED PROGRAM - CUSTOMIZED VARIABLES ***
  579. 5810  PRINT "5810 G$(0)="Q$"S = SEARCH"Q$":B="B":F="F":C$="Q$C$Q$":IFF>9THENDIMA$(F),B$(F),C$(F),D$(F), L$(F),A(F),B(F),C(F),L(F),M(F),J(9,F),E(9,F),K$(9,F)"
  580. 5820  PRINT "5820 ";: FOR X = 1 TO 4: PRINT "A$("X")="Q$A$(X)Q$":";: NEXT : PRINT 
  581. 5830  IF F >4  THEN  PRINT "5830 ";: FOR X = 5 TO 8: PRINT "A$("X")="Q$A$(X)Q$":";: NEXT : PRINT 
  582. 5840  IF F >8  THEN  PRINT "5840 ";: FOR X = 9 TO F: PRINT "A$("X")="Q$A$(X)Q$":";: NEXT : PRINT 
  583. 5850  PRINT "5850 ";: FOR X = 1 TO 8: PRINT "L("X")="L(X)":";: NEXT : PRINT " 
  584. 5860  IF F >8  THEN  PRINT "5860 ";: FOR X = 9 TO F: PRINT "L("X")="L(X)":";: NEXT : PRINT 
  585. 5870  PRINT "5870 B$="Q$B$Q$":Q="Q":K$="Q$K$Q$":K1$=K$:IFNOTBTHENK1$="Q$"PR#0"Q$
  586. 5880  PRINT "5880 ";: FOR X = 1 TO 4: PRINT "B$("X")="Q$B$(X)Q$":";: NEXT : PRINT 
  587. 5890  IF F >4  THEN  PRINT "5890 ";: FOR X = 5 TO 8: PRINT "B$("X")="Q$B$(X)Q$":";: NEXT : PRINT 
  588. 5900  IF F >8  THEN  PRINT "5900 ";: FOR X = 9 TO F: PRINT "B$("X")="Q$B$(X)Q$":";: NEXT : PRINT 
  589. 5910  PRINT "5910 ";: FOR X = 1 TO 4: PRINT "C$("X")="Q$C$(X)Q$":";: NEXT : PRINT 
  590. 5920  IF F >4  THEN  PRINT "5920 ";: FOR X = 5 TO 8: PRINT "C$("X")="Q$C$(X)Q$":";: NEXT : PRINT 
  591. 5930  IF F >8  THEN  PRINT "5930 ";: FOR X = 9 TO F: PRINT "C$("X")="Q$C$(X)Q$":";: NEXT : PRINT 
  592. 5940  PRINT "5940 ";: FOR X = 1 TO F: PRINT "A("X")="A(X)":";: NEXT : PRINT 
  593. 5950  PRINT "5950 ";: FOR X = 1 TO F: PRINT "M("X")="M(X)":";: NEXT : PRINT 
  594. 5960  PRINT "5960 RETURN"
  595. 5970  PRINT "5480 POKE 216,0: HOME: GOTO 1780"
  596. 5980  PRINT "5970 PRINT"Q$DE$Q$": END"
  597. 5990  GOTO 6010
  598. 6000  HOME : PRINT  CHR$(4)"PR#1": FOR QZ = 1 TO F: PRINT QZ"     "E$(QZ): NEXT : PRINT  CHR$(4)"PR#0": GOTO 1040: REM  5 SPACES
  599. 6010  PRINT "5980 HTAB 1: VTAB 17: PRINT"Q$"ERROR--CHECK DISK DRIVE"Q$
  600. 6020  PRINT "5990 PRINT "Q$"PRESS RETURN TO CONTINUE, ESC TO QUIT";Q$";"
  601. 6030  PRINT "6000 GET ZZ$:IF ZZ$<>CHR$(27) THEN HTAB 1:VTAB 17:CALL -868:VTAB 18:HTAB 1:CALL -868:GOTO 2380"
  602. 6040  PRINT "6010 HOME:END"
  603. 6050  GOTO 1340