home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug043.ark / A_P040.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  11KB  |  362 lines
  1.     REMARK    ****************************************\
  2.         *  A/P040.BAS   A/P CHECK CALCULATE    *\
  3.         *     6/18/79            5:10 PM       *\
  4.         ****************************************
  5.  
  6.  
  7.     DIM G2$(5),G3(5),C(27),D(27),M$(5),A$(25),A1$(25,25),P(6),Y(2)
  8.     DATA 0,3,3,6,8,11,13,16,19,21,24,26
  9. %INCLUDE CURSOR
  10.     DEF FNA(Z)=100 *(Z/100 - INT(Z - 100))
  11.     GOTO 6000
  12. %INCLUDE SUBS1
  13. %INCLUDE GENINFO
  14. %INCLUDE BINSEARC
  15. %INCLUDE READVEND
  16. %INCLUDE WRITEVND
  17. %INCLUDE READINV
  18. %INCLUDE WRITEINV
  19. %INCLUDE A/P-INFO
  20. 3650    RETURN                                REMARK    THESE LINES FOR G/L SUBROUTINES
  21. .314    RETURN
  22. .315    RETURN
  23.  
  24.  
  25. 4000    REMARK  *********   DATE SUBTRACTION ROUTINE   *********\
  26.         (THIS ROUTINE SUBTRACTS THE DATE IN  I  FROM THE\ 
  27.          IMAGINARY DATE  "00/00/00")
  28.     YEAR=100*((I/100)-INT(I/100))
  29.     DAY=100*((I-YEAR)/10000-INT((I-YEAR)/10000))
  30.     MONTH=(I-(100*DAY-YEAR))/10000
  31.  
  32.     IF MONTH=0 OR MONTH > 12 THEN A4=0:RETURN
  33.     RESTORE
  34.     FOR I%=1 TO MONTH:READ A4:NEXT I%                REMARK    READ DATA TABLE 
  35.     A4=A4+YEAR*365+INT(YEAR/4)+1+(MONTH-1)*28+DAY
  36.     IF INT(YEAR/4) <> YEAR/4 THEN RETURN
  37.     IF MONTH <= 2 THEN A4=A4-1
  38.  
  39.     RETURN
  40.     REMARK    *******************************************************
  41.  
  42.  
  43. 4150    REMARK    ********** DAYS BETWEEN TWO DATES SUBROUTINE **********\
  44.         THIS ROUTINE CALCULATES DAYS BETWEEN DATES IN I3 AND\
  45.         J2.  ANSWER (IN DAYS) IS PASSED BACK IN A.
  46.  
  47.     I=I3:GOSUB 4000
  48.     A=A4
  49.     I=J2:GOSUB 4000
  50.     A=A-A4
  51.     RETURN
  52.     REMARK    *****************************************************
  53.  
  54.  
  55. 4200    REMARK    ********** INVOICE NUMBER ENTRY **********\
  56.         ENTER INVOICE NUMBERS FOR THE K1'ST CHECK.
  57.  
  58.     XYZ$=X0$+"      "
  59.     X0$=LEFT$(XYZ$,6)
  60.     A$(K1)=X0$                            REMARK    SAVE VENDOR NUMBER
  61.     FOR J%=1 TO 25
  62.     A1$(K1,J%)=""                            REMARK    SET INVOICE NUMBERS TO NULL STRINGS
  63.     NEXT J%
  64.     IF LEN(X0$)=0 THEN GOTO 4280                    REMARK    IF BLANK VENDOR #, BRANCH
  65.     GOSUB 5450
  66.     X1=456:GOSUB 210
  67.     PRINT "ENTERING INVOICES TO PAY FOR VENDOR ";A$(K1);TAB(64)
  68. 4220    REMARK    ********** ENTER UP TO 25 INVOICE NUMBERS & ALLOW CHANGES **********
  69.  
  70.     FOR K2=1 TO 25
  71.     GOSUB 5480
  72.     IF X0=0 THEN K2=25
  73.     NEXT K2
  74. 4240    GOSUB 5500
  75.     IF X0=0 THEN 4280
  76.     K2=X0+I*5
  77.     GOSUB 5480
  78.     GOTO 4240
  79.  
  80.  
  81. 4280    REMARK    ********** RE-DISPLAY GRID WITH ALL VENDOR #'S ENTERED SO FAR FOR CHECK CALCULATION **********
  82.     GOSUB 5450
  83.     PRINT CURSOR.HOME$:PRINT:PRINT TAB(64):PRINT TAB(64)
  84.     X1=465:GOSUB 210
  85.     PRINT "ENTERING VENDOR NUMBERS TO PAY"
  86.     PRINT
  87.     K2=0
  88.     FOR I1%=1 TO 5
  89.     PRINT LEFT$(X9$,3);
  90.     FOR I%=1 TO 5
  91.     K2=K2+1
  92.     IF LEN(A$(K2)) <> 0 THEN \
  93.         PRINT LEFT$(X9$,4);:\
  94.         PRINT USING "/2345/";A$(K2);
  95.     NEXT I%
  96.     PRINT
  97.     NEXT I1%
  98.     RETURN
  99.  
  100.  
  101. 5000    IF F=0 AND W5 <= 0 AND W1% = 4 THEN RETURN            REMARK    IF DETAIL RECORD IS A LONE CREDIT MEMO,
  102.                                     REMARK    RETURN WITHOUT WRITING A RECORD.
  103.     IF F=0 THEN GOTO 5160                        REMARK    IF DETAIL PROCESSING FLAG IS SET, WRITE DETAIL CHECK RECORD.
  104.     IF W9=0\                            REMARK    IF NO DETAIL RECORDS WERE WRITTEN FOR THIS CHECK,
  105.     OR W5 <= 0 THEN \                        REMARK    OR CHECK AMOUNT IS NOT POSTIIVE,
  106.         CHECKS%=HDR%:HDR%=0:\                    REMARK    SKIP WRITING HEADER AND RESET LOGICAL EOF
  107.         RETURN
  108.     PRINT #4, HDR%; K1$, W7, W5, A8, W9
  109.     HDR%=0
  110.     XYZ$=W1$+"      "
  111.     K$=LEFT$(XYZ$,6)
  112.     RECORD.COUNT=AP.VENDFILE.EXTENT
  113.     Y2=2
  114.     GOSUB 1060                            REMARK    SEARCH FOR VENDOR RECORD
  115.     IF H=-1 OR VAR1=0 THEN 5130
  116.     X0=L:Y9=2:GOSUB 3200                        REMARK    READ THE VENDOR RECORD
  117. 5110    Y(2)=Y(2)+W5                            REMARK    ADD CHECK AMOUNT TO VENDOR ACTIVITY TOTAL
  118.     L2=L2-W5                            REMARK    SUBTRACT CHECK AMOUNT FROM G/L CASH ACCOUNT
  119.     D=A8
  120.     GOSUB 3250                            REMARK    RE-WRITE THE VENDOR RECORD 
  121. 5130    F=0:W5=0:W9=0
  122.     W7=W7+1
  123.     RETURN
  124.  
  125.  
  126. 5160                                    REMARK    WRITE CHECK DETAIL RECORD
  127.  
  128.     IF HDR%=0 THEN HDR%=CHECKS%:CHECKS%=CHECKS%+1
  129.     W9=W9+1                                REMARK    INCREMENT DETAIL COUNTER
  130.     PRINT #4,CHECKS%; W2$,W1%,D(23),W0,C(23),C(24),C(25),C(26)
  131.     CHECKS%=CHECKS%+1                        REMARK    INCREMENT TOTAL CHECK FILE RECORD COUNT.
  132.     CLOSE 4
  133.     OPEN "A/P0F030.DAT" RECL 86 AS 4
  134.     RETURN
  135.  
  136.  
  137. 5210    W2%=0                                REMARK    RESAVE INVOICE RECORD
  138.     D(24)=A8
  139.     D(25)=W7
  140.     X0=INVOICES%:GOSUB 3050
  141.     RETURN 
  142.  
  143.  
  144. 5230    RETURN                                REMARK    SKIP UNLESS G/L PROGRAMS IMPLEMENTED
  145.     X0=4
  146.     P1=2020
  147.     P2=1
  148.     P3=INT(D1/100)/100
  149.     P4=0
  150.     P5=L2
  151.     FILE.NO%=5:RECORD.NO%=EXTERNAL.POSTING.EXTENT%+1:GOSUB 3650
  152.     P1=2
  153.     RECORD.NO%=RECORD.NO%+1:GOSUB 3650
  154.     EXTERNAL.POSTING.EXTENT%=EXTERNAL.POSTING.EXTENT%+2
  155.     CLOSE 6
  156.     OPEN "G/L0F130.DAT" AS 6
  157.     FILE.NO%=6:GOSUB .315
  158.     RETURN 
  159.  
  160.  
  161. 5450    REMARK RE-DISPLAY GRID CONTENTS ON CRT
  162.     X1=448:GOSUB 210
  163.     PRINT TAB(64)
  164.     PRINT 
  165.     FOR I%=1 TO 5
  166.     PRINT USING "#";I%;:PRINT")";TAB(64)
  167.     NEXT I%
  168.     RETURN 
  169.  
  170.  
  171. 5480    X1=572+14*INT((K2-1)/5)+10*K2:X2=6:X3=0:X4=999999        REMARK    ENTER INVOICE NUMBER IN GRID
  172.     GOSUB 345
  173.     IF X%=3 THEN GOTO 6700                        REMARK  IF CTRL-C WAS DEPRESSED, EXIT PROGRAM
  174.     IF X0=0 THEN RETURN
  175.     X0$="000000"+X0$                        REMARK    RIGHT-ADJUST INVOICE NUMBER
  176.     A1$(K1,K2)=RIGHT$(X0$,6)
  177.     RETURN 
  178.  
  179. 5500    X2=1:X3=0:X4=5
  180.     X2$="ENTER ROW TO CHANGE (0 IF NONE)"
  181.     GOSUB 665
  182.     IF X0=0 THEN RETURN
  183.     I=X0-1
  184.     X2=1:X3=0:X4=5
  185.     X2$="ENTER COLUMN TO CHANGE"
  186.     GOSUB 665
  187.     IF X0=0 THEN 5500
  188.     RETURN 
  189.  
  190.  
  191. 5600    X1=572+14*INT((K-1)/5)+10*K:X2=6:X3=0:X4=0:GOSUB 345        REMARK    ENTER VENDOR NUMBER
  192.     IF X%=3 THEN GOTO 6700                        REMARK  EXIT PROGRAM IF CTRL-C DEPRESSED
  193.     RETURN 
  194.  
  195.  
  196.                                     REMARK    START OF MAIN PROGRAM
  197. 6000    MAX.CHECKS%=100                            REMARK    SET PROCESSING LIMIT FOR CHECKS
  198.     CTRL.C%=1
  199.     Y9=1
  200.     OPEN "G/I0F010.DAT" AS 1, "A/P0F110.DAT" RECL 162 AS 2,\
  201.     "A/P0F120.DAT" RECL 580 AS 3, "A/P0F130.DAT" AS 4,\
  202.     "CRT" RECL 1100 AS 19
  203.     GOSUB 700                            REMARK    GET SYSTEM GENERAL INFORMATION
  204.     X0=4:GOSUB 3310                            REMARK    READ A/P INFO FILE
  205.     CLOSE 1,4
  206.     FILE.NO=3                            REMARK    SET FILE NUMBER FOR A/P0F120.DAT
  207.     X0=6:GOSUB 260                            REMARK    GET CRT MASK #6
  208.     GOTO 6040
  209.     OPEN "G/L0F020.DAT" RECL 36 AS 5
  210.     OPEN "G/L0F130.DAT" AS 6                    REMARK    OPEN G/L INFO FILE
  211.     FILE.NO%=6:GOSUB .314
  212.     MAX.POSTINGS%=1000
  213.     IF EXTERNAL.POSTING.EXTENT% > MAX.POSTINGS%\
  214.     THEN\
  215.     X2$="G/L POSTING FILE FULL":\
  216.     GOSUB 615:\
  217.     GOTO 6700
  218. 6040    X2=5:X3=0:X4=0:X2$="'CLEAR' OR 'SAVE' LAST CHECK RUN ('END' TO EXIT)?"
  219.     GOSUB 665
  220.     IF X0$="END" THEN 6700
  221.     IF X0$="CLEAR" THEN GOTO 6059
  222.     IF X0$ <> "SAVE" THEN GOTO 6040
  223.     IF END #4 THEN 6059                        REMARK    SET DESTINATION FOR EOF
  224.     OPEN "A/P0F030.DAT" RECL 86 AS 4
  225.     IF END #4 THEN 6060
  226. 6045    READ #4; LINE X0$
  227.     CHECKS%=CHECKS% + 1
  228.     GOTO 6045
  229. 6059    IF CHECKS%=0 THEN CREATE "A/P0F030.DAT" RECL 86 AS 4
  230. 6060    IF CHECKS%=0 THEN CHECKS%=1
  231.     IF CHECKS% > 1 THEN CHECKS% = CHECKS% -1
  232. 6070    PRINT CURSOR.HOME$:PRINT TAB(64):PRINT TAB(64)
  233.     K=0
  234.     X1=269:GOSUB 673                        REMARK    ENTER CHECK DATE
  235.     A8=X0
  236.     I3=G3(1):J2=A8:GOSUB 4150
  237.     IF ABS(A) >= 7 THEN \                        REMARK    IF TOO FAR AHEAD OR BEHIND TODAY'S DATE
  238.         X2$="TOO FAR AHEAD/BEHIND":\                REMARK    THEN REJECT CHECK DATE ENTERED.
  239.         GOSUB 615:\
  240.         GOTO 6070
  241. 6080    X1=339:X2=6:X3=0:X4=999999:GOSUB 345                REMARK    ENTER NUMBER OF HANDWRITTEN CHECKS
  242.     W7=P(5)+X0                            REMARK    ADD THIS NUMBER TO NEXT CHECK REG #
  243.     X1=369:GOSUB 210:PRINT W7                    REMARK    DISPLAY NEXT CHECK REG #
  244.     K=0
  245. 6100    REMARK  **********  ENTER VENDOR/INVOICE GRID  **********
  246.  
  247.     IF K >= 25 THEN GOTO 6140
  248.     K=K+1
  249.     GOSUB 5600                            REMARK    ENTER VENDOR NUMBER IN GRID
  250.     IF LEN(X0$) = 0 AND K=1 THEN \                    REMARK    IF FIRST GRID ENTRY IS A BLANK VENDOR,
  251.         X1=411:X2=6:X3=0:X4=0:GOSUB 345:\            REMARK    PROMPT FOR VENDOR NUMBER RANGE.
  252.         A2$=X0$:\
  253.         X1=432:X2=6:X3=0:X4=0:GOSUB 345:\
  254.         X0$=X0$+"      ":\
  255.         A3$=LEFT$(X0$,6):\
  256.         A$(1)="":\                        REMARK    RESET FIRST GRID VENDOR TO NULL VALUE
  257.         GOTO 6180
  258.     IF LEN(X0$) > 0 THEN \                        REMARK    IF VENDOR # WAS ENTERED, PROCESS INVOICE GRID.
  259.         K1=K:GOSUB 4200:\
  260.         GOTO 6100
  261.  
  262.  
  263. 6140    GOSUB 5500
  264.     IF X0 > 0 THEN \                        REMARK    IF VALID FIELD NUMBER ENTERED, ALLOW CHANGES TO GRID
  265.         K=X0+5*I:\
  266.         GOSUB 5600:\
  267.         K1=K:\
  268.         GOSUB 4200:\
  269.         GOTO 6140
  270. 6180    X2=1:X3=0:X4=1
  271.     X2$="ENTRY CORRECT?"
  272.     GOSUB 665
  273.     IF X0 <> 1 THEN 6060
  274.  
  275. 6200    PRINT CURSOR.HOME$
  276.     PRINT
  277.     PRINT "PROCESSING . . . DO NOT INTERRUPT"
  278.     F9=1                                REMARK    SET FLAG FOR PROGRAM START
  279. 6220    IF LEN(A$(1)) > 0 THEN K=0:GOTO 6240                REMARK    IF GRID WAS USED, BRANCH TO GET FIRST VENDOR
  280.     RECORD.COUNT=AP.INVOICE.EXTENT
  281.     Y2=3
  282.     XYZ$=A2$+"      "
  283.     A2$=LEFT$(XYZ$,6)
  284.     K$=A2$+"000000"
  285.     GOSUB 1060                            REMARK    SEARCH INVOICE FILE FOR FIRST RECORD IN RANGE.
  286.     INVOICES%=L-1
  287.     GOTO 6320                            REMARK    BRANCH TO "VENDOR RANGE" ROUTINE
  288. 6240    K=K+1
  289.     IF K=26 THEN GOTO 6680
  290.     IF LEN(A$(K)) = 0 THEN GOTO 6680                REMARK    IF NO MORE VENDORS IN GRID, EXIT PROGRAM
  291.     K1$=A$(K)                            REMARK    SET CURRENT VENDOR NUMBER IN K1$
  292.     K1=0
  293. 6260    K1=K1+1
  294.     IF K1=26 THEN 6440
  295.     IF LEN(A1$(K,K1)) = 0 THEN 6440                    REMARK    IF NO MORE INVOICES FOR THIS VENDOR,\
  296.                                     REMARK    THEN WRITE CHECK HEADER RECORD
  297. 6280    XYZ$=K1$+"      ":ZYX$="000000"+A1$(K,K1)
  298.     K$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
  299.     RECORD.COUNT=AP.INVOICE.EXTENT
  300.     Y2=3
  301.     GOSUB 1060                            REMARK    SEARCH INVOICE FILE
  302.     IF H=-1 THEN GOTO 6260                        REMARK    IF INVOICE NOT FOUND, GET NEXT GRID ENTRY
  303.     X0%=L
  304.     GOTO 6340
  305. 6300    IF LEN(A$(1)) > 0 THEN 6260
  306.     IF K1$ > A3$ THEN GOTO 6680                    REMARK    IF CURRENT VENDOR IS PAST VENDOR RANGE,\
  307.                                         THEN BRANCH TO END OF PROGRAM.
  308. 6320    INVOICES%=INVOICES% + 1
  309.     IF INVOICES% > AP.INVOICE.EXTENT THEN GOTO 6680            REMARK    IF END OF FILE, END PROCESSING.
  310.     X0%=INVOICES%
  311. 6340    GOSUB 3000                            REMARK    READ INVOICE RECORD
  312.     IF W2%-INT(W2%/10)*10 = 2 THEN 6300            REMARK    IF INVOICE RECORD WAS DELETE-FLAGGED,
  313.     IF W1% <> 4 THEN 6420                        REMARK    OR INVOICE IS A CREDIT MEMO AND CHECK AMOUNT IS $0.00,
  314.     IF C(23)+C(24)=0 THEN 6300                    REMARK    THEN GET THE NEXT INVOICE RECORD.
  315.     IF W5=0 THEN 6300
  316. 6420    IF D(25) <> 0 THEN GOTO 6300
  317.     IF LEN(K1$)=0 THEN 6500
  318.     IF K1$=W1$ THEN 6520
  319. 6440    F=1
  320.     GOSUB 5000
  321.     IF CHECKS% > MAX.CHECKS% THEN\
  322.         PRINT "CHECK FILE FULL":\
  323.         PRINT "PRINT ALL CHECKS":\
  324.         PRINT "RERUN CALCULATE":\
  325.         PRINT "PRESS <RETURN> TO EXIT":\
  326.         INPUT "";LINE X0$:\
  327.         GOTO 6660
  328.     IF LEN(A$(1)) > 0 THEN 6240                    REMARK    IF PROCESSING BY GRID, GET NEXT VENDOR ENTRY
  329.     IF W1$ > A3$ THEN 6680                        REMARK    IF CALCULATING CHECKS BY RANGE, GET NEXT INVOICE
  330. 6500    K1$=W1$
  331. 6520    X1=448:GOSUB 210
  332.     PRINT "PROCESSING ";W1$,W0;TAB(63)
  333.     IF W1%<>4 THEN 6580                        REMARK    APPLY CREDIT MEMO TO POSITIVE CHECK AMOUNT.
  334.     C1=C(23)+C(24)
  335.     IF C1>W5 THEN C1=W5
  336.     W5=W5-C1
  337.     C(24)=C(24)-C1                            REMARK    TOTAL USED STORED AS NEGATIVE BALANCE
  338.     C(25)=C(25)+C1
  339.     GOSUB 5210
  340.     C(23)=-C1                            REMARK    ADJUST FIELDS SO CREDIT AMOUNTS WILL
  341.     C(24)=0:C(25)=0                            REMARK    APPEAR IN PROPER CHECK DETAIL FIELDS
  342.     GOTO 6600
  343. 6580    W5=W5+C(23)+C(24)+C(25)+C(26)
  344.     GOSUB 5210
  345. 6600    F=0
  346.     GOSUB 5000
  347.     GOTO 6300
  348. 6660    IF F9=0 THEN 6700
  349. 6680    F=1
  350.     GOSUB 5000
  351.     GOSUB 5230
  352.     P(5)=W7 
  353.     OPEN "A/P0F130.DAT" AS 7
  354.     X0=7
  355.     GOSUB 3350                            REMARK    SAVE A/P INFORMATION RECORD
  356.     F9=0
  357.     CREATE "A/P0F030.PST" AS 1
  358.     PRINT #1;L2
  359. 6700    CONSOLE
  360.     PRINT CLEAR.SCREEN$;"A/P CHECK CALCULATE LOADING MENU"
  361.     CHAIN "A/P000"                            REMARK    CLOSE FILES AND LOAD MENU
  362.