home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug043.ark / A_R040.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  9.0 KB  |  289 lines
  1.  
  2.     REMARK   #############################################
  3.     REMARK   #     ACCOUNTS RECEIVABLE LEDGER PROGRAM    #
  4.     REMARK   #    (A/R040)      VERS OF 3 PM   6/19/79   #
  5.     REMARK   #############################################
  6.  
  7.     DIM A(7),B.(9),C(9),M$(5),Y(2),L4(2),G3(5),D(13),G2$(5)
  8.     DATA "A/R OPEN ITEMS","A/R AGING ANALYSIS","A/R CLOSED ITEMS"
  9.     DATA "A/R UNBILLED ITEMS",0,3,3,6,8,11,13,16,19,21,24,26
  10. %INCLUDE CURSOR
  11.     GOTO 6000
  12. %INCLUDE SUBS1
  13. %INCLUDE BINSEARC
  14. %INCLUDE A/R-INFO
  15. %INCLUDE READCUST
  16. %INCLUDE GENINFO
  17. %INCLUDE A/R-INV
  18.  
  19.  
  20.  
  21. 825    IF LINE.COUNT%<55 AND PAGE.COUNT%>0 THEN RETURN            REMARK    LINE PRINTER ROUTINE
  22.     PAGE.COUNT%=PAGE.COUNT%+1
  23.     PRINT CHR$(12);
  24.     PRINT TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
  25.     X0=G3(1):GOSUB 680.5
  26.     PRINT 
  27.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
  28.     PRINT
  29.     IF R3=2 AND S=2 THEN \
  30.         PRINT " CUST #   CUSTOMER";TAB(35);"PHONE"; \
  31.     ELSE \
  32.         PRINT " INV # T CUST ORDER #  JOB # DESC  BILL DATE";
  33.  
  34. 838    IF R3=2 THEN \
  35.         PRINT TAB(46);"TOTAL BAL";TAB(59);"CURRENT";TAB(71);: \
  36.         PRINT "30 DAY";TAB(82);"60 DAY";TAB(93);"90 DAY";TAB(102);: \
  37.         PRINT "PROG CURR  PR 10-DAY PROG DUE" \
  38.     ELSE \
  39.         PRINT TAB(48);"INV AMT";TAB(62);"SHIP";TAB(72);"TAXES";: \
  40.         PRINT TAB(83);"TOTAL";TAB(92);"INV PAY";TAB(102);"PROG BILL";:\
  41.         PRINT "   PROG PAY PROG DUE"
  42.     PRINT
  43.     LINE.COUNT%=6
  44.     RETURN 
  45.  
  46.  
  47. 4000    YEAR=100*((I/100)-INT(I/100))                    REMARK    COMPUTE # OF DAYS BETWEEN DATE "I" AND 00/00/00
  48.     DAY=100*((I-YEAR)/10000-INT((I-YEAR)/10000))
  49.     MONTH=(I-(100*DAY+YEAR))/10000
  50.     IF MONTH=0 OR MONTH>12 THEN A4=0:RETURN
  51.     RESTORE
  52.     FOR I%=1 TO MONTH + 4
  53.     READ A4
  54.     NEXT I%
  55.     A4=A4+YEAR*365+INT(YEAR/4)+1+(MONTH-1)*28+DAY
  56.     IF INT(YEAR/4)<>(YEAR/4) THEN RETURN    
  57.     IF MONTH<=2 THEN A4=A4-1
  58.     RETURN 
  59.  
  60. 4080    I=I2:GOSUB 4000                            REMARK    COMPUTE THE NUMBER OF DAYS BETWEEN DATES I2 & J2
  61.     A.=A4
  62.     I=J2:GOSUB 4000
  63.     A.=A.-A4
  64.     RETURN 
  65.  
  66.                                     REMARK    PRINT CUSTOMER TOTALS, AND ADD THEM TO GRAND TOTALS
  67. 4220    IF B.(8)=0 THEN RETURN                        REMARK    BUT NOT IF CUSTOMER BALANCE IS ZERO
  68.     IF R3<>2 THEN \
  69.         PRINT "   TOTAL";: \
  70.         PRINT USING MASKC$;B.(8),B.(9);
  71.     PRINT TAB(44);
  72.     PRINT USING MASKA$;B.(1),B.(2),B.(3),B.(4),B.(5);
  73.     PRINT " ";
  74.     PRINT USING MASKA$;B.(6),B.(7)
  75.     FOR I5%=1 TO 9
  76.     C(I5%)=C(I5%)+B.(I5%)
  77.     B.(I5%)=0
  78.     NEXT I5%
  79.     X0$="----"
  80.     FOR I%=1 TO 5:X0$=X0$+X0$:NEXT I%
  81.     PRINT X0$
  82.     LINE.COUNT%=LINE.COUNT%+2
  83.     RETURN 
  84.  
  85. 4500    Y2=2                                REMARK    LOCATE, RETRIEVE, AND PRINT CUSTOMER DATA
  86.     RECORD.COUNT =  AR.CUSTFILE.EXTENT
  87.     XYZ$=W1$+"      "
  88.     K$=LEFT$(XYZ$,6)
  89.     GOSUB 1060                            REMARK    LOCATE CUSTOMER DATA
  90.     IF H=-1 OR VAR1=0 THEN \
  91.         M$(2)="NO CUSTOMER INFO": \
  92.         Y(1)=0:Y(2)=0 \
  93.     ELSE \
  94.         Y9=2:X0=L:GOSUB 3225                    REMARK    RETRIEVE CUSTOMER DATA
  95.     PRINT "CUST ";W1$;"   ";M$(2);
  96.     IF R3=2 THEN \
  97.         PRINT TAB(43);: \
  98.         X0=P9:GOSUB 760.5: \
  99.         PRINT TAB(58);: \
  100.         PRINT USING MASKB$;Y(2),Y(1): \
  101.         LINE.COUNT%=LINE.COUNT%+1:RETURN 
  102.     IF R3<2 THEN PRINT USING MASKB$;Y(2),Y(1);
  103.     PRINT 
  104.     LINE.COUNT%=LINE.COUNT%+1
  105.     RETURN 
  106.  
  107. 4620    IF B<>2 THEN RETURN                        REMARK    REVERSE SIGNS ON CREDIT MEMOS
  108.     FOR I%=1 TO 11
  109.     IF D(I%)<>0 THEN D(I%)=-D(I%)
  110.     NEXT I%
  111.     RETURN 
  112.  
  113.  
  114.                                     REMARK    START OF MAIN PROGRAM
  115. 6000    MASKA$=" #######.##"
  116.     MASKB$="    SALES YTD #######.##  LAST YEAR #######.##"
  117.     MASKC$="   BAL #######.##   #### INVOICES"
  118.     MASKD$="######"
  119.     MASKE$="#####.#"
  120.     OPEN "G/I0F010.DAT" AS 1,"A/R0F110.DAT" RECL 162 AS 2, \
  121.     "A/R0F120.DAT" RECL 226 AS 3, "A/R0F130.DAT" AS 4, \
  122.     "CRT" RECL 1100 AS 19
  123.     Y9=1:GOSUB 700                            REMARK    RETRIEVE G/I FILE DATA
  124.     FILE.NO=4:GOSUB 3.14                        REMARK    RETRIEVE A/R FILE EXTENTS
  125.     IF END #3 THEN 6475                        REMARK    IF NO INVOICES ON FILE, END PROGRAM
  126. 6020    X0=16:GOSUB 260                            REMARK    DISPLAY CRT MASK
  127.     CONSOLE
  128.     R=0:S=0:PAGE.COUNT%=0
  129.     FOR I%=1 TO 9:C(I%)=0:NEXT I%                    REMARK    ZERO TOTALS
  130.     X1=270:X2=1:X3=0:X4=4:GOSUB 345                    REMARK    ENTER REPORT FORMAT
  131.     IF X0=0 THEN 6480
  132.     R3=X0
  133.     S=1
  134.     IF R3>2 THEN 6080
  135.     X1=334:X2=1:X3=1:X4=3:GOSUB 345                    REMARK    ENTER REPORT TYPE
  136.     S=X0
  137.     IF S=3 THEN \                            REMARK    CUSTOMER RANGE REPORT TYPE
  138.         X1=538:X2=6:X3=0:X4=0:GOSUB 345:\            REMARK    ENTER FIRST CUSTOMER
  139.         X0$=X0$+"      ":\
  140.         W8$=LEFT$(X0$,6):\
  141.         X1=602:X2=6:X3=0:X4=0:GOSUB 345:\            REMARK    ENTER LAST CUSTOMER
  142.         X0$=X0$+"      ":\
  143.         W0$=LEFT$(X0$,6)
  144. 6080    IF R3=3 THEN \                            REMARK    CLOSED ITEM LISTING
  145.         X1=418:X2=1:X3=0:X4=1:GOSUB 345: \            REMARK    ENTER WHETHER TO DELETE CLOSED ITEMS
  146.         R=X0
  147.     X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665            REMARK    VERIFY ENTRY
  148.     IF X0=0 THEN 6020
  149.     X1=192:GOSUB 210
  150.     PRINT "PROCESSING...";
  151.     RESTORE
  152.     FOR I%=1 TO R3
  153.     READ X4$
  154.     NEXT I%
  155.     LPRINTER
  156.     LINE.COUNT%=60
  157.     IF S=3 THEN \                              REMARK    FOR REPORT TYPE CUSTOMER RANGE, LOCATE FIRST INVOICE
  158.         Y2=3: \
  159.         RECORD.COUNT=AR.INVFILE.EXTENT: \
  160.         XYZ$=W8$+"      ":\
  161.         K$=LEFT$(XYZ$,6)+"000000":\
  162.         GOSUB 1060: \
  163.         START.RECORD.NO=L \
  164.     ELSE \
  165.         START.RECORD.NO=1
  166.  
  167.     IF START.RECORD.NO > AR.INVFILE.EXTENT THEN \
  168.         X2$="FIRST CUSTOMER NUMBER TOO HIGH": \
  169.         GOSUB 615: \
  170.         GOTO 6020
  171.  
  172.     FOR RECORD.INDEX=START.RECORD.NO TO AR.INVFILE.EXTENT        REMARK    START PRINT LOOP
  173.     FILE.NO=3:REC.NO%=RECORD.INDEX:GOSUB 3400            REMARK    READ NEXT INVOICE OFF OF FILE
  174.     IF S=3 AND W1$>W0$ THEN 6430                    REMARK    FOR CUSTOMER RANGE, BRANCH IF PAST LAST CUSTOMER
  175.     GOSUB 4620                            REMARK    REVERSE SIGNS, IF CREDIT MEMO
  176.     IF R3=3 THEN 6380                        REMARK    BRANCH FOR CLOSED ITEMS LISTINGS
  177.     IF R3=4 THEN 6400                        REMARK    BRANCH FOR UNBILLED REPORT
  178.  
  179.                                     REMARK    OPEN ITEMS AND AGING ANALYSIS ROUTINES
  180.     IF D(7)+D(11)=0 THEN 6430                    REMARK    SKIP CLOSED ITEMS
  181.     IF PAGE.COUNT%=0 THEN W6$=W1$
  182.     IF W6$<>W1$ THEN GOSUB 4220:GOSUB 4500:W6$=W1$            REMARK    WHEN CUSTOMERS CHANGE, PRINT LAST CUSTOMER TOTALS,\
  183.                                         AND NEW CUSTOMER DATA
  184.     IF L4(1)=0 THEN D(1)=0:D(2)=0:D(3)=0:D(4)=0            REMARK    IF BILL DATE IS ZERO, FORCE INVOICE AMOUNT TO ZERO
  185.     IF L4(2)<>0 THEN 6300
  186.     D(8)=0                                REMARK    IF PROGRESS DUE DATE IS ZERO,\
  187.                                         FORCE PROGRESS BILLING AMT TO ZERO
  188.     IF L4(1)=0 THEN 6430                        REMARK    IF BOTH ARE ZERO, SKIP THIS INVOICE
  189.     GOTO 6300
  190. 6280    IF W6$=W1$ THEN 6300                        REMARK    CLOSED ITEM AND UNBILLED REPORT FORMATS
  191.     W6$=W1$
  192.     IF PAGE.COUNT%<>0 THEN GOSUB 4500                REMARK    PRINT NEW CUSTOMER DATA WHEN CUSTOMERS CHANGE
  193. 6300    IF R3=2 THEN 6320                        REMARK    FOR ALL FORMATS EXCEPT AGING ANALYSIS...
  194.     A(1)=D(1)                            REMARK    ASSIGN VALUES TO PRINT, AND ACCUMULATE THEM TO TOTALS
  195.     A(2)=D(2)
  196.     A(3)=D(3)
  197.     A(4)=D(4)
  198.     A(5)=D(6)
  199.     A(6)=D(8)
  200.     A(7)=D(10)
  201.     FOR I%=1 TO 7
  202.     B.(I%)=B.(I%)+A(I%)
  203.     NEXT I%
  204.     GOTO 6330
  205. 6320    A(2)=0:A(3)=0:A(4)=0:A(5)=0:A(6)=0:A(7)=0            REMARK    ASSIGN VALUES TO PRINT FOR AGING ANALYSIS
  206.     A(1)=D(7)+D(11)
  207.     B.(1)=B.(1)+A(1)
  208.     IF D(7)=0 THEN 6326                        REMARK    UNLESS INVOICE BALANCE IS ZERO, AGE INVOICE
  209.     I2=G3(1):J2=L4(1):GOSUB 4080
  210.     IF A.<1 THEN A.=1
  211. 6322    I=INT(A./30)+2
  212.     IF I>5 THEN I=5
  213.     A(I)=D(7)
  214.     B.(I)=B.(I)+D(7)
  215. 6326    IF D(11)=0 THEN 6330                        REMARK    UNLESS PROGRESS BALANCE IS ZERO, AGE IT
  216.     I2=G3(1):J2=L4(2):GOSUB 4080
  217.     IF A.<10 THEN I=6 \
  218.     ELSE I=7
  219.     A(I)=D(11)
  220.     B.(I)=B.(I)+D(11)
  221. 6330    B.(8)=B.(8)+D(7)+D(11)
  222.     B.(9)=B.(9)+1
  223.  
  224.     A1=115:GOSUB 825                        REMARK    START PRINT ROUTINE
  225.     IF LINE.COUNT% < 7 THEN GOSUB 4500                REMARK    PRINT CURRENT CUSTOMER AT THE TOP OF A NEW PAGE
  226.     IF S=2 THEN 6430                        REMARK    EXCEPT FOR SUMMARY ONLY REPORT, PRINT INVOICE DETAILS
  227.     PRINT USING MASKD$;L1;
  228.     PRINT B;L1$;
  229.     PRINT TAB(22);
  230.     PRINT USING MASKD$;L2;
  231.     PRINT " ";L2$;
  232.     IF L4(1)<>0 THEN PRINT TAB(36);:X0=L4(1):GOSUB 680.5
  233.     PRINT TAB(44);
  234.     PRINT USING MASKA$;A(1),A(2),A(3),A(4),A(5);
  235.     IF B=2 OR D(12)<>0 THEN PRINT "C";
  236.     PRINT TAB(100);
  237.     PRINT USING MASKA$;A(6),A(7);
  238.     IF L4(2)<>0 THEN PRINT TAB(123);:X0=L4(2):GOSUB 680.5
  239.     PRINT 
  240.     LINE.COUNT%=LINE.COUNT%+1
  241.     IF D(13)<>0 THEN \
  242.         PRINT TAB(10);"G/L #";: \
  243.         PRINT USING MASKE$;D(13): \
  244.         LINE.COUNT%=LINE.COUNT%+1
  245.     IF R=1 THEN GOTO 6420\                        REMARK    IF DELETE OPTION SELECTED, BRANCH
  246.     ELSE GOTO 6430
  247.  
  248.  
  249.                                     REMARK    CLOSED ITEM LISTING CHOSEN
  250. 6380    IF C2=5 THEN 6280                        REMARK    UNLESS DELETE FLAGGED...
  251.     IF L4(1)=0 THEN 6430                        REMARK    SKIP UNBILLED ITEMS
  252.     IF D(7)+D(11)=0 THEN GOTO 6280 \                REMARK    AND OPEN ITEMS
  253.     ELSE GOTO 6430
  254.  
  255.  
  256.                                     REMARK    UNBILLED ITEM LISTING CHOSEN
  257. 6400    IF L4(1)=0 THEN 6280                        REMARK    SKIP INVOICES WITH NON-ZERO BILL DATES
  258.     IF L4(2)=0 THEN 6430
  259.     IF D(8)=0 THEN 6280                        REMARK    UNLESS THEY HAVE A POSTIVE PROGRESS BALANCE DUE
  260.     GOTO 6430
  261.  
  262.  
  263.                                     REMARK    DELETE CLOSED ITEMS
  264. 6420    B=-1
  265.     FILE.NO=3:REC.NO%=RECORD.INDEX:GOSUB 3450
  266.  
  267. 6430    NEXT RECORD.INDEX                        REMARK    END OF MAIN PRINT LOOP
  268.  
  269.     IF R3>2 THEN \                            REMARK    ZERO TOTALS ON CLOSED ITEM AND UNBILLED FORMATS
  270.         FOR I%=1 TO 9: \
  271.         B.(I%)=0: \
  272.         NEXT I%: \
  273.         GOTO 6020                        REMARK    AND DO NOT PRINT GRAND TOTALS
  274.  
  275.     GOSUB 4220                            REMARK    PRINT LAST CUSTOMER TOTALS ON\
  276.                                         OPEN ITEM AND AGING ANALYSIS FORMATS
  277.     FOR I%=1TO 9
  278.     B.(I%)=C(I%)
  279.     NEXT I%
  280.     PRINT "   GRAND"
  281.     IF R3=2 THEN PRINT "   TOTAL";
  282.     GOSUB 4220                            REMARK    PRINT GRAND TOTALS
  283.     GOTO 6020
  284.  
  285. 6475    X2$="ZERO INVOICES ON FILE":GOSUB 615
  286. 6480    PRINT CLEAR.SCREEN$;"A/R LEDGER LOADING MENU"            REMARK    END PROGRAM AND RELOAD MENU
  287.     CHAIN"A/P000"
  288.  
  289.