CP/M/CPM_CDROM.iso/simtel/cpmug/cpmug044.ark/G_L040.BAS

BASIC Source File | 1985-02-10 | 9.0 KB | 281 lines

    REMARK    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    REMARK    +    GENERAL LEDGER REPORTS PROGRAM      (GL040)    +
    REMARK    +        VERS. OF 5.00 PM    2/23/79        +
    REMARK    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    DIM G2$(5),G3(5),D(7),G(3,10),S.(7),H.(2,3),H1(3)
    DATA "TRIAL","SPECIAL","MONTHLY","QUARTERLY"," REPORT"
    DATA " INCOME STATEMENT"," BALANCE SHEET"
    DEF FNZ(Z9)=Z9+(1-ABS(SGN(Z9))) * 1E20
%INCLUDE CURSOR
    GOTO 6000
%INCLUDE SUBS1
%INCLUDE BINSERCH
%INCLUDE GENINFO
%INCLUDE ACCTFILE
%INCLUDE G/L-INFO



825    IF LINE.COUNT%<55 THEN RETURN                    REMARK    LINE PRINTER ROUTINE
    PAGE.COUNT%=PAGE.COUNT%+1
    PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
    X0=G3(1):GOSUB 680.5
    PRINT
    PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
    PRINT
    IF R1<>0 THEN PRINT TAB(45);"PREVIOUS QUARTER ";R1
    PRINT:PRINT" ACCOUNT        NAME";
    ON R GOTO 833,834,835,836
833    IF S=2 THEN 834                            REMARK    TRIAL REPORT HEADINGS
    PRINT TAB(59);"THIS MONTH     PCT";
    IF G7>3 THEN PRINT TAB(105);"QUARTER     PCT"
    GOTO 840
834    PRINT TAB(58);"THIS MONTH"                    REMARK    SPECIAL REPORT HEADINGS
    GOTO 840
835    IF S=2 THEN 834                            REMARK    MONTHLY REPORT HEADINGS
    PRINT TAB(59);"THIS MONTH     PCT";
    IF G7<2 THEN 840
    GOTO 837
836    IF S=2 THEN PRINT TAB(75);"QUARTER";:GOTO 840            REMARK    QUARTERLY REPORT HEADINGS
    PRINT TAB(61);"QUARTER     PCT";
    IF R1<=0 AND G7<4 THEN 840
837    PRINT TAB(105);"YTD BAL     PCT"
840    PRINT:PRINT:PRINT
    LINE.COUNT%=6
    D9$="$"
    RETURN


4000    PRINT TAB(8);X0$;TAB(56);                    REMARK    PRINT RECAP LINE
    IF R=4 THEN 4005
    PRINT USING MASKB$;X0;                        REMARK    INCLUDE MONTHLY TOTAL
    IF S<>1 THEN PRINT:RETURN
    PRINT TAB(99);
    IF R=3 THEN 4015
4005    PRINT USING MASKB$;X2;                        REMARK    INCLUDE QUARTERLY TOTAL
    IF R<>4 OR S<>1 THEN PRINT:RETURN
4015    PRINT TAB(99);                            REMARK    INCLUDE YEARLY TOTAL
    PRINT USING MASKB$;X1
    RETURN


                                    REMARK    ACCUMULATE AND PRINT SUBROUTINE
4020    IF L3%=0 THEN\                            REMARK    ACCUMULATE REGULAR ACCOUNT TO ALL TOTAL LEVELS
        FOR I%=1 TO 10:\
        G(F1,I%)=G(F1,I%)+S2*D(F1):\
        NEXT I%\
    ELSE D9$="$"                            REMARK    PRECEDE TOTAL AMOUNTS WITH A DOLLAR SIGN
    PRINT TAB(55+(F-1)*(14+8*(2-S)));                REMARK    PRINT AMOUNT (WITH % OF SALES ON INCOME STATEMENT)
    PRINT D9$;
    PRINT USING MASKB$;G(F1,L6%);
    IF S<>2 THEN PRINT USING MASKA$;ABS(G(F1,L6%)/H1(F1))*100;
    FOR I%=1 TO L6%                            REMARK    CLEAR ALL TOTALS UP TO THE LEVEL JUST PRINTED
    G(F1,I%)=0
    NEXT I%
    IF L5%=1 THEN H.(1,F1)=H.(1,F1)+D(F1)\                REMARK    ACCUMULATE DEBIT TOTAL
    ELSE H.(2,F1)=H.(2,F1)+D(F1)                    REMARK    ACCUMULATE CREDIT TOTAL
    RETURN


