home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib14.dsk / EXPENSE-CALC.bas < prev    next >
BASIC Source File  |  2023-02-26  |  25KB  |  557 lines
  1. 10  REM  **********************
  2. 11  REM  *    EXPENSE-CALC    *
  3. 12  REM  *  BY JOHN A. OAKEY  *
  4. 13  REM  * COPYRIGHT (C) 1983 *
  5. 14  REM  * BY MICROSPARC, INC *
  6. 15  REM  * LINCOLN, MA. 01773 *
  7. 16  REM  **********************
  8. 1190  POKE 768,6: POKE 769,1
  9. 1200  HOME : PRINT "EC": HTAB 10: VTAB 12: INVERSE : PRINT "ONE MOMENT PLEASE": NORMAL : VTAB 20: PRINT "** COPYRIGHT 1983 BY MICROSPARC, INC. **"
  10. 1220 D$ =  CHR$(4)
  11. 1240  PRINT D$"BRUN AMPER-INTERPRETER"
  12. 1260  GOTO 11000
  13. 1280  REM  ----------------------
  14. 1300  REM  SUB TO SET CURSOR POS
  15. 1320  REM  ----------------------
  16. 1340  VTAB Y: HTAB X: RETURN 
  17. 1360  REM  ----------------------
  18. 1380  REM  SUB TO PRINT DATA COLM
  19. 1400  REM  ----------------------
  20. 1420 EX = 1:Y = 1:X = 16 +P *7: GOSUB 1340: PRINT DA$(DA)
  21. 1440 Y = 2:X = X -2: GOSUB 1340
  22. 1460  INVERSE : PRINT "------": NORMAL 
  23. 1480  REM  PRINT DATA
  24. 1500  FOR Y = 3 TO 18
  25. 1520  GOSUB 1340
  26. 1540 OP = IT(DA,EX):
  27. 1560  & PRNT,OP,F$
  28. 1580 EX = EX +1
  29. 1600  NEXT Y
  30. 1620  REM  PRINT SUBTOTAL
  31. 1640 X = X -1:Y = 19: GOSUB 1340:OP = 0
  32. 1660  & PRNT,IT(DA,17),F2$
  33. 1680 X = X +1
  34. 1700  REM  PRINT PERSONAL MILEAGE
  35. 1720 Y = 20: GOSUB 1340
  36. 1740  & PRNT,IT(DA,18),F$
  37. 1760  REM  PRINT NET TOTAL
  38. 1780 Y = 21:X = X -1: GOSUB 1340
  39. 1800  & PRNT,IT(DA,19),F2$
  40. 1820 X = X +1: IF DA < >8  THEN  RETURN 
  41. 1840  REM  IF TOTALS PRNT ADV/DIF
  42. 1860  IF IT(8,19) <10000 GOTO 1940
  43. 1880 Y = 21:X = X -3: GOSUB 1340
  44. 1900  & PRNT,IT(DA,19),F3$
  45. 1920 X = X +3
  46. 1940 Y = 22: GOSUB 1340
  47. 1950  IF  LEFT$(DA$,4) = "YEAR"  THEN AD = HOLD(8,20)
  48. 1960  & PRNT,AD,F$
  49. 1970 DI = IT(8,19) -AD
  50. 1980 X = X -3:Y = 23: GOSUB 1340
  51. 1990 AD = 100: REM  CUSTOMIZE TO YOUR OWN TASTE
  52. 2000  & PRNT,DI,F3$
  53. 2020  RETURN 
  54. 2040  REM  **********************
  55. 2060  REM 
  56. 2080  REM  SPACE RESERVED FOR A
  57. 2100  REM  BASIC SCREEN FORMAT-
  58. 2120  REM  ING ROUTINE IN CASE A
  59. 2140  REM  "PRINT USING" UTILITY
  60. 2160  REM  IS NOT AVAILABLE.  SEE
  61. 2180  REM  ARTICLE FOR OTHER RE-
  62. 2200  REM  QUIRED CHANGES.
  63. 2220  REM 
  64. 2240  REM  **********************
  65. 2260  REM  ----------------------
  66. 2280  REM  ROUTINE TO INPUT DATA
  67. 2300  REM  ----------------------
  68. 2320 A$ = "":E$ = "":X = 14 +P *7
  69. 2340  FOR Y = 3 TO 18: GOSUB 2360: NEXT : GOTO 2900
  70. 2360 EX = Y -2:I$ = EX$(EX): GOSUB 3280: GOSUB 3180:CT = 0: IF Y = 19  THEN  POP : GOSUB 3300: GOTO 2320
  71. 2380  IF EX = 1  THEN I$ = INST$: GOSUB 3180
  72. 2400  GOSUB 1340
  73. 2420  IF IT(DA,EX) < >0  THEN  GOSUB 1340: PRINT  CHR$(8)">";: & PRNT,IT(DA,EX),F$: GOTO 2460
  74. 2440  PRINT  CHR$(8)">"UNDERLINE$
  75. 2460  GOSUB 1340
  76. 2480 A$ = "":E$ = "":CT = 0: GOSUB 1340
  77. 2500  POKE 49168,0: GET A$
  78. 2520  IF A$ = "L"  OR A$ = "R"  OR A$ =  CHR$(8)  OR A$ =  CHR$(21)  OR A$ = "Q"  THEN  POP : GOSUB 3300:IT(DA,17) = 0: FOR I = 1 TO 16:IT(DA,17) = IT(DA,17) +IT(DA,I): NEXT :IT(DA,19) = IT(DA,17) -IT(DA,18):OP = IT(DA,19): GOSUB 1340: PRINT  CHR$(8)" ";: RETURN 
  79. 2540  IF A$ =  CHR$(13)  AND IT(DA,EX) < >0 GOTO 2820
  80. 2560  IF A$ =  CHR$(13)  THEN E$ = "0": GOTO 2780
  81. 2580  IF A$ < > CHR$(8)  AND A$ < > CHR$(21)  AND A$ < > CHR$(27)  AND A$ < >"L"  AND A$ < >"R"  AND A$ < >"Q"  AND A$ < >"."  AND (A$ <"0"  OR A$ >"9") GOTO 2500
  82. 2600  GOTO 2640
  83. 2620  POKE 49168,0: GET A$
  84. 2640  IF A$ =  CHR$(27)  THEN  GOSUB 3300: GOSUB 1340: PRINT  CHR$(8)" ";: & PRNT,IT(DA,EX),F$:Y = Y -1: IF Y <3  THEN Y = 3
  85. 2660  IF A$ =  CHR$(27)  THEN  GOTO 2360
  86. 2680  IF A$ =  CHR$(13) GOTO 2780
  87. 2700  IF (A$ <"0"  OR A$ >"9")  AND A$ < >"."  THEN  GOTO 2360
  88. 2720  IF CT = 0  AND IT(DA,EX) < >0  THEN  PRINT " ";: GOSUB 1340
  89. 2740  PRINT A$;:E$ = E$ +A$:CT = CT +1: IF CT = 6 GOTO 2780
  90. 2760  GOTO 2620
  91. 2780 IT(DA,EX) = ( INT( VAL(E$) *100 +0.001))/100
  92. 2800  IF IT(DA,EX) >999.99  THEN I$ = "ITEM > $999.99": FLASH : GOSUB 3200: FOR J = 1 TO 2000: NEXT J:IT(DA,EX) = 0: GOTO 2360
  93. 2820 X = X -1: GOSUB 1340: PRINT " ";: & PRNT,IT(DA,EX),F$:E$ = ""
  94. 2840  GOSUB 3300:X = X +1
  95. 2860  RETURN 
  96. 2880  REM  DO SUBTOTAL
  97. 2900 Y = 19: GOSUB 1340:OP = 0:IT(DA,17) = 0
  98. 2920  FOR I = 1 TO 16:IT(DA,17) = IT(DA,17) +IT(DA,I): NEXT :IT(DA,17) = ( INT(IT(DA,17) *100 +0.001))/100
  99. 2940  & PRNT,IT(DA,17),F$
  100. 2960  REM  GET PERSONAL MILEAGE
  101. 2980 Y = 20: GOSUB 2360: GOSUB 1340
  102. 3000  & PRNT,IT(DA,18),F$
  103. 3020  REM  PRINT NET TOTAL
  104. 3040 I$ = INST$: GOSUB 3180
  105. 3060 Y = 21: GOSUB 1340:OP = IT(DA,17) -IT(DA,18):IT(DA,19) = ( INT(OP *100 +0.001))/100
  106. 3080  & PRNT,OP,F$
  107. 3100  RETURN 
  108. 3120  REM  ----------------------
  109. 3140  REM  PRINT INSTRUCTION LINE
  110. 3160  REM  ----------------------
  111. 3180  INVERSE 
  112. 3200  VTAB 24: HTAB 1: CALL  -868: PRINT I$;: NORMAL : RETURN 
  113. 3220  REM  ----------------------
  114. 3240  REM     PRINT ITEM NAME
  115. 3260  REM  ----------------------
  116. 3280  INVERSE 
  117. 3300 XS = X:X = 1: GOSUB 1340
  118. 3320  PRINT EX$(EX): NORMAL :X = XS: RETURN 
  119. 3340  GOSUB 1340
  120. 3360  PRINT EX$(EX)
  121. 3380  NORMAL :X = XS
  122. 3400  RETURN 
  123. 3420  REM  ----------------------
  124. 3440  REM  SCREEN SET UP HERE
  125. 3460  REM  ----------------------
  126. 3480  REM  SET UP SCREEN
  127. 3500  HOME 
  128. 3520  PRINT "   ITEM        SUN    MON    TUE    WED ";
  129. 3540  INVERSE 
  130. 3560  PRINT "   ----        ---    ---    ---    --- ";
  131. 3580  NORMAL 
  132. 3600  FOR I = 1 TO 21
  133. 3620  PRINT EX$(I)
  134. 3640  NEXT 
  135. 3660 I$ = "INITIAL SET UP"
  136. 3680  GOSUB 3180
  137. 3700  IF S% = 1  THEN  RETURN 
  138. 3720 X = 20:Y = 9: GOSUB 1340
  139. 3740  PRINT "EXPENSE-CALC"
  140. 3760 Y = 10: GOSUB 1340: PRINT "BY"
  141. 3780 Y = 11: GOSUB 1340: PRINT "JOHN A. OAKEY"
  142. 3800 Y = 14: GOSUB 1340: PRINT "PLEASE CHOOSE ONE: ";
  143. 3820 Y = 15: GOSUB 1340: PRINT "<1> INPUT DATA";
  144. 3840 Y = 16: GOSUB 1340: PRINT "<2> MAIN MENU ";
  145. 3860 Y = 17: GOSUB 1340: FLASH : PRINT "->";: NORMAL : PRINT "  ";: GET A$
  146. 3880 S% = 1
  147. 3900  IF A$ = "1" GOTO 8940
  148. 3920  IF A$ = "2"  THEN  PRINT A$: GOTO 8660
  149. 3940  GOTO 3860
  150. 3960  REM  ----------------------
  151. 3980  REM  SUB TO REDUCE WINDOW
  152. 4000  REM  ----------------------
  153. 4020  POKE 33,29: POKE 32,11: POKE 34,2: RETURN 
  154. 4040  REM  ----------------------
  155. 4060  REM  REVIEW/CHG/DEL/UPDATE
  156. 4080  REM  ----------------------
  157. 4100  HOME :S2% = 0
  158. 4120  INVERSE : PRINT  SPC( 9)"REVIEW/CHANGE/UPDATE" SPC( 10): NORMAL : PRINT 
  159. 4140  VTAB 8: PRINT "DO YOU WANT:": PRINT : PRINT : PRINT "(1) YEAR-TO-DATE INFORMATION": PRINT : PRINT "(2) A PAST WEEK'S EXPENSES": IF S4% = 1  THEN  PRINT : PRINT "(3) THE DATA JUST INPUT"
  160. 4160  PRINT : PRINT : PRINT "PRESS ESC TO RETURN TO THE MAIN MENU OR INDICATE YOUR CHOICE BY NUMBER PLEASE: ";: GET ANS$: PRINT ANS$: IF ANS$ =  CHR$(27) GOTO 8660
  161. 4180  IF ANS$ <"1"  OR ANS$ >"3" GOTO 4100
  162. 4200 A =  VAL(ANS$): PRINT : PRINT : PRINT OMP$: IF A = 3  AND S4% < >1 GOTO 4100
  163. 4220  ON A GOTO 4260,4480,4860
  164. 4240  REM  YEAR-TO-DATE
  165. 4260  HOME 
  166. 4280  IF S4% = 1  AND S1% = 0  THEN  PRINT : PRINT "NOTE: THIS WILL DESTROY THE DATA WHICH  WAS JUST INPUT BUT NOT SAVED. PRESS ESC TO CONTINUE--ANYTHING ELSE TO RETURN: ";: GET A$: PRINT A$: IF A$ < > CHR$(27) GOTO 4100
  167. 4300 DA$ = "YEAR-TO-DATE"
  168. 4320 S1% = 0:S2% = 1:S3% = 1:S4% = 0:S5% = 1
  169. 4340  INVERSE : PRINT  SPC( 10)DA$" TOTALS" SPC( 11): NORMAL 
  170. 4360  POKE 34,1
  171. 4380  GOSUB 6220
  172. 4400  TEXT 
  173. 4420  FOR DA = 1 TO 8: FOR EX = 1 TO 20:IT(DA,EX) = HOLD(DA,EX): NEXT EX,DA
  174. 4440  GOTO 4860
  175. 4460  REM  PAST WEEK'S EXPENSES
  176. 4480  HOME 
  177. 4500  IF S4% = 1  AND S1% = 0  THEN  PRINT "NOTE: THIS WILL DESTROY THE DATA WHICH  WAS JUST INPUT AND NOT YET SAVED.  PRESSESC TO CONTINUE--ANYTHING ELSE TO START OVER. ->";: GET A$: PRINT A$: IF A$ < > CHR$(27) GOTO 4100
  178. 4520 S4% = 0:S2% = 1:S3% = 0: HOME 
  179. 4540  INVERSE :TI$ = "     REVIEW A PAST WEEK'S EXPENSES      ": PRINT TI$: NORMAL : POKE 34,1
  180. 4560  VTAB 8: PRINT "DO YOU WANT A CATALOG (Y/N)?";: GET A$: PRINT A$: IF A$ = "Y"  THEN  PRINT D$"CATALOG,S"SL",D"DR: PRINT : PRINT : PRINT "PRESS ANY KEY TO CONTINUE->";: GET B$: PRINT B$: GOTO 4600
  181. 4580  IF A$ < >"N" GOTO 4560
  182. 4600  HOME : VTAB 12: PRINT "PLEASE INPUT THE DATE/NAME OF THE WEEK  WHICH YOU WISH TO REVIEW.": GOSUB 7060
  183. 4620  HOME : PRINT OMP$
  184. 4640  PRINT D$"MON C,I,O"
  185. 4660  PRINT D$"OPEN EXPENSES FOR "DA$",L9,S"SL",D"DR
  186. 4680  FOR DA = 1 TO 8
  187. 4700  FOR EX = 1 TO 19
  188. 4720  PRINT D$"READ EXPENSES FOR "DA$",R";(DA -1) *19 +EX
  189. 4740  INPUT IT(DA,EX)
  190. 4760  NEXT EX,DA
  191. 4780  PRINT D$"CLOSE"
  192. 4800  PRINT D$"NOMON C,I,O"
  193. 4820  TEXT 
  194. 4840  REM  REVIEW DATA SUBROUTINE
  195. 4860  GOSUB 3500
  196. 4880 P = 0:S = 1
  197. 4900  GOSUB 4020: HOME : TEXT :I$ = "REVIEW: <-/->/L/R/C(HANGE/P(RINT/ESC": GOSUB 3180
  198. 4920  FOR DA = S TO S +3: GOSUB 1420:P = P +1: NEXT :P = 0
  199. 4940 I$ = "REVIEW: <-/->/L/R/C(HANGE/P)RINT/ESC": GOSUB 3180
  200. 4960  GET A$
  201. 4980  IF A$ =  CHR$(8)  THEN S = S -1: IF S <1  THEN S = 1: GOTO 4960
  202. 5000  IF A$ =  CHR$(8) GOTO 4900
  203. 5020  IF A$ =  CHR$(21)  THEN S = S +1: IF S >5  THEN S = 5: GOTO 4960
  204. 5040  IF A$ =  CHR$(21) GOTO 4900
  205. 5060  IF A$ = "L"  THEN S = 1: GOTO 4900
  206. 5080  IF A$ = "R"  THEN S = 5: GOTO 4900
  207. 5100  IF A$ = "C"  AND ANS$ = "1"  THEN I$ = "Y-T-D CHANGES NOT ALLOWED": FLASH : GOSUB 3200: FOR I = 1 TO 1200: NEXT : GOTO 4920
  208. 5120  IF A$ = "C" GOTO 5240
  209. 5140  IF A$ =  CHR$(27) GOTO 8660
  210. 5160  IF A$ = "P"  AND S3% = 0  THEN  GOSUB 7060
  211. 5180  IF A$ = "P"  THEN  GOSUB 9220: GOTO 4920
  212. 5200  GOTO 4960
  213. 5220  REM  CHANGE ROUTINE
  214. 5240  HOME :S5% = 1
  215. 5260  IF S4% = 1  AND S1% = 0 GOTO 5380
  216. 5280  GOSUB 6200: PRINT OMP$
  217. 5300  FOR DA = 1 TO 8
  218. 5320  FOR EX = 1 TO 19
  219. 5340 HOLD(DA,EX) = ( INT((HOLD(DA,EX) -IT(DA,EX)) *100 +.001))/100
  220. 5360  NEXT EX,DA
  221. 5370 HOLD(8,20) = HOLD(8,20) -AD
  222. 5380  GOSUB 3500: REM  MAIN INPUT ENTERS HERE
  223. 5400  GOSUB 4020: HOME : TEXT :I$ = INST$: GOSUB 3180
  224. 5420 DA = 1: FOR P = 0 TO 3: GOSUB 1420:DA = DA +1: NEXT :P = 0:DA = 1
  225. 5440  GOSUB 2320
  226. 5460 I$ = INST$: GOSUB 3180
  227. 5480  FOR PAUSE = 1 TO 1000: NEXT 
  228. 5500  GOSUB 1420
  229. 5520  IF A$ = "L" GOTO 5400
  230. 5540  IF A$ = "R"  THEN DA = 5: GOSUB 4020: HOME : TEXT :I$ = INST$: GOSUB 3180: FOR P = 0 TO 3: GOSUB 1420:DA = DA +1: NEXT :DA = 5:P = 0: GOTO 5440
  231. 5560  IF A$ = "Q" GOTO 5720
  232. 5580  IF A$ =  CHR$(8)  THEN DA = DA -1:P = P -1: IF DA <1  THEN DA = 1:P = 0
  233. 5600  IF P <0  THEN  GOSUB 4020: HOME : TEXT : FOR P = 0 TO 3: GOSUB 1420:DA = DA +1: NEXT :P = 0:DA = DA -4
  234. 5620  IF A$ =  CHR$(8) GOTO 5440
  235. 5640 DA = DA +1:P = P +1
  236. 5660  IF DA = 8 GOTO 5720
  237. 5680  IF P >3  THEN  GOSUB 4020: HOME : TEXT :DA = DA -3: FOR P = 0 TO 3: GOSUB 1420:DA = DA +1: NEXT :DA = DA -1:P = 3: GOTO 5440
  238. 5700  GOTO 5440
  239. 5720 I$ = OMP$: FLASH : GOSUB 3200: NORMAL : FOR EX = 1 TO 19:IT(8,EX) = 0: FOR DA = 1 TO 7:IT(8,EX) = IT(8,EX) +IT(DA,EX): NEXT DA,EX
  240. 5740 DA = 5: FOR P = 0 TO 3: GOSUB 1420:DA = DA +1: NEXT 
  241. 5760  POKE  -16368,0:I$ = "SELECT: 1-DEL RPT 2-SAVE 3-CONT 4-MENU:": GOSUB 3180: GET A$: IF A$ <"1"  OR A$ >"4" GOTO 5760
  242. 5780  POKE 2039, ASC(A$) +128
  243. 5800 X =  VAL(A$)
  244. 5820  ON X GOTO 5920,5860,5400,8660
  245. 5840  REM  SAVE RPT/UPDATE Y-T-D
  246. 5860  IF S4% = 1  AND S1% = 0  THEN S2% = 0:S5% = 0: POKE 34,23: HOME : PRINT : TEXT : GOTO 6160
  247. 5880  HOME :S5% = 0: GOTO 6460
  248. 5900  REM  CLEAR & ERASE
  249. 5920  HOME 
  250. 5940  IF S4% = 1  THEN  PRINT "DATA JUST INPUT HAS BEEN CLEARED.": CLEAR :S% = 1: VTAB 10: PRINT "PRESS ANY KEY TO CONTINUE: ";: GET A$: PRINT A$: GOTO 11020
  251. 5960  PRINT "THIS FUNCTION WILL COMPLETELY DELETE    THE REPORT FILE TITLED:": PRINT : PRINT "EXPENSES FOR "DA$
  252. 5980  PRINT : PRINT "AND UPDATE THE YEAR TO DATE TOTALS TO   REFLECT IT'S REMOVAL.  IF YOU ARE SURE  YOU WISH TO CONTINUE PRESS ESC.  ANY    OTHER KEY WILL RETURN YOU TO THE CHANGE MODE. ->";: GET A$: PRINT A$
  253. 6000  IF A$ < > CHR$(27) GOTO 5380
  254. 6020  PRINT D$"MON C,I,O"
  255. 6040  PRINT D$"DELETE EXPENSES FOR "DA$",S"SL",D"DR
  256. 6060 S5% = 1: GOSUB 6620
  257. 6080  GOTO 8660
  258. 6100  REM  --------------------
  259. 6120  REM  UPDATE TOTALS FILE
  260. 6140  REM  --------------------
  261. 6160  HOME : INVERSE : PRINT "GETTING YEAR-TO-DATE TOTALS FILE": NORMAL 
  262. 6180  PRINT : GOTO 6220
  263. 6200  HOME : INVERSE : PRINT "ONE MOMENT PLEASE": NORMAL 
  264. 6220  PRINT D$"VERIFY EXPCALC-TOTALS"
  265. 6240  REM  IF NO ERR SAVE FILES
  266. 6260  HOME : PRINT : PRINT D$"MON C,I,O"
  267. 6280  PRINT D$"OPEN EXPCALC-TOTALS,L9,S"SL",D"DR
  268. 6300  FOR DA = 1 TO 8
  269. 6320  FOR EX = 1 TO 19
  270. 6340  PRINT D$"READ EXPCALC-TOTALS,R"(DA -1) *19 +EX
  271. 6360  INPUT HOLD(DA,EX)
  272. 6380  NEXT EX,DA
  273. 6390  INPUT HOLD(8,20)
  274. 6400  PRINT D$;"CLOSE EXPCALC-TOTALS"
  275. 6420  PRINT D$"NOMON C,I,O"
  276. 6440  IF S5% = 1  OR S2% = 1  THEN  RETURN 
  277. 6460  HOME : INVERSE : PRINT " UPDATING YEAR-TO-DATE TOTALS FILE DATA": NORMAL : PRINT : PRINT : PRINT OMP$
  278. 6480  PRINT D$"MON C,I,O"
  279. 6500  FOR DA = 1 TO 8
  280. 6520  PRINT DA$(DA)
  281. 6540  FOR EX = 1 TO 19
  282. 6560 HOLD(DA,EX) = ( INT((HOLD(DA,EX) +IT(DA,EX)) *100 +.001))/100
  283. 6580  NEXT EX,DA
  284. 6590 HOLD(8,20) = HOLD(8,20) +AD
  285. 6600  HOME : INVERSE : PRINT "WRITING YEAR-TO-DATE TOTALS FILE": NORMAL : PRINT : PRINT 
  286. 6620  PRINT D$"OPEN EXPCALC-TOTALS,L9,S"SL",D"DR
  287. 6640  PRINT D$"DELETEEXPCALC-TOTALS,S"SL",D"DR
  288. 6660  PRINT D$"OPEN EXPCALC-TOTALS,L9,S"SL",D"DR
  289. 6680  FOR DA = 1 TO 8
  290. 6700  FOR EX = 1 TO 19
  291. 6720  PRINT D$;"WRITE EXPCALC-TOTALS,R";(DA -1) *19 +EX
  292. 6740  PRINT ( INT(HOLD(DA,EX) *100 +0.001))/100
  293. 6760  NEXT EX,DA
  294. 6770  PRINT HOLD(8,20)
  295. 6780  PRINT D$"CLOSE"
  296. 6800  PRINT D$"NOMON C,I,O"
  297. 6820  IF S5% = 1  THEN  RETURN 
  298. 6840  HOME 
  299. 6860  INVERSE : PRINT "UPDATED TOTALS FOR YEAR-TO-DATE": NORMAL : PRINT 
  300. 6880  FOR I = 1 TO 20
  301. 6900  VTAB I +2: HTAB 1
  302. 6920  PRINT EX$(I); SPC( 10)
  303. 6940  & PRNT,HOLD(8,I),F3$
  304. 6960  NEXT : VTAB 23: HTAB 39: PRINT 
  305. 6980  IF S3% = 1  THEN  VTAB 24: PRINT "PRESS ANY KEY TO CONTINUE: ";: GET A$: PRINT A$: HOME 
  306. 7000  REM  ---------------------
  307. 7020  REM  GET AND VERIFY DATE
  308. 7040  REM  ---------------------
  309. 7060  IF S3% = 1 GOTO 7700
  310. 7080 I$ = "ASSIGN DATE/NAME TO THE EXPENSE REPORT": GOSUB 3180:DA$ = "":A$ = "":MO$ = "":YR$ = "":DY$ = "": GOSUB 7140
  311. 7100  IF S2% = 1  THEN  RETURN 
  312. 7120  GOTO 7700
  313. 7140 X = 1:Y = 23: GOSUB 1340: CALL  -868: PRINT "INPUT # OF MONTH (1-12) -> ";:A$ = "":MO$ = ""
  314. 7160  GET A$: IF A$ > CHR$(47)  AND A$ < CHR$(58)  THEN MO$ = MO$ +A$: PRINT A$;: GOTO 7160
  315. 7180  IF A$ =  CHR$(13)  OR A$ = "/"  THEN A$ = "/": PRINT A$;: GOTO 7220
  316. 7200  GOTO 7140
  317. 7220 DT% =  VAL(MO$): IF DT% <1  OR DT% >12 GOTO 7140
  318. 7240 MO$ = MO$ +A$
  319. 7260  GOSUB 1340: CALL  -868: PRINT "INPUT STARTING DAY DATE (1-31) -> "MO$;:A$ = "":DY$ = ""
  320. 7280  GET A$: IF A$ > CHR$(47)  AND A$ < CHR$(58)  THEN DY$ = DY$ +A$: PRINT A$;: GOTO 7280
  321. 7300  IF A$ =  CHR$(13)  OR A$ = "/"  THEN A$ = "/": PRINT A$;: GOTO 7340
  322. 7320  GOTO 7260
  323. 7340 DT% =  VAL(DY$): IF DT% <1  OR DT% >31 GOTO 7260
  324. 7360 DY$ = DY$ +A$
  325. 7380  GOSUB 1340: CALL  -868: PRINT "INPUT YEAR ->  "MO$DY$;:A$ = "":YR$ = ""
  326. 7400  GET A$: IF A$ > CHR$(47)  AND A$ < CHR$(58)  THEN YR$ = YR$ +A$: PRINT A$;: GOTO 7400
  327. 7420  IF A$ =  CHR$(13) GOTO 7460
  328. 7440  GOTO 7380
  329. 7460  IF  LEN(YR$) = 2  OR  LEN(YR$) = 4 GOTO 7500
  330. 7480  GOTO 7380
  331. 7500  IF  LEN(YR$) = 2  THEN YR$ = "19" +YR$
  332. 7520 A$ = " ": PRINT A$;:DA$ = MO$ +DY$ +YR$
  333. 7540  GOSUB 1340: CALL  -868: PRINT DA$" <- IS THIS DATE OK (Y/N)?";: GET A$: IF A$ =  CHR$(13)  THEN A$ = "Y"
  334. 7560  PRINT A$: IF A$ = "N" GOTO 7140
  335. 7580  IF A$ < >"Y" GOTO 7540
  336. 7600 S3% = 1
  337. 7620  RETURN 
  338. 7640  REM  ---------------------
  339. 7660  REM   SEND TO DISK
  340. 7680  REM  ---------------------
  341. 7700  HOME 
  342. 7720  PRINT D$"MON C,I,O"
  343. 7740 D$ =  CHR$(4): PRINT D$;"OPEN EXPENSES FOR ";DA$;",L9,S"SL",D"DR
  344. 7760  PRINT D$;"DELETE EXPENSES FOR "DA$",S"SL",D"DR
  345. 7780  PRINT D$;"OPEN EXPENSES FOR ";DA$;",L9,S"SL",D"DR
  346. 7800  FOR H = 1 TO 8
  347. 7820  FOR I = 1 TO 19
  348. 7840  PRINT D$;"WRITE EXPENSES FOR ";DA$;",R";(H -1) *19 +I
  349. 7860  PRINT ( INT(IT(H,I) *100 +0.001))/100
  350. 7880  NEXT I,H
  351. 7900  PRINT D$;"CLOSE EXPENSES FOR ";DA$
  352. 7920  PRINT D$"NOMON C,I,O"
  353. 7940 S1% = 1
  354. 7960  IF S5% = 1  THEN  RETURN 
  355. 7980  GOTO 8660
  356. 8000  REM  --------------------
  357. 8020  REM   CHANGE FILE NAME
  358. 8040  REM  --------------------
  359. 8060  HOME :HOLD$ = DA$:S2% = 1: INVERSE :TI$ = "CHANGE DATE/NAME OF AN EXISTING REPORT": PRINT TI$: NORMAL : VTAB 4: PRINT "OPTIONS:": PRINT : PRINT 
  360. 8080  PRINT "    1) CATALOG DRIVE "DR: PRINT : PRINT "    2) ENTER PRESENT DATE/NAME OF THE          REPORT TO BE CHANGED": PRINT : PRINT : PRINT "PRESS ESC TO RETURN TO THE MAIN MENU OR ENTER YOUR CHOICE BY NUMBER PLEASE: ";: GET A$: PRINT A$
  361. 8100  IF A$ =  CHR$(27) GOTO 8660
  362. 8120  IF A$ = "1"  THEN  HOME : PRINT D$"CATALOG, S"SL",D"DR: PRINT "PRESS ANY KEY TO CONTINUE:";: GET B$: PRINT B$
  363. 8140  IF A$ < >"2" GOTO 8060
  364. 8160  HOME : INVERSE : PRINT TI$: NORMAL : PRINT : PRINT : PRINT "PLEASE ENTER THE CURRENT DATE/NAME OF THE REPORT WHICH YOU WISH TO CHANGE."
  365. 8180 S3% = 0: GOSUB 7080
  366. 8200 DT$ = DA$
  367. 8220  HOME : INVERSE : PRINT TI$: NORMAL 
  368. 8240  VTAB 6: PRINT "OLD FILE DATE/NAME:": PRINT : PRINT "EXPENSES FOR "DT$
  369. 8260  VTAB 20: PRINT "PLEASE ENTER THE REPLACEMENT DATE/NAME:"
  370. 8280 S3% = 0: GOSUB 7080
  371. 8300  HOME : PRINT "PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " AND YOU WILL CHANGE:": PRINT : PRINT "EXPENSES FOR "DT$
  372. 8320  PRINT : PRINT "TO": PRINT : PRINT "EXPENSES FOR "DA$: PRINT : PRINT : PRINT : PRINT : PRINT "ANY OTHER KEY EXITS TO MENU-->";
  373. 8340  GET A$: PRINT A$: IF A$ < > CHR$(13) GOTO 8660
  374. 8360  PRINT D$"MON C,I,O"
  375. 8380 ERR$ = "ON"
  376. 8400  PRINT D$"RENAME EXPENSES FOR "DT$",EXPENSES FOR "DA$
  377. 8420 ERR$ = ""
  378. 8440  PRINT D$"NOMON C,I,O"
  379. 8460 DA$ = HOLD$: IF DA$ < >""  THEN S3% = 1
  380. 8480  GOTO 8660
  381. 8500  REM  ---------------------
  382. 8520  REM  ROUTINE TO CATALOG
  383. 8540  REM  ---------------------
  384. 8560  HOME : PRINT  CHR$(13) CHR$(4)"CATALOG,S"SL",D"DR
  385. 8580  PRINT : PRINT "PRESS ANY KEY TO CONTINUE. ": GET A$: PRINT A$: GOTO 8660
  386. 8600  REM  --------------------
  387. 8620  REM  **  MAIN MENU     **
  388. 8640  REM  --------------------
  389. 8660  HOME : INVERSE : PRINT  SPC( 14)"EXPENSE-CALC" SPC( 14): NORMAL 
  390. 8680  VTAB 3: PRINT "OPTIONS: "
  391. 8700  VTAB 5: PRINT "1) INPUT A NEW REPORT"
  392. 8720  VTAB 7: PRINT "2) REVIEW/CHANGE/DELETE/UPDATE"
  393. 8740  VTAB 9: PRINT "3) SEE CATALOG OF THIS DISK'S FILES"
  394. 8760  VTAB 11: PRINT "4) PRINT HARD COPY OF DATA"
  395. 8780  VTAB 13: PRINT "5) CHANGE DATE/NAME OF A FILE"
  396. 8800  VTAB 15: HTAB 1: PRINT "6) CHANGE DRIVE # : DRIVE NOW = ";: INVERSE : PRINT DR: NORMAL 
  397. 8820  VTAB 17: HTAB 1: PRINT "7) CHANGE SLOT # :  SLOT NOW = ";: INVERSE : PRINT SL: NORMAL 
  398. 8840  VTAB 19: PRINT "8) END"
  399. 8860 I$ = "PLEASE TYPE THE NUMBER OF YOUR CHOICE"
  400. 8880  GOSUB 3180: GET A$
  401. 8900  IF A$ =  CHR$(13)  THEN A$ = "X"
  402. 8920  PRINT A$;
  403. 8940  IF A$ = "1"  THEN  HOME : PRINT OMP$: CLEAR :S% = 1:S2% = 1:S4% = 1:S5% = 1: GOSUB 11020:S2% = 0: GOTO 5380
  404. 8960  IF A$ = "2" GOTO 4100
  405. 8980  IF A$ = "3" GOTO 8560
  406. 9000  IF A$ = "4"  THEN  GOSUB 9220: GOTO 8660
  407. 9020  IF A$ = "5" GOTO 8060
  408. 9040  IF A$ = "6"  AND DR = 1  THEN DR = 2: POKE 769,DR: GOTO 8800
  409. 9060  IF A$ = "6"  AND DR = 2  THEN DR = 1: POKE 769,DR: GOTO 8800
  410. 9080  IF A$ = "7"  THEN  HOME : VTAB 12: PRINT "WHICH SLOT # (1-7)? ";: GET SL$: IF SL$ <"1"  OR SL$ >"7" GOTO 9080
  411. 9100  IF A$ = "7"  THEN SL =  VAL(SL$): POKE 768,SL: GOTO 8660
  412. 9120  IF A$ = "8"  THEN  HOME : END 
  413. 9140  GOTO 8880
  414. 9160  REM  -------------------
  415. 9180  REM  PRINTER ROUTINE
  416. 9200  REM  -------------------
  417. 9220  IF S3% = 0  THEN I$ = "ASSIGN A DATE/NAME TO THIS REPORT": HTAB 1: VTAB 24: CALL  -868: GOSUB 3180: GOSUB 7140
  418. 9230  IF  LEFT$(DA$,4) = "YEAR"  THEN DI = IT(8,19) -HOLD(8,20)
  419. 9240 I$ =  CHR$(9)
  420. 9250 DI = IT(8,19) -AD: IF  LEFT$(DA$,4) = "YEAR"  THEN DI = IT(8,19) -HOLD(8,20)
  421. 9260  PR# 1
  422. 9280  PRINT I$"80N"
  423. 9300  PRINT : PRINT : PRINT  TAB( 27)"EXPENSE REPORT FOR ";DA$: PRINT : PRINT 
  424. 9320  PRINT "    ITEM      ";: FOR I = 1 TO 7: PRINT "  ";DA$(I);"   ";: NEXT : PRINT "    TOTAL":
  425. 9340  PRINT "------------  ";: FOR I = 1 TO 7: PRINT "------- ";: NEXT : PRINT "  -------"
  426. 9360  PRINT 
  427. 9380  FOR EX = 1 TO 16
  428. 9400  PRINT EX$(EX);"  ";
  429. 9420  FOR DA = 1 TO 7
  430. 9440 A = IT(DA,EX): GOSUB 9800
  431. 9460  PRINT  TAB( 9 - LEN(A$))A$;
  432. 9480  NEXT DA
  433. 9500 A = IT(8,EX): GOSUB 9800
  434. 9520  PRINT  TAB( 10 - LEN(A$))A$
  435. 9540  NEXT EX
  436. 9560  FOR I = 1 TO 78: PRINT "-";: NEXT : PRINT "-"
  437. 9580  FOR EX = 17 TO 18
  438. 9600  PRINT EX$(EX);"  ";
  439. 9620  FOR DA = 1 TO 7:A = IT(DA,EX): GOSUB 9800: PRINT  TAB( 9 - LEN(A$))A$;: NEXT 
  440. 9640 A = IT(8,EX): GOSUB 9800: PRINT  TAB( 10 - LEN(A$))A$
  441. 9660  NEXT EX
  442. 9680  FOR I = 1 TO 78: PRINT "-";: NEXT : PRINT "-"
  443. 9700  PRINT EX$(19);"  ";: FOR DA = 1 TO 7:A = IT(DA,19): GOSUB 9800: PRINT  TAB( 9 - LEN(A$))A$;: NEXT :A = IT(8,19): GOSUB 9800: PRINT  TAB( 10 - LEN(A$))A$
  444. 9710 A = ADV: IF  LEFT$(DA$,4) = "YEAR"  THEN A = HOLD(8,20)
  445. 9720  PRINT EX$(20);: GOSUB 9800: PRINT  TAB( 68 - LEN(A$))A$
  446. 9740  PRINT EX$(21);:A = DI: GOSUB 9800: PRINT  TAB( 68 - LEN(A$))A$
  447. 9760  PRINT : PRINT : PRINT : PRINT 
  448. 9780  PR# 0: RETURN 
  449. 9800  IF A = 0  THEN A$ = "-": RETURN 
  450. 9820 B$ =  STR$( INT((A +.005) *100)): IF  LEN(B$) >2  THEN A$ =  LEFT$(B$, LEN(B$) -2) +"." + RIGHT$(B$,2): RETURN 
  451. 9840  IF  LEN(B$) = 2  THEN A$ = "." +B$: RETURN 
  452. 9860 A$ = ".0" +B$: RETURN 
  453. 9880  REM  --------------------
  454. 9900  REM  ONERR PRINT OUT AND
  455. 9920  REM  ERR HANDLING ROUTINE
  456. 9940  REM  --------------------
  457. 9960 X =  PEEK(222): REM  GET ERROR CODE
  458. 9980  REM  ** APPLESOFT ERRORS **
  459. 10000  IF X = 0  THEN  PRINT "NEXT WITHOUT FOR";
  460. 10020  IF X = 16  THEN  PRINT "SYNTAX";
  461. 10040  IF X = 22  THEN  PRINT "RETURN WITHOUT GOSUB";
  462. 10060  IF X = 42  THEN  PRINT "OUT OF DAT<CTRL-A>A";
  463. 10080  IF X = 53  THEN  PRINT "ILLEGAL QUANTITY";
  464. 10100  IF X = 69  THEN  PRINT "OVERFLOW";
  465. 10120  IF X = 77  THEN  PRINT "OUT OF MEMORY";
  466. 10140  IF X = 90  THEN  PRINT "UNDEFINED STATEMENT";
  467. 10160  IF X = 107  THEN  PRINT "BAD SUBSCRIPT";
  468. 10180  IF X = 120  THEN  PRINT "REDIMENSIONED ARRAY";
  469. 10200  IF X = 133  THEN  PRINT "DIVISION BY ZERO";
  470. 10220  IF X = 163  THEN  PRINT "TYPE MISMATCH";
  471. 10240  IF X = 176  THEN  PRINT "STRING TOO LONG";
  472. 10260  IF X = 191  THEN  PRINT "FORMULA TOO COMPLEX";
  473. 10280  IF X = 224  THEN  PRINT "UNDEFINED FUNCTION";
  474. 10300  IF X = 254  THEN  PRINT "BAD RESPONSE TO INPUT STATEMENT";
  475. 10320  IF X = 255  THEN  PRINT "CTRL C INTERRUPT";
  476. 10340  REM  ****DOS MESSAGES***
  477. 10360  IF X = 1  THEN  PRINT "LANGUAGE NOT AVAILABLE";
  478. 10380  IF X = 2  OR X = 3  THEN  PRINT "RANGE ERROR";
  479. 10400  IF X = 4  THEN  PRINT "WRITE PROTECTED";
  480. 10420  IF X = 5 GOTO 10820
  481. 10440  IF X = 6  AND ERR$ = "ON"  THEN ERR$ = "OFF": GOTO 10820
  482. 10460  IF X = 6 GOTO 10720
  483. 10480  IF X = 7  THEN  PRINT "VOL. MISMATCH";
  484. 10500  IF X = 8  THEN  PRINT "I/0 ERROR";
  485. 10520  IF X = 9  THEN  PRINT "DISK FULL";
  486. 10540  IF X = 10  THEN  PRINT "FILE LOCKED";
  487. 10560  IF X = 11  THEN  PRINT "SYNTAX";
  488. 10580  IF X = 12  THEN  PRINT "NO BUFFERS AVAILABLE";
  489. 10600  IF X = 13  THEN  PRINT "FILE TYPE MISMATCH";
  490. 10620  IF X = 14  THEN  PRINT "PROGRAM TOO LARGE";
  491. 10640  IF X = 15  THEN  PRINT "NOT DIRECT COMMAND";
  492. 10660  PRINT " ERROR IN LINE # ";( PEEK(218) +( PEEK(219) *256))
  493. 10680  END 
  494. 10700  REM  CREATE NEW HEADER
  495. 10720  HOME : PRINT "THERE IS NO PREVIOUSLY ESTABLISHED      EXPENSE HEADER FILE ON THIS DISK.": PRINT : PRINT "DO YOU WISH TO INITILIZE A HEADER ON    THIS DISK FOR A NEW EXPENSE PERIOD?     (Y OR N): ";: GET A$: PRINT A$
  496. 10740  IF A$ = "N" GOTO 8660
  497. 10760  IF A$ < >"Y" GOTO 10720
  498. 10780  GOTO 6460
  499. 10800  REM  HANDLE REQUEST FOR BOGUS FILE
  500. 10820  TEXT : PRINT : HOME 
  501. 10840  PRINT D$"OPEN EXPENSES FOR "DA$",L9,S"SL",D"DR
  502. 10860  PRINT D$"DELETE EXPENSES FOR "DA$",S"SL",D"DR
  503. 10880  PRINT : PRINT "THE DATE ";DA$;" IS NOT CURRENTLY": PRINT "IN MEMORY AS A DATE BEGINNING AN ESTAB- LISHED EXPENSE PERIOD.": PRINT : PRINT "PRESS ANY KEY TO CONTINUE: ": GET A$: PRINT A$
  504. 10900  PRINT D$"NOMON C,I,O"
  505. 10920 S3% = 0: GOTO 8660
  506. 10940  REM  --------------------
  507. 10960  REM   DEFINE VARIABLES
  508. 10980  REM  --------------------
  509. 11000  CLEAR 
  510. 11020  ONERR  GOTO 9960
  511. 11040 OMP$ = "ONE MOMENT PLEASE"
  512. 11060  DIM IT(8,21)
  513. 11080  DIM DA$(8)
  514. 11100  DIM EX$(21)
  515. 11120  DIM HOLD(8,20)
  516. 11140 F$ = "FRMT,X6,S,2,0;"
  517. 11160 F2$ = "FRMT,X7,S,2,0;"
  518. 11180 F3$ = "FRMT,'$',X8,S,2,0;"
  519. 11200 INST$ = "RET(ENTER):ESC(^):<-:->:L(EFT:R(T:Q(UIT"
  520. 11220 DA$(4) = "WED"
  521. 11240 ADVANCE = 100: REM  CUSTOM-IZE TO SUIT YOURSELF
  522. 11260 DA$(1) = "SUN"
  523. 11280 DA$(2) = "MON"
  524. 11300 DA$(3) = "TUE"
  525. 11320 DA$(4) = "WED"
  526. 11340 DA$(5) = "THR"
  527. 11360 DA$(6) = "FRI"
  528. 11380 DA$(7) = "SAT"
  529. 11400 DA$(8) = "TOT"
  530. 11420 OV$ = "OVRFLW"
  531. 11440 EX$(1) = " 1 AIR TRAN"
  532. 11460 EX$(2) = " 2 LOC TRAN"
  533. 11480 EX$(3) = " 3 GAS-OIL "
  534. 11500 EX$(4) = " 4 MAINT.  "
  535. 11520 EX$(5) = " 5 PARKING "
  536. 11540 EX$(6) = " 6 TOLLS   "
  537. 11560 EX$(7) = " 7 CAR RENT"
  538. 11580 EX$(8) = " 8 MI ALLOW"
  539. 11600 EX$(9) = " 9 HOTEL   "
  540. 11620 EX$(10) = "10 BKFAST  "
  541. 11640 EX$(11) = "11 LUNCH   "
  542. 11660 EX$(12) = "12 DINNER  "
  543. 11680 EX$(13) = "13 PHONE   "
  544. 11700 EX$(14) = "14 ENTRTNMT"
  545. 11720 EX$(15) = "15 MISC.   "
  546. 11740 EX$(16) = "16 OTHER   "
  547. 11760 EX$(17) = "SUBTOTAL ->"
  548. 11780 EX$(18) = "- CO CHGES."
  549. 11800 EX$(19) = "NET TOTAL->"
  550. 11820 EX$(20) = "ADVANCE    "
  551. 11840 EX$(21) = "DIFFERENCE "
  552. 11860 SL =  PEEK(768):DR =  PEEK(769)
  553. 11880 D$ =  CHR$(4)
  554. 11900  FOR I = 1 TO 6:UNDERLINE$ = UNDERLINE$ + CHR$(95): NEXT 
  555. 11920  IF S2% = 1  AND S% = 1  THEN  RETURN 
  556. 11940  IF S% = 1 GOTO 8660
  557. 11960  GOTO 3500