home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / DF1.DSK / SH.bas < prev    next >
BASIC Source File  |  2014-09-09  |  22KB  |  348 lines
  1. 10 TE$ = "": POKE 216,0: TEXT :SE = 0: SPEED= 255:D$ =  CHR$(4): PRINT D$"NOMON I,O,C": GOSUB 750: POKE 37902,255: GOTO 100
  2. 40  PRINT D$"OPEN"N$".P,D"D1: PRINT D$"READ"N$".P": INPUT CO,F1,LI,F2,F1$,F3,F3$,F6$,F8$,F8,MO,CT$,N,TF$,LF$: PRINT CL$: IF P1$ = "Y"  THEN  PRINT D$"OPEN DATE": PRINT D$"READ DATE": CALL 783:DA$ =  MID$ (TE$,1): PRINT : PRINT D$"CLOSE"
  3. 50  RETURN 
  4. 80  PRINT  TAB( 3)"* UNIV. DATA MANAGEMENT SYSTEM 4.0 *": PRINT  TAB( 6)"COPYRIGHT 1980 BY W.L.PASSAUER": RETURN 
  5. 100 D1 =  PEEK(864):P$ =  CHR$( PEEK(865)):P1$ =  CHR$( PEEK(866)):S$ =  STR$( PEEK(867)):I =  PEEK(868): FOR X = 869 TO I +868:N$ = N$ + CHR$( PEEK(X)): NEXT 
  6. 120 RF$ = D$ +"READ" +N$ +",R":OF$ = D$ +"OPEN" +N$ +",L":CL$ = D$ +"CLOSE": IF D1 = 1  THEN  HOME : PRINT  CHR$(7): VTAB 12: HTAB 4: PRINT "LOAD ";: INVERSE : PRINT "DATA DISK";: NORMAL : PRINT " THEN PRESS 'RTN'";: GET Z$
  7. 140  PRINT : PRINT D$"OPEN"N$".V,D"D1: PRINT D$"READ"N$".V": INPUT NC,RC,RR: DIM CL(NC): FOR X = 1 TO NC: INPUT CL(X): NEXT :LL = (CL(NC) +NC): PRINT D$"OPEN"N$",L"LL",D"D1: DIM PC(NC +5),A$(NC),S$(RC),DT$(RC),H$(NC),CL%(NC),SH$(50),X4(NC),X5(NC)
  8. 190  FOR X = 1 TO NC:B1 = CL(X -1): PRINT D$"READ"N$",R"0",B"B1: CALL 783:H$(X) =  MID$ (TE$,1): NEXT : PRINT D$"CLOSE": FOR X = 1 TO NC:CL%(X) = CL(X) -CL(X -1) -1: NEXT : GOSUB 40
  9. 220  PRINT  CHR$(7): GOTO 5000
  10. 230  PRINT D$"PR#"F8: IF F8 = 3  AND   NOT D6  THEN  PRINT :D6 = 1
  11. 231  IF CT$ < >""  THEN  PRINT CT$;
  12. 232  RETURN 
  13. 240  PRINT D$"PR#"MO: RETURN 
  14. 250  IF V$ = "V"  OR S < >0  THEN 260
  15. 252  GOSUB 230: FOR LF = LN TO LI: IF LF$ = "Y"  THEN  PRINT  CHR$(10): GOTO 257
  16. 255  PRINT 
  17. 257  NEXT : IF F3$ = "Y"  THEN PG = PG +1: PRINT  TAB( TB)"PAGE-";PG: GOSUB 240: RETURN 
  18. 260  GOSUB 240: RETURN 
  19. 270  ONERR  GOTO 285
  20. 280  PRINT : PRINT OF$LL",D"D1: FOR I = 1 TO RC:B1 = CL(C -1): PRINT RF$I",B"B1: CALL 783:S$(I) =  MID$ (TE$,1): NEXT : PRINT CL$: POKE 216,0: RETURN 
  21. 285  POKE 216,0: GOSUB 240: PRINT  CHR$(7): HOME : VTAB 12: PRINT "DISK ERROR-RECORD ";: INVERSE : PRINT I;: NORMAL : PRINT " MAY BE BAD": PRINT "PRESS 'RTN'";: GET Z$: GOTO 5612
  22. 290  ONERR  GOTO 325
  23. 300  PRINT OF$LL",D"D1: FOR X = 1 TO NC:B1 = CL(X -1): IF X = 1  AND F7$ = "Y"  AND C1 =  >CP -1  AND (P$ = "N"  OR P$ = "")  THEN  PRINT 
  24. 320  PRINT RF$RS",B"B1: CALL 783:A$(X) =  MID$ (TE$,1): NEXT : PRINT CL$: POKE 216,0: RETURN 
  25. 325 I = RS: GOTO 285
  26. 330 CV =  PEEK(37): POKE 37,(CV -1): CALL  -958: RETURN 
  27. 340  FOR X = 1 TO NC: PRINT  TAB( 4)X;"- ("CL%(X)") ";: HTAB 14: PRINT H$(X): NEXT : RETURN 
  28. 350  FOR X = 1 TO 40: PRINT "-";: NEXT : RETURN 
  29. 360  HOME : VTAB 12: PRINT  TAB( 11)"> RECALLING DATA <": RETURN 
  30. 370  ONERR  GOTO 700
  31. 375 F5$ = "":W3$ = "":WR$ = "": PRINT D$"OPEN"N$".F": PRINT D$"READ"N$".F": INPUT NR: FOR J = 1 TO NR: INPUT R$(J): NEXT : PRINT CL$: POKE 216,0: HOME :B = 1: PRINT : PRINT "FORMAT SELECT:": PRINT : FOR I = 1 TO NR: PRINT I" "R$(I): NEXT : PRINT : PRINT I" CREATE A NEW FORMAT ": PRINT 
  32. 440  INPUT "WHICH: ";Z5$:Z =  VAL(Z5$): IF Z <1  OR Z >I  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 440
  33. 450  HOME : IF Z = I  THEN B = 0: GOTO 4050
  34. 460  PRINT D$"OPEN"R$(Z)"-F,D"D1: PRINT D$" READ "R$(Z)"-F": INPUT CO,F1,LI,F2,F1$,F3,F6$,F8$,F3$,A$,F5$,W3$,W2$,H1,WR$,F7$,CP,WN$,N,TF$,V$: FOR X = 1 TO CP -1: INPUT PC(X): NEXT : PRINT : PRINT CL$
  35. 490  RETURN 
  36. 510  IF NR =  >10  THEN 5610
  37. 520  HOME : PRINT  CHR$(7);: VTAB 11: INPUT "SAVE THIS FORMAT TO DISK (Y/N) ";Z5$: IF Z5$ < >"Y"  AND Z5$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 520
  38. 530 B = 1: IF Z5$ = "N"  THEN 5610
  39. 540  IF NR <1  THEN NR = 0
  40. 550  ONERR  GOTO 710
  41. 560  PRINT 
  42. 570  PRINT "ENTER NAME FOR FORMAT (28) ":L = 28: GOSUB 800:R$(NR +1) = B$: IF R$(NR +1) = ""  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 570
  43. 575  IF P$ = "Y"  THEN R$(NR +1) = R$(NR +1) +".P": GOTO 580
  44. 577 R$(NR +1) = R$(NR +1) +".M"
  45. 580 NN = NR +1: PRINT : PRINT D$"OPEN"R$(NN)"-F,D"D1: PRINT D$"WRITE"R$(NN)"-F": PRINT CO: PRINT F1: PRINT LI: PRINT F2: PRINT F1$: PRINT F3: PRINT F6$: PRINT F8$: PRINT F3$: PRINT A$: PRINT F5$: PRINT W3$: PRINT W2$: PRINT H1: PRINT WR$: PRINT F7$: PRINT CP: PRINT WN$: PRINT N: PRINT TF$: PRINT V$: FOR X = 1 TO CP -1: PRINT PC(X): NEXT : PRINT CL$: POKE 216,0
  46. 585  IF   NOT NR  THEN 600
  47. 587  FOR J = 1 TO NR: IF R$(J) = R$(NR +1)  THEN  RETURN 
  48. 588  NEXT 
  49. 600  PRINT D$"OPEN"N$".F": PRINT D$"WRITE"N$".F": PRINT NR +1: FOR J = 1 TO NR +1: PRINT R$(J): NEXT : PRINT : PRINT CL$: RETURN 
  50. 700  CALL 1013: GOTO 4050
  51. 710  CALL 1013: PRINT  CHR$(7): PRINT "BAD FORMAT NAME-TRY AGAIN": GOTO 560
  52. 750  FOR I = 1013 TO 1022: READ PP: POKE I,PP: NEXT : RETURN : DATA 104,168,104,166,223,154,72,152,72,96
  53. 800 B$ = "": PRINT : FOR I = 1 TO L: PRINT "_";: NEXT : VTAB ( PEEK(37) +2 -(L/39.9)): HTAB 1
  54. 810  FOR I = 1 TO L +1
  55. 820  GET E$
  56. 822  IF E$ =  CHR$(10)  THEN E$ =  CHR$(92)
  57. 823  IF E$ =  CHR$(11)  THEN E$ =  CHR$(91)
  58. 824  IF E$ =  CHR$(12)  THEN E$ =  CHR$(95)
  59. 825  IF E$ =  CHR$(17)  THEN B$ = E$: RETURN 
  60. 830  IF E$ =  CHR$(21)  THEN 820
  61. 840  IF E$ =  CHR$(8)  THEN  GOSUB 890: GOTO 820
  62. 850  IF E$ =  CHR$(13)  THEN  PRINT E$;: RETURN 
  63. 860  PRINT E$;:B$ = B$ +E$: NEXT 
  64. 870  IF  RIGHT$(B$,1) < > CHR$(13)  THEN  GOSUB 940: GOTO 800
  65. 880  RETURN 
  66. 890  IF I < = 1  THEN  RETURN 
  67. 900  PRINT  CHR$(8);"_"; CHR$(8);
  68. 910 I = I -1
  69. 920  IF I =  <1  THEN I = 1:B$ = "": RETURN 
  70. 930 B$ =  LEFT$(B$, LEN(B$) -1): RETURN 
  71. 940  PRINT  CHR$(7): INVERSE : HTAB 10: PRINT "ENTRY TOO LONG": NORMAL : RETURN 
  72. 950 SK =  INT(CL%(C)/40): FOR X = 1 TO SK: PRINT : NEXT : RETURN 
  73. 960 FQ = 0:F0 = 0:FM = 0:FK = 0: IF A$ < >"Y"  OR TF$ = "N"  THEN 980
  74. 962  FOR XT = 1 TO NC: IF FL = 1  AND  RIGHT$(H$(XT),1) = " "  THEN A$(XT) =  STR$(X4(XT)): GOTO 966
  75. 963  IF FL = 2  AND  RIGHT$(H$(XT),1) = " "  THEN A$(XT) =  STR$(X5(XT)): GOTO 966
  76. 964 A$(XT) = " "
  77. 966  NEXT 
  78. 968  FOR XT = 1 TO NC: IF  RIGHT$(H$(XT),1) < >" "  THEN 984
  79. 970 FQ = 1:RT = RT +1: IF LN = LI -1  THEN F0 = 1:FM = 1: GOSUB 250: GOSUB 230: GOSUB 2780: GOSUB 2000: IF FL  THEN S = 0: GOSUB 250: GOTO 980
  80. 971  IF FM  THEN 980
  81. 972  IF LN = LI  THEN  GOSUB 230:F0 = 1:FM = 1: GOSUB 230: GOSUB 2780: GOSUB 2000: IF FL  THEN S = 0: GOSUB 250: GOTO 982
  82. 973  IF FM  THEN 982
  83. 974  IF LN = LI -2  THEN  GOSUB 230: GOSUB 2000:F0 = 1:S = 1: GOTO 980
  84. 975  IF LN = LI -3  THEN  GOSUB 230: GOSUB 2000:FM = 1: IF FL  THEN  GOSUB 250: GOSUB 230: GOSUB 2780: GOTO 982
  85. 976  IF FM  THEN 982
  86. 979  GOSUB 230: GOSUB 2000:F0 = 1: IF FJ  THEN  GOSUB 230: PRINT :LN = LN +1:FJ = 0
  87. 980  IF F0 = 0  AND MA =  >RS  THEN  GOSUB 250
  88. 982 FQ = 0:F0 = 0:RT = RC:FM = 0:FK = 0: RETURN 
  89. 984  NEXT XT: RETURN 
  90. 2000  REM 
  91. 2010 A = 1
  92. 2020  IF W2$ = "Y"  OR WN$ = "Y"  THEN F4 = F1 +5: GOTO 2040
  93. 2030 F4 = F1
  94. 2040 F5 = 0: IF F5$ = "Y"  THEN F5 = F5 +2
  95. 2050  IF F3$ = "Y"  THEN F5 = F5 +2
  96. 2060  IF A$ = "Y"  THEN F5 = F5 +2
  97. 2070 S = 0: IF A$ = "N"  THEN 2390
  98. 2080  IF LN = F5  AND V$ < >"V"  THEN 2110
  99. 2085  IF FM  THEN 2110
  100. 2090  IF CK >0  THEN 2391
  101. 2100 CK = 1:PG = 0: HOME :TA =  INT((CO/2) -( LEN(N$)/2)):TB = (CO/2) -3
  102. 2110  PRINT : IF F5$ = "N"  THEN 2127
  103. 2120  PRINT  SPC( TA)N$;: PRINT  SPC(  INT((CO -1) -(TA + LEN(N$) + LEN(DA$))))DA$: IF LF$ = "Y"  THEN  PRINT  CHR$(10): GOTO 2130
  104. 2125  PRINT 
  105. 2127  IF V$ = "V"  THEN 2390
  106. 2130 CH = 0:CH = CH +(F4 -1):CH% = 0: FOR C1 = 1 TO H1:CH = CH +(CL%(PC(C1)) +1):CH% = CH% +CL%(PC(C1)): IF CH >CO  THEN 2880
  107. 2200  NEXT :SP =  INT((CO -F4 -1 -CH%)/H1): IF SP <1  THEN  IF H1 +CH% < = CO  THEN SP = 1
  108. 2230  IF SP < = 0  THEN 2880
  109. 2240 HC = 0: IF A$ = "N"  THEN 2390
  110. 2250  IF WR$ = "Y"  THEN H2 = CP -1: GOTO 2270
  111. 2260 H2 = H1
  112. 2270  FOR C1 = 1 TO H2: IF C1 <2  THEN  HTAB F4
  113. 2320  IF WR$ = "Y"  THEN HC = HC +1: IF HC = H1  THEN 2350
  114. 2330  IF C1 =  >H2  THEN 2350
  115. 2340  PRINT H$(PC(C1));: PRINT  SPC( CL%(PC(C1)) - LEN(H$(PC(C1))) +SP);: GOTO 2360
  116. 2350  PRINT H$(PC(C1)):HC = 0: IF C1 <H2  THEN F5 = F5 +1: IF CP < >C1  THEN  HTAB F4
  117. 2360  NEXT : FOR TI = 1 TO CO -1: PRINT "-";: NEXT : PRINT 
  118. 2390 LN = F5:HC = 0
  119. 2391  IF Z4$ = "N"  OR P$ = "N"  OR MA >SH  OR FO = 1  THEN 2400
  120. 2392  IF SH$(MA) = ""  THEN FO = 1: GOTO 2400
  121. 2394 FO = 1:TD = (CO/2) -(( LEN(SH$(MA)) +4)/2): PRINT  SPC( TD)"--"SH$(MA)"--":LN = LN +1: IF LN > = LI  THEN 2730
  122. 2395  IF F2 <2  THEN 2400
  123. 2396  FOR X = 1 TO F2 -1: IF LF$ = "Y"  THEN  PRINT  CHR$(10): GOTO 2398
  124. 2397  PRINT 
  125. 2398 LN = LN +1: IF LN > = LI  THEN 2730
  126. 2399  NEXT X
  127. 2400  FOR C1 = A TO CP -1: IF A$(PC(C1)) = ""  THEN A$(PC(C1)) = " "
  128. 2440  IF   NOT FQ  AND HC = 0  AND C1 = 1  AND  ASC(A$(PC(C1))) < >64  THEN NO = NO +1
  129. 2450  IF  ASC(A$(PC(C1))) = 64  THEN 2610
  130. 2455  IF V$ = "V"  THEN 2950
  131. 2460 HC = HC +1: IF HC > = H1  OR C1 = CP -1  THEN 2542
  132. 2470  IF A$ = "Y"  THEN 2505
  133. 2475  IF WN$ = "Y"  AND HC = 1  THEN  PRINT NO".";: GOTO 2490
  134. 2480  IF W2$ = "Y"  AND HC = 1  THEN  PRINT RS;
  135. 2490  IF HC = 1  THEN  HTAB F4
  136. 2500  PRINT A$(PC(C1));: PRINT " ";: GOTO 2610
  137. 2505  IF FL = 2  AND FQ  THEN  FOR TI = 1 TO CO: PRINT "-";: NEXT :LN = LN +1:FL = 0:FK = 1:FJ = 1: PRINT 
  138. 2507  IF FL  AND FQ  THEN  FOR TI = 1 TO CO: PRINT "=";: NEXT :LN = LN +1:FL = 0:FK = 1: PRINT 
  139. 2510  IF F7$ = "Y"  AND C1 =  >H1  THEN 2545
  140. 2515  IF   NOT FK  AND WN$ = "Y"  AND HC = 1  THEN  PRINT NO".";: GOTO 2530
  141. 2520  IF   NOT FK  AND W2$ = "Y"  AND HC = 1  THEN  PRINT RS;
  142. 2530  IF HC = 1  THEN  HTAB F4
  143. 2535  IF A$(PC(C1)) < >" "  AND  RIGHT$(H$(PC(C1)),1) = " "  THEN 2900
  144. 2540  PRINT A$(PC(C1));:PC = CL%(PC(C1)) - LEN(A$(PC(C1))) +SP: PRINT  SPC( PC);: GOTO 2600
  145. 2542  IF A$(PC(C1)) < >" "  AND  RIGHT$(H$(PC(C1)),1) = " "  THEN 2900
  146. 2545  IF WN$ = "Y"  AND HC = 1  THEN  PRINT NO".";: GOTO 2560
  147. 2550  IF W2$ = "Y"  AND HC = 1  THEN  PRINT RS;
  148. 2560  IF HC = 1  OR (F7$ = "Y"  AND C1 =  >H1)  THEN  HTAB F4
  149. 2570  PRINT A$(PC(C1)): IF LF$ = "Y"  AND A$ = "N"  THEN  PRINT  CHR$(10)
  150. 2575 HC = 0: IF F7$ = "Y"  AND C1 =  >H1  THEN HC = C1
  151. 2580 LN = LN +1: IF LN > = LI  THEN 2730
  152. 2582  IF F2 <2  THEN 2600
  153. 2584  FOR X = 1 TO F2 -1: IF LF$ = "Y"  THEN  PRINT  CHR$(10): GOTO 2587
  154. 2586  PRINT 
  155. 2587 LN = LN +1: IF LN > = LI  THEN 2730
  156. 2588  NEXT 
  157. 2600 X = 0:X =  PEEK( -16384): POKE  -16368,0: IF X = 17  THEN  PRINT : GOSUB 240: POP : GOTO 5000
  158. 2610  NEXT C1: IF F7$ = "Y"  THEN HC = 0
  159. 2620  IF F1$ < >"F"  OR F6$ < >"R"  THEN 2640
  160. 2625  FOR X = 1 TO F3 -1: IF LF$ = "Y"  THEN  PRINT  CHR$(10): NEXT : GOTO 2640
  161. 2627  PRINT : NEXT 
  162. 2640  IF C1 < = NC  THEN  IF A$ = "N"  AND HC > = H1  AND PC(C1) <NC  THEN  PRINT 
  163. 2700  IF W2$ = "Y"  THEN F4 = F1 -5
  164. 2710  IF C1 <CP -1  THEN  PRINT OF$LL",D"D1: HOME :A = C1 +1: GOTO 2020
  165. 2720  GOSUB 240: RETURN 
  166. 2730  IF F7$ = "N"  AND WR$ = "N"  AND C1 > = CP -1  THEN  PRINT 
  167. 2740  IF F3$ = "N"  OR V$ = "V"  THEN  PRINT : GOTO 2760
  168. 2745  IF LF$ = "Y"  THEN  PRINT  CHR$(10): GOTO 2750
  169. 2747  PRINT 
  170. 2750 PG = PG +1: PRINT  SPC( TB)"PAGE-";PG:HC = 0
  171. 2760  IF F7$ = "Y"  AND RS =  >RT  THEN  GOSUB 240:S = 1: IF W2$ = "Y"  THEN F4 = F1 -5
  172. 2770  IF F7$ = "Y"  AND RS =  >RT  THEN  RETURN 
  173. 2780  IF F1$ < >"F"  OR F3 <2  THEN 2790
  174. 2782  FOR X = 1 TO F3 -1: IF LF$ = "Y"  THEN  PRINT  CHR$(10): GOTO 2786
  175. 2784  PRINT 
  176. 2786  NEXT : IF F0  THEN  RETURN 
  177. 2790  GOSUB 240: IF C1 = CP  AND RS = RC  THEN S = 1: IF W2$ = "Y"  THEN F4 = F1 -5
  178. 2800  IF C1 = CP  AND RS = RC  THEN S = 1: RETURN 
  179. 2810  IF F1$ = "F"  AND F8$ = "C"  THEN 2850
  180. 2820  HOME : PRINT  CHR$(7): VTAB 12: PRINT "E)ND,OR 'RTN' TO CONTINUE.";: GET Z$: IF Z$ = "E"  THEN  IF W2$ = "Y"  THEN F4 = F1 -5
  181. 2830  IF Z$ = "E"  AND B = 0  THEN  GOSUB 510
  182. 2840  IF Z$ = "E"  THEN  POP : GOTO 5580
  183. 2850  IF F7$ = "Y"  THEN HC = 0
  184. 2860  HOME : PRINT : GOSUB 230: IF F8 = 3  THEN  PRINT  CHR$(12)
  185. 2865  IF F5$ = "Y"  AND F3$ = "Y"  THEN LN = 6: GOTO 2700
  186. 2870 LN = 4: IF RS <FR  OR (  NOT FL)  THEN 2700
  187. 2875  GOTO 2020
  188. 2880  HOME : PRINT  CHR$(7): VTAB 12: HTAB (5): PRINT "TOO MANY HORIZ. CHARACTERS USED !": FOR X = 1 TO 4000: NEXT : POP : GOSUB 240: GOTO 5580
  189. 2900  IF   NOT FK  THEN X4(PC(C1)) = X4(PC(C1)) + VAL(A$(PC(C1))):X5(PC(C1)) = X5(PC(C1)) + VAL(A$(PC(C1)))
  190. 2903 S1 = CL%(PC(C1)):X4 =  VAL(A$(PC(C1))):X$ = " " + STR$( INT(X4 *10 ^N +.5)):Q =  LEN(X$) -( VAL(X$) <0)
  191. 2905  IF S1 -Q =  <0  THEN  PRINT : GOSUB 240: POP : HOME : PRINT  CHR$(7);: VTAB 12: PRINT "NO.TOO LARGE TO JUSTIFY ERROR!": PRINT "PRESS 'RTN'";: GET Z$: GOTO 5580
  192. 2910  PRINT  SPC( S1 -Q *(Q >N +1) -(N +2) *(Q < = N +1) -1);: PRINT  MID$ (X$,1 +( VAL(X$) <0),(Q < = N) +(Q -N) *(Q >N));
  193. 2920  PRINT  MID$ ("0.00",1 +((N +1) <Q),1 +(N -Q +2) *(Q <N +2));
  194. 2930  IF HC > = H1  THEN  PRINT  RIGHT$(X$,N *(Q >N) +(Q -1) *(Q < = N)): GOTO 2575
  195. 2940  PRINT  RIGHT$(X$,N *(Q >N) +(Q -1) *(Q < = N));: PRINT  SPC( SP);: GOTO 2610
  196. 2950  IF WN$ < >"Y"  AND W2$ < >"Y"  THEN 2990
  197. 2975  IF WN$ = "Y"  THEN  PRINT NO".";: GOTO 2985
  198. 2980  PRINT RS;
  199. 2985  HTAB F4
  200. 2990  PRINT H$(PC(C1))" - "A$(PC(C1)): GOTO 2582
  201. 3000  REM 
  202. 3005 X = 0:X =  PEEK( -16384): POKE  -16368,0: IF X = 17  THEN  PRINT : GOSUB 240: POP : GOTO 5000
  203. 3010 A = 1
  204. 3020 S = S +1:LN = LN +1: IF S >1  THEN 3140
  205. 3040  IF A$ = "N"  OR W3$ = "V"  THEN 3140
  206. 3050  FOR C1 = 1 TO H1: IF (W2$ = "Y"  OR WN$ = "Y")  AND C1 = 1  THEN  HTAB 5
  207. 3100  PRINT H$(PC(C1));:PC = CL%(PC(C1)) - LEN(H$(PC(C1))) +1: PRINT  SPC( PC)"";: NEXT : PRINT : FOR X = 1 TO 40: PRINT "-";: NEXT 
  208. 3140  FOR C1 = A TO CP -1: IF A$(PC(C1)) = ""  THEN A$(PC(C1)) = " "
  209. 3180  IF HC = 0  AND C1 = 1  AND  ASC(A$(PC(C1))) < >64  THEN NO = NO +1
  210. 3190  IF  ASC(A$(PC(C1))) = 64  THEN 3340
  211. 3200  IF A$ = "Y"  AND W3$ = "H"  THEN 3260
  212. 3210  IF A$ = "N"  THEN 3230
  213. 3220  PRINT : PRINT H$(PC(C1));" - "
  214. 3230 HC = HC +1: IF HC =  >H1  THEN 3295
  215. 3235  IF WN$ = "Y"  AND HC = 1  THEN  PRINT NO".";: HTAB 5: GOTO 3250
  216. 3240  IF W2$ = "Y"  AND HC = 1  THEN  PRINT RS;: HTAB 5
  217. 3250  PRINT A$(PC(C1));: PRINT " ";: GOTO 3340
  218. 3260 HC = HC +1: IF HC > = H1  THEN 3295
  219. 3270  IF F7$ = "Y"  AND C1 =  >H1  THEN 3295
  220. 3275  IF WN$ = "Y"  AND HC = 1  THEN  PRINT NO".";: HTAB 5: GOTO 3290
  221. 3280  IF W2$ = "Y"  AND HC = 1  THEN  PRINT RS;: HTAB 5
  222. 3290  PRINT A$(PC(C1));:PC = CL%(PC(C1)) - LEN(A$(PC(C1))) +1: PRINT  SPC( PC)"";: GOTO 3340
  223. 3295  IF WN$ = "Y"  AND HC = 1  THEN  PRINT NO".";: HTAB 5: GOTO 3310
  224. 3300  IF W2$ = "Y"  AND HC = 1  THEN  PRINT RS;: HTAB 5
  225. 3310  PRINT A$(PC(C1)):HC = 0:CV =  PEEK(37): IF CV >18  THEN 3370
  226. 3340  NEXT C1: IF H1 <CP -1  AND (F7$ = "N"  OR F7$ = "")  THEN HC = 0: PRINT 
  227. 3360  RETURN 
  228. 3370  PRINT : PRINT :HC = 0: PRINT : PRINT CL$: IF C1 = CP  AND RS = RC  THEN  RETURN 
  229. 3390  PRINT "E)ND,OR 'RTN' TO CONT. ";: GET Z1$: IF Z1$ = "R"  AND B = 0  THEN  GOSUB 510
  230. 3410  IF Z1$ = "E"  THEN  POP : GOTO 5580
  231. 3420 S = 0: PRINT : PRINT OF$LL",D"D1: HOME :A = C1 +1: IF A =  <CP -1  THEN 3020
  232. 3430  GOTO 3360
  233. 4000  REM 
  234. 4010  HOME : PRINT  TAB( 8)"> PRINT-OUT FORMATTING <": GOSUB 350: PRINT 
  235. 4020 LN = 0:S = 0:F5$ = "":F7$ = "":HC = 0:H1 = 0:W2$ = "":W3$ = "":WR$ = "":WN$ = "":NO = 0: IF P1$ = "Y"  THEN  INPUT "ON PRINTER (Y/N) ? ";P$: VTAB 3: CALL  -958: HTAB 1: IF P$ < >"Y"  AND P$ < >"N"  THEN  PRINT  CHR$(7): GOTO 4020
  236. 4030  IF P$ = "Y"  THEN  HOME : FLASH : PRINT  CHR$(7): VTAB 12: HTAB 11: PRINT "TURN ON PRINTER !!": NORMAL : PRINT  CHR$(7)
  237. 4040 B = 0: GOTO 370
  238. 4050  POKE 216,0: IF B = 1  THEN 4370
  239. 4055  IF P$ = "Y"  THEN  HOME : INPUT "PRINT RECORDS HORIZ./VERT. (H/V)? ";V$: IF V$ < >"H"  AND V$ < >"V"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4055
  240. 4057  IF V$ = "V"  THEN 4090
  241. 4060  HOME : GOSUB 340: PRINT 
  242. 4070  INPUT "PRINT FIELD NAMES (Y/N) ? ";A$: IF A$ < >"Y"  AND A$ < >"N"  OR A$ = ""  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4070
  243. 4080  IF A$ = "N"  OR P$ = "N"  THEN 4110
  244. 4090  PRINT 
  245. 4100  INPUT "PRINT FILE TITLE (Y/N) ? ";F5$: IF F5$ < >"Y"  AND F5$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4100
  246. 4110  PRINT 
  247. 4120  IF P$ = "N"  AND A$ = "Y"  THEN  INPUT "PRINT RECORDS HORIZ./VERT. (H/V)? ";W3$: IF W3$ < >"H"  AND W3$ < >"V"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4120
  248. 4130  PRINT 
  249. 4135  INPUT "NUMBER LINES (Y/N) ? ";WN$: IF WN$ < >"Y"  AND WN$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4135
  250. 4137  IF WN$ = "Y"  THEN 4150
  251. 4139  PRINT 
  252. 4140  INPUT "PRINT RECORD NUMBERS (Y/N) ? ";W2$: IF W2$ < >"Y"  AND W2$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4140
  253. 4150  PRINT : IF W3$ = "V"  THEN 4200
  254. 4155  IF V$ = "V"  THEN H1 = 1: GOTO 4195
  255. 4160  HOME : GOSUB 340: PRINT 
  256. 4170  PRINT "PRINT HOW MANY FIELDS HORIZONTALLY": PRINT "BEFORE CARRIAGE RETURN ";: INPUT H1: IF H1 <1  OR H1 >NC +5  THEN  PRINT  CHR$(7);:CV =  PEEK(37): POKE 37,(CV -2): CALL  -958: GOTO 4170
  257. 4190  PRINT 
  258. 4195  IF V$ = "V"  THEN  HOME : GOSUB 340: PRINT 
  259. 4200  GOSUB 350: PRINT "FIELD SELECTION-ENTER '0' WHEN FINISHED": GOSUB 350: PRINT :CP = 0: FOR CP = 1 TO NC +5
  260. 4220  PRINT "PRINT WHICH FIELD #: ";: INPUT PC(CP): IF PC(CP) = 0  THEN 4260
  261. 4240  IF PC(CP) >NC  THEN  PRINT  CHR$(7): PRINT "INPUT TO HIGH!!": GOTO 4220
  262. 4250  NEXT 
  263. 4260  IF CP -1 <H1  THEN  PRINT  CHR$(7): HOME : VTAB 11: PRINT "YOU SELECTED TO PRINT "H1" FIELDS": PRINT "ACROSS, BUT ONLY CHOSE TO PRINT "CP -1: PRINT "FIELDS, PRESS 'RTN' TO TRY AGAIN. ";: GET Z$: HOME : GOTO 4170
  264. 4270  IF W3$ = "V"  THEN 4370
  265. 4280  IF CP >NC  THEN 4300
  266. 4290  IF PC(CP) = 0  AND CP = H1 +1  THEN 4370
  267. 4300  IF H1 = CP -1  THEN 4370
  268. 4305  IF V$ = "V"  THEN 4370
  269. 4310  PRINT : IF A$ = "N"  OR P$ = "N"  THEN 4340
  270. 4320  INPUT "USE WRAP AROUND OPTION (Y/N) ? ";WR$: IF WR$ < >"Y"  AND WR$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4320
  271. 4330  IF WR$ = "Y"  THEN 4370
  272. 4340  PRINT : IF A$ = "N"  AND P$ = "N"  THEN 4370
  273. 4360  IF H1 =  <CP -1  THEN  INPUT "USE UNDERNEATH FORMATTING (Y/N) ? ";F7$: IF F7$ < >"Y"  AND F7$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 4360
  274. 4370  HOME : RETURN 
  275. 5000  CALL 37896: REM  
  276. 5010 D6 = 0:RT = RC:PG = 0:CK = 0:LN = 0:SH = 0:W9$ = "": HOME : PRINT  TAB( 9)"* SEARCH DATA ROUTINE *": GOSUB 350: PRINT 
  277. 5020  INPUT "RECORD NUMBER SEARCH (Y/N) ? ";Z$: IF Z$ < >""  THEN  IF  ASC(Z$) = 17  THEN 5612
  278. 5030  IF Z$ < >"Y"  AND Z$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 5020
  279. 5040  PRINT : IF Z$ = "Y"  THEN  VTAB 3: PRINT  TAB( 4)"RECORD SEARCH-FOR RECORDS (1-"RC")": GOSUB 350: POKE 34,7: GOTO 5200
  280. 5060  VTAB 3: CALL  -958: PRINT  TAB( 13)"'ENTRY' SEARCH": GOSUB 350: PRINT : POKE 34,4: GOSUB 340: PRINT 
  281. 5090  INPUT "SEARCH FROM WHICH FIELD #: ";C: IF C <1  OR C >NC  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 5090
  282. 5100  PRINT : HOME : VTAB 7: HTAB 8: PRINT "* SEARCH MATCH OPTIONS *": PRINT : HTAB 10: PRINT "1- CHARACTERS ENTERED": HTAB 10: PRINT "2- ENTIRE FIELD": PRINT 
  283. 5120  HTAB 16: INPUT "WHICH: ";W9$: IF W9$ <"1"  OR W9$ >"2"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 5120
  284. 5130  IF W9$ = "2"  THEN  PRINT : GOTO 5160
  285. 5140  PRINT 
  286. 5150  INPUT "REGULAR OR INTERNAL SEARCH (R/I) ? ";Z2$: IF Z2$ < >"R"  AND Z2$ < >"I"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 5150
  287. 5160  HOME : VTAB 7: HTAB 10: PRINT "* PRINT-OUT ITEMS *": PRINT : HTAB 9: PRINT "1- EQUAL TO ENTRY": HTAB 9: PRINT "2- NOT EQUAL TO ENTRY": PRINT 
  288. 5170  HTAB 16: INPUT "WHICH: ";Z3$: IF Z3$ <"1"  OR Z3$ >"2"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 5170
  289. 5171  IF P1$ = "N"  THEN Z4$ = "N": GOTO 5180
  290. 5172  PRINT : INPUT "USE SUBHEADINGS (Y/N) ? ";Z4$: IF Z4$ < >"Y"  AND Z4$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 5172
  291. 5180  IF Z3$ = "2"  THEN  PRINT : HTAB 2: INVERSE : PRINT "> YOU MAY SEARCH FOR ONLY ONE ITEM <": NORMAL 
  292. 5190  IF Z3$ = "1"  THEN  HOME 
  293. 5200  IF Z3$ = "1"  OR Z$ = "Y"  THEN  PRINT  TAB( 6)"PRESS <CTRL-Q> WHEN FINISHED": GOSUB 350:CV =  PEEK(37): POKE 34,CV
  294. 5210  FOR SL = 1 TO RC: IF Z4$ = "Y"  AND SL <51  THEN  PRINT : PRINT "ENTER SUBHEADING OR <CTRL-Q>:":L = CO -4: GOSUB 800:SH$(SL) = B$:SH = SH +1: PRINT : IF SH$(SL) =  CHR$(17)  THEN SH = SH -1:SL = SL -1: TEXT : GOTO 5280
  295. 5221  PRINT : IF Z$ = "N"  THEN  PRINT "CHOICE ";SL;" ";:L = CL%(C): GOSUB 800:DT$(SL) = B$: GOSUB 950: IF DT$(SL) =  CHR$(17)  THEN SL = SL -1: TEXT : GOTO 5280
  296. 5230  IF Z$ = "N"  THEN 5260
  297. 5240  PRINT "CHOICE ";SL;" ";: INPUT DT$(SL): IF DT$(SL) =  CHR$(17)  THEN SL = SL -1: TEXT : GOTO 5280
  298. 5250  IF Z$ = "Y"  AND  VAL(DT$(SL)) <1  OR  VAL(DT$(SL)) >RC  THEN  PRINT  CHR$(7);: GOSUB 330: GOTO 5240
  299. 5260  IF Z3$ = "2"  THEN  TEXT : GOTO 5280
  300. 5270  NEXT 
  301. 5280  GOSUB 4000
  302. 5290  IF Z$ = "Y"  THEN  HOME : GOTO 5330
  303. 5305  IF C = SE  THEN 5320
  304. 5310  GOSUB 360: GOSUB 270: HOME 
  305. 5320 FX = 1: VTAB 12: HTAB 14: PRINT "> SEARCHING <":SE = C: IF Z2$ = "I"  THEN 5620
  306. 5330  FOR MA = 1 TO SL:FO = 0:PA =  LEN(DT$(MA)): IF PA <1  THEN PA = 1
  307. 5340  IF Z$ = "Y"  THEN RS =  VAL(DT$(MA)): GOTO 5495
  308. 5350  FOR RS = 1 TO RC: IF W9$ = "2"  THEN 5450
  309. 5400  IF Z3$ = "2"  THEN 5430
  310. 5410  IF  LEFT$(S$(RS),PA) = DT$(MA)  THEN 5495
  311. 5420  GOTO 5540
  312. 5430  IF  LEFT$(S$(RS),PA) < >DT$(MA)  THEN 5495
  313. 5440  GOTO 5540
  314. 5450  IF Z3$ = "2"  THEN 5480
  315. 5460  IF S$(RS) = DT$(MA)  THEN 5495
  316. 5470  GOTO 5540
  317. 5480  IF S$(RS) < >DT$(MA)  THEN 5495
  318. 5490  GOTO 5540
  319. 5495  IF FX = 1  THEN  HOME :FX = 0
  320. 5500  GOSUB 290: IF P$ = "N"  THEN 5530
  321. 5520  GOSUB 230: GOSUB 2000: IF Z$ = "Y"  THEN 5550
  322. 5525  GOTO 5540
  323. 5530  GOSUB 3000: IF Z$ = "Y"  THEN 5550
  324. 5540  NEXT RS
  325. 5545  IF Z$ = "N"  AND Z4$ = "N"  THEN FL = 2: GOSUB 960: FOR XT = 1 TO NC:X5(XT) = 0: NEXT 
  326. 5547  IF Z$ = "N"  AND Z4$ = "Y"  AND MA +1 =  <50  THEN  IF SH$(MA +1) < >""  THEN FL = 2: GOSUB 960: FOR XT = 1 TO NC:X5(XT) = 0: NEXT : GOTO 5550
  327. 5548  IF Z$ = "N"  AND Z4$ = "Y"  AND MA = SL  THEN FL = 2: GOSUB 960: FOR XT = 1 TO NC:X5(XT) = 0: NEXT 
  328. 5550  NEXT MA
  329. 5560  IF P$ = "N"  OR A$ = "N"  THEN 5580
  330. 5565 FK = 1:FL = 1: GOSUB 960: FOR XT = 1 TO NC:X4(XT) = 0: NEXT 
  331. 5570  GOSUB 250
  332. 5580  PRINT : PRINT  CHR$(7): INVERSE : PRINT "FINISHED!";: NORMAL : PRINT " A)NOTHER,R)ESTART,'RTN'MENU";: GET ZZ$: IF ZZ$ = "A"  THEN PG = 0:CK = 0:LN = 0:S = 0:NO = 0: HOME : PRINT : GOTO 5290
  333. 5590  IF B = 0  THEN  GOSUB 510
  334. 5610  IF ZZ$ = "R"  THEN 5000
  335. 5612  IF D1 = 1  THEN  HOME : PRINT  CHR$(7): VTAB 12: HTAB 4: PRINT "LOAD ";: INVERSE : PRINT "REPORT DISK";: NORMAL : PRINT " THEN PRESS 'RTN'";: GET Z$
  336. 5614  HOME : VTAB 12: HTAB 11: PRINT ">> LOADING MENU <<"
  337. 5616  PRINT D$"RUN MENU,D1"
  338. 5620  FOR MA = 1 TO SL:FO = 0:PA =  LEN(DT$(MA)): IF PA <1  THEN PA = 1
  339. 5640  FOR RS = 1 TO RC:F =  LEN(S$(RS)): FOR X = 1 TO F: IF  MID$ (S$(RS),X,PA) = DT$(MA)  THEN 5710
  340. 5680  NEXT : IF Z3$ = "2"  THEN 5715
  341. 5700  GOTO 5760
  342. 5710  IF Z3$ = "2"  THEN 5760
  343. 5715  IF FX = 1  THEN  HOME :FX = 0
  344. 5720  GOSUB 290: IF P$ = "N"  THEN 5750
  345. 5740  GOSUB 230: GOSUB 2000: GOTO 5760
  346. 5750  GOSUB 3000
  347. 5760  NEXT RS: NEXT MA: GOTO 5560
  348. 63000  GOTO 5000