4140    F=INT((L6%+3)/3)                        REMARK    DETERMINE PRINT COLUMN BY TOTAL LEVEL
    IF F>3 THEN F=3
    RETURN


5000    IF L2%<>0 THEN RETURN                        REMARK    MOVE TOTALS (REGULAR ACCOUNTS ONLY)
    ON S GOTO 5060,5040,5020
5020    D(7)=D(2)                            REMARK    YEARLY TOTAL
    IF L4%=1 THEN D(2)=0                        REMARK    ZERO THIS YEAR TOTAL FIELD ON I & E ACCOUNTS
5040    D(6)=D(5)                            REMARK    QUARTERLY TOTAL
    D(5)=D(4)
    D(4)=D(3)
    IF L4%=1 THEN D(3)=0:D(1)=0:GOSUB 3550:RETURN            REMARK    ZERO THIS QUARTER FIELD ON I & E ACCOUNTS
5060    IF L4%=1 THEN D(1)=0                        REMARK    ZERO THIS MONTH TOTAL FIELD ON I & E ACCOUNTS
    GOSUB 3550                            REMARK    WRITE RECORD BACK TO FILE
    RETURN



6000    MASKA$=" ###.##%"                        REMARK    - - - START OF MAIN PROGRAM - - -
    MASKB$=" #########.##"
    MASKC$="#####.#"
    OPEN "G/I0F010.DAT" AS 1,"G/L0F110.DAT" RECL 157 AS 2,\
    "G/L0F130.DAT" AS 5, "CRT" RECL 1100 AS 19
    FILE.NO%=1:GOSUB 700                        REMARK    RETRIEVE GENERAL INFORMATION
    G6=INT(G3(1)/10000)
    G7=12*((G6-G5+12)/12-INT((G6-G5+12)/12))            REMARK    COMPUTE EFFECTIVE MONTH FROM END OF FISCAL YEAR
    FILE.NO%=5:GOSUB .314                        REMARK    RETRIEVE EXTENT INFORMATION
    RECORD.COUNT%=ACCOUNT.FILE.EXTENT%
    Y2=2
6020    CONSOLE
    X0=3:GOSUB 260                            REMARK    LOAD CRT MASK
    IF DIRECT.POSTING.EXTENT%>0 OR EXTERNAL.POSTING.EXTENT%>0 THEN\    REMARK    DETERMINE IF ANY POSTINGS HAVE NOT BEEN UPDATED
        X1=832:GOSUB 210:\
        PRINT DIRECT.POSTING.EXTENT%;"DIRECT AND";:\
        PRINT EXTERNAL.POSTING.EXTENT%;"INDIRECT POSTINGS NOT UPDATED";
    R=0:R1=0:S=0:PAGE.COUNT%=0                    REMARK    INITIALIZE REPORT PARAMETERS
    LINE.COUNT%=66
    X1=327:X2=1:X3=0:X4=5:GOSUB 345                    REMARK    ENTER REPORT TYPE
    R=X0
    IF R=0 THEN 6800
    IF R=2  THEN 6100
    IF R=5  THEN \
        X1=375:X2=1:X3=1:X4=3:GOSUB 345:\            REMARK    ENTER WHICH TOTALS TO MOVE
        S=X0:\
        GOTO 6100\
    ELSE\
        X1=345:X2=1:X3=1:X4=2:GOSUB 345:\            REMARK    ENTER REPORT FORMAT
        S=X0
    IF R=4 THEN\
        X1=362:X2=1:X3=0:X4=3:GOSUB 345:\            REMARK    ENTER WHICH QUARTER TO REPORT
        R1=X0
