home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug043.ark / A_P030.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  11.8 KB  |  361 lines
  1.  
  2.     REMARK    #################################################
  3.     REMARK    #    A/P UPDATE PROGRAM    (A/P030)    #
  4.     REMARK    #    VERS. OF 11.20 AM    6/25/79        #
  5.     REMARK    #################################################
  6.  
  7.  
  8. %INCLUDE CURSOR
  9.     DIM C(27),D(27),B(6,5),C5(27),D5(27),G2$(5),G3(5),B1(2,6),Y(2),M$(5)
  10.     DIM P(5)
  11.     DEF FNF(X9)=X9-INT(X9/10)*10                    REMARK    STRIP OFF TENS DIGIT
  12.     GOTO 6000
  13.     DATA "INVOICE","DELETE","MODIFY","CREDIT MEMO","DEBIT MEMO"
  14. %INCLUDE SUBS1
  15. %INCLUDE GENINFO
  16. %INCLUDE A/P-INFO
  17. %INCLUDE BINSEARC
  18. %INCLUDE READINV
  19. %INCLUDE WRITEINV
  20. %INCLUDE READVEND
  21. %INCLUDE WRITEVND
  22. .314    RETURN                                REMARK    THESE LINE NUMBERS FOR G/L SUBROUTINES
  23. .315    RETURN
  24. 3650    RETURN
  25.  
  26.  
  27.  
  28. 825    IF LINE.COUNT%<55 THEN RETURN                    REMARK    LINE PRINTER ROUTINE
  29.     PAGE.COUNT%=PAGE.COUNT%+1
  30.     PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
  31.     X0=G3(1):GOSUB 680.5
  32.     PRINT 
  33.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
  34.     PRINT
  35.     IF LINE.COUNT%<>100 THEN\
  36.         PRINT " R#  VENDOR   INV # DESCRIPTION     TRANSACTION   ERROR"
  37.     PRINT
  38.     LINE.COUNT%=6
  39.     RETURN 
  40.  
  41.  
  42.                                     REMARK    CHECK EXISTENCE OF INVOICE RECORD FOR TRANSACTION
  43. 4100    IF J%=1 AND TRAN.KEY$=INV.KEY$ THEN \                REMARK    RECORD SHOULD BE AND IS ON FILE
  44.         INVOICE.POINTER%=INVOICE.POINTER%+1:\
  45.         RETURN
  46.     IF J%=2 AND TRAN.KEY$<>INV.KEY$ THEN RETURN            REMARK    RECORD SHOULD NOT BE AND IS NOT ON FILE
  47. 4140    X4$="A/P UPDATE REPORT":A1=60:GOSUB 825                REMARK    PRINT TRANSACTION ON ERROR REPORT
  48.     B1(2,A%)=B1(2,A%)+1
  49.     PRINT USING MASKA$;R%;W1$;W0;
  50.     PRINT TAB(23);W2$;TAB(37);
  51.     RESTORE
  52.     FOR I%=1 TO A%
  53.     READ A$
  54.     NEXT I%
  55.     PRINT A$;
  56.     IF J%=1 THEN PRINT TAB(50);"NOT ON FILE"
  57.     IF J%=2 THEN PRINT TAB(50);"DUPLICATE"
  58.     IF J%=3 THEN PRINT TAB(50);"DOUBLE TRANSACTION"
  59.     J%=0
  60.     LINE.COUNT%=LINE.COUNT%+1
  61.     RETURN
  62.  
  63.  
  64. 4200    IF I2<12 THEN \                            REMARK    ACCUMULATE G/L DISTRIBUTION TOTAL
  65.         B8=B8+C(I2):\
  66.         RETURN:\                        REMARK    SKIP IF G/L NOT IMPLEMENTED
  67.         P1=D(I2):\
  68.         P4=W0:\
  69.         P5=C(I2):\                        REMARK    ALSO, ADD TO G/L POSTING FILE
  70.         EXTERNAL.POSTING.EXTENT%=EXTERNAL.POSTING.EXTENT%+1:\
  71.         FILE.NO%=5:RECORD.NO%=EXTERNAL.POSTING.EXTENT%:GOSUB 3650\
  72.     ELSE\
  73.         B9=B9+C(I2)                        REMARK    OR, ACCUMULATE JOB DISTRIBUTION TOTAL
  74.     RETURN 
  75.  
  76.  
  77. 4300    PRINT USING MASKB$;P1;                        REMARK    PRINT G/L POSTING, AND ADD TO G/L POSTING FILE
  78.     PRINT "  ";D$;TAB(30);
  79.     PRINT USING MASKC$;P5
  80.     RETURN                                REMARK    SKIP WITHOUT G/L PROGRAMS
  81.     P4=0
  82.     EXTERNAL.POSTING.EXTENT%=EXTERNAL.POSTING.EXTENT%+1
  83.     FILE.NO%=5:RECORD.NO%=EXTERNAL.POSTING.EXTENT%:GOSUB 3650
  84.     RETURN 
  85.  
  86.  
  87.                                     REMARK    ACCUMULATE TRANSACTION AMOUNTS TO G/L POSTING TOTALS
  88. 5000    IF W1%=4 THEN B(A%,1)=B(A%,1)+F*(C(23)+C(24)):RETURN        REMARK    FOR CREDIT MEMOS 
  89.     FOR A1=1 TO 4                            REMARK    FOR INVOICES OR DEBIT MEMOS
  90.     IF C(22+A1)<>0 THEN B(A%,A1)=B(A%,A1)+F*C(22+A1)
  91.     NEXT A1
  92.     IF D(25)<>0 THEN \
  93.         D1=-(C(23)+C(24)+C(25)+C(26))*F:\
  94.         B2=B2+D1:\
  95.         B7=B7+D1
  96.     RETURN 
  97.  
  98.  
  99.                                     REMARK    RETRIEVE EXISTING INVOICE DATA
  100. 5300    READ #3,INVOICE.POINTER%-1; XX$,XX,YY$,ZZ$,W1%,F5,D5(1),D5(2),D5(3),\
  101.     D5(4),D5(5),D5(6),D5(7),D5(8),D5(9),D5(10),D5(11),D5(12),D5(13),\
  102.     D5(14),D5(15),D5(16),D5(17),D5(18),D5(19),D5(20),D5(21),D5(22),D5(23),\
  103.     D5(24),D5(25),D5(26),D5(27),C5(1),C5(2),C5(3),C5(4),C5(5),C5(6),\
  104.     C5(7),C5(8),C5(9),C5(10),C5(11),C5(12),C5(13),C5(14),C5(15),C5(16),\
  105.     C5(17),C5(18),C5(19),C5(20),C5(21),C5(22),C5(23),C5(24),C5(25),\
  106.     C5(26),C5(27)
  107.     RETURN
  108.  
  109.  
  110. 5400    IF W1%=4 THEN F=-F                        REMARK    CHANGE SIGN OF "F" ON CREDIT MEMOS
  111.     RETURN 
  112.  
  113.  
  114.                                     REMARK    START OF MAINLINE CODE
  115. 6000    MASKA$="###  /    / ######"
  116.     MASKB$="#####.#"
  117.     MASKC$=" ########.##"
  118.     MASKD$="###"
  119.     OPEN "G/I0F010.DAT" AS 1, "A/P0F110.DAT" RECL 162 AS 2,\
  120.     "A/P0F120.DAT" RECL 580 AS 3, "A/P0F020.DAT" RECL 580 AS 4,\
  121.     "A/P0F130.DAT" AS 6
  122.     CREATE "WORKFILE.DAT" RECL 580 AS 7
  123.     Y9=1:GOSUB 700                            REMARK    RETRIEVE G/I FILE DATA
  124.     X0=6:GOSUB 3310                            REMARK    RETRIEVE A/P INFORMATION FILE DATA
  125.     P2=1                                REMARK    SET G/L POSTING SOURCE CODE
  126.     P3=(INT(G3(1)/100))/100                        REMARK    SET G/L POSTING DATE
  127.     INVOICE.POINTER%=1
  128. 6010    MAX.POSTING.RECORDS = 3600
  129. 6020    MAX.INVOICE.RECORDS = 100
  130.     E$=" "
  131.     W0$=" "
  132.     GOTO 6040                            REMARK    SKIP UNLESS G/L PROGRAMS IMPLEMENTED
  133.     OPEN "G/L0F020.DAT" RECL 36 AS 5,"G/L0F130.DAT" AS 8
  134.     GOSUB .314
  135. 6040    PRINT CLEAR.SCREEN$;"A/P UPDATE"
  136.     IF SORT%=0 THEN \
  137.         PRINT:PRINT:PRINT:\
  138.         PRINT"THE TRANSACTION FILE IS NOT SORTED.  TRANSACTION":\
  139.         PRINT"PRINT MUST BE RUN BEFORE PROCEEDING WITH THE UPDATE"
  140.     PRINT CURSOR.HOME$
  141.     PRINT "KEY RETURN TO BEGIN; ENTER 'END' TO EXIT"
  142.     INPUT LINE A$
  143.     IF SORT%=0 AND A$="END" THEN CHAIN "A/P02A"
  144.     IF SORT%=0 THEN GOTO 6040
  145.     IF A$="END" THEN GOTO 6680
  146.     PRINT "PROCESSING...DO NOT INTERRUPT"
  147.     PRINT 
  148.     LINE.COUNT%=66
  149.     LPRINTER
  150. 6080    IF EXTERNAL.POSTING.EXTENT%+DIRECT.POSTING.EXTENT% > \        REMARK    CHECK FOR G/L POSTING FILE OVERFLOW
  151.     MAX.POSTING.RECORDS THEN E$="G/L"
  152.     IF R% THEN \                            REMARK    RESAVE THE TRANSACTION MARKED 'USED'
  153.         W2%=W2%+10:\
  154.         FILE.NO=4:X0%=R%:GOSUB 3050
  155.     IF E$<>" " THEN GOSUB 6740:GOTO 6540
  156.     R%=R%+1                                REMARK    INCREMENT TRANSACTION FILE COUNTER
  157.     IF R%>TRANSACTION.RCD.COUNT% THEN 6540                REMARK    BRANCH AT END OF TRANSACTION FILE
  158.     FILE.NO=4:X0%=R%:GOSUB 3000                    REMARK    RETRIEVE TRANSACTION RECORD
  159.     Y2=3
  160.     RECORD.COUNT=AP.INVOICE.EXTENT
  161.     XYZ$=W1$+"      ":ZYX$="000000"+STR$(W0)
  162.     NEW.KEY$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
  163.     IF NEW.KEY$=TRAN.KEY$ THEN \                    REMARK    IF DUPLICATE TRANSACTION, PRINT ON ERROR REPORT
  164.         J%=3:\
  165.         GOSUB 4140:\
  166.         GOTO 6080
  167.     TRAN.KEY$=NEW.KEY$
  168.     IF AP.INVOICE.EXTENT=0 THEN INV.KEY$="ZZZZZZZZZZZZ"
  169.     IF INV.KEY$="ZZZZZZZZZZZZ" THEN 6100                REMARK    IF THE LAST INVOICE RECORD HAS BEEN READ, BRANCH
  170.     K$=TRAN.KEY$
  171.     GOSUB 1060                            REMARK    LOCATE NEXT INVOICE RECORD
  172.     IF INVOICE.POINTER% > AP.INVOICE.EXTENT THEN \
  173.     INVOICE.POINTER% = INVOICE.POINTER% - 1
  174.     IF INVOICE.POINTER%=L THEN 6090                    REMARK    IF NEXT INVOICE HAS NOT CHANGED, BRANCH
  175.     FOR I%=INVOICE.POINTER% TO L-1
  176.     FILE.NO=3:X0%=I%:GOSUB 3000                    REMARK    COPY UNCHANGED INVOICES TO WORKFILE
  177.     INVOICE.POINTER%=INVOICE.POINTER%+1
  178.     IF W1%=-1 THEN 6085
  179.     GOSUB 6900
  180. 6085    NEXT I%
  181.     IF E$<>" " THEN GOSUB 6740:GOTO 6540
  182.     IF L>AP.INVOICE.EXTENT THEN INV.KEY$="ZZZZZZZZZZZZ":GOTO 6095
  183. 6090    FILE.NO=3:X0%=INVOICE.POINTER%:GOSUB 3000            REMARK    READ NEXT INVOICE FROM INVOICE FILE
  184.     XYZ$=W1$+"      ":ZYX$="000000"+STR$(W0)
  185.     INV.KEY$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
  186.     IF W1%=-1 AND INV.KEY$=TRAN.KEY$ THEN 6080
  187. 6095    FILE.NO=4:X0%=R%:GOSUB 3000                    REMARK    RE-LOAD TRANSACTION DATA
  188. 6100    CONSOLE
  189.     PRINT CURSOR.HOME$:PRINT:PRINT:PRINT"UPDATING: ";W1$;" ";W0
  190.     LPRINTER
  191.     IF W2%>9 THEN 6080                        REMARK    IF TRANSACTION IS VOID, SKIP IT
  192.     IF W2%=1 THEN A%=W1%\                        REMARK    SET COMPOSITE TRANSACTION TYPE AND OPERATION
  193.     ELSE A%=W2%
  194.     ON A% GOTO 6160,6360,6400,6160,6160                REMARK    BRANCH ON TRANSACTION TYPE AND OPERATION
  195.  
  196.  
  197.  
  198.                                     REMARK    NEW INVOICE, CREDIT MEMO, OR DEBIT MEMO
  199. 6160    J%=2:GOSUB 4100                            REMARK    MAKE SURE INVOICE DOES NOT ALREADY EXIST
  200.     F=1
  201.     IF J%=0 THEN 6080                        REMARK    IF INVOICE ALREADY EXISTS, GET NEXT TRANSACTION
  202. 6180    GOSUB 6900                            REMARK    SAVE TRANSACTION ON WORKFILE
  203.     B1(1,A%)=B1(1,A%)+1
  204.     GOSUB 5400                            REMARK    CHANGE SIGNS, IF CREDIT MEMO
  205.     FOR I%=1 TO 22
  206.     IF C(I%)<>0 THEN C(I%)=C(I%)*F:I2=I%:GOSUB 4200            REMARK    POST G/L EXPENSE ACCOUNT DISTRIBUTIONS
  207.     NEXT I%
  208. 6260    GOSUB 5000                            REMARK    ACCUMULATE OTHER G/L ACCOUNT POSTINGS
  209.     IF B7=0 THEN 6080                        REMARK    IF NO CHANGE IN VENDOR TOTALS, GET NEXT TRANSACTION
  210.     IF W0$=" " THEN 6280
  211.     IF W0$=W1$ THEN 6320                        REMARK    IF VENDOR HAS CHANGED...
  212.     X0$=W1$
  213.     W1$=W0$
  214.     Y9=2:X0=VENDOR.POINTER:GOSUB 3250                REMARK    SAVE LAST VENDOR'S DATA
  215.     W1$=X0$
  216. 6280    XYZ$=W1$+"      "
  217.     Y2=2
  218.     K$=LEFT$(XYZ$,6)
  219.     RECORD.COUNT=AP.VENDFILE.EXTENT
  220.     GOSUB 1060                            REMARK    LOCATE NEXT VENDOR'S DATA
  221.     IF H=-1 OR VAR1=0 THEN:\
  222.         W0$=" ":\
  223.         PRINT W1$;"NOT ON VENDOR FILE":\
  224.         GOTO 6340\
  225.     ELSE\
  226.         Y9=2:X0=L:GOSUB 3200:\                    REMARK    RETRIEVE NEXT VENDOR'S DATA
  227.         VENDOR.POINTER=L:\
  228.         W0$=W1$
  229. 6320    Y(2)=Y(2)-B7:D=D(23)
  230. 6340    B7=0
  231.     GOTO 6080
  232.  
  233.  
  234.                                     REMARK    OPERATION IS DELETE
  235. 6360    J%=1:GOSUB 4100                            REMARK    MAKE SURE INVOICE ALREADY EXISTS
  236.     F=-1
  237.     IF J%=0 THEN 6080                        REMARK    IF INVOICE DOES NOT EXIST, GET NEXT TRANSACTION
  238.     GOSUB 5300                            REMARK    RETRIEVE INVOICE DATA
  239.     IF FNF(F5)=2 OR D5(25)<>0 THEN 6380                REMARK    DO NOT DELETE AN ALREADY DELETED OR CLOSED INVOICE
  240.     IF W1%<>4 OR C(24)=0 THEN 6180
  241. 6380    J%=2
  242.     GOSUB 4140                            REMARK    PRINT TRANSACTION ON ERROR REPORT
  243.     GOTO 6080
  244.  
  245.  
  246.                                     REMARK    OPERATION IS MODIFY
  247. 6400    J%=1:GOSUB 4100                            REMARK    MAKE SURE INVOICE ALREADY EXISTS
  248.     IF J%=0 THEN 6080                        REMARK    IF IT DOES NOT, GET NEXT TRANSACTION
  249.     F=1
  250.     GOSUB 5300                            REMARK    RETRIEVE INVOICE DATA
  251.     IF FNF(F5)=2 THEN 6180                        REMARK    IF THE INVOICE IS DELETE-FLAGGED,\
  252.                                         THE TRANSACTION EFFECTIVELY BECOMES A NEW INVOICE    
  253.     GOSUB 5400                            REMARK    REVERSE SIGN, IF CREDIT MEMO
  254.     GOSUB 5000                            REMARK    ACCUMULATE TRANSACTION TOTALS TO G/L POSTING AMOUNTS
  255.     GOSUB 6900                            REMARK    SAVE TRANSACTION ON WORKFILE
  256.     B1(1,A%)=B1(1,A%)+1
  257.     IF W1%=4 THEN \
  258.         FOR I%=1 TO 22:\
  259.         C(I%)=-C(I%):\
  260.         C5(I%)=-C5(I%):\
  261.         NEXT I%
  262.     FOR I%=1 TO 22                            REMARK    ADJUST G/L DISTRIBUTIONS IF THEY HAVE BEEN MODIFIED
  263.     IF D(I%)=D5(I%) THEN 6480
  264.     I2=I%:GOSUB 4200
  265.     D(I%)=D5(I%)
  266.     C(I%)=-C5(I%)
  267.     GOTO 6520
  268. 6480    C(I%)=C(I%)-C5(I%)
  269.     IF C(I%)<>0 THEN I2=I%:GOSUB 4200
  270. 6520    NEXT I%
  271.     FOR I%=1 TO 4                            REMARK    BACK OUT OLD INVOICE AMOUNTS FROM TOTALS
  272.     C(22+I%)=C5(22+I%)
  273.     NEXT I%
  274.     D(25)=D5(25)
  275.     F=-1
  276.     GOSUB 5400
  277.     GOTO 6260
  278.  
  279.  
  280.  
  281.                                     REMARK    END OF PROGRAM - PRINT TOTALS
  282. 6540    IF INVOICE.POINTER% >= AP.INVOICE.EXTENT THEN 6555
  283.     FOR I%=INVOICE.POINTER% TO AP.INVOICE.EXTENT            REMARK    COPY THE REST OF THE INVOICE FILE TO THE WORKFILE
  284.     FILE.NO=3:X0%=I%:GOSUB 3000
  285.     INVOICE.POINTER%=INVOICE.POINTER%+1
  286.     IF W1%<>-1 THEN GOSUB 6900
  287.     NEXT I%
  288. 6555    IF E$<>" " THEN GOTO 6560
  289.     DELETE 4                            REMARK    ERASE TRANSACTION FILE
  290.     CREATE "A/P0F020.DAT" RECL 580 AS 4
  291.     TRANSACTION.RCD.COUNT%=0
  292. 6560    CLOSE 7                                REMARK    CLOSE WORKFILE BEFORE RENAMING
  293.     DELETE 3                            REMARK    ERASE INVOICE FILE
  294.     A=RENAME ("A/P0F120.DAT","WORKFILE.DAT")
  295.     CLOSE 6
  296.     OPEN "A/P0F130.DAT" AS 6
  297.     AP.INVOICE.EXTENT=OUTPUT.COUNT%
  298.     X0=6:GOSUB 3350
  299.     LPRINTER
  300.     LINE.COUNT%=100
  301.     B6=0:B4=0
  302.     IF W0$<>" " THEN W1$=W0$:Y9=2:X0=VENDOR.POINTER:GOSUB 3250    REMARK    SAVE FINAL VENDOR'S DATA
  303.     X4$="A/P UPDATE REPORT":A1=115:GOSUB 825
  304.     PRINT:PRINT:PRINT TAB(61);"AMOUNT    DISCOUNT  ";
  305.     PRINT "   FREIGHT       TAXES       TOTAL   ERRORS"
  306.     RESTORE 
  307.     FOR B0=1 TO 5
  308.     READ X0$
  309.     PRINT TAB(12);
  310.     PRINT USING MASKD$;B1(1,B0);
  311.     PRINT "   ";
  312.     PRINT X0$;" TRANSACTIONS";TAB(55);
  313.     B6=B6+B1(1,B0)
  314.     B5=0
  315.     FOR I%=1 TO 4
  316.     PRINT USING MASKC$;B(B0,I%);
  317.     B(6,I%)=B(6,I%)+B(B0,I%)
  318.     B5=B5+B(B0,I%)
  319.     NEXT I%
  320.     PRINT USING MASKC$;B5;
  321.     PRINT "     ";B1(2,B0)
  322.     NEXT B0
  323.     PRINT:PRINT:PRINT TAB(12);
  324.     PRINT USING MASKD$;B6;
  325.     PRINT "   TRANSACTIONS";TAB(55);
  326.     FOR I%=1 TO 4
  327.     PRINT USING MASKC$;B(6,I%);
  328.     B4=B4+B(6,I%)
  329.     NEXT I%
  330.     PRINT USING MASKC$;B4
  331.     PRINT:PRINT:PRINT TAB(9);"G/L POSTINGS":PRINT            REMARK    PRINT G/L TOTALS, AND ADD TO G/L POSTING FILE
  332.     W0=0
  333.     P1=2:P5=B2:D$="CASH":GOSUB 4300
  334.     P1=2020:P5=B4+B2:D$="ACCT PAYABLE":GOSUB 4300
  335.     PRINT TAB(9);"ALL OTHERS";TAB(30);
  336.     PRINT USING MASKC$;B8
  337.     PRINT:PRINT:PRINT "TOTAL JOB POSTINGS";TAB(30);
  338.     PRINT USING MASKC$;B9
  339.     GOTO 6680                            REMARK    IF G/L NOT IMPLEMENTED, SKIP
  340.     CLOSE 8                                REMARK    SAVE CHANGED G/L EXTENT INFORMATION
  341.     OPEN "G/L0F130.DAT" AS 8
  342.     FILE.NO%=8:GOSUB .315
  343. 6680    CONSOLE
  344.     PRINT CLEAR.SCREEN$;"A/P UPDATE LOADING MENU"
  345.     CHAIN "A/P000"
  346.  
  347. 6740    CONSOLE
  348.     PRINT "PROGRAM TERMINATED DUE TO ";E$;
  349.     PRINT " FILE FILLED TO LIMIT."
  350.     PRINT "ENTER 'RETURN' TO CONTINUE"
  351. 6741    IF CONSTAT% THEN PRINT:RETURN ELSE GOTO 6741
  352.  
  353.  
  354. 6900    OUTPUT.COUNT%=OUTPUT.COUNT%+1                    REMARK    SUBROUTINE TO ADD A RECORD TO THE WORKFILE
  355.     IF OUTPUT.COUNT% + AP.INVOICE.EXTENT - INVOICE.POINTER% >= \
  356.     MAX.INVOICE.RECORDS - 1 THEN E$="INVOICE"
  357.     FILE.NO=7
  358.     X0%=OUTPUT.COUNT%
  359.     GOSUB 3050
  360.     RETURN
  361.