home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / DF1.DSK / M.bas < prev    next >
BASIC Source File  |  2014-09-09  |  12KB  |  168 lines
  1. 10 TE$ = "": POKE 216,0: TEXT :D$ =  CHR$(4): PRINT D$"NOMON I,O,C": 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$: RETURN 
  3. 80  PRINT  TAB( 3)"* UNIV. DATA MANAGEMENT SYSTEM 4.0 *": PRINT  TAB( 6)"COPYRIGHT 1980 BY W.L.PASSAUER": RETURN 
  4. 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 
  5. 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$
  6. 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 
  7. 180 LL = (CL(NC) +NC): PRINT D$"OPEN"N$",L"LL",D"D1: DIM BB(RC),A$(NC),S$(RC),H$(NC),CL%(NC),WC$(RC),WT$(RC): 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
  8. 220  PRINT  CHR$(7);: GOTO 2000
  9. 230  PRINT D$"PR#"F8: IF CT$ < >""  THEN  PRINT CT$
  10. 231  RETURN 
  11. 240  PRINT D$"PR#"MO: RETURN 
  12. 250  PRINT : PRINT OF$LL",D"D1: FOR I = 1 TO X2:B1 = CL(C -1): PRINT RF$BB(I)",B"B1: INPUT S$(I): NEXT : PRINT CL$: RETURN 
  13. 270  PRINT OF$LL",D"D1: FOR I = 1 TO X2:B1 = CL(W1 -1): PRINT RF$I",B"B1: INPUT WC$(I): NEXT : PRINT CL$: RETURN 
  14. 280  PRINT OF$LL",D"D1: FOR I = 1 TO X2:B1 = CL(W1 -1): PRINT RF$BB(I)",B"B1: INPUT WC$(I): NEXT : PRINT CL$: RETURN 
  15. 290  PRINT OF$LL",D"D1: FOR I = 1 TO X2:B1 = CL(C -1): PRINT RF$I",B"B1: INPUT S$(I): NEXT : PRINT CL$: RETURN 
  16. 310  PRINT OF$LL",D"D1: FOR I = 1 TO X1:B1 = CL(DT -1): PRINT RF$I",B"B1: CALL 783:S$(I) =  MID$ (TE$,1): NEXT : PRINT CL$: RETURN 
  17. 330  PRINT OF$LL",D"D1: FOR I = 1 TO X1:B1 = CL(DT -1): PRINT RF$BB(I)",B"B1: CALL 783:S$(I) =  MID$ (TE$,1): NEXT : PRINT CL$: RETURN 
  18. 350  ONERR  GOTO 365
  19. 360  PRINT OF$LL",D"D1: FOR I = 1 TO RC:B1 = CL(WC -1): PRINT RF$I",B"B1: CALL 783:S$(I) =  MID$ (TE$,1): NEXT : PRINT CL$: POKE 216,0: RETURN 
  20. 365  POKE 216,0: PRINT  CHR$(7): HOME : VTAB 12: PRINT "DISK ERROR-RECORD ";: INVERSE : PRINT I;: NORMAL : PRINT " MAY BE BAD": PRINT "PRESS 'RTN'";: GET Z$: GOTO 3027
  21. 370 CV =  PEEK(37): POKE 37,(CV -1): CALL  -958: RETURN 
  22. 380  FOR X = 1 TO NC: PRINT  TAB( 4)X;"- ("CL%(X)") ";: HTAB 14: PRINT H$(X): NEXT : RETURN 
  23. 390  FOR X = 1 TO 40: PRINT "-";: NEXT : RETURN 
  24. 400  CALL 37896: RETURN 
  25. 410  PRINT : PRINT OF$LL",D"D1: FOR I = 1 TO X2: IF S$(I) < >""  THEN B1 = CL(Z5% -1): PRINT D$"WRITE"N$",R"BB(I)",B"B1: PRINT WT$(BB(I))
  26. 420  NEXT : PRINT CL$: RETURN 
  27. 800 B$ = "": PRINT :CV =  PEEK(37): HTAB HT: VTAB CV +V: FOR I = 1 TO L: PRINT "_";: NEXT : VTAB CV +V: HTAB HT
  28. 810  FOR I = 1 TO L +1
  29. 820  GET A$
  30. 823  IF E$ =  CHR$(10)  THEN E$ =  CHR$(92)
  31. 824  IF E$ =  CHR$(11)  THEN E$ =  CHR$(91)
  32. 825  IF E$ =  CHR$(12)  THEN E$ =  CHR$(95)
  33. 830  IF A$ =  CHR$(21)  THEN 820
  34. 840  IF A$ =  CHR$(8)  THEN  GOSUB 890: GOTO 820
  35. 850  IF A$ =  CHR$(13)  THEN  PRINT A$;: RETURN 
  36. 860  PRINT A$;:B$ = B$ +A$: NEXT 
  37. 870  IF  RIGHT$(B$,1) < > CHR$(13)  THEN  GOSUB 940: GOTO 800
  38. 880  RETURN 
  39. 890  IF I < = 1  THEN  RETURN 
  40. 900  PRINT  CHR$(8);"_"; CHR$(8);
  41. 910 I = I -1
  42. 920  IF I =  <1  THEN I = 1:B$ = "": RETURN 
  43. 930 B$ =  LEFT$(B$, LEN(B$) -1): RETURN 
  44. 940  PRINT  CHR$(7): INVERSE : HTAB 10: PRINT "ENTRY IS TOO LONG": NORMAL : RETURN 
  45. 2000  REM 
  46. 2010  CALL 37896:F4 = 0
  47. 2020 Z3$ = "":WC = 0:SU = 0:SN = 0:SA = 0:X1 = 0:X2 = 0:W9$ = "": HOME : PRINT  TAB( 12)"> MATH ROUTINE <": GOSUB 390: PRINT : IF P1$ = "N"  THEN 2060
  48. 2030  PRINT : INPUT "ON PRINTER (Y/N) ? ";P$: IF P$ < >""  THEN  IF  ASC(P$) = 17  THEN 3027
  49. 2040  IF P$ < >"Y"  AND P$ < >"N"  THEN  PRINT  CHR$(7): GOTO 2020
  50. 2050  GOSUB 370
  51. 2060  HTAB 12: PRINT "* MATH OPTIONS *": PRINT : HTAB 11: PRINT "1- TOTAL": HTAB 11: PRINT "2- AVERAGE": HTAB 11: PRINT "3- COUNT": HTAB 11: PRINT "4- TOTAL & AVERAGE"
  52. 2070  HTAB 11: PRINT "5- TOTAL & COUNT": HTAB 11: PRINT "6- AVERAGE & COUNT": HTAB 11: PRINT "7- ALL": PRINT : HTAB 16: INPUT "WHICH:";Z8$: IF Z8$ < >""  THEN  IF  ASC(Z8$) = 17  THEN 3027
  53. 2080  IF  VAL(Z8$) <1  OR  VAL(Z8$) >7  THEN  PRINT  CHR$(7): HOME : GOTO 2060
  54. 2085  IF Z8$ = "3"  THEN 2179
  55. 2090  HOME : GOSUB 380: PRINT : INPUT "COMPUTE WHICH FIELD # ";C:SU = 0: IF C <1  OR C >NC  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2090
  56. 2110  PRINT 
  57. 2120  INPUT "USE WEIGHTED OPTION (Y/N) ";Z2$: IF Z2$ < >"Y"  AND Z2$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2120
  58. 2130  IF Z2$ = "N"  THEN 2179
  59. 2140  HOME : VTAB 8: HTAB 10: PRINT "* WEIGHTED OPTIONS *": PRINT : HTAB 14: PRINT "1- SUM": HTAB 14: PRINT "2- SUBTRACT": HTAB 14: PRINT "3- MULTIPLY": HTAB 14: PRINT "4- DIVIDE": PRINT 
  60. 2150  HTAB 16: INPUT "WHICH: ";Z3$: IF Z3$ <"1"  OR Z3$ >"4"  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2150
  61. 2152  IF Z3$ = "1"  THEN W$ = "SUM"
  62. 2153  IF Z3$ = "2"  THEN W$ = "SUBTRACT"
  63. 2154  IF Z3$ = "3"  THEN W$ = "MULTIPLY"
  64. 2155  IF Z3$ = "4"  THEN W$ = "DIVIDE"
  65. 2160  HOME : GOSUB 380: PRINT : INVERSE : PRINT W$;: NORMAL : PRINT " FIELD ";: INVERSE : PRINT C;: NORMAL : PRINT " BY FIELD:";: INPUT "";W1: IF W1 <1  OR W1 >NC  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2160
  66. 2172  IF Z2$ = "N"  THEN 2180
  67. 2174  PRINT 
  68. 2175  INPUT "STORE WEIGHTED RESULT IN A FIELD (Y/N)";Z5$: IF Z5$ < >"Y"  AND Z5$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2175
  69. 2177  IF Z5$ = "Y"  THEN  HOME : GOSUB 380: PRINT : PRINT "STORE IN WHICH FIELD (1-"NC") ";: INPUT Z5%: IF Z5% <1  OR Z5% >NC  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2177
  70. 2179  HOME : PRINT 
  71. 2180  INPUT "'ENTRY' SEARCH OPTION (Y/N) ? ";W4$: IF W4$ < >"Y"  AND W4$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2180
  72. 2190  PRINT : IF W4$ = "N"  THEN  PRINT : GOTO 2280
  73. 2200  INPUT "MATCH EXACTLY (Y/N) ? ";W9$: IF W9$ < >"Y"  AND W9$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2200
  74. 2210  IF A1$ = "N"  THEN 2280
  75. 2220  PRINT : HTAB 11: PRINT "* COMPUTE ITEMS *": PRINT : HTAB 9: PRINT "1- EQUAL TO 'ENTRY'": HTAB 9: PRINT "2- NOT EQUAL TO 'ENTRY'": PRINT 
  76. 2230  HTAB 16: INPUT "WHICH: ";Z4$: IF Z4$ <"1"  OR Z4$ >"2"  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2230
  77. 2240  HOME : GOSUB 380: PRINT : INPUT "'ENTRY' FOUND IN WHAT FIELD # ?";WC: IF WC <1  OR WC >NC  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2240
  78. 2260  PRINT : PRINT "ENTER 'ENTRY': ":L = CL%(WC):V = 1:HT = 1: GOSUB 800:WO$ = B$:PA =  LEN(WO$): IF PA = 0  THEN PA = 1
  79. 2270  PRINT 
  80. 2280  INPUT "USE DATE OPTION (Y/N) ? ";Z$: IF Z$ < >"Y"  AND Z$ < >"N"  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2280
  81. 2290  PRINT : IF Z$ = "N"  THEN 2350
  82. 2300  PRINT 
  83. 2310  PRINT "'FROM' DATE (MM/DD/YY) ? ";:L = 8:HT = 27:V = 0: GOSUB 800:Y$ = B$: IF Y$ = ""  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2310
  84. 2320  PRINT 
  85. 2330  PRINT "'TO' DATE (MM/DD/YY) ? ";:L = 8:HT = 27:V = 0: GOSUB 800:X$ = B$: IF X$ = ""  THEN  PRINT  CHR$(7);: GOSUB 370: GOTO 2330
  86. 2340  HOME : GOSUB 380: PRINT : INPUT "DATES IN WHAT FIELD # ? ";DT: IF DT <1  OR DT >NC  THEN  PRINT  CHR$(7): GOTO 2340
  87. 2350  HOME : VTAB 12: HTAB 15: FLASH : PRINT "< WORKING >": NORMAL : PRINT : PRINT : IF W4$ = "Y"  THEN 2390
  88. 2370  IF W4$ = "N"  AND Z$ = "Y"  THEN X1 = RC: GOTO 2560
  89. 2380 X2 = RC: GOTO 2650
  90. 2390  GOSUB 350: FOR X = 1 TO RC: IF Z4$ = "1"  AND W9$ = "N"  THEN 2460
  91. 2420  IF Z4$ = "2"  AND W9$ = "Y"  THEN 2480
  92. 2430  IF Z4$ = "2"  AND W9$ = "N"  THEN 2500
  93. 2440  IF S$(X) = WO$  THEN 2520
  94. 2450  GOTO 2530
  95. 2460  IF  LEFT$(S$(X),PA) = WO$  THEN 2520
  96. 2470  GOTO 2530
  97. 2480  IF S$(X) < >WO$  THEN 2520
  98. 2490  GOTO 2530
  99. 2500  IF  LEFT$(S$(X),PA) < >WO$  THEN 2520
  100. 2510  GOTO 2530
  101. 2520 X1 = X1 +1:BB(X1) = X
  102. 2530  NEXT : IF X1 <1  THEN  PRINT "NO > WORD/NUMBER < MATCHES FOUND": GOTO 3020
  103. 2535  IF Z8$ = "3"  AND Z$ = "N"  THEN  HOME : GOTO 2766
  104. 2540  IF Z$ = "N"  THEN X2 = X1: GOTO 2650
  105. 2550  IF W4$ = "Y"  THEN  GOSUB 400: GOSUB 330: GOTO 2570
  106. 2560  GOSUB 400: GOSUB 310
  107. 2570  FOR X = 1 TO X1: IF  RIGHT$(S$(X),2) + LEFT$(S$(X),2) + MID$ (S$(X),4,2) > =  RIGHT$(Y$,2) + LEFT$(Y$,2) + MID$ (Y$,4,2)  THEN 2600
  108. 2590  GOTO 2640
  109. 2600  IF  RIGHT$(S$(X),2) + LEFT$(S$(X),2) + MID$ (S$(X),4,2) < =  RIGHT$(X$,2) + LEFT$(X$,2) + MID$ (X$,4,2)  THEN 2620
  110. 2610  GOTO 2640
  111. 2620  IF W4$ = "Y"  AND Z$ = "Y"  THEN X2 = X2 +1:BB(X2) = BB(X): GOTO 2640
  112. 2630 X2 = X2 +1:BB(X2) = X
  113. 2640  NEXT 
  114. 2650  IF X2 <1  THEN  PRINT : PRINT "NO > DATE < MATCHES FOUND": GOTO 3020
  115. 2655  IF Z8$ = "3"  THEN  HOME : GOTO 2766
  116. 2660  IF Z$ = "Y"  OR W4$ = "Y"  THEN  GOSUB 400: GOSUB 250: IF Z2$ = "Y"  THEN  GOSUB 280
  117. 2670  IF Z$ = "Y"  OR W4$ = "Y"  THEN  GOTO 2690
  118. 2680  GOSUB 290: IF Z2$ = "Y"  THEN  GOSUB 270
  119. 2685  FOR X = 1 TO RC:BB(X) = X: NEXT 
  120. 2690  FOR AD = 1 TO X2:AB = AD: IF S$(AB) = ""  THEN S$(AB) = "00": GOTO 2760
  121. 2715  IF  ASC( LEFT$(S$(AB),1)) = 36  THEN 3400
  122. 2720  IF Z2$ = "Y"  THEN 3030
  123. 2740 SU = SU + VAL(S$(AB)):SN = SN +1
  124. 2760  NEXT : HOME : VTAB 3: IF P$ = "Y"  THEN  GOSUB 230
  125. 2765 SU =  INT(SU *10 ^N +.5)/ INT(10 ^N +.5)
  126. 2766  IF W4$ = "Y"  THEN  PRINT "'ENTRY' ENTERED: <"WO$">": PRINT 
  127. 2767  IF Z$ = "Y"  THEN  PRINT "DATES ENTERED: FROM: <"Y$">": HTAB 16: PRINT "TO:   <"X$">": PRINT 
  128. 2768  IF Z8$ = "3"  AND Z$ = "N"  AND W4$ = "Y"  THEN 3410
  129. 2769  IF Z8$ = "3"  THEN 3420
  130. 2780  IF Z2$ = "Y"  AND Z3$ = "1"  THEN  PRINT : PRINT "-SUM- WEIGHTED,USING <"H$(W1)"> FIELD"
  131. 2785  IF Z2$ = "Y"  AND Z3$ = "2"  THEN  PRINT : PRINT "-SUBRTACT- WEIGHTED,USING <"H$(W1)"> FIELD"
  132. 2790  IF Z2$ = "Y"  AND Z3$ = "3"  THEN  PRINT : PRINT "-MULTIPLY- WEIGHTED,USING <"H$(W1)"> FIELD"
  133. 2795  IF Z2$ = "Y"  AND Z3$ = "4"  THEN  PRINT : PRINT "-DIVIDE-WEIGHTED,USING <"H$(W1)"> FIELD"
  134. 2800  IF S$(AD -1) = ""  THEN 2890
  135. 2880  IF Z8$ = "1"  THEN  GOSUB 2950: GOTO 3018
  136. 2890  IF Z8$ = "2"  THEN  GOSUB 2980: GOTO 3018
  137. 2900  IF Z8$ = "3"  THEN  GOSUB 2970: GOTO 3018
  138. 2910  IF Z8$ = "4"  THEN  GOSUB 2950: GOSUB 2980: GOTO 3018
  139. 2920  IF Z8$ = "5"  THEN  GOSUB 2950: GOSUB 2970: GOTO 3018
  140. 2930  IF Z8$ = "6"  THEN  GOSUB 2980: GOSUB 2970: GOTO 3018
  141. 2940  IF Z8$ = "7"  THEN  GOSUB 2950: GOSUB 2980: GOSUB 2970: GOTO 3018
  142. 2950  PRINT : PRINT H$(C)" = ";SU: RETURN 
  143. 2970  PRINT : PRINT H$(C)" (COUNT)= "SN: RETURN 
  144. 2980  IF SN >0  THEN SA = SU/SN: PRINT : PRINT H$(C)" (AVE.)= "SA: RETURN 
  145. 2990  PRINT : PRINT H$(C)" (AVE.)= 0": RETURN 
  146. 3018  IF F4 >0  THEN  PRINT : PRINT F4" 'NULLS' FOUND IN FIELD # "W1
  147. 3019  GOSUB 240: IF Z5$ = "Y"  THEN  FLASH : VTAB 22: HTAB 4: PRINT "WRITING WEIGHTED ANSWERS TO FILE": NORMAL : GOSUB 410: GOTO 3025
  148. 3020  IF Z5$ < >"Y"  THEN  VTAB 23
  149. 3025 CV =  PEEK(37): POKE 37,(CV -2): CALL  -958: PRINT  CHR$(7);: INVERSE : PRINT "R)ESTART, 'RTN' TO MENU ";: GET Z$: NORMAL 
  150. 3026  IF Z$ = "R"  THEN 2000
  151. 3027  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$
  152. 3028  HOME : VTAB 12: HTAB 11: PRINT ">> LOADING MENU <<"
  153. 3029  PRINT D$"RUN MENU,D1"
  154. 3030  IF WC$(AB) = ""  THEN S$(AB) = "":WT =  VAL(S$(AB)):F4 = F4 +1: GOTO 3380
  155. 3035  IF  ASC( LEFT$(WC$(AB),1)) = 36  THEN 3400
  156. 3040  IF Z3$ = "1"  THEN 3130
  157. 3045  IF Z3$ = "2"  THEN 3230
  158. 3047  IF Z3$ = "4"  THEN 3330
  159. 3080 WT = ( VAL(S$(AB)) * VAL(WC$(AB))): GOTO 3380
  160. 3130 WT = ( VAL(S$(AB)) + VAL(WC$(AB))): GOTO 3380
  161. 3230 WT = ( VAL(S$(AB)) - VAL(WC$(AB))): GOTO 3380
  162. 3330 WT = ( VAL(S$(AB))/ VAL(WC$(AB))): GOTO 3380
  163. 3380  IF S$(AB) < >""  OR S$(AB) < >"@"  THEN SU = SU +WT:WT$(BB(AB)) =  STR$( INT(WT *10 ^N +.5)/ INT(10 ^N +.5)):SN = SN +1
  164. 3390  GOTO 2760
  165. 3400  HOME : PRINT  CHR$(7): VTAB 12: HTAB 9: PRINT "-$- ERROR! PRESS 'RTN'";: GET Z$: GOTO 3025
  166. 3410  VTAB 12: PRINT H$(WC)" (COUNT)="X1: GOTO 3018
  167. 3420  VTAB 12: PRINT H$(DT)" (COUNT)="X2: GOTO 3018
  168. 63000  GOTO 2000