6100    X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665            REMARK    VERIFY ENTRY OF REPORT OPTIONS
    IF X0=0 THEN 6020
    IF R<>5 THEN 6120
                                    REMARK    MOVE TOTALS ROUTINE
    X2=1:X3=0:X4=1:X2$="HAVE YOU RUN ALL YOUR REPORTS":GOSUB 665
    IF X0=0 THEN 6020
    X1=192:GOSUB 210
    PRINT "WORKING...DO NOT INTERRUPT"
    FILE.NO%=2
    FOR RECORD.NO%=1 TO ACCOUNT.FILE.EXTENT%
    GOSUB 3500                            REMARK    RETRIEVE NEXT ACCOUNT
    GOSUB 5000                            REMARK    MOVE TOTALS
    NEXT RECORD.NO%
    GOTO 6020


                                    REMARK    - - - START MAIN PRINT SEQUENCE - - -
6120    RESTORE                                REMARK    CONSTRUCT REPORT TITLE
    FOR I=1.0 TO R
    READ X4$
    NEXT I
    RESTORE
    FOR I=1.0 TO S+5
    READ XX$
    NEXT I
    X4$=X4$+XX$
    X1=192:GOSUB 210
    PRINT "PRINTING..."
    LPRINTER
    FOR I%=1 TO 3                            REMARK    ZERO TOTALS
    FOR J%=1 TO 10
    G(I%,J%)=0
    IF J%<3 THEN H.(J%,I%)=0
    NEXT J%,I%
    FILE.NO%=2:RECORD.NO%=ACCOUNT.FILE.EXTENT%:GOSUB 3500        REMARK    RETRIEVE SALES ACCOUNTS TOTAL
    H1(1)=FNZ(D(1))
    H1(3)=FNZ(D(3+R1))
    IF INT((G7+2)/3)>R1 THEN H1(2)=FNZ(D(2))\
    ELSE H1(2)=FNZ(D(7))
    IF S=1 THEN\
        K1=30000:\                        REMARK    POSITION FILE TO FIRST BALANCE SHEET ACCOUNT
        GOSUB 10.60:\
        RECORD.NO%=L-1\
    ELSE RECORD.NO%=0                        REMARK    POSITION FILE TO FIRST ACCOUNT
6220    RECORD.NO%=RECORD.NO%+1                        REMARK    LOCATE NEXT ACCOUNT RECORD
    IF RECORD.NO%=ACCOUNT.FILE.EXTENT% THEN 6660            REMARK    CHECK FOR END OF REPORT
    GOSUB 3500                            REMARK    RETRIEVE NEXT ACCOUNT
    IF R<>2 AND L4%<>S THEN 6660
    L6%=L6%+1
    IF L5%=S1 THEN S2=1\                        REMARK    COMPUTE NORMAL SIGN OF ACCOUNT BALANCE
    ELSE S2=-1
    IF R1=0 THEN 6320
    D(3)=D(3+R1)                            REMARK    USE REQUESTED QUARTERLY TOTALS
    D(1)=0
    IF INT((G7+2)/3)<=R1 THEN D(2)=D(7)
6320    IF R<>2 THEN 6340                        REMARK    INCLUDE ONLY REGULAR ACCOUNTS ON SPECIAL REPORT
    IF L2%<>0 OR L9%=0 THEN 6220
6340    A1=110:GOSUB 825
    IF L3%=0 THEN PRINT USING MASKC$;L1;                REMARK    PRINT REGULAR ACCOUNT'S NUMBER
    IF L3%=1 THEN\                            REMARK    PRINT TITLE IN "EXPANDED PRINT"
        S1=L5%:\
        PRINT TAB(17-L6);:\
        FOR I%=1 TO LEN(L1$):\
        PRINT MID$(L1$,I%,1);" ";:\
        NEXT I%:\
        GOTO 6420
    PRINT TAB(17-L6%);L1$;TAB(48);                    REMARK    PRINT ACCOUNT NAME
    IF L3%=3 THEN 6420
    ON R GOSUB 6460,6560,6580,6620
    D9$=" "
