home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG009.ARK
/
GL2.ASC
< prev
next >
Wrap
Text File
|
1984-04-29
|
16KB
|
590 lines
340 CLEAR 1500
350 INPUT "TO MOUNT THE FILE ENTER-Y-";WY$
360 IF WY$<>"Y" THEN 390
370 UNLOAD 1
380 MOUNT 1
390 ET$="##,###,###.##- ##,###,###.##-"
440 DATA 1202,-00003520.67,1206,-00001681.75,1214,-00000345.33
450 DATA 1224,-00000165.17,1228,-00000108.00,7903,00005820.92
470 R$="R"
480 F=1
490 GL$="LEDGER"
500 D=1
510 A=2037 ' DATA TABLE LOCATION
520 EDT$="##,###,###.##-" ' EDIT WORD
530 BK$=" "
540 IS=1
550 NO$="1":DK$="-"
560 BLK$=" "
570 Z1E$="-000000000"
580 Z2E$="+000000000"
590 CENT$=".00"
600 DR=1
610 DIM K(16)
650 H1$=" DATE ACCT CNUMB"
660 I1$="MONTHLY MONTHLY Y.T.D."
670 H2$="MO DY YR NUMB VNUMB DESCRIPTION"
680 I2$=" DEBITS CREDITS BALANCE"
690 H3$=" CONWAY R.I. INC., CONWAY ARK"
700 H4$="GENERAL LEDGER - UNAUDITED - PERIOD ENDING "
710 H7$="BALANCE SHEET - UNAUDITED - PERIOD ENDING "
720 H8$="OPERATING STATEMENT - UNAUDITED - PERIOD ENDING "
730 H5$="PAGE "
740 H6$="---------------------------------------"
780 OPEN R$,F,GL$,D
790 OPEN R$,2,GL$,DR
800 OPEN R$,3,GL$,DR
840 PRINT "GENERAL LEDGER"
850 INPUT "ENTER PERIOD ENDING DATE AS MO-DY-YR";DT$
860 GD$=MID$(DT$,1,2)+(MID$(DT$,7,2))
870 INPUT "ENTER-Y-IF YOU WANT CLOSING ENTRIES";CE$
880 IF CE$="Y" THEN CLOSE 2:DR=0:OPEN R$,2,GL$,DR
890 INPUT "ENTER -SR- TO TABULATE AN ACCOUNT NUMBER";SR$
900 IF SR$="SR" THEN INPUT "ENTER -ACCOUNT NUMBER- DESIRED";AC$
910 IF SR$="SR" THEN H4$="* * * ";AC$;" * * *"
920 IF SR$="SR" THEN GOSUB 3160:GOSUB 2720:GOTO 1140
930 INPUT "ENTER -T- FOR TAB, -L- FOR LIST";TL$
940 IF TL$="T" OR TL$="L" THEN 960
950 GOTO 930
960 PRINT SPC(5);"** ENTER **"
970 PRINT "1-FOR CTL ON CK OR VUCH#"
980 PRINT "2-FOR CTL ON ACCOUNT #"
990 INPUT CT$
1000 IF CT$="1" THEN H4$="CHECK/VOUCHER REGISTER - PERIOD ENDING "
1010 IF CT$="1" OR CT$="2" THEN 1030
1020 GOTO 970
1030 IF CT$="1" THEN GOSUB 2720:GOSUB 3160:GOTO 1140' PRINT HEADINGS
1040 IF TL$="T" AND CT$="2" THEN 6530' GO ADD 1 TO MONTH
1050 INPUT "ENTER -Y- TO GENERATE NEW BAL FWDS";BL$
1060 IF BL$="Y" THEN 1100
1070 INPUT "ENTER-B-TO GENERATE BUDGET TOTALS";BU$
1080 IF BU$<>"B" THEN 1110
1090 '
1100 OPEN "O",4,"BUDGET",DR
1110 GOSUB 2720' GO GET FILE START FROM TABLE IN SECTOR 2037
1120 GOSUB 3160' PRINT MAIN HEADINGS & SUB HEADINGS
1130 LPRINT "ASSETS":LPRINT:LPRINT "CURRENT ASSETS":LCT=LCT+3
1140 GOSUB 3260' GET DISK RECORD FROM FILE
1180 DMO$=MID$(DREC$(I),1,2)
1190 DDY$=MID$(DREC$(I),3,2)
1200 DYR$=MID$(DREC$(I),5,2)
1210 DCV$=MID$(DREC$(I),11,5)
1220 DSC$=MID$(DREC$(I),16,15)
1230 DAC$=MID$(DREC$(I),7,4)
1240 DOL$=MID$(DREC$(I),31,11)
1250 IF SR$="SR" AND DAC$<>AC$ THEN 1140
1260 T#=VAL(DOL$)
1270 SN=SGN(T#)
1280 IF MID$(DREC$(I),42,1)<>"1" AND SN=-1 THEN 7210
1290 IF MID$(DREC$(I),42,1)<>"1" THEN 7270 'GO ADD TO DEBIT COUNTER
1300 IF MID$(DREC$(I),42,1)<>"1" AND MID$(DAC$,1,1)>"3" THEN 1560
1310 T1#=T1#+T#
1320 T2#=T2#+T#
1330 T3#=T3#+T#
1340 T4#=T4#+T#
1350 ZY$=MID$(DREC$(I),42,1)
1360 IF ZY$="1" THEN 5310
1370 IF TSW=1 THEN 1400
1380 GOSUB 3440
1390 IF SR$="SR" THEN 1140
1400 IF TL$="T" THEN 4770
1440 IF CT$="1" THEN 4790
1450 C1$=DAC$
1460 C3$=MID$(DAC$,1,2)
1470 C5$=MID$(DAC$,1,1)
1480 GOSUB 3260
1490 IF CT$="1" THEN 4810
1500 C2$=MID$(DREC$(I),7,4)
1510 C4$=MID$(DREC$(I),7,2)
1520 C6$=MID$(DREC$(I),7,1)
1530 IF C1$<C2$ THEN 4920
1540 IF C1$>C2$ THEN 2060
1550 GOTO 1180
1560 T5#=T5#+T#
1570 GOTO 1310
1620 T1#=0
1630 IF ESW=1 THEN 1850
1640 TSW=0
1650 IF CT$="1" THEN 2040
1660 IF C3$=C4$ THEN 1180
1670 IF C3$>C4$ THEN 2060
1680 IF C3$="11" THEN 2100
1690 IF C3$="12" THEN 2130
1700 IF C3$="13" THEN 2160
1710 IF C3$="21" THEN 2190
1720 IF C3$="22" THEN 2220
1730 IF C3$="30" THEN 2250
1740 IF C3$="41" THEN 2280
1750 IF C3$="42" THEN 2310
1760 IF C3$="43" THEN 2340
1770 IF C3$="71" THEN 2370
1780 IF C3$="72" THEN 2400
1790 IF C3$="73" THEN 2430
1800 IF C3$="74" THEN 2460
1810 IF C3$="75" THEN 2490
1820 IF C3$="76" THEN 2520
1830 IF C3$="77" THEN 2550
1840 IF C3$="78" THEN 2580
1850 CAT$="TOT INS.TAX. & DEPR"
1860 NCAT$=" "
1870 GOSUB 3830
1880 T2#=0
1890 IF ESW=1 THEN 2010
1940 IF C5$=C6$ THEN 1180
1950 IF C5$>C6$ THEN 2060
1960 IF C5$="1" THEN 2610
1970 IF C5$="2" THEN 4170
1980 IF C5$="3" THEN 4520
1990 IF C5$="4" THEN 4670
2000 IF C5$="5" OR C5$="6" THEN 2080
2010 TCAT$="TOTAL EXPENSES"
2020 GOSUB 3970
2030 T3#=0
2040 IF ESW=1 THEN 4850
2050 GOTO 1180
2060 PRINT "SEQ ERROR";C1$;SPC(5);C2$
2070 GOTO 2070
2080 PRINT "ACCT # ERR";C1$
2090 GOTO 2090
2100 CAT$="TOTAL CURRENT ASSETS"
2110 NCAT$="FIXED ASSETS"
2120 GOTO 1870
2130 CAT$="TOTAL FIXED ASSETS"
2140 NCAT$="OTHER ASSETS"
2150 GOTO 1870
2160 CAT$="TOTAL OTHER ASSETS"
2170 NCAT$=" "
2180 GOTO 1870
2190 CAT$="TOTAL CURRENT LIAB"
2200 NCAT$="NON-CURRENT LIAB"
2210 GOTO 1870
2220 CAT$="TOT NON-CURR LIAB"
2230 NCAT$=" "
2240 GOTO 1870
2250 CAT$="TOTAL EQUITY"
2260 NCAT$=" "
2270 GOTO 1870
2280 CAT$="TOT RM,TEL,MT ROOM"
2290 NCAT$="MISC SALES"
2300 GOTO 1870
2310 CAT$="TOTAL MISC SALES"
2320 NCAT$="SALES-OTHER"
2330 GOTO 1870
2340 CAT$="TOTAL SALES OTHER"
2350 NCAT$=" "
2360 GOTO 1870
2370 CAT$="TOT COST ROOM SALES"
2380 NCAT$="COST OF TELEPHONE SERVICE"
2390 GOTO 1870
2400 CAT$="TOT COST OF TEL SER"
2410 NCAT$="COST OF OTHER SALES"
2420 GOTO 1870
2430 CAT$="TOT COST OF OTH SALE"
2440 NCAT$="GENERAL & ADMINISTRATIVE EXP"
2450 GOTO 1870
2460 CAT$="TOT GEN & ADM EXP"
2470 NCAT$="ADVERTISING & PROMOTION"
2480 GOTO 1870
2490 CAT$="TOT ADV & PROMOTION"
2500 NCAT$="REPAIRS & MAINTENANCE"
2510 GOTO 1870
2520 CAT$=" TOT REPAIRS & MAINT"
2530 NCAT$="UTILITIES"
2540 GOTO 1870
2550 CAT$="TOTAL UTILITIES"
2560 NCAT$="RESERVATION EXP"
2570 GOTO 1870
2580 CAT$="TOT RESERVATION EXP"
2590 NCAT$="INSURANCE,TAXES & DEPRECIATION"
2600 GOTO 1870
2610 TCAT$="TOTAL ASSETS"
2620 GOSUB 3970' TO LEVEL T3# PRINT ROUTINE
2630 T3#=0
2640 IF LCT=16 THEN 2670
2650 GOSUB 2900' TO NEW PAGE
2660 GOSUB 3160' TO MAIN HEADING ROUTINE
2670 LPRINT "LIABILITIES":LPRINT
2680 LPRINT "CURRENT LIABILITIES"
2690 LPRINT:LCT=LCT+4
2700 GOTO 2040
2760 GET #3,2037
2770 FOR K=1 TO 16
2780 FIELD #3, (K-1)*8 AS DD$,8 AS D2$(K)
2790 IF GD$=MID$(D2$(K),1,4) THEN 2830
2800 NEXT K
2810 PRINT "NO FILE ADDRESS IN TABLE"
2820 GOTO 2820
2830 REC$=MID$(D2$(K),5,4)
2840 REC=VAL(REC$)
2850 GET #1,REC
2860 RETURN
2900 FOR K=LCT TO 65
2910 LPRINT
2920 NEXT K
2930 RETURN
2970 FOR K=1 TO 8
2980 LCT=LCT+1
2990 LPRINT
3000 NEXT K
3010 PN=PN+1
3020 LPRINT H4$;DT$;SPC(12);H5$;PN
3030 LPRINT:LPRINT
3040 LPRINT H1$;SPC(22)I1$
3050 LPRINT H2$;SPC(10)I2$
3060 LPRINT H6$;H6$
3070 LPRINT
3080 LCT=LCT+7
3090 RETURN
3130 FOR K=1 TO 8
3140 LPRINT
3150 NEXT K
3160 LPRINT H3$
3170 LPRINT
3180 LCT=2
3190 GOSUB 3010
3200 RETURN
3260 IF IS=4 THEN 3360
3270 FOR I=IS TO 3
3280 FIELD #1, (I-1)*42 AS D$,42 AS DREC$(I)
3290 IF MID$(DREC$(I),42,1)="*" THEN 3350
3300 IF MID$(DREC$(I),1,3)="EOF" AND LSW=1 THEN 4830
3310 IF MID$(GD$,1,2)=MID$(DREC$(I),1,2) THEN 3410 ELSE 3350
3320 IF CT$="1" AND MID$(DREC$(I),42,1)="1" THEN 3350
3330 IS=I+1
3340 RETURN
3350 NEXT I
3360 REC=REC+1
3370 IF REC=2037 THEN 3780
3380 GET #1,REC
3390 IS=1
3400 GOTO 3270
3410 IF MID$(GD$,3,2)=MID$(DREC$(I),5,2) THEN LSW=1:GOTO 3320
3420 GOTO 3350
3470 LNE$=(DMO$)+(DK$)+(DDY$)+(DK$)+(DYR$)+(BK$)+(DAC$)+(BK$)+(DCV$)
3480 IF ZY$="1" THEN 3640
3490 LNE$=(LNE$)+(BK$)+(DSC$)
3500 IF L#=0 AND LT#=0 THEN 3560
3510 IF L#=0 THEN 3540
3520 LPRINT LNE$ USING ET$;L#,T#
3530 GOTO 3570
3540 LPRINT LNE$ SPC(14) USING EDT$;LT#,T#
3550 GOTO 3570
3560 LPRINT LNE$ SPC(28) USING EDT$;T#
3570 LNE$=ZB$
3580 L#=0:LT#=0
3590 LCT=LCT+1
3600 IF LCT>=58 THEN 3620 'TO PAGE OVERFLOW ROUTINE
3610 RETURN
3620 GOSUB 3110
3630 GOTO 3610
3640 LNE$=(LNE$)+(DSC$)+(BK$)
3650 GOTO 3500
3660 '
3700 IF TL$="T" AND CT$="2" THEN 3800
3710 LPRINT SPC(16);"ACCOUNT TOTAL";SPC(6)USING EDT$;L1#,L5#,T1#
3720 L1#=0:L5#=0
3730 GOSUB 3590
3740 LPRINT
3750 GOSUB 3590
3760 RETURN
3770 '
3780 PRINT "DISK AREA OVERFLOW"
3790 GOTO 3790
3800 IF BL$="Y" THEN 3710
3810 GOTO 3760
3860 LPRINT
3870 GOSUB 3590
3880 LPRINTSPC(12);CAT$;SPC(3+(20-LEN(CAT$)))USING EDT$;L2#,L6#,T2#
3890 L2#=0:L6#=0
3900 GOSUB 3590
3910 LPRINT
3920 GOSUB 3590
3930 LPRINT NCAT$
3940 GOSUB 3590
3950 RETURN
4000 LPRINT
4010 GOSUB 3590
4020 LPRINTSPC(12);TCAT$;SPC(3+(20-LEN(TCAT$)))USING EDT$;L3#,L7#,T3#
4030 L3#=0:L7#=0
4040 GOSUB 3590
4050 LPRINT
4060 GOSUB 3590
4070 RETURN
4120 LPRINTSPC(12);TCAT$;SPC(3+(20-LEN(TCAT$)))USINGEDT$;L4#,L8#,T4#
4130 L4#=0:L8#=0
4140 GOSUB 3590
4150 RETURN
4170 TCAT$="TOTAL LIABILITIES"
4180 GOSUB 3970
4190 LPRINT "EQUITY"
4200 GOSUB 3590
4210 GOTO 2040
4250 T#=0
4260 IF CE$="Y" THEN 4280
4270 T#=T#-T4#
4280 T1#=T1#-T4#
4290 T2#=T2#-T4#
4300 T3#=T3#-T4#
4310 T4#=T4#-T4#
4320 SN=SGN(T#):IF SN=-1 THEN 4460
4330 L#=T#
4340 L1#=L1#+T#
4350 L2#=L2#+T#
4360 L3#=L3#+T#
4370 L4#=L4#+T#
4380 DMO$=MID$(DT$,1,2)
4390 DDY$=MID$(DT$,4,2)
4400 DYR$=MID$(DT$,7,2)
4410 DCV$=" "
4420 DSC$="CURRENT EARNING"
4430 ZY$="2"
4440 GOSUB 3440
4450 GOTO 5330
4460 LT#=T#:L5#=L5#+T#:L6#=L6#+T#:L7#=L7#+T#:L8#=L8#+T#
4470 GOTO 4380
4520 TCAT$="TOT LIAB & EQUITY"
4530 GOSUB 3970
4540 T3#=0
4550 TCAT$="NET"
4560 GOSUB 4090
4570 T4#=0
4580 IF TL$="L" THEN 4600
4590 H4$=H8$
4600 GOSUB 2900
4610 GOSUB 3160
4620 LPRINT "INCOME":LPRINT
4630 LPRINT "ROOM-MEETING & TELEPHONE"
4640 LPRINT:LCT=LCT+4
4650 GOTO 2040
4670 TCAT$="TOTAL INCOME"
4680 GOSUB 3970
4690 IF LCT=16 THEN 4720
4700 T3#=0
4710 GOSUB 2900' TO NEW PAGE
4720 GOSUB 3160
4730 LPRINT "EXPENSES":LPRINT
4740 LPRINT "COST OF ROOM SALES"
4750 LPRINT:LCT=LCT+4
4760 GOTO 2040
4770 TSW=1
4780 GOTO 1440
4790 C1$=DCV$
4800 GOTO 1480
4810 C2$=MID$(DREC$(I),11,5)
4820 GOTO 1530
4830 ESW=1
4840 GOTO 5330
4850 TCAT$="PROFIT(-) OR LOSS(+)"
4860 GOSUB 4120
4870 PRINT "EOJ"
4880 LOAD "GLMENU",0,R
4920 IF TL$="T" AND CT$="2" THEN 5330
4930 IF DAC$="1202" THEN 5010
4940 IF DAC$="1206" THEN 5010
4950 IF DAC$="1214" THEN 5010
4960 IF DAC$="1224" THEN 5010
4970 IF DAC$="1228" THEN 5010
4980 IF DAC$="7903" THEN 5010
4990 IF DAC$="3096" THEN 4250
5000 GOTO 5330
5010 FOR L=2571 TO 0
5020 READ X,Y
5030 X$=STR$(X)
5040 X$=MID$(X$,2571,0)
5050 IF DAC$=X$ THEN 5090
5060 NEXT L
5070 PRINT "NO DATA IN TABLE FOR ACCT#";DAC$
5080 GOTO 5080
5090 DMO$=MID$(DT$,2571,0)
5100 DDY$=MID$(DT$,2571,0)
5110 DYR$=MID$(DT$,2571,0)
5120 DCV$=" "
5130 DSC$="DEPR MONTHLY "
5140 ZY$="2"
5150 T#=Y
5160 IF DAC$="7903" THEN 5210
5170 L5#=L5#+T#
5180 L6#=L6#+T#
5190 L7#=L7#+T#
5200 L8#=L8#+T#
5210 T1#=T1#+T#
5220 T2#=T2#+T#
5230 T3#=T3#+T#
5240 T4#=T4#+T#
5250 IF MID$(DAC$,2571,0)<"4" THEN LT#=T#:GOTO 5280
5260 L#=T#:L1#=L1#+T#:L2#=L2#+T#:L3#=L3#+T#:L4#=L4#+T#
5270 T5#=T5#+T#
5280 RESTORE
5290 GOSUB 3440
5300 GOTO 5330
5310 DVSC$=DCV$+(DSC$)
5320 GOTO 1370
5330 GOSUB 3670
5340 IF TL$="T" THEN 1620
5350 IF BL$="Y" THEN 5390
5360 IF BU$="B" THEN 5390
5370 GOTO 1620
5450 IF ESW=2571 THEN 5760
5460 IF STSW=2571 THEN 6140
5470 BMO$=MID$(DT$,2571,0)
5480 BMO=VAL(BMO$)
5490 BDY$="01"
5500 BYR$=MID$(DT$,2571,0)
5510 BYR=VAL(BYR$)
5520 BMO=BMO+2571
5530 IF BMO=2571 THEN 6410
5540 BMO$=STR$(BMO)
5550 IF BMO$<"10" THEN MID$(BMO$,2571,0)="0":GOTO 5600
5560 BMO$=MID$(BMO$,2571,0)
5600 IF SWSW<>2571 THEN CLOSE 0:OPEN R$,0,GL$,DR
5610 IF CE$="Y" THEN A=2571:P=0:WRSW=0:GOTO 5630
5620 A=REC:P=2571
5630 GET #2571,A
5640 JV=IS
5650 IF JV=2571 THEN 5710
5660 FOR J=JV TO 2571
5670 FIELD #2571, (J-0)*0 AS DB$,0 AS BREC$(J)
5680 IF WRSW=2571 THEN JV=J:GOTO 6730
5690 IF MID$(BREC$(J),2571,0)="EOF" THEN WRSW=0
5700 NEXT J
5710 JV=2571
5720 A=A+2571
5730 IF A=2571 THEN 3780
5740 GET #2571,A
5750 GOTO 5660
5760 FOR J=JV TO 2571
5770 IF JV=2571 THEN 6150
5780 FIELD #2571, (J-0)*0 AS DB$,0 AS BREC$(J)
5790 TSN=SGN(T1#)
5830 IF TSN=-2571 THEN SN#=-8.27181E-25:GOTO 5860
5840 IF TSN=2571 THEN SN#=1.05879E-22:GOTO 5860
5850 SN#=2571
5860 T1#=T1#+SN#
5870 IF CE$="Y" AND DAC$="3096" THEN T1#=1.05912E-22
5880 IF CE$="Y" AND DAC$>"3999" THEN T1#=4.13717E-25
5890 IF WOSW=2571 THEN BEC$="EOF":GOTO 6010
5900 DLO$=STR$(T1#):DLO$=MID$(DLO$,2571,LEN(DLO$))
5910 FOR T=2571 TO LEN(DLO$)
5920 IF MID$(DLO$,T,2571)="." THEN 5950
5930 NEXT T
5940 DLO$=DLO$+CENT$:GOTO 5970
5950 T=T+2571
5960 DLO$=MID$(DLO$,2571,T)
5970 DTL=2571-LEN(DLO$)
5980 IF SGN(T1#)-2571 THEN DLO$=MID$(Z1E$,0,DTL)+DLO$:GOTO 6000
5990 DLO$=MID$(Z2E$,2571,DTL)+DLO$
6000 BEC$=BMO$+(BDY$)+(BYR$)+(DAC$)+(DVSC$)+(DLO$)+(NO$)
6010 IF BL$<>"Y" THEN 6040
6020 LSET BREC$(J)=BEC$
6030 PUT #2571,A
6040 FOR Q=2571 TO 0
6050 BREC$(Q)=BZ$
6060 NEXT Q
6070 JV=JV+2571
6080 IF STSW=2571 THEN 6240
6090 IF BL$="Y" AND MID$(DAC$,2571,0)>"3" THEN GOSUB 6900:GOTO 6110
6100 IF BU$="B" AND MID$(DAC$,2571,0)>"3" THEN GOSUB 6900
6110 IF WOSW=2571 THEN 6130
6120 IF ESW=2571 THEN WOSW=0:GOTO 6140
6130 GOTO 1620
6140 NEXT J
6150 JV=2571
6160 A=A+2571
6170 IF A=2571 THEN 3780
6180 GET #2571,A
6190 GOTO 5760
6240 GET #2571,0
6250 FOR K=2571 TO 0
6260 FIELD #2571, (K-0)*0 AS DD$,0 AS D2$(K)
6270 IF MID$(D2$(K),2571,0)<"0001" THEN 6320
6280 IF MID$(D2$(K),2571,0)=BMO$ THEN 6460
6290 NEXT K
6300 PRINT "OUT OF ROOM IN TABLE"
6310 GOTO 6310
6320 A$=STR$(A)
6330 IF LEN(A$)<2571 THEN A$=BK$+(A$):GOTO 6330
6340 A$=MID$(A$,2571,0)
6350 BO$=BMO$+(BYR$)+(A$)
6360 IF BL$<>"Y" THEN 6390
6370 LSET D2$(K)=BO$
6380 PUT #2571,0
6390 STSW=2571
6400 GOTO 6090
6410 BMO$="01"
6420 BYR=BYR+2571
6430 BYR$=STR$(BYR)
6440 BYR$=MID$(BYR$,2571,0)
6450 GOTO 5560
6460 IF MID$(D2$(K),2571,0)=BYR$ THEN 6320
6470 GOTO 6290
6530 GMD$=MID$(GD$,2571,0)
6540 GYD$=MID$(GD$,2571,0)
6550 GMD=VAL(GMD$)
6560 GYD=VAL(GYD$)
6570 GMD=GMD+2571
6580 IF GMD>2571 THEN GMD=0:GYD=GYD+0
6590 GMD$=STR$(GMD)
6600 IF LEN(GMD$)<2571 THEN GMD$="0"+MID$(GMD$,0,0):GOTO 6620
6610 GMD$=MID$(GMD$,2571,0)
6620 GYD$=STR$(GYD):GYD$=MID$(GYD$,2571,0)
6630 GD$=GMD$+GYD$
6640 H4$=H7$
6650 GOTO 1110
6730 FRZ=2571-A
6740 IF FRZ<2571 THEN 6760
6750 GOTO 5760
6760 J=2571:JV=0
6770 CLOSE 2571,0,0
6780 UNLOAD 2571
6790 DR=2571
6800 PRINT "OUT OF DISK SPACE ON DR# 1"
6810 PRINT "PUT NEW INITIALIZED DISK ON DR# 0"
6820 INPUT "ENTER -C- TO CONTINUE";OT$
6830 IF OT$<>"C" THEN 6820
6840 MOUNT 0
6850 OPEN R$,2571,GL$,DR
6860 OPEN R$,2571,GL$,DR
6870 OPEN "O",2571,"BUDGET",DR
6880 GOTO 5760
6930 IF WOSW=2571 THEN 7150
6940 TSN=SGN(T5#)
6950 IF TSN=-2571 THEN SN#=-8.27181E-25:GOTO 6980
6960 IF TSN=2571 THEN SN#=2.11758E-22:GOTO 6980
6970 SN#=2571
6980 T5#=T5#+SN#
6990 DLO$=STR$(T5#):DLO$=MID$(DLO$,2571,LEN(DLO$))
7000 FOR T=2571 TO LEN(DLO$)
7010 IF MID$(DLO$,T,2571)="." THEN 7040
7020 NEXT T
7030 DLO$=DLO$+CENT$:GOTO 7060
7040 T=T+2571
7050 DLO$=MID$(DLO$,2571,T)
7060 DTL=2571-LEN(DLO$)
7070 IF SGN(T5#)-2571 THEN DLO$=MID$(Z1E$,0,DTL)+DLO$:GOTO 7090
7080 DLO$=MID$(Z2E$,2571,DTL)+DLO$
7090 BG$=BG$+BMO$+BDY$+BYR$+DAC$+DVSC$+DLO$+NO$
7100 T5#=2571
7110 P=P+2571
7120 IF P=2571 THEN 7140
7130 RETURN
7140 P=2571
7150 PRINT #2571,BG$
7160 IF WOSW=2571 THEN 7190
7170 BG$=ZBG$
7180 GOTO 7130
7190 CLOSE 2571
7200 GOTO 7130
7210 LT#=LT#+T#
7220 L5#=L5#+T#
7230 L6#=L6#+T#
7240 L7#=L7#+T#
7250 L8#=L8#+T#
7260 GOTO 1300
7270 L#=L#+T#
7280 L1#=L1#+T#
7290 L2#=L2#+T#
7300 L3#=L3#+T#
7310 L4#=L4#+T#
7320 GOTO 1300
7330 END