15 REM ****************************************
20 REM * CASH ACCOUNTS PROGRAM, VERSION 1.0 *
25 REM * MAURICE FERYN 06/19/82 *
26 REM * Rt #1, Box 394 *
27 REM * Mead, WA 99021 *
28 REM * Phone: 509-466-3685 *
30 REM ****************************************
31 REM MERGE with REMCACC for a listing with remarks.
100 REM INITIALIZE , DECLARE AND DIMENSION VARIABLES
105 SCREEN 0,0,0: WIDTH 80
110 DEFINT C,F,I,B: DEFSNG A: DEFDBL D: DEFSTR S: FD=0: CA=195: CE=195:B=13: KEY OFF
120 DIM AAC1(CA), SAC2(CA), DAC3(CA), DAC4(CA)
130 DIM SEN1(CE), SEN2(CE), SEN3(CE), DEN4(CE), AEN5(CE)
135 ON ERROR GOTO 8500
140 REM HEADER, PRINT AND DATE
150 CLS: PRINT TAB(30);: COLOR 0,7: PRINT" CASH ACCOUNTS ": COLOR 7,0: PRINT
160 INPUT"ENTER TODAY'S DATE (MO/DA/YR) ";SCDATE
300 REM DISPLAY MAIN MENU AND SELECT OPTION
310 FL=1: CLS
320 WHILE FL
330 PRINT TAB(30);:COLOR 0,7: PRINT " MAIN MENU ": COLOR 7,0
340 PRINT:PRINT:PRINT
345 PRINT"1. INITIALIZE PROGRAM"
347 PRINT"2. INPUT DATA"
350 PRINT"3. ADD, DELETE OR PRINT ACCOUNTS"
360 PRINT"4. ENTER OR EDIT CURRENT TRANSATIONS"
370 PRINT"5. REPORTS"
380 PRINT"6. START NEW ACCOUNTING PERIOD"
390 PRINT"7. SAVE DATA"
394 PRINT"8. END RUN"
400 PRINT: PRINT "TYPE the number of the option desired ";:S= INPUT$(1): I= VAL(S)
405 IF I<1 OR I>8 THEN BEEP
410 IF I>2 AND I<8 AND FD=0 THEN GOSUB 8000
420 ON I GOSUB 500,8000,1000,2000,3000,4000,5000,7000
430 CLS
440 WEND
445 END
500 REM INITIALIZE PROGRAM
510 CLS: PRINT:PRINT TAB(30): COLOR 0,7:PRINT " INITIALIZE PROGRAM ":COLOR 7,0:PRINT:PRINT
520 FL1=1
530 WHILE FL1
540 AAC1(1)=100:SAC2(1)="ASSET ACCOUNTS"
550 PRINT"The account for CHECKBOOK balance is assigned the number 101"
560 PRINT"and the PETTY CASH account is assigned the number 102"
570 PRINT: PRINT"Enter initial balances for these accounts as requested":PRINT
580 AAC1(2)=101:SAC2(2)="CHECKBOOK":AAC1(3)=102:SAC2(3)="PETTY CASH":IACN=3:IALI=4: IAIN=4: IAEX=4: IENN=0
590 FOR C=2 TO IACN
600 PRINT AAC1(C);" ";SAC2(C);:INPUT " Balance ";DAC4(C)
610 NEXT C: FL1=0
620 WEND:FD=1:RETURN
1000 REM ADD, EDIT OR PRINT ACCOUNTS SUBROUTINE
1010 FL1=1
1030 WHILE FL1
1040 CLS: PRINT TAB(25);:COLOR 0,7: PRINT" ADD, EDIT OR PRINT ACCOUNTS ":COLOR 7,0: PRINT: PRINT
1050 PRINT "1. ADD ACCOUNTS"
1060 PRINT "2. EDIT ACCOUNTS"
1070 PRINT "3. PRINT CHART OF ACCOUNTS"
1080 PRINT: PRINT "TYPE the number of the option desired else `E'to end";: S= INPUT$(1)
1085 IF S="E" OR S="e" THEN FL1=0: I=0 ELSE I= VAL(S)
1090 IF I<1 OR I>3 THEN BEEP
1100 ON I GOSUB 1200,1400,1600
1120 WEND
1130 RETURN
1200 REM ADD ACCOUNTS SUBROUTINE
1210 CLS: GOSUB 1800
1220 PRINT TAB(30) "ADD ACCOUNTS": PRINT: PRINT
1230 FL2=1
1240 INPUT "ENTER account # else `E' to end";S
1250 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S):SDDATE=SCDATE
1260 REM INPUT ACCOUNT INFORMATION LOOP
1270 WHILE FL2
1275 C=0: FL3=0
1277 AT=A*10 - INT(A*10):IF AT<>0 OR A<100 OR A>999.9 THEN INPUT "Bad range, Redo";S:A=VAL(S):GOTO 1277
1280 C=C + 1: IF C<(IACN + 1) THEN IF A=AAC1(C) THEN FL3=1 ELSE GOTO 1280
1290 IF FL3=1 THEN INPUT "Number entered is current, redo";S:A=VAL(S):C=0:FL3=0: GOTO 1277
1300 GOSUB 1850: REM ADJUST ACCOUNT POINTERS
1310 I=CSRLIN: LOCATE I,31: PRINT"|";:LOCATE I,1: INPUT "NAME ";SAC2(CS)
1320 INPUT "BALANCE";DAC4(CS): DAC3(CS)=0: PRINT: PRINT
1340 INPUT "ENTER account # else `E' to end";S
1350 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S)
1360 WEND
1370 RETURN
1400 REM EDIT ACCOUNTS SUBROUTINE
1410 CLS: GOSUB 1800: REM PRINT BOTTOM LINE
1420 PRINT TAB(30)"EDIT ACCOUNTS": PRINT: PRINT
1430 FL2=1
1440 INPUT "ENTER account # else `E' to end";S
1450 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S):SDDATE=SCDATE
1460 REM EDIT ACCOUNTS LOOP
1470 WHILE FL2
1480 C=0
1490 C=C+1: IF A=AAC1(C) THEN FL3=1:CE=C ELSE IF C=IACN THEN FL3=0 ELSE GOTO 1490
1500 IF FL3=0 THEN INPUT"ACCOUNT NOT FOUND, REDO";A: GOTO 1480 ELSE PRINT"NAME ";SAC2(CE): PRINT"MONTHLY BALANCE ";DAC3(C): PRINT"YTD BALANCE ";DAC4(C)
1510 PRINT: INPUT"IS THIS THE RIGHT ACCOUNT, Y/N ";S
1520 IF S="Y" OR S="y" THEN FL4=1 ELSE FL4=0
1530 WHILE FL4
1540 PRINT:INPUT"Retype account #";S:A=VAL(S):AT=A*10 - INT(A*10):IF AT<>0 OR A<100 OR A>999.9 THEN PRINT"Bad range, Redo":GOTO 1540
1545 IF A<>AAC1(CE) THEN GOSUB 1950: GOSUB 1850 ELSE CS=CE
1550 I=CSRLIN: LOCATE I,31: PRINT"|";:LOCATE I,1: INPUT "NAME ";SAC2(CS)
1555 INPUT "BALANCE";DAC4(CS): DAC3(CS)=0: PRINT: PRINT
1557 IF SAC2(CS)="" THEN SE=SC:GOSUB 1950
1560 FL4=0
1570 WEND
1580 INPUT "ENTER account # else `E' to end";S
1590 IF S="E" OR S="e" THEN FL2=0 ELSE A= VAL(S)
1595 WEND
1596 RETURN
1600 REM PRINT CHART OF ACCOUNTS SUBROUTINE
1610 PRINT: PRINT: PRINT"Ready printer and hit ENTER else type `E' to return to menu";:S= INPUT$(1)
1620 IF S= "E" OR S= "e" THEN GOTO 1680
1630 LPRINT CHR$(15);CHR$(27);CHR$(48):WIDTH "LPT1:",132:CI=INT(IACN/3 + 1)
1640 FOR C=1 TO CI
1650 LPRINT USING " ###.# \ \ ###.# \ \ ###.# \ \";AAC1(C),SAC2(C),AAC1(C+CI),SAC2(C+CI),AAC1(C+2*CI),SAC2(C+2*CI)
1660 NEXT C
1670 LPRINT CHR$(18);CHR$(27);CHR$(50);CHR$(12)
1680 RETURN
1800 REM PRINT BOTTOM LINE SUBROUTINE
1810 LOCATE 25,1: COLOR 0,7: PRINT" Acc. #'s: Asset 103-199; Liability 201-299; Income 301-599; Expense 601-899 ";:COLOR 7,0
1820 LOCATE 1,1: RETURN
1850 REM ADJUST ACCOUNT POINTERS
1855 IF A<200 THEN IALI = IALI + 1
1860 IF A<300 THEN IAIN = IAIN + 1
1870 IF A<600 THEN IAEX = IAEX + 1
1880 GOSUB 1900: REM GO SUB SORT
1890 RETURN
1900 REM ADD ACCOUNT SORT SUBROUTINE
1910 C=IACN
1920 IF A2 THEN BEEP
2090 ON I GOSUB 2200,2500
2100 WEND
2110 RETURN
2200 REM ENTER TRANSACTIONS SUBROUTINE
2210 CLS: GOSUB 2800: REM PRINT BOTTOM LINE
2220 DBAL=DAC4(2):SH="ENTER":GOSUB 2830: REM PRINT HEADING SUBROUTINE
2230 CF=IENN+1:CE=0:PRINT USING "###";CF;:PRINT TAB(4);:INPUT;S: IF S="E" OR S="e" THEN FL2=0 ELSE FL2=1:SDDATE=SCDATE
2240 WHILE FL2
2245 IR=CSRLIN:IF VAL(LEFT$(S,1))=0 AND LEFT$(S,1)<>"D" AND S<>"C+" AND S<>"C-" AND S<>"I" AND S<>"A+" AND S<>"A-" AND S<>"E" THEN LOCATE IR,4:PRINT" Redo";:LOCATE IR,4:INPUT;S:GOTO 2245
2247 IF S="E" THEN FL2=0:GOTO 2350
2250 IENN=IENN+1:C=IENN:CL=IENN:SEN1(C)=S
2260 IF LEFT$(S,1)="I" THEN LOCATE IR,11:INPUT;SEN2(C):LOCATE IR,22:INPUT;SEN3(C):LOCATE IR,79:PRINT "|";:FL3=0 ELSE FL3=1
2270 WHILE FL3
2280 LOCATE IR,11:INPUT;SEN2(C):LOCATE IR,22:INPUT;SEN3(C):LOCATE IR,54:PRINT "| ";
2282 LOCATE IR,56:INPUT;S:D=VAL(S):IF D=0 THEN LOCATE IR,56:PRINT" Redo ":GOTO 2282 ELSE DEN4(C)=D
2284 LOCATE IR,70:INPUT;S:A=VAL(S):IF A=0 THEN LOCATE IR,70:PRINT" Redo ":GOTO 2284 ELSE AEN5(C)=A
2290 FT=0:FOR CT=1 TO IACN: IF AEN5(C)=AAC1(CT) THEN FT=1
2295 NEXT CT:IF FT=0 THEN LOCATE IR,70:PRINT" Bad #";:GOTO 2284
2310 FL3=0
2320 WEND
2325 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL-DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL+DEN4(C)
2330 PRINT:CE=CE+1:IF CE>20 THEN IR=CSRLIN:LOCATE 1,1:GOSUB 2830:LOCATE IR,1 ELSE IR=CSRLIN:LOCATE IH,64:PRINT USING "$###,###.##";DBAL:LOCATE IR,1
2340 PRINT USING "###";C+1;:PRINT TAB(4);:INPUT;S: IF S="E" OR S="e" THEN FL2=0
2350 WEND
2360 REM EDIT CURRENT TRANSACTIONS
2370 FL2=0:IF CE<>0 THEN CLS:PRINT:PRINT"Do you want to EDIT the previous transactions, Y/N";:S=INPUT$(1)
2380 IF S="Y" OR S="y" THEN FL2=1
2390 WHILE FL2
2400 CLS:GOSUB 2860: REM PRINT BOTTOM LINE
2410 SH=" EDIT":GOSUB 2830: REM PRINT HEADER
2420 FL3=1:C=CF:SP="|"
2430 WHILE FL3
2440 GOSUB 2600:IF C<>CL THEN C=C+1 ELSE FL3=0
2450 WEND:FL2=0
2460 WEND
2470 COLOR 23,0:PRINT "Entering transactions":COLOR 7,0:FOR C=CF TO CL:IF LEFT$(SEN1(C),1)<>"I" THEN GOSUB 2910
2475 NEXT C
2480 RETURN
2500 REM EDIT SPECIFIC TRANSACTION SUBROUTINE
2510 CLS:GOSUB 2860: REM PRINT BOTTOM LINE
2520 DBAL=DAC4(2):SH="EDIT":GOSUB 2830: REM PRINT HEADER
2530 INPUT"ENTER Transaction # else `E' to end";S
2540 IF S="E" OR S="e" THEN FL2=0 ELSE FL2=1:C=VAL(S):FL4=0:SDDATE=SCDATE
2550 WHILE FL2
2555 IF LEFT$(SEN1(C),1)<>"I" THEN GOSUB 2934 : REM ADJUST ACCOUNTS
2560 GOSUB 2600:IF LEFT$(SEN1(C),1)<>"I" THEN GOSUB 2910
2565 INPUT"ENTER Transaction # else `E' to end";S
2570 IF S="E" OR S="e" THEN FL2=0 ELSE C=VAL(S)
2580 WEND
2590 RETURN
2600 REM EDIT TRANSACTIONS SUBROUTINE
2610 FL4=1:IF LEFT$(SEN1(C),1)="I" THEN GOSUB 2750 ELSE GOSUB 2760
2612 LOCATE ,,,B:IR=CSRLIN:IF IR>23 THEN LOCATE 1,1:GOSUB 2830:LOCATE IR,1
2615 WHILE FL4
2620 S=INPUT$(1):IF S=CHR$(13) THEN I=0:FL4=0:PRINT"" ELSE I=VAL(S):IR=CSRLIN
2630 ON I GOSUB 2680,2690,2700,2710,2720
2640 LOCATE ,,,B
2650 WEND
2660 IR=CSRLIN:IF IR>23 THEN LOCATE 1,1:GOSUB 2830:LOCATE IR,1 ELSE LOCATE IH,64:PRINT USING "$###,###.##";DBAL:LOCATE IR,1
2670 RETURN
2680 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL+DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL-DEN4(C)
2682 LOCATE IR,4,1,1,B:INPUT;S:IF VAL(LEFT$(S,1))=0 AND LEFT$(S,1)<>"D" AND S<>"C-" AND S<>"C+" AND S<>"I" AND S<>"A+" AND S<>"A-" THEN LOCATE IR,4,0:PRINT" Redo":GOTO 2682 ELSE SEN1(C)=S
2684 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL-DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL+DEN4(C)
2686 RETURN
2690 LOCATE IR,11,1,1,B:INPUT;SEN2(C):RETURN
2700 LOCATE IR,22,1,1,B:INPUT;SEN3(C):RETURN
2710 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL+DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL-DEN4(C)
2712 LOCATE IR,56,1,1,B:INPUT;S:D=VAL(S):IF D=0 THEN LOCATE IR,56:PRINT" Redo ":GOTO 2712 ELSE DEN4(C)=D
2714 IF INT(VAL(LEFT$(SEN1(C),2)))<>0 THEN DBAL=DBAL-DEN4(C) ELSE IF LEFT$(SEN1(C),1)="D" THEN DBAL=DBAL+DEN4(C)
2716 RETURN
2720 LOCATE IR,70,1,1,B:INPUT;S:A=VAL(S):IF A=0 THEN LOCATE IR,70:PRINT" Redo ":GOTO 2720 ELSE AEN5(C)=A:FT=0:FOR CT=1 TO IACN: IF AEN5(C)=AAC1(CT) THEN FT=1
2725 NEXT CT:IF FT=0 THEN LOCATE IR,70:PRINT" Bad #";:GOTO 2720
2730 RETURN
2750 REM PRINT INFORMATION TRANSACTION DATA
2752 PRINT USING "### \ \ \ \ \ \!";C,SEN1(C),SEN2(C),SEN3(C),SP
2754 RETURN
2760 REM PRINT CHECK, DEP, CASH, OR ADJ TRANSACTIONS
2764 PRINT USING "### \ \ \ \ \ \! $###,###.## ###.#";C,SEN1(C),SEN2(C),SEN3(C),SP,DEN4(C),AEN5(C)
2766 RETURN
2800 REM PRINT BOTTOM LINE SUBROUTINE
2810 LOCATE 25,1: COLOR 0,7: PRINT" CODE:Chk.- #; Dep.- D + opt.#; Cash - C+/C-; Inf.- I; Adj.- A+/A-; End - E ";:COLOR 7,0
2820 LOCATE 1,1: RETURN
2830 REM PRINT HEADING SUBROUTINE
2840 IH=CSRLIN:PRINT TAB(20) SH;" TRANSACTIONS";TAB(50);:PRINT USING "CHECK BALANCE $###,###.##";DBAL
2842 PRINT " 1 2 3 4 5 "
2844 PRINT " # Code Date Description ..................| Amount Acc# "
2850 RETURN
2860 REM PRINT BOTTOM LINE SUBROUTINE
2870 LOCATE 25,1:COLOR 0,7:PRINT " TO EDIT: Hit the col. #, ENTER new data else hit ENTER when the line is okay ";:COLOR 7,0
2880 LOCATE 1,1:RETURN
2900 REM ENTER OR DELETE TRANSACTIONS TO ACCOUNTS SUBROUTINES
2910 REM ENTER TRANSACTION INFORMATION TO ACCOUNTS SUBROUTINE
2912 IT=VAL(LEFT$(SEN1(C),1)):IF IT<>0 THEN DAC4(2)=DAC4(2) - DEN4(C)
2914 ST=LEFT$(SEN1(C),1):IF ST="D" THEN DAC4(2)=DAC4(2) + DEN4(C)
2916 IF SEN1(C)="C+" THEN DAC4(3)=DAC4(3) + DEN4(C)
2918 IF SEN1(C)="C-" THEN DAC4(3)=DAC4(3) - DEN4(C)
2920 CA=0
2922 CA=CA+1:IF AEN5(C)<>AAC1(CA) THEN GOTO 2922
2924 IF IT<>0 OR SEN1(C)="C-" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2962 ELSE GOSUB 2964
2926 IF ST="D" OR SEN1(C)="C+" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2964 ELSE GOSUB 2962
2928 IF SEN1(C)="A+" THEN GOSUB 2962
2930 IF SEN1(C)="A-" THEN GOSUB 2964
2932 RETURN
2934 REM DELETE TRANSACTION INFORMATION TO ACCOUNTS SUBROUTINE
2936 IT=VAL(LEFT$(SEN1(C),1)):IF IT<>0 THEN DAC4(2)=DAC4(2) + DEN4(C)
2938 ST=LEFT$(SEN1(C),1):IF ST="D" THEN DAC4(2)=DAC4(2) - DEN4(C)
2940 IF SEN1(C)="C+" THEN DAC4(3)=DAC4(3) - DEN4(C)
2942 IF SEN1(C)="C-" THEN DAC4(3)=DAC4(3) + DEN4(C)
2944 CA=0
2946 CA=CA+1:IF AEN5(C)<>AAC1(CA) THEN GOTO 2946
2948 IF IT<>0 OR SEN1(C)="C-" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2964 ELSE GOSUB 2962
2950 IF ST="D" OR SEN1(C)="C+" THEN IF AEN5(C)<200 OR AEN5(C)>599.9 THEN GOSUB 2962 ELSE GOSUB 2964
2952 IF SEN1(C)="A+" THEN GOSUB 2964
2954 IF SEN1(C)="A-" THEN GOSUB 2962
2956 RETURN
2960 REM ADD OR SUBTRACT ACCOUNT BALANCES
2962 DAC4(CA)=DAC4(CA) + DEN4(C):DAC3(CA)=DAC3(CA) + DEN4(C):RETURN
2964 DAC4(CA)=DAC4(CA) - DEN4(C):DAC3(CA)=DAC3(CA) - DEN4(C):RETURN
3000 REM REPORTS SUBROUTINE
3010 FL1=1:GOSUB 3904
3040 WHILE FL1
3050 CLS:PRINT TAB(25);:COLOR 0,7:PRINT" REPORT to ";SP;" ":COLOR 7,0:PRINT:PRINT
3060 PRINT "1. ACCOUNTS"
3070 PRINT "2. TRANSACTIONS"
3080 PRINT "3. CHANGE OUTPUT TO PRINTER"
3090 PRINT "4. CHANGE OUTPUT TO SCREEN"
3100 PRINT:PRINT "TYPE the number of the option desired else `E' to end";:S=INPUT$(1)
3110 IF S="E" OR S="e" THEN FL1=0:I=0 :CLOSE #2 ELSE I=VAL(S)
3120 IF I<1 OR I>4 THEN BEEP
3130 ON I GOSUB 3200,3500,3902,3904
3140 WEND
3150 RETURN
3200 REM REPORT ACCOUNTS SUBROUTINE
3210 FL2=1:IF SP="PRINTER" THEN CLT=50 ELSE CLT=15
3220 WHILE FL2
3230 CLS:PRINT TAB(25);"REPORT ACCOUNTS to ";SP:PRINT:PRINT
3240 PRINT"1. ASSET"
3242 PRINT"2. LIABILITY"
3244 PRINT"3. INCOME"
3246 PRINT"4. EXPENSE"
3248 PRINT"5. SELECT RANGE"
3250 PRINT:PRINT"TYPE the number of the option desired else `E' to end";:S=INPUT$(1)
3260 IF S="E" OR S="e" THEN FL2=0:I=0 ELSE I=VAL(S):DTOTMO=0:DTOTYTD=0:IF SP="SCREEN" THEN CLS ELSE PRINT " Writing to printer"
3270 IF I<1 OR I>5 THEN BEEP
3280 ON I GOSUB 3310,3320,3330,3340,3350
3290 WEND
3300 RETURN
3310 REM PRINT ASSET ACCOUNTS
3314 CL=0:C1=1:C2=IALI-1:SH=" ASSET ACCOUNTS"
3318 GOSUB 3400: RETURN
3320 REM PRINT LIABILITY ACCOUNTS
3324 CL=0:C1=IALI:C2=IAIN-1:SH=" LIABILITY ACCOUNTS"
3328 GOSUB 3400: RETURN
3330 REM PRINT INCOME ACCOUNTS
3334 CL=0:C1=IAIN:C2=IAEX-1:SH=" INCOME ACCOUNTS"
3338 GOSUB 3400: RETURN
3340 REM PRINT EXPENSE ACCOUNTS
3344 CL=0:C1=IAEX:C2=IACN:SH=" EXPENSE ACCOUNTS"
3348 GOSUB 3400: RETURN
3350 REM PRINT SELECT ACCOUNT RANGE
3354 PRINT TAB(20);"SELECT ACCOUNT RANGE FOR REPORT":PRINT
3358 I=CSRLIN:INPUT"ENTER low account # and high account #. Ex: 200,500 ";SC1,SC2
3362 IF VAL(SC1)=0 OR VAL(SC2)=0 OR VAL(SC1)>VAL(SC2) THEN LOCATE I,1:PRINT "Redo! ";:GOTO 3358
3366 C=1
3370 IF AAC1(C)=>VAL(SC1) THEN C1=C ELSE C=C+1:GOTO 3370
3374 C=IACN
3378 IF AAC1(C)<=VAL(SC2) THEN C2=C ELSE C=C-1: GOTO 3378
3382 PRINT:PRINT "ENTER name for account range, up to 40 char. ":INPUT ST
3386 SH=" "+ST:CL=0
3390 CLS: GOSUB 3400: RETURN
3400 REM PROCESS AND PRINT ACCOUNTS SUBROUTINE
3404 GOSUB 3908: REM PRINT HEADER
3408 FOR C = C1 TO C2
3412 CS=C:A=AAC1(C+1) - INT(AAC1(C+1))
3416 IF A<>0 THEN FL4=1:DAC3(CS)=0:DAC4(CS)=0 ELSE FL4=0
3420 WHILE FL4
3424 C=C+1:DAC3(CS)=DAC3(CS) + DAC3(C):DAC4(CS)=DAC4(CS) + DAC4(C)
3428 CP=C:GOSUB 3912:CL=CL+1
3432 A=AAC1(C+1) - INT(AAC1(C+1))
3436 IF A=0 THEN FL4=0
3440 WEND
3444 CP=CS:DTOTMO=DTOTMO+DAC3(CP):DTOTYTD=DTOTYTD+DAC4(CP):GOSUB 3912:CL=CL+1
3448 IF C=>C2 THEN GOSUB 3950:IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3452 IF CL=>CLT AND C<>C2 AND SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3456 IF CL=>CLT AND C<>C2 THEN PRINT#2,CHR$(12);: GOSUB 3908:CL=0
3460 NEXT C
3464 PRINT#2,CHR$(12)
3468 RETURN
3500 REM REPORT TRANSACTIONS SUBROUTINE
3510 FL2=1: IF SP="PRINTER" THEN CLT=50 ELSE CLT=15
3520 WHILE FL2
3530 CLS:PRINT TAB(25); "REPORT TRANSACTIONS to ";SP:PRINT:PRINT
3532 PRINT "1. CHECKS"
3534 PRINT "2. DEPOSITS"
3536 PRINT "3. CASH"
3538 PRINT "4. INFORMATION"
3540 PRINT "5. ADJUSTMENTS"
3542 PRINT "6. ALL"
3550 PRINT:PRINT "TYPE the number of the option desired else `E' to end";:S=INPUT$(1)
3560 IF S="E" OR S="e" THEN FL2=0:I=0 ELSE I=VAL(S):CL=0:IF SP="SCREEN" THEN CLS ELSE PRINT " Writing to printer"
3570 IF I<1 OR I>6 THEN BEEP
3580 ON I GOSUB 3600,3620,3640,3660,3680,3700
3585 WEND:RETURN
3598 REM PRINT VARIOUS TRANSACTIONS SUBROUTINES
3600 SH=" CHECKS":GOSUB 3920:GOSUB 3940
3602 FOR C=1 TO IENN
3604 IT = VAL(LEFT$(SEN1(C),1)): IF IT<>0 THEN GOSUB 3720
3606 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3607 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3608 PRINT#2,CHR$(12):RETURN
3620 SH=" DEPOSITS":GOSUB 3920:GOSUB 3940
3622 FOR C=1 TO IENN
3624 IF LEFT$(SEN1(C),1)="D" THEN GOSUB 3720
3626 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3627 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3628 PRINT#2,CHR$(12):RETURN
3640 SH=" PETTY CASH":GOSUB 3920:GOSUB 3940
3642 FOR C=1 TO IENN
3644 IF LEFT$(SEN1(C),1)="C" THEN GOSUB 3720
3646 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3647 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3648 PRINT#2,CHR$(12):RETURN
3660 SH=" INFORMATION":GOSUB 3930:GOSUB 3940
3662 FOR C=1 TO IENN
3664 IF SEN1(C)="I" THEN GOSUB 3720
3666 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3667 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3668 PRINT#2,CHR$(12):RETURN
3680 SH=" ADJUSTMENTS":GOSUB 3920:GOSUB 3940
3682 FOR C=1 TO IENN
3684 IF LEFT$(SEN1(C),1)="A" THEN GOSUB 3720
3686 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3687 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3688 PRINT#2,CHR$(12):RETURN
3700 SH=" ALL TRANSACTIONS":GOSUB 3920:GOSUB 3940
3702 FOR C=1 TO IENN
3704 GOSUB 3720
3706 NEXT C:IF CL=0 THEN PRINT#2," *** NO ENTRIES ***"
3707 IF SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3708 PRINT#2,CHR$(12):RETURN
3720 REM PRINT TRANSACTION DATA SUBROUTINE
3722 IF CL=>CLT AND SP="SCREEN" THEN INPUT "Hit ENTER to continue";S
3724 IF CL=>CLT THEN PRINT#2,CHR$(12):GOSUB 3940:CL=0
3726 IF SEN1(C)<>"I" THEN GOSUB 3742 ELSE GOSUB 3744
3728 CL=CL+1
3730 RETURN
3740 REM PRINT TRANSACTION DATA LINE
3742 PRINT#2,USING" ### \ \ \ \ \ \ $###,###.## ###.#";C,SEN1(C),SEN2(C),SEN3(C),DEN4(C),AEN5(C):RETURN
3744 PRINT#2,USING" ### \ \ \ \ \ \";C,SEN1(C),SEN2(C),SEN3(C):RETURN
3900 REM SET PRINTER OR SCREEN FILE
3902 CLOSE #2:PRINT:INPUT"Check printer then hit ENTER";S1:SP="PRINTER":OPEN "LPT1:" FOR OUTPUT AS 2:RETURN
3904 CLOSE #2:SP="SCREEN":OPEN "SCRN:" FOR OUTPUT AS 2:RETURN
3908 REM PRINT ACCOUNTS HEADER
3910 PRINT#2,SH;TAB(70);SDDATE:PRINT#2,""
3911 PRINT#2, " NUMBER NAME PERIOD BAL. CURRENT BAL.":PRINT#2,"":RETURN
3912 REM PRINT ACCOUNTS DATA
3913 PRINT#2,USING" ###.# \ \ $$,###,###.## $$,###,###.##";AAC1(CP),SAC2(CP),DAC3(CP),DAC4(CP):RETURN
3919 REM SET TRANSACTION COLUMN HEADING AND PRINT HEADER SUBROUTINES
3920 SC= " # Code Date Description ...................| Amount Acc#":RETURN
3930 SC= " # Code Date Description .......................................|":RETURN
3940 PRINT#2,SH;TAB(70);SDDATE:PRINT#2,"":PRINT#2,"":PRINT#2,SC:PRINT#2,"":RETURN
3950 REM PRINT ACCOUNT TOTALS
3952 PRINT#2,TAB(45);"------------ ------------"
3954 PRINT#2,TAB(36);USING "TOTAL $$,###,###.## $$,###,###.##";DTOTMO,DTOTYTD
3956 RETURN
4000 REM START NEW ACCOUNTING PERIOD SUBROUTINE
4010 PRINT:COLOR 0,7:PRINT" Start new accounting period ":COLOR 7,0
4020 PRINT"Do you want to save current data, TYPE Y,N or any other key to cancel";:S=INPUT$(1)
4030 IF S="Y" OR S="y" THEN GOSUB 8200
4040 IF S="N" OR S="n" THEN PRINT"TYPE `OK' to start new accounting period";:S=INPUT$(2)
4050 IF S="OK" OR S="ok" THEN FOR C=1 TO IACN:DAC3(C)=0:NEXT C:IENN=0 ELSE COLOR 17,7: PRINT " DATA NOT CLEARED ": COLOR 7,0: FOR C=1 TO 3000:NEXT C
4060 RETURN
5000 REM SAVE DATA SUBROUTINE
5010 PRINT:COLOR 0,7:PRINT" Save data ":COLOR 7,0
5020 PRINT "Is this what you want, Y/N ":S=INPUT$(1)
5030 IF S="Y" OR S="y" THEN FL1=1
5040 WHILE FL1
5050 GOSUB 8200
5060 PRINT"Do you want another copy, Y/N ":S=INPUT$(1)
5070 IF S="N" OR S="n" THEN FL1=0 ELSE FL1=1
5080 WEND
5100 RETURN
7000 REM END RUN
7010 CLS:PRINT :PRINT TAB(30);:COLOR 0,7:PRINT " END RUN ":COLOR 7,0:PRINT
7020 PRINT "Do you need to save data or return to Main Menu, Y/N":S=INPUT$(1): IF S="N" OR S="n" THEN FL=0
7030 RETURN
8000 REM DATA INPUT SUBROUTINE
8010 CLS: PRINT TAB(30);:COLOR 0,7:PRINT " DATA INPUT ":COLOR 7,0: PRINT
8012 IF I>2 AND I<8 THEN PRINT "You need to input data first!"
8015 FL1=0:PRINT"Is this what you want, Y/N ":S=INPUT$(1):IF S="Y" OR S="y" THEN FL1=1 ELSE I=0
8018 WHILE FL1
8020 INPUT "Insert data disk and then hit ENTER";S
8030 PRINT "Data files on disk are;": FILES "*.ACC"
8040 PRINT: INPUT "ENTER file name(without ext.), N to check another disk or E to end";S: IF S="N" OR S="n" THEN FL2=0 ELSE IF S="E" OR S="e" THEN FL1=0:FL2=0 ELSE FL2=1
8043 WHILE FL2
8045 SA=S + SPACE$(8-LEN(S)) + ".ACC"
8050 OPEN SA FOR INPUT AS 1
8055 PRINT: COLOR 23,0:PRINT"Loading data":COLOR 7,0
8060 INPUT#1, IACN,IALI,IAIN,IAEX
8070 FOR C=1 TO IACN: INPUT#1, AAC1(C),SAC2(C),DAC3(C),DAC4(C): NEXT C
8080 CLOSE #1
8085 SF=S+ SPACE$(8-LEN(S)) + ".ENT"
8090 OPEN SF FOR INPUT AS 1
8100 INPUT#1, SDDATE,IENN
8110 PRINT "Date of Data ";SDDATE:FOR C=1 TO 1500:NEXT C
8120 FOR C=1 TO IENN: INPUT#1, SEN1(C),SEN2(C),SEN3(C),DEN4(C),AEN5(C): NEXT C
8125 CLOSE #1:FL2=0:FL1=0:FD=1
8127 WEND
8128 WEND
8130 RETURN
8200 REM DATA OUTPUT SUBROUTINE
8210 PRINT: INPUT"SAVE DATA, Insert disk then hit ENTER ";S
8220 PRINT: INPUT"ENTER accounting period name(up to 8 chr) ";S
8230 SA= S + ".ACC":SF= S + ".ENT"
8240 OPEN SA FOR OUTPUT AS 1
8245 PRINT:I=CSRLIN: COLOR 23,0:PRINT"Saving data";:COLOR 7,0:LOCATE I,1
8250 WRITE#1, IACN,IALI, IAIN, IAEX
8260 FOR C=1 TO IACN: WRITE#1, AAC1(C),SAC2(C),DAC3(C),DAC4(C): NEXT C
8270 CLOSE #1
8280 OPEN SF FOR OUTPUT AS 1
8290 WRITE#1, SDDATE, IENN
8300 FOR C=1 TO IENN: WRITE#1, SEN1(C), SEN2(C), SEN3(C), DEN4(C), AEN5(C): NEXT C
8305 CLOSE #1
8310 RETURN
8500 REM ERROR TRAPPING
8510 IF (ERR=53) THEN PRINT"File not on disk":RESUME 8040
8520 IF (ERR=27) OR (ERR=68) THEN INPUT "Check printer, then hit ENTER to return to MAIN MENU ";S:RESUME 300
8530 IF (ERR=70) OR (ERR=71) THEN INPUT "Check disk, then hit ENTER to return to MAIN MENU ";S:RESUME 300
8540 IF (ERR=61) THEN PRINT "Disk is full":RESUME 8200 ELSE INPUT "UNKNOWN ERROR, Hit ENTER to return to MAIN MENU";S: RESUME 300