home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug043.ark / A_P070.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  10KB  |  352 lines
  1.  
  2.     REMARK    ####################################################
  3.     REMARK    #         ACCOUNTS PAYABLE LEDGER PROGRAM          #
  4.     REMARK    #    (A/P070)     VERS OF 10.00 AM    6/20/79      #
  5.     REMARK    ####################################################
  6.  
  7. %INCLUDE CURSOR
  8.     A4$="----"
  9.     FOR I%=1 TO 4:A4$=A4$+A4$:NEXT I%
  10.     DEF FNA(Z)=100*((Z/100)-INT(Z/100))                REMARK    ZERO OUT TENS AND ONES DIGITS
  11.     MASKA$=" ######"
  12.     MASKB$="#####.#"
  13.     MASKC$="  #######.##"
  14.     MASKD$=" #######.##"
  15.     MASKE$="###"
  16.     DIM W(4),W1.(4),A1(5),W2.(4),A2(6),M$(5),Y(2),C(27),D(27),G3(5),\
  17.     G2$(5),P(5)
  18.     GOTO 6000
  19.     DATA 0,3,3,6,8,1,13,16,19,21,24,26
  20. %INCLUDE SUBS1
  21. %INCLUDE BINSEARC
  22. %INCLUDE GENINFO
  23. %INCLUDE READVEND
  24. %INCLUDE READINV
  25. %INCLUDE WRITEINV
  26. %INCLUDE A/P-INFO
  27.  
  28.  
  29. 825    IF LINE.COUNT%<55 THEN RETURN                    REMARK    LINE PRINTER ROUTINE
  30.     PAGE.COUNT%=PAGE.COUNT%+1
  31.     PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
  32.     X0=G3(1):GOSUB 680.5
  33.     PRINT 
  34.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
  35.     PRINT
  36.     IF TOTAL.FLAG%<>2 THEN \
  37.         PRINT "  VENDOR  INV #  DESCR.   BUY INV DATE PAY DATE";: \
  38.         PRINT"  CK REG  (G/L #)";
  39.     PRINT TAB(69);"AMOUNT   DISCOUNT";TAB(92);"OTHER    NET DUE ";
  40.     GOSUB 5660                            REMARK    PRINT AGING HEADINGS
  41.     PRINT
  42.     LINE.COUNT%=6
  43.     RETURN
  44.  
  45.  
  46. 5020    PRINT A6$;TAB(8);L5$;TAB(21);                    REMARK    PRINT ONE TOTAL LINE
  47.     PRINT USING MASKA$;I3
  48.     RETURN 
  49.  
  50.  
  51. 5040    YEAR = FNA(I)                            REMARK    COMPUTE # OF DAYS BETWEEN DATE "I" AND 00/00/00
  52.     DAY=100*((I-YEAR)/10000-INT((I-YEAR)/10000))
  53.     MONTH=(I-(100*DAY+YEAR))/10000
  54.     IF MONTH=0 OR MONTH>12 THEN A4=0:RETURN
  55.     RESTORE
  56.     FOR I%=1 TO MONTH
  57.     READ A4
  58.     NEXT I%
  59.     A4=A4+YEAR*365+INT(YEAR/4)+1+(MONTH-1)*28+DAY
  60.     IF INT(YEAR/4)<>YEAR/4 THEN RETURN
  61.     IF MONTH<=2 THEN A4=A4-1
  62.     RETURN 
  63.  
  64.  
  65. 5140    X4$=L4$:A1=115:GOSUB 825                    REMARK    PRINT ONE DETAIL LINE
  66.     IF W9>1 AND LINE.COUNT%<7 THEN \
  67.         PRINT M$(2);" - CONTINUED": \
  68.         LINE.COUNT%=LINE.COUNT%+1
  69.     PRINT TAB(3);W1$;TAB(9);
  70.     PRINT USING MASKA$;W0;
  71.     PRINT TAB(17);W2$;TAB(27);W3$;TAB(31);
  72.     X0=D(23):GOSUB 680.5
  73.     PRINT " ";
  74.     X0=D(24):GOSUB 680.5
  75.     D1=C(2)+C(3)+C(4)+C(5)+C(6)+C(7)+C(8)+C(9)+C(10)+C(11)
  76.     PRINT USING MASKA$;D(25);
  77.     IF D1=0 THEN PRINT "  ";:PRINT USING MASKB$;D(1);
  78.     PRINT TAB(64);
  79.     PRINT USING MASKD$;C(23);C(24);C(25);C0;
  80.     LINE.COUNT%=LINE.COUNT%+1
  81.     IF C3<>0 THEN PRINT TAB(C3);"X";                REMARK    AGING
  82.     PRINT TAB(126);
  83.     IF W1%=1 THEN X0$="INV"
  84.     IF W1%=4 THEN X0$="CR"
  85.     IF W1%=5 THEN X0$="DB"
  86.     PRINT X0$
  87.     RETURN 
  88.  
  89.  
  90. 5400    X4$=L4$:A1=115:GOSUB 825                    REMARK    LOCATE, RETRIEVE AND PRINT VENDOR DATA
  91.     Y2=2
  92.     RECORD.COUNT = AP.VENDFILE.EXTENT
  93.     XYZ$=W1$+"      "
  94.     K$=LEFT$(XYZ$,6)
  95.     GOSUB 1060
  96.     IF H=-1 OR VAR1=0 THEN \
  97.         M$(2)="NO VENDOR INFORMATION": \
  98.         Y(1)=0:Y(2)=0 \
  99.     ELSE \
  100.         Y9=2:X0=L:GOSUB 3200
  101.     PRINT M$(2);TAB(40);"(YEAR TO DATE";
  102.     PRINT USING MASKC$;Y(2);
  103.     PRINT ")  (LAST YEAR";
  104.     PRINT USING MASKC$;Y(1);
  105.     PRINT ")"
  106.     LINE.COUNT%=LINE.COUNT%+1
  107.     RETURN 
  108.  
  109.  
  110. 5460    IF W9=0 THEN RETURN                        REMARK    PRINT AND ZERO OVERALL REPORT TOTALS
  111.     IF W9>1 OR S=1 THEN \
  112.         PRINT "   TOTAL";TAB(25);: \
  113.         PRINT USING MASKE$;W9;: \
  114.         PRINT " INVOICES";: \
  115.         PRINT TAB(64);: \
  116.         PRINT USING MASKD$;W(1);W(2);W(3);W(4): \
  117.         PRINT: \
  118.         LINE.COUNT%=LINE.COUNT%+2
  119.     W9=0:W(1)=0:W(2)=0:W(3)=0:W(4)=0
  120.     RETURN 
  121.  
  122.  
  123. 5540    IF D1=0 THEN RETURN                        REMARK    PRINT MULTIPLE GENERAL LEDGER NUMBERS
  124.     PRINT TAB(7);"G/L";
  125.     FOR I1%=1 TO 11
  126.     IF C(I1%)<>0 THEN PRINT "    ";:PRINT USING MASKB$;D(I1%);
  127.     NEXT I1%
  128.     PRINT 
  129.     PRINT TAB(7);"AMT";
  130.     FOR I1%=1 TO 11
  131.     IF C(I1%)<>0 THEN PRINT USING MASKD$;C(I1%);
  132.     NEXT I1%
  133.     PRINT 
  134.     LINE.COUNT%=LINE.COUNT%+2
  135.     RETURN 
  136.  
  137.  
  138.  
  139. 5620    IF A9=0 THEN RETURN                        REMARK    PRINT AND ZERO ACCOUNT TOTALS
  140.     PRINT "--ACCOUNT TOTALS---";LEFT$(A4$,44);
  141.     PRINT USING MASKD$;W2.(1);W2.(2);W2.(3);W2.(4);
  142.     PRINT LEFT$(A4$,23)
  143.     PRINT
  144.     A9=0:W2.(1)=0:W2.(2)=0:W2.(3)=0:W2.(4)=0
  145.     LINE.COUNT%=LINE.COUNT%+2
  146.     RETURN 
  147.  
  148.  
  149. 5660    PRINT USING MASKE$;P(1);P(2);P(3);P(4);                REMARK    PRINT COLUMN HEADINGS FOR AGING
  150.     PRINT"  >"
  151.     RETURN 
  152.  
  153.  
  154.  
  155. 6000    OPEN "G/I0F010.DAT" AS 1, "A/P0F110.DAT" RECL 162 AS 2, \    REMARK    MAIN PROGRAM STARTS HERE
  156.     "A/P0F120.DAT" RECL 580 AS 3, "A/P0F130.DAT" AS 4, \
  157.     "CRT" RECL 1100 AS 19
  158.     Y9=1:GOSUB 700                            REMARK    RETREIVE G/I FILE DATA
  159.     I=G3(1):GOSUB 5040                        REMARK    COMPUTE # OF DAYS BETWEEN TODAY & 00/00/00
  160.     D3=A4
  161.     X0=4:GOSUB 3310                            REMARK    RETREIVE A/P GENERAL INFORMATION
  162. 6040    FOR I%=1 TO 4                            REMARK    CLEAR TOTAL AND INVOICE FILE VARIABLES
  163.     A1(I%)=0:A2(I%)=0:W(I%)=0:W1.(I%)=0:W2.(I%)=0
  164.     NEXT I%
  165.     DELETE.COUNT%=0:INVOICE.RECORD.NO=0:TOTAL.FLAG%=0
  166.     A1(5)=0:A2(5)=0:A2(6)=0
  167.     L5$=" INVOICES"
  168.     L4$="A/P LEDGER OPEN ITEM LISTING"
  169.     CONSOLE
  170.     X0=7:GOSUB 260
  171.     W8=0:W9=0:R1=0:R=0:S=0:PAGE.COUNT%=0:OPEN.COUNT%=0:CLOSED.COUNT%=0
  172.     LINE.COUNT%=62
  173.     X1=270:X2=1:X3=0:X4=2:GOSUB 345                    REMARK    ENTER REPORT FORMAT
  174.     ON X0+1 GOTO 6060,6120,6080
  175.  
  176.  
  177. 6060    CONSOLE                                REMARK    END PROGRAM ROUTINE
  178.     PRINT CLEAR.SCREEN$;"A/P LEDGER LOADING MENU"
  179.     CHAIN "A/P000"
  180.  
  181.  
  182. 6080    R=1                                REMARK    CLOSED ITEM LISTING CHOSEN
  183.     L4$="A/P LEDGER CLOSED ITEM LISTING"
  184.     X1=355:X2=1:X3=0:X4=1:GOSUB 345                    REMARK    ENTER WHETHER TO DELETE    CLOSED ITEMS
  185.     R1=X0
  186. 6120    X1=398:X2=1:X3=1:X4=3:GOSUB 345                    REMARK    ENTER REPORT TYPE
  187.     ON X0 GOTO 6180,6160,6140
  188.  
  189. 6140    S=3                                REMARK    ONE-VENDOR-ONLY TYPE CHOSEN
  190.     X1=410:X2=6:X3=0:X4=0:GOSUB 345                    REMARK    ENTER VENDOR NUMBER
  191.     XYZ$=X0$+"      "
  192.     W7$=LEFT$(XYZ$,6)
  193.     GOTO 6180
  194. 6160    S=1
  195. 6180    X1=534:GOSUB 673                        REMARK    ENTER START DATE
  196.     I=X0:GOSUB 5040                            REMARK    FIND # OF DAYS BETWEEN START DATE AND 00/00/00
  197.     B0=X0
  198.     B=A4
  199.     X1=598:GOSUB 673                        REMARK    ENTER END DATE
  200.     I=X0:GOSUB 5040                            REMARK    FIND # OF DAYS BETWEEN END DATE AND 00/00/00
  201.     E0=X0
  202.     E=A4
  203.     X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665
  204.     IF X0=0 THEN 6040
  205.     LPRINTER
  206.     IF S=3 THEN \                            REMARK    IF TYPE IS ONE-VENDOR-ONLY FIND THAT VENDOR
  207.         Y2=3: \
  208.         RECORD.COUNT=AP.INVOICE.EXTENT: \
  209.         K$=W7$+"000000":\
  210.         GOSUB 1060: \
  211.         INVOICE.RECORD.NO=L-1 \
  212.     ELSE\
  213.         INVOICE.RECORD.NO=0
  214.  
  215.     IF INVOICE.RECORD.NO<0 OR INVOICE.RECORD.NO>AP.INVOICE.EXTENT-1 THEN\
  216.         X2$="VENDOR NUMBER OUT OF RANGE": \
  217.         GOSUB 615: \
  218.         GOTO 6040
  219. 6260    INVOICE.RECORD.NO = INVOICE.RECORD.NO + 1
  220.     IF INVOICE.RECORD.NO > AP.INVOICE.EXTENT THEN 6680
  221.     FILE.NO=3:X0%=INVOICE.RECORD.NO:GOSUB 3000            REMARK    GET INVOICE RECORD
  222.     IF S=3 AND W1$<>W7$ THEN 6680                    REMARK    IF TYPE IS ONE-VENDOR, BRANCH WHEN PAST THAT VENDOR
  223.     IF W2%=2 THEN DELETE.COUNT% = DELETE.COUNT% + 1: GOTO 6300
  224.     IF D(25)<>0 THEN CLOSED.COUNT%=CLOSED.COUNT%+1:GOTO 6300
  225.     IF W1%<>4 THEN OPEN.COUNT%=OPEN.COUNT%+1:GOTO 6300
  226.     IF C(23)+C(24)=0 THEN CLOSED.COUNT%=CLOSED.COUNT%+1\
  227.     ELSE OPEN.COUNT%=OPEN.COUNT%+1
  228. 6300    I=D(24):GOSUB 5040
  229.     IF A4<B OR A4>E THEN 6260                    REMARK    CHECK INVOICE DATE AGAINST START & END DATES
  230.     IF W2%>9 THEN W2%=W2%-10                    REMARK    STRIP OFF TENS DIGIT, IF ANY, FROM OPERATION CODE
  231.     IF R=1 THEN 6400                        REMARK    IF CLOSED ITEM LISTING, BRANCH
  232.  
  233.                                     REMARK    OPEN ITEM LISTING ROUTINES
  234.     IF W2%=2 THEN \                             REMARK    SKIP DELETE-FLAGGED INVOICES ON OPEN ITEM LISTING
  235.         GOTO 6260
  236.     IF W6$=W1$ THEN 6480
  237.     IF PAGE.COUNT%=0 THEN 6380
  238.     GOSUB 5460
  239.     IF LEFT$(W1$,2)<>LEFT$(W6$,2) THEN GOSUB 5620
  240. 6380    W6$=W1$                                REMARK    SET CURRENT VENDOR
  241.     S3=1
  242.     GOTO 6480
  243.  
  244.                                     REMARK    CLOSED ITEM LISTING ROUTINES
  245. 6400    IF W2%=2 THEN \                            REMARK    ZERO INVOICE AMOUNTS ON DELETE-FLAGGED INVOICES
  246.         C(23)=0:C(24)=0:C(25)=0:C(26)=0:GOTO 6540
  247.     IF D(25)=0 THEN 6260                        REMARK    SKIP OPEN ITEMS
  248.     IF W1%<>4 THEN 6540                        REMARK    IF NOT A CREDIT MEMO, BRANCH
  249.     C1=C(25)
  250.     C2=D(25)
  251.     IF C(23)+C(24)<=0 THEN W2%=2:GOTO 6460
  252.     IF C(25)=0 THEN 6260
  253.     D(25)=0:C(25)=0:W2%=0
  254.     GOSUB 3050                            REMARK    RESAVE CREDIT MEMO 
  255. 6460    C(23)=-C1
  256.     D(25)=C2
  257.     GOTO 6500
  258.                                     REMARK    RESUME OPEN ITEM LISTING ROUTINES
  259. 6480    IF W1%<>4 THEN 6520                        REMARK    IF NOT A CREDIT MEMO, BRANCH
  260.     IF C(23)+C(24)=0 THEN 6260                    REMARK    SKIP TOTALLY USED CREDIT MEMOS
  261.     C(23)=-C(23)-C(24)
  262.     D(25)=0
  263. 6500    C(24)=0:C(25)=0:C(26)=0
  264.     GOTO 6540
  265. 6520    IF D(25)<>0 THEN 6260                        REMARK    SKIP CLOSED ITEMS
  266. 6540    C(25)=C(25)+C(26)                        REMARK    ACCUMULATE TOTALS
  267.     FOR I%=1 TO 3
  268.     W(I%)=W(I%)+C(22+I%)
  269.     W1.(I%)=W1.(I%)+C(22+I%)
  270.     W2.(I%)=W2.(I%)+C(22+I%)
  271.     NEXT I%
  272.     W8=W8+1
  273.     IF S<>3 THEN A9=1
  274.     IF R=0 THEN W9=W9+1
  275.     C0=C(23)+C(24)+C(25)
  276.     W(4)=W(4)+C0
  277.     W1.(4)=W1.(4)+C0
  278.     W2.(4)=W2.(4)+C0
  279.     C3=0
  280.     IF R=1 THEN 6640                        REMARK    IF CLOSED ITEM LISTING, SKIP AGING
  281.  
  282.     A=D3-A4                                REMARK    AGE OPEN ITEMS
  283.     I%=1
  284. 6580    IF A < P(I%) THEN 6600
  285.     I%=I%+1
  286.     IF I% < 5 THEN 6580
  287. 6600    A1(I%) = A1(I%)+C0
  288.     C3 = I%*3 + 108
  289.     IF W1%<>4 THEN A2(I%)=A2(I%)+C(24)
  290.     IF S3=1 THEN GOSUB 5400:S3=0
  291. 6640    IF S=1 THEN 6260                        REMARK    IF REPORT TYPE IS SUMMARY, GET NEXT INVOICE
  292.     GOSUB 5140
  293.     GOSUB 5540
  294.     IF R1=0 THEN 6260                        REMARK    IF NOT DELETING CLOSED ITEMS, GET NEXT INVOICE
  295.     IF W2%=2 OR W1%<>4 THEN\
  296.         W1%=-1:\
  297.         FILE.NO=3:X0%=INVOICE.RECORD.NO:GOSUB 3050
  298.     GOTO 6260
  299.  
  300.  
  301. 6680    IF R=0 THEN GOSUB 5460:GOSUB 5620                REMARK    -   * * *  TOTALS SECTION  * * *   -
  302.     TOTAL.FLAG%=2
  303.     LINE.COUNT%=66
  304.     X4$=L4$:A1=115:GOSUB 825
  305.     PRINT:PRINT TAB(30);"TOTALS";
  306.     PRINT TAB(45);
  307.     PRINT USING MASKA$;W8;
  308.     PRINT " INVOICES";TAB(64);
  309.     FOR I%=1 TO 4
  310.     PRINT USING MASKD$;W1.(I%);
  311.     NEXT I%
  312.     PRINT:PRINT:PRINT:PRINT
  313.     IF R=1 THEN 6780                        REMARK    SKIP AGING SUMMARY FOR CLOSED ITEMS
  314.  
  315.     PRINT TAB(44);"AGING";TAB(71);"AMOUNT    DISCOUNT"        REMARK    AGING SUMMARY
  316.     PRINT
  317.     FOR I%=1 TO 5
  318.     PRINT TAB(40);
  319.     IF I<5 THEN \
  320.         PRINT "UNDER";: \
  321.         PRINT USING MASKE$;P(I%); \
  322.     ELSE \
  323.         PRINT "OVER ";: \
  324.         PRINT USING MASKE$;P(I%-1);
  325.     PRINT " DAYS";
  326.     PRINT TAB(65);
  327.     PRINT USING MASKC$;A1(I%);A2(I%)
  328.     PRINT
  329.     NEXT I%
  330.     PRINT:PRINT:PRINT TAB(53);"TOTAL";
  331.     PRINT TAB(65);
  332.     FOR I%=2 TO 5
  333.     A1(1)=A1(1)+A1(I%)
  334.     A2(1)=A2(1)+A2(I%)
  335.     NEXT I%
  336.     PRINT USING MASKC$;A1(1);A2(1)
  337. 6780    PRINT:PRINT
  338.     PRINT "THIS REPORT INCLUDES INVOICES";
  339.     IF S=3 THEN PRINT" FOR VENDOR # ";W7$;
  340.     PRINT" FROM ";
  341.     X0=B0:GOSUB 680.5
  342.     PRINT " TO ";
  343.     X0=E0:GOSUB 680.5
  344.     PRINT:PRINT
  345.     A6$="OPEN":I3=OPEN.COUNT%:GOSUB 5020
  346.     A6$="CLOSED":I3=CLOSED.COUNT%:GOSUB 5020
  347.     A6$="DELETED":I3=DELETE.COUNT%:GOSUB 5020
  348.     IF S=3 THEN I3=OPEN.COUNT%+CLOSED.COUNT%+DELETE.COUNT%\
  349.     ELSE I3=AP.INVOICE.EXTENT
  350.     A6$="TOTAL":GOSUB 5020
  351.     GOTO 6040
  352.