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
/
CPMUG044.ARK
/
G_L030.BAS
< prev
next >
Wrap
BASIC Source File
|
1985-02-10
|
6KB
|
186 lines
REMARK #########################################################
REMARK # GENERAL LEDGER POSTING UPDATE (GL030) #
REMARK # VERS. OF 9.30 PM 3/2/79 #
REMARK #########################################################
%INCLUDE CURSOR
DIM E$(16),C.(6,2),G3(5),G2$(5),D(7)
GOTO 6000
%INCLUDE SUBS1
%INCLUDE ACCTFILE
%INCLUDE POSTFILE
%INCLUDE GENINFO
%INCLUDE G/L-INFO
%INCLUDE BINSERCH
825 IF LINE.COUNT%<55 AND PAGE.COUNT%>0 THEN RETURN REMARK LINE PRINTER ROUTINE
PAGE.COUNT%=PAGE.COUNT%+1
PRINT CHR$(12);
PRINT 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
XY$="SRCE DATE REF AMOUNT"
IF F=0 THEN PRINT" ACCT ";XY$;":::";XY$;":::";XY$;":::";XY$ \
ELSE \
FOR I1%=1 TO 2:\
PRINT "ACCT NO ";XY$;" ";:\
NEXT I1%:\
PRINT "ACCT NO ";XY$
PRINT
LINE.COUNT%=6
RETURN
4000 IF E2%=0 THEN RETURN REMARK FOUR POSTINGS PRINTED PER LINE
PRINT
LINE.COUNT%=LINE.COUNT%+1
E2%=0
GOSUB 825
RETURN
4020 IF F1=1 THEN RETURN REMARK PRINT ACCOUNT TOTALS
FILE.NO%=2:RECORD.NO%=L
GOSUB 3500 REMARK RETRIEVE ACCOUNT RECORD
D0=D(1)
D(1)=D(1)+C
D(2)=D(2)+C
D(3)=D(3)+C
GOSUB 3550 REMARK RESAVE ACCOUNT WITH ACCUMULATED POSTINGS
IF E2%<>0 THEN \
PRINT:\
LINE.COUNT%=LINE.COUNT%+1:\
E2%=0
PRINT L1$;TAB(35); REMARK PRINT ACCOUNT TOTALS
PRINT USING MASKA$;C.(1,1),C.(2,1),C.(3,1),C.(4,1);
PRINT TAB(94);"OPENING BAL";
PRINT USING MASKD$;D0
PRINT " NET CHANGE";
PRINT USING MASKD$;C;
PRINT TAB(29);
PRINT USING MASKD$;C.(1,2);C.(2,2);C.(3,2);C.(4,2);
PRINT TAB(94);"CLOSING BAL";
PRINT USING MASKD$;D(1)
PRINT:PRINT
IF L5%=1 THEN D9=D9+C\
ELSE C9=C9+C
LINE.COUNT%=LINE.COUNT%+4
F1=1
RETURN
4180 ERROR.COUNT% = ERROR.COUNT% + 1 REMARK SAVE ONE ERROR RECORD
FILE.NO%=3:RECORD.NO%=ERROR.COUNT%:GOSUB 3650
RETURN
REMARK START OF MAIN PROGRAM
6000 MASKA$="P/R ### A/P ### A/R ### G/L ###"
MASKB$="## ##/## ######-#######.##"
MASKC$="#####.#"
MASKD$=" #########.##"
OPEN "G/I0F010.DAT" AS 1, "G/L0F110.DAT" RECL 157 AS 2,\
"G/L0F020.DAT" RECL 36 AS 4,"G/L0F130.DAT" AS 5
CREATE "ERRORFIL.DAT" RECL 36 AS 3
FILE.NO%=1:GOSUB 700 REMARK RETRIEVE GENERAL INFORMATION
FILE.NO%=5:GOSUB .314 REMARK RETRIEVE EXTENT INFORMATION
PRINT CLEAR.SCREEN$;"GENERAL LEDGER UPDATE"
PRINT "PROCESSING...DO NOT INTERRUPT"
X4$="G/L UPDATE":A1=100
LPRINTER
F1=1
LINE.COUNT%=66
FOR INDEX%=1 TO EXTERNAL.POSTING.EXTENT%
FILE.NO%=4:RECORD.NO%=INDEX%:GOSUB 3600 REMARK RETRIEVE NEXT POSTING
IF P1=0 THEN 6280 REMARK SKIP POSTINGS TO ACCOUNT NUMBER ZERO
IF P1=CURRENT.ACCOUNT THEN 6120
IF P1=LAST.ERROR THEN 6240
GOSUB 4020 REMARK THIS POSTING IS TO A NEW ACCOUNT
RECORD.COUNT%=ACCOUNT.FILE.EXTENT%
Y2=2
K1=P1
GOSUB 10.60 REMARK SEARCH ACCOUNT FILE FOR ACCOUNT NUMBER "P1"
IF H=-1 THEN 6240 REMARK ACCOUNT NOT FOUND. ADD THIS POSTING TO ERROR FILE
GOSUB 825
PRINT USING MASKC$;P1;
FOR I1%=1 TO 6 REMARK CLEAR TOTALS AND RESET FLAGS
C.(I1%,1)=0:C.(I1%,2)=0
NEXT I1%
C=0:E2%=0:F1=0
CURRENT.ACCOUNT=P1
6120 IF E2%=4 THEN GOSUB 4000
IF P5=0 THEN 6200 REMARK IF POSTING AMOUNT IS ZERO, DO NOT PRINT POSTING
IF E2%=0 THEN PRINT TAB(11);
PRINT " ";
PRINT USING MASKB$;P2;INT(P3);100*(P3-INT(P3));P4;P5;
IF E2%<3 THEN PRINT ":::";
C=C+P5
C.(P2+1,1)=C.(P2+1,1)+1
C.(P2+1,2)=C.(P2+1,2)+P5
E2%=E2%+1
6200 P1=0
FILE.NO%=4:RECORD.NO%=INDEX%
GOSUB 3650 REMARK RESAVE POSTING WITH ZERO ACCOUNT NO.
GOTO 6280
6240 GOSUB 4180
LAST.ERROR=P1
GOTO 6200
6280 NEXT INDEX%
GOSUB 4000 REMARK END OF POSTING FILE
GOSUB 4020
LINE.COUNT%=LINE.COUNT%+5
GOSUB 825
PRINT:PRINT:PRINT"TOTAL NET CHANGE:" REMARK PRINT UPDATE RECAP
PRINT:PRINT"DEBIT ACCOUNTS",
PRINT USING MASKD$;D9
PRINT "CREDIT ACCOUNTS",
PRINT USING MASKD$;C9
PRINT:PRINT"PROOF",
PRINT USING MASKD$;D9-C9
PRINT
LINE.COUNT%=66 REMARK RESET COUNTERS AND FLAGS FOR ERROR FILE PRINTOUT
C=0:C1=0
E2%=3
F=1
X4$="G/L POSTING ERRORS"
IF ERROR.COUNT%=0 THEN 6440
FOR ERROR.INDEX%=1 TO ERROR.COUNT%
FILE.NO%=3:RECORD.NO%=ERROR.INDEX%:GOSUB 3600 REMARK RETRIEVE NEXT ERROR POSTING
IF E2%=3 THEN \
PRINT:\
LINE.COUNT%=LINE.COUNT%+1:\
E2%=0:\
GOSUB 825
PRINT USING MASKC$;P1;
PRINT " ";
PRINT USING MASKB$;P2;INT(P3);100*(P3-INT(P3));P4;P5;
IF E2%<2 THEN PRINT " ";
C=C+P5
C1=C1+1
E2%=E2%+1
NEXT ERROR.INDEX%
IF E2%>0 THEN GOSUB 4000 REMARK PRINT LAST LINE OF ERROR REPORT, IF ANY
6440 PRINT:PRINT C1;" ERROR POSTINGS = $"; REMARK PRINT ERROR TOTALS
PRINT USING MASKD$;C
DELETE 3,4 REMARK ERASE ERROR FILE AND POSTING FILE
CREATE "G/L0F020.DAT" RECL 36 AS 4 REMARK RECREATE THE POSTING FILE, NOW EMPTY
CLOSE 5
OPEN "G/L0F130.DAT" AS 5
EXTERNAL.POSTING.EXTENT%=0
FILE.NO%=5:GOSUB .315 REMARK RESAVE ZERO EXTENT FOR POSTING FILE
CHAIN "G/L000" REMARK END OF PROGRAM; RELOAD MENU
POSTING ERRORS"
IF ERROR.COUNT%=0 THEN 6440
FOR ERROR.INDEX%=1 TO ERROR.COUNT%
FILE.NO%=3:RECORD.NO%=ERROR.INDEX%:GOSUB