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_L040.BAS < prev    next >
BASIC Source File  |  1985-02-10  |  9KB  |  281 lines
  1.  
  2.     REMARK    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3.     REMARK    +    GENERAL LEDGER REPORTS PROGRAM      (GL040)    +
  4.     REMARK    +        VERS. OF 5.00 PM    2/23/79        +
  5.     REMARK    +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6.  
  7.     DIM G2$(5),G3(5),D(7),G(3,10),S.(7),H.(2,3),H1(3)
  8.     DATA "TRIAL","SPECIAL","MONTHLY","QUARTERLY"," REPORT"
  9.     DATA " INCOME STATEMENT"," BALANCE SHEET"
  10.     DEF FNZ(Z9)=Z9+(1-ABS(SGN(Z9))) * 1E20
  11. %INCLUDE CURSOR
  12.     GOTO 6000
  13. %INCLUDE SUBS1
  14. %INCLUDE BINSERCH
  15. %INCLUDE GENINFO
  16. %INCLUDE ACCTFILE
  17. %INCLUDE G/L-INFO
  18.  
  19.  
  20.  
  21. 825    IF LINE.COUNT%<55 THEN RETURN                    REMARK    LINE PRINTER ROUTINE
  22.     PAGE.COUNT%=PAGE.COUNT%+1
  23.     PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
  24.     X0=G3(1):GOSUB 680.5
  25.     PRINT
  26.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
  27.     PRINT
  28.     IF R1<>0 THEN PRINT TAB(45);"PREVIOUS QUARTER ";R1
  29.     PRINT:PRINT" ACCOUNT        NAME";
  30.     ON R GOTO 833,834,835,836
  31. 833    IF S=2 THEN 834                            REMARK    TRIAL REPORT HEADINGS
  32.     PRINT TAB(59);"THIS MONTH     PCT";
  33.     IF G7>3 THEN PRINT TAB(105);"QUARTER     PCT"
  34.     GOTO 840
  35. 834    PRINT TAB(58);"THIS MONTH"                    REMARK    SPECIAL REPORT HEADINGS
  36.     GOTO 840
  37. 835    IF S=2 THEN 834                            REMARK    MONTHLY REPORT HEADINGS
  38.     PRINT TAB(59);"THIS MONTH     PCT";
  39.     IF G7<2 THEN 840
  40.     GOTO 837
  41. 836    IF S=2 THEN PRINT TAB(75);"QUARTER";:GOTO 840            REMARK    QUARTERLY REPORT HEADINGS
  42.     PRINT TAB(61);"QUARTER     PCT";
  43.     IF R1<=0 AND G7<4 THEN 840
  44. 837    PRINT TAB(105);"YTD BAL     PCT"
  45. 840    PRINT:PRINT:PRINT
  46.     LINE.COUNT%=6
  47.     D9$="$"
  48.     RETURN
  49.  
  50.  
  51. 4000    PRINT TAB(8);X0$;TAB(56);                    REMARK    PRINT RECAP LINE
  52.     IF R=4 THEN 4005
  53.     PRINT USING MASKB$;X0;                        REMARK    INCLUDE MONTHLY TOTAL
  54.     IF S<>1 THEN PRINT:RETURN
  55.     PRINT TAB(99);
  56.     IF R=3 THEN 4015
  57. 4005    PRINT USING MASKB$;X2;                        REMARK    INCLUDE QUARTERLY TOTAL
  58.     IF R<>4 OR S<>1 THEN PRINT:RETURN
  59. 4015    PRINT TAB(99);                            REMARK    INCLUDE YEARLY TOTAL
  60.     PRINT USING MASKB$;X1
  61.     RETURN 
  62.  
  63.  
  64.                                     REMARK    ACCUMULATE AND PRINT SUBROUTINE
  65. 4020    IF L3%=0 THEN\                            REMARK    ACCUMULATE REGULAR ACCOUNT TO ALL TOTAL LEVELS
  66.         FOR I%=1 TO 10:\
  67.         G(F1,I%)=G(F1,I%)+S2*D(F1):\
  68.         NEXT I%\
  69.     ELSE D9$="$"                            REMARK    PRECEDE TOTAL AMOUNTS WITH A DOLLAR SIGN
  70.     PRINT TAB(55+(F-1)*(14+8*(2-S)));                REMARK    PRINT AMOUNT (WITH % OF SALES ON INCOME STATEMENT)
  71.     PRINT D9$;
  72.     PRINT USING MASKB$;G(F1,L6%);
  73.     IF S<>2 THEN PRINT USING MASKA$;ABS(G(F1,L6%)/H1(F1))*100;
  74.     FOR I%=1 TO L6%                            REMARK    CLEAR ALL TOTALS UP TO THE LEVEL JUST PRINTED
  75.     G(F1,I%)=0
  76.     NEXT I%
  77.     IF L5%=1 THEN H.(1,F1)=H.(1,F1)+D(F1)\                REMARK    ACCUMULATE DEBIT TOTAL
  78.     ELSE H.(2,F1)=H.(2,F1)+D(F1)                    REMARK    ACCUMULATE CREDIT TOTAL
  79.     RETURN 
  80.  
  81.  
  82. 4140    F=INT((L6%+3)/3)                        REMARK    DETERMINE PRINT COLUMN BY TOTAL LEVEL
  83.     IF F>3 THEN F=3
  84.     RETURN 
  85.  
  86.  
  87. 5000    IF L2%<>0 THEN RETURN                        REMARK    MOVE TOTALS (REGULAR ACCOUNTS ONLY)
  88.     ON S GOTO 5060,5040,5020
  89. 5020    D(7)=D(2)                            REMARK    YEARLY TOTAL
  90.     IF L4%=1 THEN D(2)=0                        REMARK    ZERO THIS YEAR TOTAL FIELD ON I & E ACCOUNTS
  91. 5040    D(6)=D(5)                            REMARK    QUARTERLY TOTAL
  92.     D(5)=D(4)
  93.     D(4)=D(3)
  94.     IF L4%=1 THEN D(3)=0:D(1)=0:GOSUB 3550:RETURN            REMARK    ZERO THIS QUARTER FIELD ON I & E ACCOUNTS 
  95. 5060    IF L4%=1 THEN D(1)=0                        REMARK    ZERO THIS MONTH TOTAL FIELD ON I & E ACCOUNTS
  96.     GOSUB 3550                            REMARK    WRITE RECORD BACK TO FILE
  97.     RETURN 
  98.  
  99.  
  100.  
  101. 6000    MASKA$=" ###.##%"                        REMARK    - - - START OF MAIN PROGRAM - - -
  102.     MASKB$=" #########.##"
  103.     MASKC$="#####.#"
  104.     OPEN "G/I0F010.DAT" AS 1,"G/L0F110.DAT" RECL 157 AS 2,\
  105.     "G/L0F130.DAT" AS 5, "CRT" RECL 1100 AS 19
  106.     FILE.NO%=1:GOSUB 700                        REMARK    RETRIEVE GENERAL INFORMATION
  107.     G6=INT(G3(1)/10000)
  108.     G7=12*((G6-G5+12)/12-INT((G6-G5+12)/12))            REMARK    COMPUTE EFFECTIVE MONTH FROM END OF FISCAL YEAR
  109.     FILE.NO%=5:GOSUB .314                        REMARK    RETRIEVE EXTENT INFORMATION
  110.     RECORD.COUNT%=ACCOUNT.FILE.EXTENT%
  111.     Y2=2
  112. 6020    CONSOLE
  113.     X0=3:GOSUB 260                            REMARK    LOAD CRT MASK
  114.     IF DIRECT.POSTING.EXTENT%>0 OR EXTERNAL.POSTING.EXTENT%>0 THEN\    REMARK    DETERMINE IF ANY POSTINGS HAVE NOT BEEN UPDATED
  115.         X1=832:GOSUB 210:\
  116.         PRINT DIRECT.POSTING.EXTENT%;"DIRECT AND";:\
  117.         PRINT EXTERNAL.POSTING.EXTENT%;"INDIRECT POSTINGS NOT UPDATED";
  118.     R=0:R1=0:S=0:PAGE.COUNT%=0                    REMARK    INITIALIZE REPORT PARAMETERS
  119.     LINE.COUNT%=66
  120.     X1=327:X2=1:X3=0:X4=5:GOSUB 345                    REMARK    ENTER REPORT TYPE
  121.     R=X0
  122.     IF R=0 THEN 6800
  123.     IF R=2  THEN 6100
  124.     IF R=5  THEN \
  125.         X1=375:X2=1:X3=1:X4=3:GOSUB 345:\            REMARK    ENTER WHICH TOTALS TO MOVE
  126.         S=X0:\
  127.         GOTO 6100\
  128.     ELSE\
  129.         X1=345:X2=1:X3=1:X4=2:GOSUB 345:\            REMARK    ENTER REPORT FORMAT
  130.         S=X0
  131.     IF R=4 THEN\
  132.         X1=362:X2=1:X3=0:X4=3:GOSUB 345:\            REMARK    ENTER WHICH QUARTER TO REPORT
  133.         R1=X0
  134. 6100    X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665            REMARK    VERIFY ENTRY OF REPORT OPTIONS
  135.     IF X0=0 THEN 6020
  136.     IF R<>5 THEN 6120
  137.                                     REMARK    MOVE TOTALS ROUTINE
  138.     X2=1:X3=0:X4=1:X2$="HAVE YOU RUN ALL YOUR REPORTS":GOSUB 665
  139.     IF X0=0 THEN 6020
  140.     X1=192:GOSUB 210
  141.     PRINT "WORKING...DO NOT INTERRUPT"
  142.     FILE.NO%=2
  143.     FOR RECORD.NO%=1 TO ACCOUNT.FILE.EXTENT%
  144.     GOSUB 3500                            REMARK    RETRIEVE NEXT ACCOUNT
  145.     GOSUB 5000                            REMARK    MOVE TOTALS
  146.     NEXT RECORD.NO%
  147.     GOTO 6020
  148.  
  149.  
  150.                                     REMARK    - - - START MAIN PRINT SEQUENCE - - -
  151. 6120    RESTORE                                REMARK    CONSTRUCT REPORT TITLE
  152.     FOR I=1.0 TO R
  153.     READ X4$
  154.     NEXT I
  155.     RESTORE
  156.     FOR I=1.0 TO S+5
  157.     READ XX$
  158.     NEXT I
  159.     X4$=X4$+XX$
  160.     X1=192:GOSUB 210
  161.     PRINT "PRINTING..."
  162.     LPRINTER
  163.     FOR I%=1 TO 3                            REMARK    ZERO TOTALS
  164.     FOR J%=1 TO 10
  165.     G(I%,J%)=0
  166.     IF J%<3 THEN H.(J%,I%)=0
  167.     NEXT J%,I%
  168.     FILE.NO%=2:RECORD.NO%=ACCOUNT.FILE.EXTENT%:GOSUB 3500        REMARK    RETRIEVE SALES ACCOUNTS TOTAL
  169.     H1(1)=FNZ(D(1))
  170.     H1(3)=FNZ(D(3+R1))
  171.     IF INT((G7+2)/3)>R1 THEN H1(2)=FNZ(D(2))\
  172.     ELSE H1(2)=FNZ(D(7))
  173.     IF S=1 THEN\
  174.         K1=30000:\                        REMARK    POSITION FILE TO FIRST BALANCE SHEET ACCOUNT
  175.         GOSUB 10.60:\
  176.         RECORD.NO%=L-1\
  177.     ELSE RECORD.NO%=0                        REMARK    POSITION FILE TO FIRST ACCOUNT
  178. 6220    RECORD.NO%=RECORD.NO%+1                        REMARK    LOCATE NEXT ACCOUNT RECORD
  179.     IF RECORD.NO%=ACCOUNT.FILE.EXTENT% THEN 6660            REMARK    CHECK FOR END OF REPORT
  180.     GOSUB 3500                            REMARK    RETRIEVE NEXT ACCOUNT
  181.     IF R<>2 AND L4%<>S THEN 6660
  182.     L6%=L6%+1
  183.     IF L5%=S1 THEN S2=1\                        REMARK    COMPUTE NORMAL SIGN OF ACCOUNT BALANCE
  184.     ELSE S2=-1
  185.     IF R1=0 THEN 6320
  186.     D(3)=D(3+R1)                            REMARK    USE REQUESTED QUARTERLY TOTALS
  187.     D(1)=0
  188.     IF INT((G7+2)/3)<=R1 THEN D(2)=D(7)
  189. 6320    IF R<>2 THEN 6340                        REMARK    INCLUDE ONLY REGULAR ACCOUNTS ON SPECIAL REPORT
  190.     IF L2%<>0 OR L9%=0 THEN 6220
  191. 6340    A1=110:GOSUB 825
  192.     IF L3%=0 THEN PRINT USING MASKC$;L1;                REMARK    PRINT REGULAR ACCOUNT'S NUMBER
  193.     IF L3%=1 THEN\                            REMARK    PRINT TITLE IN "EXPANDED PRINT"
  194.         S1=L5%:\
  195.         PRINT TAB(17-L6);:\
  196.         FOR I%=1 TO LEN(L1$):\
  197.         PRINT MID$(L1$,I%,1);" ";:\
  198.         NEXT I%:\
  199.         GOTO 6420
  200.     PRINT TAB(17-L6%);L1$;TAB(48);                    REMARK    PRINT ACCOUNT NAME
  201.     IF L3%=3 THEN 6420
  202.     ON R GOSUB 6460,6560,6580,6620
  203.     D9$=" "
  204. 6420    IF L7%=9 THEN LINE.COUNT%=60\                    REMARK    ADVANCE TO NEXT PAGE
  205.     ELSE\
  206.         FOR I%=1 TO L7%+1:\                    REMARK    PRINT EXTRA BLANK LINES
  207.         PRINT:\
  208.         NEXT I%:\
  209.         LINE.COUNT%=LINE.COUNT%+L7%+1
  210.     GOTO 6220
  211.  
  212.  
  213. 6460    IF S=2 THEN\                            REMARK    MONTHLY TRIAL BALANCE
  214.         GOSUB 4140:\
  215.         F1=1:GOSUB 4020:\
  216.         GOTO 6540
  217.     F=1:F1=1:GOSUB 4020                        REMARK    TRIAL INCOME STATEMENT
  218.     IF G7>3 THEN F=3:F1=3:GOSUB 4020
  219. 6540    IF L8%=0 THEN RETURN
  220.     FOR I%=1 TO 7                            REMARK    ACCUMULATE NEW SALES TOTALS
  221.     S.(I%)=S.(I%)+D(I%)*S2
  222.     NEXT I%
  223.     RETURN 
  224.  
  225.  
  226. 6560    PRINT TAB(55);                            REMARK    SPECIAL REPORT: PRINT MONTHLY TOTALS
  227.     PRINT USING MASKB$;D(1);
  228.     RETURN 
  229.  
  230.  
  231. 6580    IF S=2 THEN \                            REMARK    MONTHLY BALANCE SHEET
  232.         GOSUB 4140:\
  233.         F1=1:GOSUB 4020:\
  234.         RETURN
  235.     F=1:F1=1:GOSUB 4020                        REMARK    MONTHLY INCOME STATEMENT
  236.     IF G7>1 THEN F=3:F1=2:GOSUB 4020
  237.     RETURN 
  238.  
  239.  
  240. 6620    IF S=2 THEN \
  241.         GOSUB 4140:\                        REMARK    QUARTERLY BALANCE SHEET
  242.         F1=3:GOSUB 4020:\
  243.         RETURN
  244.     F=1:F1=3:GOSUB 4020                        REMARK    QUARTERLY INCOME STATEMENT
  245.     IF R1>0 OR G7>3 THEN F=3:F1=2:GOSUB 4020
  246.     RETURN 
  247.  
  248.  
  249.                                     REMARK    - - - END OF REPORT - - -
  250. 6660    IF R=2 THEN 6020                        REMARK    NO RECAP ON SPECIAL REPORT
  251.     LINE.COUNT%=LINE.COUNT%+7-2*S
  252.     A1=110:GOSUB 825
  253.     IF S=2 THEN C1$="PROOF":GOTO 6720\
  254.     ELSE C1$="RETAINED EARNINGS"
  255.     IF R<>1 THEN 6720
  256.     FILE.NO%=2:RECORD.NO%=ACCOUNT.FILE.EXTENT%:GOSUB 3500
  257.     FOR I%=1 TO 7
  258.     D(I%)=S.(I%)
  259.     NEXT I%
  260.     GOSUB 3550                            REMARK    SAVE UPDATED SPECIAL SALES TOTAL RECORD
  261.     IF INT((G7+2)/3)>R1 THEN X1=S.(2)\
  262.     ELSE X1=S.(7)
  263.     X0$="SALES ACCOUNTS TOTAL":X0=S.(1):X2=S.(3+R1):GOSUB 4000
  264. 6720    PRINT                                REMARK    PRINT TOTALS
  265.     X0$="DEBIT TOTAL":X0=H.(1,1):X1=H.(1,2):X2=H.(1,3):GOSUB 4000
  266.     X0$="CREDIT TOTAL":X0=H.(2,1):X1=H.(2,2):X2=H.(2,3):GOSUB 4000
  267.     PRINT
  268.     X0$=C1$:X0=H.(2,1)-H.(1,1):X1=H.(2,2)-H.(1,2):X2=H.(2,3)-H.(1,3)
  269.     GOSUB 4000
  270.     GOTO 6020
  271.  
  272.  
  273. 6800    CONSOLE
  274.     PRINT CLEAR.SCREEN$;"G/L REPORTS LOADING MENU"            REMARK    - - - END  PROGRAM - - -
  275.     CHAIN "G/L000"
  276. :GOSUB 4020                        REMARK    QUARTERLY INCOME STATEMENT
  277.     IF R1>0 OR G7>3 THEN F=3:F1=2:GOSUB 4020
  278.     RETURN 
  279.  
  280.  
  281.                                     REMARK    - -