6420    IF L7%=9 THEN LINE.COUNT%=60\                    REMARK    ADVANCE TO NEXT PAGE
    ELSE\
        FOR I%=1 TO L7%+1:\                    REMARK    PRINT EXTRA BLANK LINES
        PRINT:\
        NEXT I%:\
        LINE.COUNT%=LINE.COUNT%+L7%+1
    GOTO 6220


6460    IF S=2 THEN\                            REMARK    MONTHLY TRIAL BALANCE
        GOSUB 4140:\
        F1=1:GOSUB 4020:\
        GOTO 6540
    F=1:F1=1:GOSUB 4020                        REMARK    TRIAL INCOME STATEMENT
    IF G7>3 THEN F=3:F1=3:GOSUB 4020
6540    IF L8%=0 THEN RETURN
    FOR I%=1 TO 7                            REMARK    ACCUMULATE NEW SALES TOTALS
    S.(I%)=S.(I%)+D(I%)*S2
    NEXT I%
    RETURN


6560    PRINT TAB(55);                            REMARK    SPECIAL REPORT: PRINT MONTHLY TOTALS
    PRINT USING MASKB$;D(1);
    RETURN


6580    IF S=2 THEN \                            REMARK    MONTHLY BALANCE SHEET
        GOSUB 4140:\
        F1=1:GOSUB 4020:\
        RETURN
    F=1:F1=1:GOSUB 4020                        REMARK    MONTHLY INCOME STATEMENT
    IF G7>1 THEN F=3:F1=2:GOSUB 4020
    RETURN


6620    IF S=2 THEN \
        GOSUB 4140:\                        REMARK    QUARTERLY BALANCE SHEET
        F1=3:GOSUB 4020:\
        RETURN
    F=1:F1=3:GOSUB 4020                        REMARK    QUARTERLY INCOME STATEMENT
    IF R1>0 OR G7>3 THEN F=3:F1=2:GOSUB 4020
    RETURN


                                    REMARK    - - - END OF REPORT - - -
6660    IF R=2 THEN 6020                        REMARK    NO RECAP ON SPECIAL REPORT
    LINE.COUNT%=LINE.COUNT%+7-2*S
    A1=110:GOSUB 825
    IF S=2 THEN C1$="PROOF":GOTO 6720\
    ELSE C1$="RETAINED EARNINGS"
    IF R<>1 THEN 6720
    FILE.NO%=2:RECORD.NO%=ACCOUNT.FILE.EXTENT%:GOSUB 3500
    FOR I%=1 TO 7
    D(I%)=S.(I%)
    NEXT I%
    GOSUB 3550                            REMARK    SAVE UPDATED SPECIAL SALES TOTAL RECORD
    IF INT((G7+2)/3)>R1 THEN X1=S.(2)\
    ELSE X1=S.(7)
    X0$="SALES ACCOUNTS TOTAL":X0=S.(1):X2=S.(3+R1):GOSUB 4000
6720    PRINT                                REMARK    PRINT TOTALS
    X0$="DEBIT TOTAL":X0=H.(1,1):X1=H.(1,2):X2=H.(1,3):GOSUB 4000
    X0$="CREDIT TOTAL":X0=H.(2,1):X1=H.(2,2):X2=H.(2,3):GOSUB 4000
    PRINT
    X0$=C1$:X0=H.(2,1)-H.(1,1):X1=H.(2,2)-H.(1,2):X2=H.(2,3)-H.(1,3)
    GOSUB 4000
    GOTO 6020


6800    CONSOLE
    PRINT CLEAR.SCREEN$;"G/L REPORTS LOADING MENU"            REMARK    - - - END  PROGRAM - - -
    CHAIN "G/L000"
:GOSUB 4020                        REMARK    QUARTERLY INCOME STATEMENT
    IF R1>0 OR G7>3 THEN F=3:F1=2:GOSUB 4020
    RETURN


                                    REMARK    - -