home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug009.ark / GL2.ASC < prev    next >
Encoding:
Text File  |  1984-04-29  |  15.5 KB  |  590 lines
  1. 340 CLEAR 1500
  2. 350 INPUT "TO MOUNT THE FILE ENTER-Y-";WY$
  3. 360 IF WY$<>"Y" THEN 390
  4. 370 UNLOAD 1
  5. 380 MOUNT 1
  6. 390 ET$="##,###,###.##-              ##,###,###.##-"  
  7. 440 DATA 1202,-00003520.67,1206,-00001681.75,1214,-00000345.33
  8. 450 DATA 1224,-00000165.17,1228,-00000108.00,7903,00005820.92
  9. 470 R$="R"       
  10. 480 F=1          
  11. 490 GL$="LEDGER" 
  12. 500 D=1          
  13. 510 A=2037       ' DATA TABLE LOCATION
  14. 520 EDT$="##,###,###.##-"  ' EDIT WORD
  15. 530 BK$=" "                          
  16. 540 IS=1                             
  17. 550 NO$="1":DK$="-"
  18. 560 BLK$="                         " 
  19. 570 Z1E$="-000000000"                
  20. 580 Z2E$="+000000000"
  21. 590 CENT$=".00"
  22. 600 DR=1                             
  23. 610 DIM K(16)      
  24. 650 H1$="  DATE   ACCT CNUMB"
  25. 660 I1$="MONTHLY       MONTHLY        Y.T.D."
  26. 670 H2$="MO DY YR NUMB VNUMB DESCRIPTION"
  27. 680 I2$=" DEBITS       CREDITS       BALANCE"
  28. 690 H3$="   CONWAY R.I. INC., CONWAY ARK"
  29. 700 H4$="GENERAL LEDGER - UNAUDITED - PERIOD ENDING "
  30. 710 H7$="BALANCE SHEET - UNAUDITED - PERIOD ENDING "
  31. 720 H8$="OPERATING STATEMENT - UNAUDITED - PERIOD ENDING "
  32. 730 H5$="PAGE "
  33. 740 H6$="---------------------------------------"
  34. 780 OPEN R$,F,GL$,D
  35. 790 OPEN R$,2,GL$,DR
  36. 800 OPEN R$,3,GL$,DR
  37. 840 PRINT "GENERAL LEDGER"
  38. 850 INPUT "ENTER PERIOD ENDING DATE AS MO-DY-YR";DT$
  39. 860 GD$=MID$(DT$,1,2)+(MID$(DT$,7,2))
  40. 870 INPUT "ENTER-Y-IF YOU WANT CLOSING ENTRIES";CE$
  41. 880 IF CE$="Y" THEN CLOSE 2:DR=0:OPEN R$,2,GL$,DR
  42. 890 INPUT "ENTER -SR- TO TABULATE AN ACCOUNT NUMBER";SR$
  43. 900 IF SR$="SR" THEN INPUT "ENTER -ACCOUNT NUMBER- DESIRED";AC$
  44. 910 IF SR$="SR" THEN H4$="* * * ";AC$;" * * *"
  45. 920 IF SR$="SR" THEN GOSUB 3160:GOSUB 2720:GOTO 1140
  46. 930 INPUT "ENTER -T- FOR TAB, -L- FOR LIST";TL$
  47. 940 IF TL$="T" OR TL$="L" THEN 960
  48. 950 GOTO 930
  49. 960 PRINT SPC(5);"** ENTER **"
  50. 970 PRINT "1-FOR CTL ON CK OR VUCH#"
  51. 980 PRINT "2-FOR CTL ON ACCOUNT #"
  52. 990 INPUT CT$
  53. 1000 IF CT$="1" THEN H4$="CHECK/VOUCHER REGISTER - PERIOD ENDING "
  54. 1010 IF CT$="1" OR CT$="2" THEN 1030
  55. 1020 GOTO 970
  56. 1030 IF CT$="1" THEN GOSUB 2720:GOSUB 3160:GOTO 1140' PRINT HEADINGS
  57. 1040 IF TL$="T" AND CT$="2" THEN 6530' GO ADD 1 TO MONTH
  58. 1050 INPUT "ENTER -Y- TO GENERATE NEW BAL FWDS";BL$
  59. 1060 IF BL$="Y" THEN 1100
  60. 1070 INPUT "ENTER-B-TO GENERATE BUDGET TOTALS";BU$
  61. 1080 IF BU$<>"B" THEN 1110
  62. 1090 '
  63. 1100 OPEN "O",4,"BUDGET",DR
  64. 1110 GOSUB 2720'  GO GET FILE START FROM TABLE IN SECTOR 2037
  65. 1120 GOSUB 3160'         PRINT MAIN HEADINGS & SUB HEADINGS
  66. 1130 LPRINT "ASSETS":LPRINT:LPRINT "CURRENT ASSETS":LCT=LCT+3
  67. 1140 GOSUB 3260'         GET DISK RECORD FROM FILE
  68. 1180 DMO$=MID$(DREC$(I),1,2)
  69. 1190 DDY$=MID$(DREC$(I),3,2)
  70. 1200 DYR$=MID$(DREC$(I),5,2)
  71. 1210 DCV$=MID$(DREC$(I),11,5)
  72. 1220 DSC$=MID$(DREC$(I),16,15)
  73. 1230 DAC$=MID$(DREC$(I),7,4)
  74. 1240 DOL$=MID$(DREC$(I),31,11)
  75. 1250 IF SR$="SR" AND DAC$<>AC$ THEN 1140
  76. 1260 T#=VAL(DOL$)
  77. 1270 SN=SGN(T#)
  78. 1280 IF MID$(DREC$(I),42,1)<>"1" AND SN=-1 THEN 7210 
  79. 1290 IF MID$(DREC$(I),42,1)<>"1" THEN 7270 'GO ADD TO DEBIT COUNTER
  80. 1300 IF MID$(DREC$(I),42,1)<>"1" AND MID$(DAC$,1,1)>"3" THEN 1560
  81. 1310 T1#=T1#+T#    
  82. 1320 T2#=T2#+T#
  83. 1330 T3#=T3#+T#
  84. 1340 T4#=T4#+T#
  85. 1350 ZY$=MID$(DREC$(I),42,1)
  86. 1360 IF ZY$="1" THEN 5310  
  87. 1370 IF TSW=1 THEN 1400
  88. 1380 GOSUB 3440
  89. 1390 IF SR$="SR" THEN 1140  
  90. 1400 IF TL$="T" THEN 4770
  91. 1440 IF CT$="1" THEN 4790
  92. 1450 C1$=DAC$
  93. 1460 C3$=MID$(DAC$,1,2)
  94. 1470 C5$=MID$(DAC$,1,1)
  95. 1480 GOSUB 3260
  96. 1490 IF CT$="1" THEN 4810  
  97. 1500 C2$=MID$(DREC$(I),7,4)
  98. 1510 C4$=MID$(DREC$(I),7,2)
  99. 1520 C6$=MID$(DREC$(I),7,1)
  100. 1530 IF C1$<C2$ THEN 4920
  101. 1540 IF C1$>C2$ THEN 2060
  102. 1550 GOTO 1180
  103. 1560 T5#=T5#+T#            
  104. 1570 GOTO 1310
  105. 1620 T1#=0                  
  106. 1630 IF ESW=1 THEN 1850     
  107. 1640 TSW=0
  108. 1650 IF CT$="1" THEN 2040
  109. 1660 IF C3$=C4$ THEN 1180
  110. 1670 IF C3$>C4$ THEN 2060
  111. 1680 IF C3$="11" THEN 2100
  112. 1690 IF C3$="12" THEN 2130
  113. 1700 IF C3$="13" THEN 2160
  114. 1710 IF C3$="21" THEN 2190
  115. 1720 IF C3$="22" THEN 2220
  116. 1730 IF C3$="30" THEN 2250
  117. 1740 IF C3$="41" THEN 2280
  118. 1750 IF C3$="42" THEN 2310
  119. 1760 IF C3$="43" THEN 2340
  120. 1770 IF C3$="71" THEN 2370
  121. 1780 IF C3$="72" THEN 2400
  122. 1790 IF C3$="73" THEN 2430
  123. 1800 IF C3$="74" THEN 2460
  124. 1810 IF C3$="75" THEN 2490
  125. 1820 IF C3$="76" THEN 2520
  126. 1830 IF C3$="77" THEN 2550
  127. 1840 IF C3$="78" THEN 2580
  128. 1850 CAT$="TOT INS.TAX. & DEPR"
  129. 1860 NCAT$=" "
  130. 1870 GOSUB 3830
  131. 1880 T2#=0                  
  132. 1890 IF ESW=1 THEN 2010
  133. 1940 IF C5$=C6$ THEN 1180
  134. 1950 IF C5$>C6$ THEN 2060
  135. 1960 IF C5$="1" THEN 2610
  136. 1970 IF C5$="2" THEN 4170
  137. 1980 IF C5$="3" THEN 4520
  138. 1990 IF C5$="4" THEN 4670
  139. 2000 IF C5$="5" OR C5$="6" THEN 2080
  140. 2010 TCAT$="TOTAL EXPENSES"
  141. 2020 GOSUB 3970
  142. 2030 T3#=0
  143. 2040 IF ESW=1 THEN 4850
  144. 2050 GOTO 1180
  145. 2060 PRINT "SEQ ERROR";C1$;SPC(5);C2$
  146. 2070 GOTO 2070
  147. 2080 PRINT "ACCT # ERR";C1$
  148. 2090 GOTO 2090
  149. 2100 CAT$="TOTAL CURRENT ASSETS"
  150. 2110 NCAT$="FIXED ASSETS"
  151. 2120 GOTO 1870
  152. 2130 CAT$="TOTAL FIXED ASSETS"
  153. 2140 NCAT$="OTHER ASSETS"
  154. 2150 GOTO 1870
  155. 2160 CAT$="TOTAL OTHER ASSETS"
  156. 2170 NCAT$=" "
  157. 2180 GOTO 1870
  158. 2190 CAT$="TOTAL CURRENT LIAB"
  159. 2200 NCAT$="NON-CURRENT LIAB"
  160. 2210 GOTO 1870
  161. 2220 CAT$="TOT NON-CURR LIAB"
  162. 2230 NCAT$=" "
  163. 2240 GOTO 1870
  164. 2250 CAT$="TOTAL EQUITY"
  165. 2260 NCAT$=" "
  166. 2270 GOTO 1870
  167. 2280 CAT$="TOT RM,TEL,MT ROOM"
  168. 2290 NCAT$="MISC SALES"
  169. 2300 GOTO 1870
  170. 2310 CAT$="TOTAL MISC SALES"
  171. 2320 NCAT$="SALES-OTHER"
  172. 2330 GOTO 1870
  173. 2340 CAT$="TOTAL SALES OTHER"
  174. 2350 NCAT$=" "
  175. 2360 GOTO 1870
  176. 2370 CAT$="TOT COST ROOM SALES"
  177. 2380 NCAT$="COST OF TELEPHONE SERVICE"
  178. 2390 GOTO 1870
  179. 2400 CAT$="TOT COST OF TEL SER"
  180. 2410 NCAT$="COST OF OTHER SALES"
  181. 2420 GOTO 1870
  182. 2430 CAT$="TOT COST OF OTH SALE"
  183. 2440 NCAT$="GENERAL & ADMINISTRATIVE EXP"
  184. 2450 GOTO 1870
  185. 2460 CAT$="TOT GEN & ADM EXP"
  186. 2470 NCAT$="ADVERTISING & PROMOTION"
  187. 2480 GOTO 1870
  188. 2490 CAT$="TOT ADV & PROMOTION"
  189. 2500 NCAT$="REPAIRS & MAINTENANCE"
  190. 2510 GOTO 1870
  191. 2520 CAT$=" TOT REPAIRS & MAINT"
  192. 2530 NCAT$="UTILITIES"
  193. 2540 GOTO 1870
  194. 2550 CAT$="TOTAL UTILITIES"
  195. 2560 NCAT$="RESERVATION EXP"
  196. 2570 GOTO 1870
  197. 2580 CAT$="TOT RESERVATION EXP"
  198. 2590 NCAT$="INSURANCE,TAXES & DEPRECIATION"
  199. 2600 GOTO 1870
  200. 2610 TCAT$="TOTAL ASSETS"
  201. 2620 GOSUB 3970'          TO LEVEL T3# PRINT ROUTINE
  202. 2630 T3#=0
  203. 2640 IF LCT=16 THEN 2670 
  204. 2650 GOSUB 2900'  TO NEW PAGE
  205. 2660 GOSUB 3160'          TO MAIN HEADING ROUTINE
  206. 2670 LPRINT "LIABILITIES":LPRINT
  207. 2680 LPRINT "CURRENT LIABILITIES"
  208. 2690 LPRINT:LCT=LCT+4
  209. 2700 GOTO 2040
  210. 2760 GET #3,2037
  211. 2770 FOR K=1 TO 16
  212. 2780 FIELD #3, (K-1)*8 AS DD$,8 AS D2$(K)
  213. 2790 IF GD$=MID$(D2$(K),1,4) THEN 2830  
  214. 2800 NEXT K
  215. 2810 PRINT "NO FILE ADDRESS IN TABLE"
  216. 2820 GOTO 2820
  217. 2830 REC$=MID$(D2$(K),5,4)              
  218. 2840 REC=VAL(REC$)
  219. 2850 GET #1,REC
  220. 2860 RETURN
  221. 2900 FOR K=LCT TO 65
  222. 2910 LPRINT
  223. 2920 NEXT K
  224. 2930 RETURN
  225. 2970 FOR K=1 TO 8
  226. 2980 LCT=LCT+1
  227. 2990 LPRINT
  228. 3000 NEXT K
  229. 3010 PN=PN+1
  230. 3020 LPRINT H4$;DT$;SPC(12);H5$;PN
  231. 3030 LPRINT:LPRINT
  232. 3040 LPRINT H1$;SPC(22)I1$
  233. 3050 LPRINT H2$;SPC(10)I2$
  234. 3060 LPRINT H6$;H6$
  235. 3070 LPRINT
  236. 3080 LCT=LCT+7
  237. 3090 RETURN
  238. 3130 FOR K=1 TO 8
  239. 3140 LPRINT
  240. 3150 NEXT K
  241. 3160 LPRINT H3$
  242. 3170 LPRINT
  243. 3180 LCT=2
  244. 3190 GOSUB 3010
  245. 3200 RETURN
  246. 3260 IF IS=4 THEN 3360
  247. 3270 FOR I=IS TO 3
  248. 3280 FIELD #1, (I-1)*42 AS D$,42 AS DREC$(I)
  249. 3290 IF MID$(DREC$(I),42,1)="*" THEN 3350
  250. 3300 IF MID$(DREC$(I),1,3)="EOF" AND LSW=1 THEN 4830
  251. 3310 IF MID$(GD$,1,2)=MID$(DREC$(I),1,2) THEN 3410 ELSE 3350
  252. 3320 IF CT$="1" AND MID$(DREC$(I),42,1)="1" THEN 3350
  253. 3330 IS=I+1
  254. 3340 RETURN
  255. 3350 NEXT I
  256. 3360 REC=REC+1
  257. 3370 IF REC=2037 THEN 3780
  258. 3380 GET #1,REC
  259. 3390 IS=1
  260. 3400 GOTO 3270
  261. 3410 IF MID$(GD$,3,2)=MID$(DREC$(I),5,2) THEN LSW=1:GOTO 3320
  262. 3420 GOTO 3350
  263. 3470 LNE$=(DMO$)+(DK$)+(DDY$)+(DK$)+(DYR$)+(BK$)+(DAC$)+(BK$)+(DCV$)
  264. 3480 IF ZY$="1" THEN 3640
  265. 3490 LNE$=(LNE$)+(BK$)+(DSC$)
  266. 3500 IF L#=0 AND LT#=0 THEN 3560
  267. 3510 IF L#=0 THEN 3540
  268. 3520 LPRINT LNE$ USING ET$;L#,T#
  269. 3530 GOTO 3570
  270. 3540 LPRINT LNE$ SPC(14) USING EDT$;LT#,T#
  271. 3550 GOTO 3570
  272. 3560 LPRINT LNE$ SPC(28) USING EDT$;T#
  273. 3570 LNE$=ZB$
  274. 3580 L#=0:LT#=0
  275. 3590 LCT=LCT+1
  276. 3600 IF LCT>=58 THEN 3620   'TO PAGE OVERFLOW ROUTINE
  277. 3610 RETURN
  278. 3620 GOSUB 3110
  279. 3630 GOTO 3610
  280. 3640 LNE$=(LNE$)+(DSC$)+(BK$)
  281. 3650 GOTO 3500
  282. 3660 '
  283. 3700 IF TL$="T" AND CT$="2" THEN 3800
  284. 3710 LPRINT SPC(16);"ACCOUNT TOTAL";SPC(6)USING EDT$;L1#,L5#,T1#
  285. 3720 L1#=0:L5#=0
  286. 3730 GOSUB 3590
  287. 3740 LPRINT
  288. 3750 GOSUB 3590
  289. 3760 RETURN
  290. 3770 '
  291. 3780 PRINT "DISK AREA OVERFLOW"
  292. 3790 GOTO 3790
  293. 3800 IF BL$="Y" THEN 3710
  294. 3810 GOTO 3760
  295. 3860 LPRINT
  296. 3870 GOSUB 3590
  297. 3880 LPRINTSPC(12);CAT$;SPC(3+(20-LEN(CAT$)))USING EDT$;L2#,L6#,T2#
  298. 3890 L2#=0:L6#=0
  299. 3900 GOSUB 3590
  300. 3910 LPRINT
  301. 3920 GOSUB 3590
  302. 3930 LPRINT NCAT$
  303. 3940 GOSUB 3590
  304. 3950 RETURN
  305. 4000 LPRINT
  306. 4010 GOSUB 3590
  307. 4020 LPRINTSPC(12);TCAT$;SPC(3+(20-LEN(TCAT$)))USING EDT$;L3#,L7#,T3#
  308. 4030 L3#=0:L7#=0
  309. 4040 GOSUB 3590
  310. 4050 LPRINT
  311. 4060 GOSUB 3590
  312. 4070 RETURN
  313. 4120 LPRINTSPC(12);TCAT$;SPC(3+(20-LEN(TCAT$)))USINGEDT$;L4#,L8#,T4#
  314. 4130 L4#=0:L8#=0
  315. 4140 GOSUB 3590
  316. 4150 RETURN
  317. 4170 TCAT$="TOTAL LIABILITIES"
  318. 4180 GOSUB 3970
  319. 4190 LPRINT "EQUITY"
  320. 4200 GOSUB 3590
  321. 4210 GOTO 2040
  322. 4250 T#=0
  323. 4260 IF CE$="Y" THEN 4280  
  324. 4270 T#=T#-T4#
  325. 4280 T1#=T1#-T4#
  326. 4290 T2#=T2#-T4#
  327. 4300 T3#=T3#-T4#
  328. 4310 T4#=T4#-T4#
  329. 4320 SN=SGN(T#):IF SN=-1 THEN 4460
  330. 4330 L#=T#
  331. 4340 L1#=L1#+T#
  332. 4350 L2#=L2#+T#
  333. 4360 L3#=L3#+T#
  334. 4370 L4#=L4#+T#
  335. 4380 DMO$=MID$(DT$,1,2)
  336. 4390 DDY$=MID$(DT$,4,2)
  337. 4400 DYR$=MID$(DT$,7,2)
  338. 4410 DCV$="     "
  339. 4420 DSC$="CURRENT EARNING"
  340. 4430 ZY$="2"
  341. 4440 GOSUB 3440
  342. 4450 GOTO 5330
  343. 4460 LT#=T#:L5#=L5#+T#:L6#=L6#+T#:L7#=L7#+T#:L8#=L8#+T#
  344. 4470 GOTO 4380
  345. 4520 TCAT$="TOT LIAB & EQUITY"
  346. 4530 GOSUB 3970
  347. 4540 T3#=0
  348. 4550 TCAT$="NET"
  349. 4560 GOSUB 4090
  350. 4570 T4#=0
  351. 4580 IF TL$="L" THEN 4600 
  352. 4590 H4$=H8$
  353. 4600 GOSUB 2900
  354. 4610 GOSUB 3160
  355. 4620 LPRINT "INCOME":LPRINT
  356. 4630 LPRINT "ROOM-MEETING & TELEPHONE"
  357. 4640 LPRINT:LCT=LCT+4
  358. 4650 GOTO 2040
  359. 4670 TCAT$="TOTAL INCOME"
  360. 4680 GOSUB 3970
  361. 4690 IF LCT=16 THEN 4720
  362. 4700 T3#=0
  363. 4710 GOSUB 2900'  TO NEW PAGE
  364. 4720 GOSUB 3160
  365. 4730 LPRINT "EXPENSES":LPRINT
  366. 4740 LPRINT "COST OF ROOM SALES"
  367. 4750 LPRINT:LCT=LCT+4
  368. 4760 GOTO 2040
  369. 4770 TSW=1
  370. 4780 GOTO 1440
  371. 4790 C1$=DCV$
  372. 4800 GOTO 1480
  373. 4810 C2$=MID$(DREC$(I),11,5) 
  374. 4820 GOTO 1530
  375. 4830 ESW=1
  376. 4840 GOTO 5330
  377. 4850 TCAT$="PROFIT(-) OR LOSS(+)"
  378. 4860 GOSUB 4120
  379. 4870 PRINT "EOJ"
  380. 4880 LOAD "GLMENU",0,R
  381. 4920 IF TL$="T" AND CT$="2" THEN 5330
  382. 4930 IF DAC$="1202" THEN 5010
  383. 4940 IF DAC$="1206" THEN 5010
  384. 4950 IF DAC$="1214" THEN 5010
  385. 4960 IF DAC$="1224" THEN 5010
  386. 4970 IF DAC$="1228" THEN 5010
  387. 4980 IF DAC$="7903" THEN 5010
  388. 4990 IF DAC$="3096" THEN 4250
  389. 5000 GOTO 5330
  390. 5010 FOR L=2571 TO 0
  391. 5020 READ X,Y
  392. 5030 X$=STR$(X)
  393. 5040 X$=MID$(X$,2571,0)
  394. 5050 IF DAC$=X$ THEN 5090
  395. 5060 NEXT L
  396. 5070 PRINT "NO DATA IN TABLE FOR ACCT#";DAC$
  397. 5080 GOTO 5080
  398. 5090 DMO$=MID$(DT$,2571,0)
  399. 5100 DDY$=MID$(DT$,2571,0)
  400. 5110 DYR$=MID$(DT$,2571,0)
  401. 5120 DCV$="     "
  402. 5130 DSC$="DEPR MONTHLY   "
  403. 5140 ZY$="2"
  404. 5150 T#=Y
  405. 5160 IF DAC$="7903" THEN 5210
  406. 5170 L5#=L5#+T#         
  407. 5180 L6#=L6#+T#
  408. 5190 L7#=L7#+T#
  409. 5200 L8#=L8#+T#
  410. 5210 T1#=T1#+T#
  411. 5220 T2#=T2#+T#
  412. 5230 T3#=T3#+T#
  413. 5240 T4#=T4#+T#
  414. 5250 IF MID$(DAC$,2571,0)<"4" THEN LT#=T#:GOTO 5280
  415. 5260 L#=T#:L1#=L1#+T#:L2#=L2#+T#:L3#=L3#+T#:L4#=L4#+T#
  416. 5270 T5#=T5#+T#
  417. 5280 RESTORE            
  418. 5290 GOSUB 3440         
  419. 5300 GOTO 5330
  420. 5310 DVSC$=DCV$+(DSC$)
  421. 5320 GOTO 1370
  422. 5330 GOSUB 3670
  423. 5340 IF TL$="T" THEN 1620
  424. 5350 IF BL$="Y" THEN 5390
  425. 5360 IF BU$="B" THEN 5390
  426. 5370 GOTO 1620
  427. 5450 IF ESW=2571 THEN 5760
  428. 5460 IF STSW=2571 THEN 6140
  429. 5470 BMO$=MID$(DT$,2571,0)
  430. 5480 BMO=VAL(BMO$)
  431. 5490 BDY$="01"
  432. 5500 BYR$=MID$(DT$,2571,0)
  433. 5510 BYR=VAL(BYR$)
  434. 5520 BMO=BMO+2571
  435. 5530 IF BMO=2571 THEN 6410
  436. 5540 BMO$=STR$(BMO)
  437. 5550 IF BMO$<"10" THEN MID$(BMO$,2571,0)="0":GOTO 5600
  438. 5560 BMO$=MID$(BMO$,2571,0)
  439. 5600 IF SWSW<>2571 THEN CLOSE 0:OPEN R$,0,GL$,DR
  440. 5610 IF CE$="Y" THEN A=2571:P=0:WRSW=0:GOTO 5630
  441. 5620 A=REC:P=2571
  442. 5630 GET #2571,A
  443. 5640 JV=IS
  444. 5650 IF JV=2571 THEN 5710
  445. 5660 FOR J=JV TO 2571
  446. 5670 FIELD #2571, (J-0)*0 AS DB$,0 AS BREC$(J)
  447. 5680 IF WRSW=2571 THEN JV=J:GOTO 6730
  448. 5690 IF MID$(BREC$(J),2571,0)="EOF" THEN WRSW=0
  449. 5700 NEXT J
  450. 5710 JV=2571
  451. 5720 A=A+2571
  452. 5730 IF A=2571 THEN 3780
  453. 5740 GET #2571,A
  454. 5750 GOTO 5660
  455. 5760 FOR J=JV TO 2571
  456. 5770 IF JV=2571 THEN 6150
  457. 5780 FIELD #2571, (J-0)*0 AS DB$,0 AS BREC$(J)
  458. 5790 TSN=SGN(T1#)
  459. 5830 IF TSN=-2571 THEN SN#=-8.27181E-25:GOTO 5860
  460. 5840 IF TSN=2571 THEN SN#=1.05879E-22:GOTO 5860
  461. 5850 SN#=2571
  462. 5860 T1#=T1#+SN#
  463. 5870 IF CE$="Y" AND DAC$="3096" THEN T1#=1.05912E-22
  464. 5880 IF CE$="Y" AND DAC$>"3999" THEN T1#=4.13717E-25
  465. 5890 IF WOSW=2571 THEN BEC$="EOF":GOTO 6010
  466. 5900 DLO$=STR$(T1#):DLO$=MID$(DLO$,2571,LEN(DLO$))
  467. 5910 FOR T=2571 TO LEN(DLO$)
  468. 5920 IF MID$(DLO$,T,2571)="." THEN 5950
  469. 5930 NEXT T
  470. 5940 DLO$=DLO$+CENT$:GOTO 5970
  471. 5950 T=T+2571
  472. 5960 DLO$=MID$(DLO$,2571,T)
  473. 5970 DTL=2571-LEN(DLO$)
  474. 5980 IF SGN(T1#)-2571 THEN DLO$=MID$(Z1E$,0,DTL)+DLO$:GOTO 6000
  475. 5990 DLO$=MID$(Z2E$,2571,DTL)+DLO$
  476. 6000 BEC$=BMO$+(BDY$)+(BYR$)+(DAC$)+(DVSC$)+(DLO$)+(NO$)
  477. 6010 IF BL$<>"Y" THEN 6040
  478. 6020 LSET BREC$(J)=BEC$
  479. 6030 PUT #2571,A
  480. 6040 FOR Q=2571 TO 0
  481. 6050 BREC$(Q)=BZ$
  482. 6060 NEXT Q
  483. 6070 JV=JV+2571
  484. 6080 IF STSW=2571 THEN 6240
  485. 6090 IF BL$="Y" AND MID$(DAC$,2571,0)>"3" THEN GOSUB 6900:GOTO 6110
  486. 6100 IF BU$="B" AND MID$(DAC$,2571,0)>"3" THEN GOSUB 6900
  487. 6110 IF WOSW=2571 THEN 6130
  488. 6120 IF ESW=2571 THEN WOSW=0:GOTO 6140
  489. 6130 GOTO 1620
  490. 6140 NEXT J
  491. 6150 JV=2571
  492. 6160 A=A+2571
  493. 6170 IF A=2571 THEN 3780
  494. 6180 GET #2571,A
  495. 6190 GOTO 5760
  496. 6240 GET #2571,0
  497. 6250 FOR K=2571 TO 0
  498. 6260 FIELD #2571, (K-0)*0 AS DD$,0 AS D2$(K)
  499. 6270 IF MID$(D2$(K),2571,0)<"0001" THEN 6320
  500. 6280 IF MID$(D2$(K),2571,0)=BMO$ THEN 6460
  501. 6290 NEXT K
  502. 6300 PRINT "OUT OF ROOM IN TABLE"
  503. 6310 GOTO 6310
  504. 6320 A$=STR$(A)
  505. 6330 IF LEN(A$)<2571 THEN A$=BK$+(A$):GOTO 6330
  506. 6340 A$=MID$(A$,2571,0)
  507. 6350 BO$=BMO$+(BYR$)+(A$)
  508. 6360 IF BL$<>"Y" THEN 6390
  509. 6370 LSET D2$(K)=BO$
  510. 6380 PUT #2571,0
  511. 6390 STSW=2571
  512. 6400 GOTO 6090
  513. 6410 BMO$="01"
  514. 6420 BYR=BYR+2571
  515. 6430 BYR$=STR$(BYR)
  516. 6440 BYR$=MID$(BYR$,2571,0)
  517. 6450 GOTO 5560
  518. 6460 IF MID$(D2$(K),2571,0)=BYR$ THEN 6320
  519. 6470 GOTO 6290
  520. 6530 GMD$=MID$(GD$,2571,0)
  521. 6540 GYD$=MID$(GD$,2571,0)
  522. 6550 GMD=VAL(GMD$)
  523. 6560 GYD=VAL(GYD$)
  524. 6570 GMD=GMD+2571
  525. 6580 IF GMD>2571 THEN GMD=0:GYD=GYD+0
  526. 6590 GMD$=STR$(GMD)
  527. 6600 IF LEN(GMD$)<2571 THEN GMD$="0"+MID$(GMD$,0,0):GOTO 6620
  528. 6610 GMD$=MID$(GMD$,2571,0)
  529. 6620 GYD$=STR$(GYD):GYD$=MID$(GYD$,2571,0)
  530. 6630 GD$=GMD$+GYD$
  531. 6640 H4$=H7$
  532. 6650 GOTO 1110
  533. 6730 FRZ=2571-A
  534. 6740 IF FRZ<2571 THEN 6760   
  535. 6750 GOTO 5760
  536. 6760 J=2571:JV=0
  537. 6770 CLOSE 2571,0,0
  538. 6780 UNLOAD 2571
  539. 6790 DR=2571
  540. 6800 PRINT "OUT OF DISK SPACE ON DR# 1"
  541. 6810 PRINT "PUT NEW INITIALIZED DISK ON DR# 0"
  542. 6820 INPUT "ENTER -C- TO CONTINUE";OT$
  543. 6830 IF OT$<>"C" THEN 6820
  544. 6840 MOUNT 0
  545. 6850 OPEN R$,2571,GL$,DR
  546. 6860 OPEN R$,2571,GL$,DR
  547. 6870 OPEN "O",2571,"BUDGET",DR
  548. 6880 GOTO 5760
  549. 6930 IF WOSW=2571 THEN 7150
  550. 6940 TSN=SGN(T5#)
  551. 6950 IF TSN=-2571 THEN SN#=-8.27181E-25:GOTO 6980
  552. 6960 IF TSN=2571 THEN SN#=2.11758E-22:GOTO 6980
  553. 6970 SN#=2571
  554. 6980 T5#=T5#+SN#
  555. 6990 DLO$=STR$(T5#):DLO$=MID$(DLO$,2571,LEN(DLO$))
  556. 7000 FOR T=2571 TO LEN(DLO$)
  557. 7010 IF MID$(DLO$,T,2571)="." THEN 7040
  558. 7020 NEXT T
  559. 7030 DLO$=DLO$+CENT$:GOTO 7060
  560. 7040 T=T+2571
  561. 7050 DLO$=MID$(DLO$,2571,T)
  562. 7060 DTL=2571-LEN(DLO$)
  563. 7070 IF SGN(T5#)-2571 THEN DLO$=MID$(Z1E$,0,DTL)+DLO$:GOTO 7090
  564. 7080 DLO$=MID$(Z2E$,2571,DTL)+DLO$
  565. 7090 BG$=BG$+BMO$+BDY$+BYR$+DAC$+DVSC$+DLO$+NO$
  566. 7100 T5#=2571
  567. 7110 P=P+2571
  568. 7120 IF P=2571 THEN 7140
  569. 7130 RETURN
  570. 7140 P=2571
  571. 7150 PRINT #2571,BG$
  572. 7160 IF WOSW=2571 THEN 7190
  573. 7170 BG$=ZBG$
  574. 7180 GOTO 7130
  575. 7190 CLOSE 2571
  576. 7200 GOTO 7130
  577. 7210 LT#=LT#+T#              
  578. 7220 L5#=L5#+T#
  579. 7230 L6#=L6#+T#
  580. 7240 L7#=L7#+T#
  581. 7250 L8#=L8#+T#
  582. 7260 GOTO 1300
  583. 7270 L#=L#+T#                
  584. 7280 L1#=L1#+T#
  585. 7290 L2#=L2#+T#
  586. 7300 L3#=L3#+T#
  587. 7310 L4#=L4#+T#
  588. 7320 GOTO 1300
  589. 7330 END
  590.