home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug044.ark / G_L030.BAS < prev    next >
BASIC Source File  |  1985-02-10  |  6KB  |  186 lines
  1.  
  2.     REMARK    #########################################################
  3.     REMARK    #    GENERAL LEDGER POSTING UPDATE   (GL030)        #
  4.     REMARK    #        VERS. OF 9.30 PM    3/2/79        #
  5.     REMARK    #########################################################
  6.  
  7. %INCLUDE CURSOR
  8.     DIM E$(16),C.(6,2),G3(5),G2$(5),D(7)
  9.     GOTO 6000
  10. %INCLUDE SUBS1
  11. %INCLUDE ACCTFILE
  12. %INCLUDE POSTFILE
  13. %INCLUDE GENINFO
  14. %INCLUDE G/L-INFO
  15. %INCLUDE BINSERCH
  16.  
  17.  
  18. 825    IF LINE.COUNT%<55 AND PAGE.COUNT%>0 THEN RETURN            REMARK    LINE PRINTER ROUTINE
  19.     PAGE.COUNT%=PAGE.COUNT%+1
  20.     PRINT CHR$(12);
  21.     PRINT TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
  22.     X0=G3(1):GOSUB 680.5
  23.     PRINT
  24.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
  25.     PRINT
  26.     XY$="SRCE  DATE    REF     AMOUNT"
  27.     IF F=0 THEN PRINT"  ACCT    ";XY$;":::";XY$;":::";XY$;":::";XY$ \
  28.     ELSE \
  29.         FOR I1%=1 TO 2:\
  30.         PRINT "ACCT NO  ";XY$;"        ";:\
  31.         NEXT I1%:\
  32.         PRINT "ACCT NO  ";XY$
  33.     PRINT
  34.     LINE.COUNT%=6
  35.     RETURN
  36.  
  37.  
  38. 4000    IF E2%=0 THEN RETURN                        REMARK    FOUR POSTINGS PRINTED PER LINE
  39.     PRINT 
  40.     LINE.COUNT%=LINE.COUNT%+1
  41.     E2%=0
  42.     GOSUB 825
  43.     RETURN 
  44.  
  45. 4020    IF F1=1 THEN RETURN                        REMARK    PRINT ACCOUNT TOTALS
  46.     FILE.NO%=2:RECORD.NO%=L
  47.     GOSUB 3500                            REMARK    RETRIEVE ACCOUNT RECORD
  48.     D0=D(1)
  49.     D(1)=D(1)+C
  50.     D(2)=D(2)+C
  51.     D(3)=D(3)+C
  52.     GOSUB 3550                            REMARK    RESAVE ACCOUNT WITH ACCUMULATED POSTINGS
  53.     IF E2%<>0 THEN \
  54.         PRINT:\ 
  55.         LINE.COUNT%=LINE.COUNT%+1:\
  56.         E2%=0
  57.     PRINT L1$;TAB(35);                        REMARK    PRINT ACCOUNT TOTALS
  58.     PRINT USING MASKA$;C.(1,1),C.(2,1),C.(3,1),C.(4,1);
  59.     PRINT TAB(94);"OPENING BAL";
  60.     PRINT USING MASKD$;D0
  61.     PRINT "  NET CHANGE";
  62.     PRINT USING MASKD$;C;
  63.     PRINT TAB(29);
  64.     PRINT USING MASKD$;C.(1,2);C.(2,2);C.(3,2);C.(4,2);
  65.     PRINT TAB(94);"CLOSING BAL";
  66.     PRINT USING MASKD$;D(1)
  67.     PRINT:PRINT
  68.     IF L5%=1 THEN D9=D9+C\
  69.     ELSE C9=C9+C
  70.     LINE.COUNT%=LINE.COUNT%+4
  71.     F1=1
  72.     RETURN 
  73.  
  74.  
  75. 4180    ERROR.COUNT% = ERROR.COUNT% + 1                    REMARK    SAVE ONE ERROR RECORD
  76.     FILE.NO%=3:RECORD.NO%=ERROR.COUNT%:GOSUB 3650
  77.     RETURN 
  78.  
  79.  
  80.                                     REMARK    START OF MAIN PROGRAM
  81. 6000    MASKA$="P/R ###      A/P ###      A/R ###      G/L ###"
  82.     MASKB$="## ##/## ######-#######.##"
  83.     MASKC$="#####.#"
  84.     MASKD$=" #########.##"
  85.     OPEN "G/I0F010.DAT" AS 1, "G/L0F110.DAT" RECL 157 AS 2,\
  86.     "G/L0F020.DAT" RECL 36 AS 4,"G/L0F130.DAT" AS 5
  87.     CREATE "ERRORFIL.DAT" RECL 36 AS 3
  88.     FILE.NO%=1:GOSUB 700                        REMARK    RETRIEVE GENERAL INFORMATION
  89.     FILE.NO%=5:GOSUB .314                        REMARK    RETRIEVE EXTENT INFORMATION
  90.     PRINT CLEAR.SCREEN$;"GENERAL LEDGER UPDATE"
  91.     PRINT "PROCESSING...DO NOT INTERRUPT"
  92.     X4$="G/L UPDATE":A1=100
  93.     LPRINTER
  94.     F1=1
  95.     LINE.COUNT%=66
  96.  
  97.     FOR INDEX%=1 TO EXTERNAL.POSTING.EXTENT%
  98.     FILE.NO%=4:RECORD.NO%=INDEX%:GOSUB 3600                REMARK    RETRIEVE NEXT POSTING
  99.     IF P1=0 THEN 6280                        REMARK    SKIP POSTINGS TO ACCOUNT NUMBER ZERO
  100.     IF P1=CURRENT.ACCOUNT THEN 6120
  101.     IF P1=LAST.ERROR THEN 6240
  102.     GOSUB 4020                            REMARK    THIS POSTING IS TO A NEW ACCOUNT
  103.     RECORD.COUNT%=ACCOUNT.FILE.EXTENT%
  104.     Y2=2
  105.     K1=P1
  106.     GOSUB 10.60                            REMARK    SEARCH ACCOUNT FILE FOR ACCOUNT NUMBER "P1"
  107.     IF H=-1 THEN 6240                        REMARK    ACCOUNT NOT FOUND. ADD THIS POSTING TO ERROR FILE
  108.     GOSUB 825
  109.     PRINT USING MASKC$;P1;
  110.     FOR I1%=1 TO 6                            REMARK    CLEAR TOTALS AND RESET FLAGS
  111.     C.(I1%,1)=0:C.(I1%,2)=0
  112.     NEXT I1%
  113.     C=0:E2%=0:F1=0
  114.     CURRENT.ACCOUNT=P1
  115. 6120    IF E2%=4 THEN GOSUB 4000
  116.     IF P5=0 THEN 6200                        REMARK    IF POSTING AMOUNT IS ZERO, DO NOT PRINT POSTING
  117.     IF E2%=0 THEN PRINT TAB(11);
  118.     PRINT "  ";
  119.     PRINT USING MASKB$;P2;INT(P3);100*(P3-INT(P3));P4;P5;
  120.     IF E2%<3 THEN PRINT ":::";
  121.     C=C+P5
  122.     C.(P2+1,1)=C.(P2+1,1)+1
  123.     C.(P2+1,2)=C.(P2+1,2)+P5
  124.     E2%=E2%+1
  125. 6200    P1=0
  126.     FILE.NO%=4:RECORD.NO%=INDEX%
  127.     GOSUB 3650                            REMARK    RESAVE POSTING WITH ZERO ACCOUNT NO.
  128.     GOTO 6280
  129.  
  130. 6240    GOSUB 4180
  131.     LAST.ERROR=P1
  132.     GOTO 6200
  133.  
  134.  
  135. 6280    NEXT INDEX%
  136.     GOSUB 4000                            REMARK    END OF POSTING FILE
  137.     GOSUB 4020
  138.     LINE.COUNT%=LINE.COUNT%+5
  139.     GOSUB 825
  140.     PRINT:PRINT:PRINT"TOTAL NET CHANGE:"                REMARK    PRINT UPDATE RECAP
  141.     PRINT:PRINT"DEBIT ACCOUNTS",
  142.     PRINT USING MASKD$;D9
  143.     PRINT "CREDIT ACCOUNTS",
  144.     PRINT USING MASKD$;C9
  145.     PRINT:PRINT"PROOF",
  146.     PRINT USING MASKD$;D9-C9
  147.     PRINT 
  148.     LINE.COUNT%=66                            REMARK    RESET COUNTERS AND FLAGS FOR ERROR FILE PRINTOUT
  149.     C=0:C1=0
  150.     E2%=3
  151.     F=1
  152.     X4$="G/L POSTING ERRORS"
  153.  
  154.     IF ERROR.COUNT%=0 THEN 6440
  155.     FOR ERROR.INDEX%=1 TO ERROR.COUNT%
  156.     FILE.NO%=3:RECORD.NO%=ERROR.INDEX%:GOSUB 3600            REMARK    RETRIEVE NEXT ERROR POSTING
  157.     IF E2%=3 THEN \
  158.         PRINT:\
  159.         LINE.COUNT%=LINE.COUNT%+1:\
  160.         E2%=0:\
  161.         GOSUB 825
  162.     PRINT USING MASKC$;P1;
  163.     PRINT "    ";
  164.     PRINT USING MASKB$;P2;INT(P3);100*(P3-INT(P3));P4;P5;
  165.     IF E2%<2 THEN PRINT "        ";
  166.     C=C+P5
  167.     C1=C1+1
  168.     E2%=E2%+1
  169.     NEXT ERROR.INDEX%
  170.  
  171.     IF E2%>0 THEN GOSUB 4000                    REMARK    PRINT LAST LINE OF ERROR REPORT, IF ANY
  172. 6440    PRINT:PRINT C1;" ERROR POSTINGS = $";                REMARK    PRINT ERROR TOTALS
  173.     PRINT USING MASKD$;C
  174.     DELETE 3,4                            REMARK    ERASE ERROR FILE AND POSTING FILE
  175.     CREATE "G/L0F020.DAT" RECL 36 AS 4                REMARK    RECREATE THE POSTING FILE, NOW EMPTY
  176.     CLOSE 5
  177.     OPEN "G/L0F130.DAT" AS 5
  178.     EXTERNAL.POSTING.EXTENT%=0
  179.     FILE.NO%=5:GOSUB .315                        REMARK    RESAVE ZERO EXTENT FOR POSTING FILE
  180.  
  181.     CHAIN "G/L000"                            REMARK    END OF PROGRAM;  RELOAD MENU
  182. POSTING ERRORS"
  183.  
  184.     IF ERROR.COUNT%=0 THEN 6440
  185.     FOR ERROR.INDEX%=1 TO ERROR.COUNT%
  186.     FILE.NO%=3:RECORD.NO%=ERROR.INDEX%:GOSUB