home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug043.ark / A_R03B.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  11.2 KB  |  326 lines
  1.  
  2.     REMARK    #########################################################
  3.     REMARK    #    ACCOUNTS RECEIVABLE UPDATE    (A/R03B)    #
  4.     REMARK    #        VERS. OF 1.15 PM    6/28/79            #
  5.     REMARK    #########################################################
  6.  
  7. %INCLUDE CURSOR
  8.     DIM G(6),F(10,2),S(6,8),C.(7),D(13),G2$(5),G3(5),L4(2)
  9.     DIM M$(5),Y(2),R1(10),R2(10),R$(10)
  10.     GOTO 6000
  11.     DATA "NEW","INV BILLING","INV PAYMENT","PROG PAYMENT","DELETE","MODIFY"
  12. %INCLUDE SUBS1
  13. %INCLUDE BINSEARC
  14. %INCLUDE GENINFO
  15. %INCLUDE A/RTAX
  16. %INCLUDE A/R-INFO
  17. %INCLUDE A/R-INV
  18. %INCLUDE READCUST
  19. %INCLUDE WRITCUST
  20. .314    RETURN                                REMARK    THESE LINE NUMBERS FOR G/L SUBROUTINES
  21. .315    RETURN
  22. 3650    RETURN
  23.  
  24.  
  25.  
  26. 825    IF LINE.COUNT%<55 THEN RETURN                    REMARK    LINE PRINTER ROUTINE
  27.     PAGE.COUNT%=PAGE.COUNT%+1
  28.     PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
  29.     X0=G3(1):GOSUB 680.5
  30.     PRINT 
  31.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
  32.     PRINT
  33.     IF LINE.COUNT%<>100 THEN \
  34.         PRINT "REC   CUST INV #";TAB(24);"CASH  ACCT RCVB  SALES";:\
  35.         PRINT " INC  DEFER INC   SHIPPING";TAB(78);"TAXES    INV";:\
  36.         PRINT " AMT TAX TYPE   OP" \
  37.     ELSE \
  38.         PRINT TAB(34);"INV AMT";TAB(48);"SHIP";TAB(58);"TAXES  INV";:\
  39.         PRINT " TOTAL";TAB(78);"INV PAY";TAB(89);"PR BILL   PROG PAY"
  40.     PRINT
  41.     LINE.COUNT%=6
  42.     RETURN 
  43.  
  44.  
  45. 4000    PRINT USING MASKB$;P1;                        REMARK    PRINT POSTING TOTALS
  46.     PRINT " ";X0$;TAB(27);
  47.     IF I1<>0 THEN PRINT USING MASKA$;I1;
  48.     PRINT TAB(38);
  49.     PRINT USING MASKA$;P5
  50. 4040    IF P1*P5=0 THEN RETURN                        REMARK    UPDATE TRANSACTION TO G/L POSTING FILE
  51.     P4=L1
  52.     RETURN                                REMARK    SKIP UNLESS G/L IMPLEMENTED
  53.     EXTERNAL.POSTING.EXTENT%=EXTERNAL.POSTING.EXTENT%+1
  54.     IF EXTERNAL.POSTING.EXTENT% + DIRECT.POSTING.EXTENT% \
  55.      >= MAX.POSTING.RECORDS THEN GL.FILE.FULL = 1
  56.     FILE.NO%=8:RECORD.NO%=EXTERNAL.POSTING.EXTENT%:GOSUB 3650
  57.     RETURN 
  58.  
  59.  
  60. 4140    FOR I%=1 TO 11                            REMARK    REVERSE SIGN OF INVOICE AMOUNTS
  61.     IF D(I%)<>0 THEN D(I%)=-D(I%)
  62.     NEXT I%
  63.     RETURN 
  64.  
  65.  
  66.                                     REMARK    SAVE TRANSACTION RECORD ON WORKFILE
  67. 4160    IF C=5 THEN \                            REMARK    ZERO ALL NUMERIC FIELDS ON DELETE-FLAGGED INVOICES
  68.         FOR I%=1 TO 13:\
  69.         D(I%)=0:\
  70.         NEXT I%
  71.     IF H2$<>" " THEN RETURN                        REMARK    DO NOT SAVE TRANSACTION IF IT CAUSED AN ERROR
  72.     IF B=2 THEN GOSUB 4140                        REMARK    RE-REVERSE THE SIGNS ON A CREDIT MEMO
  73.     GOSUB 6900                            REMARK    SAVE THE TRANSACTION TO THE WORKFILE
  74.     IF C>1 THEN INVOICE.POINTER%=INVOICE.POINTER%+1
  75.     RETURN
  76.  
  77.  
  78.  
  79. 4260    IF CUSTOMER.POINTER%=0 OR Y(2)=Y1 THEN RETURN
  80.     W$=W1$
  81.     W1$=I1$
  82.     Y9=2:X0=CUSTOMER.POINTER%:GOSUB 3275            REMARK    RESAVE THE CUSTOMER RECORD
  83.     W1$=W$
  84.     RETURN 
  85.  
  86.  
  87.  
  88. 6000    MASKA$=" #######.##"                        REMARK    START OF MAINLINE CODE
  89.     MASKB$=" #####.#"
  90.     MASKC$=" ######"
  91.     MASKD$="###"
  92.     PRINT CLEAR.SCREEN$;"A/R UPDATE"
  93.     PRINT "WORKING... DO NOT INTERRUPT"
  94.     OPEN "G/I0F010.DAT" AS 1,"A/R0F110.DAT" RECL 162 AS 2,\
  95.     "A/R0F120.DAT" RECL 226 AS 3,"A/R0F020.DAT" RECL 226 AS 4,\
  96.     "A/R0F030.DAT" AS 5, "A/R0F130.DAT" AS 6
  97.     CREATE "WORKFILE.DAT" RECL 226 AS 7
  98. 6010    MAX.INVOICE.RECORDS = 200
  99.     MAX.POSTING.RECORDS = 1000
  100.     GOTO 6040                            REMARK    SKIP OPENING THE G/L FILES
  101.     OPEN "G/L0F020.DAT" RECL 36 AS 8,"G/L0F130.DAT" AS 9
  102.     FILE.NO%=9:GOSUB .314
  103. 6040    Y9=1:GOSUB 700                            REMARK    RETRIEVE G/I FILE DATA
  104.     FILE.NO=6:GOSUB 3.14                        REMARK    RETRIEVE A/R INFORMATION FILE DATA
  105.     A1=5:GOSUB 3700                            REMARK    RETRIEVE A/R TAX CODE INFORMATION
  106.     I1$=" "                                REMARK    INITIALIZE VARIABLES
  107.     H2$=" "
  108.     INVOICE.POINTER%=1
  109.     P2=2
  110.     P3=(INT(G3(1)/100))/100
  111.     LINE.COUNT%=60
  112.     LPRINTER
  113.  
  114. 6060    FOR I%=1 TO 7                            REMARK    ZERO TRANSACTION TOTALS
  115.     C.(I%)=0
  116.     NEXT I%
  117.     IF R% THEN \
  118.         C2=C2+10:\
  119.         FILE.NO=4:REC.NO%=R%:GOSUB 3450
  120.     IF INV.FILE.FULL THEN GOTO 6840
  121.     IF GL.FILE.FULL THEN GOTO 6850
  122.     R%=R%+1                                REMARK    INCREMENT TRANSACTION FILE COUNTER
  123.     IF R%>AR.TRANFILE.EXTENT THEN 6580                REMARK    BRANCH AT END OF TRANSACTION FILE
  124.     FILE.NO=4:REC.NO%=R%:GOSUB 3400                    REMARK    RETRIEVE NEXT TRANSACTION DATA
  125.     IF B=2 THEN GOSUB 4140
  126.     C=C2
  127.     IF C>9 THEN 6060                        REMARK    SKIP "USED" TRANSACTIONS
  128.     Y2=3
  129.     RECORD.COUNT=AR.INVFILE.EXTENT
  130.     XYZ$=W1$+"      ":ZYX$="000000"+STR$(L1)
  131.     NEW.KEY$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
  132.     IF NEW.KEY$=TRAN.KEY$ THEN H2$="DOUBLE TRANSACTION":GOTO 6360
  133.     TRAN.KEY$=NEW.KEY$
  134.     IF INV.KEY$="ZZZZZZZZZZZZ" THEN 6100                REMARK    IF LAST INVOICE RECORD HAS BEEN READ, BRANCH
  135.     K$=TRAN.KEY$
  136.     GOSUB 1060                            REMARK    LOCATE NEXT INVOICE RECORD
  137.     IF INVOICE.POINTER% > AR.INVFILE.EXTENT THEN \
  138.     INV.KEY$="ZZZZZZZZZZZZ":GOTO 6100
  139.     IF INVOICE.POINTER%=L THEN 6070                    REMARK    IF NEXT INVOICE HAS NOT CHANGED, BRANCH
  140.     FOR I%=INVOICE.POINTER% TO L-1
  141.     FILE.NO=3:REC.NO%=I%:GOSUB 3400                    REMARK    COPY UNCHANGED INVOICE TO WORKFILE
  142.     INVOICE.POINTER%=INVOICE.POINTER%+1
  143.     IF B<>-1 THEN GOSUB 6900
  144.     NEXT I%
  145.     IF INV.FILE.FULL THEN GOTO 6840
  146.     IF L>AR.INVFILE.EXTENT THEN INV.KEY$="ZZZZZZZZZZZZ":GOTO 6080
  147. 6070    FILE.NO=3:REC.NO%=INVOICE.POINTER%:GOSUB 3400            REMARK    READ NEXT INVOICE FROM INVOICE FILE
  148.     IF B=2 THEN GOSUB 4140
  149.     XYZ$=W1$+"      ":ZYX$="000000"+STR$(L1)
  150.     INV.KEY$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
  151.     IF B=-1 AND INV.KEY$=TRAN.KEY$ THEN 6060
  152. 6080    FILE.NO=4:REC.NO%=R%:GOSUB 3400                    REMARK    RE-LOAD TRANSACTION DATA
  153.     IF B=2 THEN GOSUB 4140
  154. 6100    IF C=1 AND TRAN.KEY$=INV.KEY$ THEN H2$="DUPLICATE":GOTO 6360    REMARK    CHECK FOR ERRORS
  155.     IF C>1 AND TRAN.KEY$<>INV.KEY$ THEN H2$="NOT ON INV FILE":GOTO 6360
  156.     S(C,8)=S(C,8)+1
  157.     ON C GOTO 6140,6320,6200,6260,6120,6320                REMARK    BRANCH ON OPERATION CODE
  158.  
  159.  
  160. 6120    D(5)=D(6)                            REMARK    OPERATION IS DELETE
  161.     D(9)=D(10)
  162.     GOSUB 4140                            REMARK    REVERSE SIGNS TO SUBTRACT VALUES FROM TOTALS
  163.                                     REMARK    FOR TRANSACTIONS WITH NON-ZERO BILL DATES
  164. 6140    IF L4(1)=0 THEN 6240                        REMARK    ADD INVOICE AMOUNTS, ETC. TO TOTALS
  165.     C.(5)=C.(5)+D(2)
  166.     F(L6+1,1)=F(L6+1,1)+D(3)
  167.     C.(6)=C.(6)+D(3)
  168.     C.(3)=C.(3)+D(4)
  169.     C.(2)=C.(2)+D(4)
  170.     F(L6+1,2)=F(L6+1,2)+D(1)
  171.     C.(7)=C.(7)+D(1)
  172.     FOR I%=1 TO 4
  173.     S(C,I%)=S(C,I%)+D(I%)
  174.     NEXT I%
  175.     IF L4(2)<>0 THEN C.(2)=C.(2)-D(8):C.(4)=C.(4)-D(8)        REMARK    ADJUST A/R AND DEFERRED INCOME TOTALS
  176.     IF D(13)<>0 THEN P1=ABS(D(13)):P5=SGN(D(13))*D(1):GOSUB 4040    REMARK    POST AMOUNT D(1) TO ACCOUNT D(13)
  177.     IF D(13)<0 THEN F(1,1)=F(1,1)-D(1)
  178.     IF D(13)<=0 THEN F(1,2)=F(1,2)-D(1)
  179. 6200    IF D(5)<>0 THEN \                        REMARK    ADJUST CASH AND A/R TOTALS WITH NON-ZERO PAYMENTS
  180.         C.(1)=C.(1)+D(5):\
  181.         C.(2)=C.(2)-D(5):\
  182.         S(C,5)=S(C,5)+D(5)
  183.     IF C=3 THEN 6360                        REMARK    END OF INVOICE PAYMENT OPERATION
  184. 6240    IF L4(2)=0 THEN 6300                        REMARK    IF PROGRESS DUE DATE IS NON-ZERO...
  185.     S(C,6)=S(C,6)+D(8)                        REMARK    ADJUST TOTALS BY PROGRESS BILLING AMOUNT
  186.     C.(2)=C.(2)+D(8)
  187.     C.(4)=C.(4)+D(8)
  188. 6260    IF D(9)<>0 THEN \                        REMARK    IF PROGRESS PAYMENT AMOUNT IS NON-ZERO...
  189.         C.(1)=C.(1)+D(9):\                    REMARK    ADJUST CASH AND A/R TOTALS
  190.         C.(2)=C.(2)-D(9):\
  191.         S(C,7)=S(C,7)+D(9)
  192.     IF C=4 THEN 6360                        REMARK    END OF PROGRESS PAYMENT OPERATION
  193. 6300    IF F7=1 THEN GOTO 6340 \
  194.     ELSE GOTO 6360
  195.                                     REMARK    START MODIFY OPERATION
  196. 6320    FILE.NO=3:REC.NO%=INVOICE.POINTER%:GOSUB 3400            REMARK    RETRIEVE OLD INVOICE
  197.     IF B=2 THEN GOSUB 4140
  198.     IF C2=5 THEN 6340
  199.     GOSUB 4140                            REMARK    REVERSE SIGNS
  200.     F7=1
  201.     GOTO 6140                            REMARK    BACK INVOICE AMOUNTS OUT OF TOTALS
  202. 6340    F7=0                                REMARK    MODIFY OPERATION, PART TWO
  203.     FILE.NO=4:REC.NO%=R%:GOSUB 3400                    REMARK    RETRIEVE MODIFY TRANSACTION DATA
  204.     IF B=2 THEN GOSUB 4140
  205.     GOTO 6140                            REMARK    ADD TRANSACTION AMOUNTS TO TOTALS
  206. 6360    GOSUB 4160                            REMARK    SAVE TRANSACTION ON WORKFILE
  207.     FOR I%=1 TO 4                            REMARK    ACCUMULATE TRANSACTION TOTALS TO GRAND TOTALS
  208.     G(I%)=G(I%)+C.(I%)
  209.     NEXT I%
  210.     IF L6=0 THEN G(6)=G(6)+C.(5):\
  211.     ELSE G(5)=G(5)+C.(5)
  212.     X4$="A/R UPDATE":A1=115:GOSUB 825                REMARK    PRINT TRANSACTION TOTALS
  213.     PRINT USING MASKD$;R%;
  214.     PRINT TAB(5);W1$;
  215.     PRINT USING MASKC$;L1;
  216.     FOR I%=1 TO 7
  217.     PRINT USING MASKA$;C.(I%);
  218.     NEXT I%
  219.     PRINT " ";L6;"  ";B;"   ";C;
  220.     IF D(12)<>0 THEN PRINT " (CR) ";
  221.     PRINT TAB(112);H2$
  222.     H2$=" "
  223.     LINE.COUNT%=LINE.COUNT%+1
  224.     IF D(13)<>0 THEN \                        REMARK    PRINT G/L NUMBER, IF ANY, ON A SEPARATE LINE
  225.         PRINT "   G/L #";:\
  226.         PRINT USING MASKB$;D(13):\
  227.         LINE.COUNT%=LINE.COUNT%+1
  228.     IF C.(3)+C.(4)=0 THEN 6060
  229.     IF I1$=" " THEN 6460
  230.     IF I1$=W1$ THEN 6500                        REMARK    WHEN CUSTOMERS CHANGE...
  231.     GOSUB 4260                            REMARK    UPDATE THE OLD CUSTOMER RECORD
  232. 6460    XYZ$=W1$+"      "
  233.     Y2=2
  234.     K$=LEFT$(XYZ$,6)
  235.     RECORD.COUNT=AR.CUSTFILE.EXTENT
  236.     GOSUB 1060                            REMARK    LOCATE THE NEW CUSTOMER RECORD
  237.     IF H=-1 OR VAR1=0 THEN \
  238.         I1$=" ":\
  239.         PRINT W1$," NOT IN CUSTOMER FILE":\
  240.         CUSTOMER.POINTER%=0:\
  241.         LINE.COUNT%=LINE.COUNT%+1:\
  242.         GOTO 6060
  243.     Y9=2:X0=L:GOSUB 3225                        REMARK    AND RETRIEVE THE NEW CUSTOMER DATA
  244.     CUSTOMER.POINTER%=L
  245.     I1$=W1$
  246.     Y1=Y(2)
  247. 6500    Y(2)=Y(2)+C.(3)+C.(4)                        REMARK    ADD NEW AMOUNTS TO CUSTOMER BILLING TOTAL
  248.     IF L4(1)>D THEN D=L4(1)
  249.     GOTO 6060
  250.  
  251.  
  252. 6580    LPRINTER                            REMARK    END PROGRAM AND PRINT TOTALS
  253.     GOSUB 4260                            REMARK    RESAVE LAST CUSTOMER RECORD
  254.     IF INVOICE.POINTER% >= AR.INVFILE.EXTENT THEN 6620        REMARK    COPY THE REST OF THE INVOICE FILE TO THE WORKFILE
  255.     FOR I%=INVOICE.POINTER% TO AR.INVFILE.EXTENT
  256.     FILE.NO=3:REC.NO%=I%:GOSUB 3400
  257.     INVOICE.POINTER%=INVOICE.POINTER%+1
  258.     IF B<>-1 THEN GOSUB 6900
  259.     NEXT I%
  260. 6620    LINE.COUNT%=100
  261.     X4$="A/R UPDATE":A1=115:GOSUB 825                REMARK    PRINT TOTALS
  262.     RESTORE 
  263.     FOR I%=1 TO 6
  264.     READ A$
  265.     PRINT USING MASKC$;S(I%,8);
  266.     PRINT TAB(8);" ";
  267.     PRINT A$;" TRANS";TAB(30);
  268.     FOR J%=1 TO 7
  269.     PRINT USING MASKA$;S(I%,J%);
  270.     NEXT J%
  271.     PRINT
  272.     NEXT I%
  273.     PRINT:PRINT:PRINT TAB(9);"GENERAL LEDGER POSTING TOTALS":PRINT
  274.     PRINT "  ACCT # NAME";TAB(43);"AMOUNT"
  275.     L1=0
  276.     P1=2:I1=0:P5=G(1):X0$="CASH":GOSUB 4000
  277.     P1=5:I1=0:P5=G(2):X0$="ACCT. RECEIVABLE":GOSUB 4000
  278.     P1=2029:I1=0:P5=F(2,1)+F(3,1)+F(4,1)+F(5,1)+F(6,1)+F(7,1)+F(8,1)+F(9,1)
  279.     P5=P5+F(10,1):X0$="SALES TAX PAYABLE":GOSUB 4000
  280.     P1=2230:I1=0:P5=G(4):X0$="DEFERRED INCOME":GOSUB 4000
  281.     P1=2611:I1=0:P5=-G(5):X0$="SHIPPING":GOSUB 4000
  282.     P1=3325:I1=0:P5=-G(6):X0$="TRAVEL, ETC.":GOSUB 4000
  283.     PRINT:PRINT:PRINT "  ACCT # SALES ACCOUNTS";TAB(35);"TAX     AMOUNT"
  284.     FOR I%=2 TO 10
  285.     P1=R2(I%):I1=F(I%,1):P5=F(I%,2):X0$=R$(I%):GOSUB 4000
  286.     NEXT I%
  287.     PRINT:PRINT:PRINT TAB(30);"DECREASE   INCREASE"
  288.     P1=0:I1=F(1,1):P5=F(1,2):X0$=R$(1):GOSUB 4000
  289.     PRINT
  290.     GOTO 6800                            REMARK    BYPASS SAVING NEW G/L EXTENT INFORMATION
  291.     CLOSE 9
  292.     OPEN "G/L0F130.DAT" AS 9
  293.     FILE.NO%=9:GOSUB .315
  294. 6800    IF INV.FILE.FULL OR GL.FILE.FULL THEN GOTO 6810            REMARK    IF UPDATE CONCLUDED SUCCESSFULLY...
  295.     DELETE 4                            REMARK    DELETE THE OLD TRANSACTION FILE
  296.     CREATE "A/R0F020.DAT" RECL 226 AS 4                REMARK    CREATE AN EMPTY TRANSACTION FILE
  297.     AR.TRANFILE.EXTENT=0
  298. 6810    CLOSE 6
  299.     OPEN "A/R0F130.DAT" AS 6
  300.     AR.INVFILE.EXTENT=OUTPUT.COUNT%
  301.     FILE.NO=6:GOSUB 3.15                        REMARK    RESET THE A/R EXTENT INFORMATION
  302.     CLOSE 7
  303.     DELETE 3
  304.     A=RENAME("A/R0F120.DAT","WORKFILE.DAT")
  305. 6820    CONSOLE
  306.     PRINT CLEAR.SCREEN$;"A/R UPDATE LOADING MENU"
  307.     CHAIN "A/P000"
  308.  
  309. 6840    CONSOLE                                REMARK    INVOICE FILE OVERFLOW DETECTED
  310.     PRINT "INVOICE FILE FULL. PRESS 'RETURN' TO PRINT TOTALS"
  311. 6841    IF CONSTAT% THEN PRINT:GOTO 6580 ELSE GOTO 6841
  312.  
  313.  
  314. 6850    CONSOLE                                REMARK    G/L FILE OVERFLOW DETECTED
  315.     PRINT "G/L FILE FULL. PRESS 'RETURN' TO PRINT TOTALS"
  316. 6851    IF CONSTAT% THEN PRINT:GOTO 6580 ELSE GOTO 6851
  317.  
  318.  
  319. 6900    OUTPUT.COUNT%=OUTPUT.COUNT%+1                    REMARK    SUBROUTINE TO ADD A RECORD TO THE WORKFILE
  320.     IF OUTPUT.COUNT% + AR.INVFILE.EXTENT - INVOICE.POINTER% >= \
  321.     MAX.INVOICE.RECORDS - 1 THEN INV.FILE.FULL = 1
  322.     FILE.NO=7
  323.     REC.NO%=OUTPUT.COUNT%
  324.     GOSUB 3450
  325.     RETURN
  326.