home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug044.ark
/
G_L040.BAS
< prev
next >
Wrap
BASIC Source File
|
1985-02-10
|
9KB
|
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 - -