CP/M/CPM_CDROM.iso/simtel/cpmug/cpmug043.ark/A_P040.BAS

BASIC Source File | 1984-04-29 | 10.6 KB | 362 lines

    REMARK    ****************************************\
        *  A/P040.BAS   A/P CHECK CALCULATE    *\
        *     6/18/79            5:10 PM       *\
        ****************************************


    DIM G2$(5),G3(5),C(27),D(27),M$(5),A$(25),A1$(25,25),P(6),Y(2)
    DATA 0,3,3,6,8,11,13,16,19,21,24,26
%INCLUDE CURSOR
    DEF FNA(Z)=100 *(Z/100 - INT(Z - 100))
    GOTO 6000
%INCLUDE SUBS1
%INCLUDE GENINFO
%INCLUDE BINSEARC
%INCLUDE READVEND
%INCLUDE WRITEVND
%INCLUDE READINV
%INCLUDE WRITEINV
%INCLUDE A/P-INFO
3650    RETURN                                REMARK    THESE LINES FOR G/L SUBROUTINES
.314    RETURN
.315    RETURN


4000    REMARK  *********   DATE SUBTRACTION ROUTINE   *********\
        (THIS ROUTINE SUBTRACTS THE DATE IN  I  FROM THE\
         IMAGINARY DATE  "00/00/00")
    YEAR=100*((I/100)-INT(I/100))
    DAY=100*((I-YEAR)/10000-INT((I-YEAR)/10000))
    MONTH=(I-(100*DAY-YEAR))/10000

    IF MONTH=0 OR MONTH > 12 THEN A4=0:RETURN
    RESTORE
    FOR I%=1 TO MONTH:READ A4:NEXT I%                REMARK    READ DATA TABLE
    A4=A4+YEAR*365+INT(YEAR/4)+1+(MONTH-1)*28+DAY
    IF INT(YEAR/4) <> YEAR/4 THEN RETURN
    IF MONTH <= 2 THEN A4=A4-1

    RETURN
    REMARK    *******************************************************


4150    REMARK    ********** DAYS BETWEEN TWO DATES SUBROUTINE **********\
        THIS ROUTINE CALCULATES DAYS BETWEEN DATES IN I3 AND\
        J2.  ANSWER (IN DAYS) IS PASSED BACK IN A.

    I=I3:GOSUB 4000
    A=A4
    I=J2:GOSUB 4000
    A=A-A4
    RETURN
    REMARK    *****************************************************


4200    REMARK    ********** INVOICE NUMBER ENTRY **********\
        ENTER INVOICE NUMBERS FOR THE K1'ST CHECK.

    XYZ$=X0$+"      "
    X0$=LEFT$(XYZ$,6)
    A$(K1)=X0$                            REMARK    SAVE VENDOR NUMBER
    FOR J%=1 TO 25
    A1$(K1,J%)=""                            REMARK    SET INVOICE NUMBERS TO NULL STRINGS
    NEXT J%
    IF LEN(X0$)=0 THEN GOTO 4280                    REMARK    IF BLANK VENDOR #, BRANCH
    GOSUB 5450
    X1=456:GOSUB 210
    PRINT "ENTERING INVOICES TO PAY FOR VENDOR ";A$(K1);TAB(64)
4220    REMARK    ********** ENTER UP TO 25 INVOICE NUMBERS & ALLOW CHANGES **********

    FOR K2=1 TO 25
    GOSUB 5480
    IF X0=0 THEN K2=25
    NEXT K2
4240    GOSUB 5500
    IF X0=0 THEN 4280
    K2=X0+I*5
    GOSUB 5480
    GOTO 4240


4280    REMARK    ********** RE-DISPLAY GRID WITH ALL VENDOR #'S ENTERED SO FAR FOR CHECK CALCULATION **********
    GOSUB 5450
    PRINT CURSOR.HOME$:PRINT:PRINT TAB(64):PRINT TAB(64)
    X1=465:GOSUB 210
    PRINT "ENTERING VENDOR NUMBERS TO PAY"
    PRINT
    K2=0
    FOR I1%=1 TO 5
    PRINT LEFT$(X9$,3);
    FOR I%=1 TO 5
    K2=K2+1
    IF LEN(A$(K2)) <> 0 THEN \
        PRINT LEFT$(X9$,4);:\
        PRINT USING "/2345/";A$(K2);
    NEXT I%
    PRINT
    NEXT I1%
    RETURN


5000    IF F=0 AND W5 <= 0 AND W1% = 4 THEN RETURN            REMARK    IF DETAIL RECORD IS A LONE CREDIT MEMO,
                                    REMARK    RETURN WITHOUT WRITING A RECORD.
    IF F=0 THEN GOTO 5160                        REMARK    IF DETAIL PROCESSING FLAG IS SET, WRITE DETAIL CHECK RECORD.
    IF W9=0\                            REMARK    IF NO DETAIL RECORDS WERE WRITTEN FOR THIS CHECK,
    OR W5 <= 0 THEN \                        REMARK    OR CHECK AMOUNT IS NOT POSTIIVE,
        CHECKS%=HDR%:HDR%=0:\                    REMARK    SKIP WRITING HEADER AND RESET LOGICAL EOF
        RETURN
    PRINT #4, HDR%; K1$, W7, W5, A8, W9
    HDR%=0
    XYZ$=W1$+"      "
    K$=LEFT$(XYZ$,6)
    RECORD.COUNT=AP.VENDFILE.EXTENT
    Y2=2
    GOSUB 1060                            REMARK    SEARCH FOR VENDOR RECORD
    IF H=-1 OR VAR1=0 THEN 5130
    X0=L:Y9=2:GOSUB 3200                        REMARK    READ THE VENDOR RECORD
5110    Y(2)=Y(2)+W5                            REMARK    ADD CHECK AMOUNT TO VENDOR ACTIVITY TOTAL
    L2=L2-W5                            REMARK    SUBTRACT CHECK AMOUNT FROM G/L CASH ACCOUNT
    D=A8
    GOSUB 3250                            REMARK    RE-WRITE THE VENDOR RECORD
5130    F=0:W5=0:W9=0
    W7=W7+1
    RETURN


5160                                    REMARK    WRITE CHECK DETAIL RECORD

    IF HDR%=0 THEN HDR%=CHECKS%:CHECKS%=CHECKS%+1
    W9=W9+1                                REMARK    INCREMENT DETAIL COUNTER
    PRINT #4,CHECKS%; W2$,W1%,D(23),W0,C(23),C(24),C(25),C(26)
    CHECKS%=CHECKS%+1                        REMARK    INCREMENT TOTAL CHECK FILE RECORD COUNT.
    CLOSE 4
    OPEN "A/P0F030.DAT" RECL 86 AS 4
    RETURN


5210    W2%=0                                REMARK    RESAVE INVOICE RECORD
    D(24)=A8
    D(25)=W7
    X0=INVOICES%:GOSUB 3050
    RETURN


5230    RETURN                                REMARK    SKIP UNLESS G/L PROGRAMS IMPLEMENTED
    X0=4
    P1=2020
    P2=1
    P3=INT(D1/100)/100
    P4=0
    P5=L2
    FILE.NO%=5:RECORD.NO%=EXTERNAL.POSTING.EXTENT%+1:GOSUB 3650
    P1=2
    RECORD.NO%=RECORD.NO%+1:GOSUB 3650
    EXTERNAL.POSTING.EXTENT%=EXTERNAL.POSTING.EXTENT%+2
    CLOSE 6
    OPEN "G/L0F130.DAT" AS 6
    FILE.NO%=6:GOSUB .315
    RETURN


5450    REMARK RE-DISPLAY GRID CONTENTS ON CRT
    X1=448:GOSUB 210
    PRINT TAB(64)
    PRINT
    FOR I%=1 TO 5
    PRINT USING "#";I%;:PRINT")";TAB(64)
    NEXT I%
    RETURN


5480    X1=572+14*INT((K2-1)/5)+10*K2:X2=6:X3=0:X4=999999        REMARK    ENTER INVOICE NUMBER IN GRID
    GOSUB 345
    IF X%=3 THEN GOTO 6700                        REMARK  IF CTRL-C WAS DEPRESSED, EXIT PROGRAM
    IF X0=0 THEN RETURN
    X0$="000000"+X0$                        REMARK    RIGHT-ADJUST INVOICE NUMBER
    A1$(K1,K2)=RIGHT$(X0$,6)
    RETURN

5500    X2=1:X3=0:X4=5
    X2$="ENTER ROW TO CHANGE (0 IF NONE)"
    GOSUB 665
    IF X0=0 THEN RETURN
    I=X0-1
    X2=1:X3=0:X4=5
    X2$="ENTER COLUMN TO CHANGE"
    GOSUB 665
    IF X0=0 THEN 5500
    RETURN


5600    X1=572+14*INT((K-1)/5)+10*K:X2=6:X3=0:X4=0:GOSUB 345        REMARK    ENTER VENDOR NUMBER
    IF X%=3 THEN GOTO 6700                        REMARK  EXIT PROGRAM IF CTRL-C DEPRESSED
    RETURN


                                    REMARK    START OF MAIN PROGRAM
6000    MAX.CHECKS%=100                            REMARK    SET PROCESSING LIMIT FOR CHECKS
    CTRL.C%=1
    Y9=1
    OPEN "G/I0F010.DAT" AS 1, "A/P0F110.DAT" RECL 162 AS 2,\
    "A/P0F120.DAT" RECL 580 AS 3, "A/P0F130.DAT" AS 4,\
    "CRT" RECL 1100 AS 19
    GOSUB 700                            REMARK    GET SYSTEM GENERAL INFORMATION
    X0=4:GOSUB 3310                            REMARK    READ A/P INFO FILE
    CLOSE 1,4
    FILE.NO=3                            REMARK    SET FILE NUMBER FOR A/P0F120.DAT
    X0=6:GOSUB 260                            REMARK    GET CRT MASK #6
    GOTO 6040
    OPEN "G/L0F020.DAT" RECL 36 AS 5
    OPEN "G/L0F130.DAT" AS 6                    REMARK    OPEN G/L INFO FILE
    FILE.NO%=6:GOSUB .314
    MAX.POSTINGS%=1000
    IF EXTERNAL.POSTING.EXTENT% > MAX.POSTINGS%\
    THEN\
    X2$="G/L POSTING FILE FULL":\
    GOSUB 615:\
    GOTO 6700
6040    X2=5:X3=0:X4=0:X2$="'CLEAR' OR 'SAVE' LAST CHECK RUN ('END' TO EXIT)?"
    GOSUB 665
    IF X0$="END" THEN 6700
    IF X0$="CLEAR" THEN GOTO 6059
    IF X0$ <> "SAVE" THEN GOTO 6040
    IF END #4 THEN 6059                        REMARK    SET DESTINATION FOR EOF
    OPEN "A/P0F030.DAT" RECL 86 AS 4
    IF END #4 THEN 6060
6045    READ #4; LINE X0$
    CHECKS%=CHECKS% + 1
    GOTO 6045
6059    IF CHECKS%=0 THEN CREATE "A/P0F030.DAT" RECL 86 AS 4
6060    IF CHECKS%=0 THEN CHECKS%=1
    IF CHECKS% > 1 THEN CHECKS% = CHECKS% -1
6070    PRINT CURSOR.HOME$:PRINT TAB(64):PRINT TAB(64)
    K=0
    X1=269:GOSUB 673                        REMARK    ENTER CHECK DATE
    A8=X0
    I3=G3(1):J2=A8:GOSUB 4150
    IF ABS(A) >= 7 THEN \                        REMARK    IF TOO FAR AHEAD OR BEHIND TODAY'S DATE
        X2$="TOO FAR AHEAD/BEHIND":\                REMARK    THEN REJECT CHECK DATE ENTERED.
        GOSUB 615:\
        GOTO 6070
6080    X1=339:X2=6:X3=0:X4=999999:GOSUB 345                REMARK    ENTER NUMBER OF HANDWRITTEN CHECKS
    W7=P(5)+X0                            REMARK    ADD THIS NUMBER TO NEXT CHECK REG #
    X1=369:GOSUB 210:PRINT W7                    REMARK    DISPLAY NEXT CHECK REG #
    K=0
6100    REMARK  **********  ENTER VENDOR/INVOICE GRID  **********

    IF K >= 25 THEN GOTO 6140
    K=K+1
    GOSUB 5600                            REMARK    ENTER VENDOR NUMBER IN GRID
    IF LEN(X0$) = 0 AND K=1 THEN \                    REMARK    IF FIRST GRID ENTRY IS A BLANK VENDOR,
        X1=411:X2=6:X3=0:X4=0:GOSUB 345:\            REMARK    PROMPT FOR VENDOR NUMBER RANGE.
        A2$=X0$:\
        X1=432:X2=6:X3=0:X4=0:GOSUB 345:\
        X0$=X0$+"      ":\
        A3$=LEFT$(X0$,6):\
        A$(1)="":\                        REMARK    RESET FIRST GRID VENDOR TO NULL VALUE
        GOTO 6180
    IF LEN(X0$) > 0 THEN \                        REMARK    IF VENDOR # WAS ENTERED, PROCESS INVOICE GRID.
        K1=K:GOSUB 4200:\
        GOTO 6100


6140    GOSUB 5500
    IF X0 > 0 THEN \                        REMARK    IF VALID FIELD NUMBER ENTERED, ALLOW CHANGES TO GRID
        K=X0+5*I:\
        GOSUB 5600:\
        K1=K:\
        GOSUB 4200:\
        GOTO 6140
6180    X2=1:X3=0:X4=1
    X2$="ENTRY CORRECT?"
    GOSUB 665
    IF X0 <> 1 THEN 6060

6200    PRINT CURSOR.HOME$
    PRINT
    PRINT "PROCESSING . . . DO NOT INTERRUPT"
    F9=1                                REMARK    SET FLAG FOR PROGRAM START
6220    IF LEN(A$(1)) > 0 THEN K=0:GOTO 6240                REMARK    IF GRID WAS USED, BRANCH TO GET FIRST VENDOR
    RECORD.COUNT=AP.INVOICE.EXTENT
    Y2=3
    XYZ$=A2$+"      "
    A2$=LEFT$(XYZ$,6)
    K$=A2$+"000000"
    GOSUB 1060                            REMARK    SEARCH INVOICE FILE FOR FIRST RECORD IN RANGE.
    INVOICES%=L-1
    GOTO 6320                            REMARK    BRANCH TO "VENDOR RANGE" ROUTINE
6240    K=K+1
    IF K=26 THEN GOTO 6680
    IF LEN(A$(K)) = 0 THEN GOTO 6680                REMARK    IF NO MORE VENDORS IN GRID, EXIT PROGRAM
    K1$=A$(K)                            REMARK    SET CURRENT VENDOR NUMBER IN K1$
    K1=0
6260    K1=K1+1
    IF K1=26 THEN 6440
    IF LEN(A1$(K,K1)) = 0 THEN 6440                    REMARK    IF NO MORE INVOICES FOR THIS VENDOR,\
                                    REMARK    THEN WRITE CHECK HEADER RECORD
6280    XYZ$=K1$+"      ":ZYX$="000000"+A1$(K,K1)
    K$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
    RECORD.COUNT=AP.INVOICE.EXTENT
    Y2=3
    GOSUB 1060                            REMARK    SEARCH INVOICE FILE
    IF H=-1 THEN GOTO 6260                        REMARK    IF INVOICE NOT FOUND, GET NEXT GRID ENTRY
    X0%=L
    GOTO 6340
6300    IF LEN(A$(1)) > 0 THEN 6260
    IF K1$ > A3$ THEN GOTO 6680                    REMARK    IF CURRENT VENDOR IS PAST VENDOR RANGE,\
                                        THEN BRANCH TO END OF PROGRAM.
6320    INVOICES%=INVOICES% + 1
    IF INVOICES% > AP.INVOICE.EXTENT THEN GOTO 6680            REMARK    IF END OF FILE, END PROCESSING.
    X0%=INVOICES%
6340    GOSUB 3000                            REMARK    READ INVOICE RECORD
    IF W2%-INT(W2%/10)*10 = 2 THEN 6300            REMARK    IF INVOICE RECORD WAS DELETE-FLAGGED,
    IF W1% <> 4 THEN 6420                        REMARK    OR INVOICE IS A CREDIT MEMO AND CHECK AMOUNT IS $0.00,
    IF C(23)+C(24)=0 THEN 6300                    REMARK    THEN GET THE NEXT INVOICE RECORD.
    IF W5=0 THEN 6300
6420    IF D(25) <> 0 THEN GOTO 6300
    IF LEN(K1$)=0 THEN 6500
    IF K1$=W1$ THEN 6520
6440    F=1
    GOSUB 5000
    IF CHECKS% > MAX.CHECKS% THEN\
        PRINT "CHECK FILE FULL":\
        PRINT "PRINT ALL CHECKS":\
        PRINT "RERUN CALCULATE":\
        PRINT "PRESS <RETURN> TO EXIT":\
        INPUT "";LINE X0$:\
        GOTO 6660
    IF LEN(A$(1)) > 0 THEN 6240                    REMARK    IF PROCESSING BY GRID, GET NEXT VENDOR ENTRY
    IF W1$ > A3$ THEN 6680                        REMARK    IF CALCULATING CHECKS BY RANGE, GET NEXT INVOICE
6500    K1$=W1$
6520    X1=448:GOSUB 210
    PRINT "PROCESSING ";W1$,W0;TAB(63)
    IF W1%<>4 THEN 6580                        REMARK    APPLY CREDIT MEMO TO POSITIVE CHECK AMOUNT.
    C1=C(23)+C(24)
    IF C1>W5 THEN C1=W5
    W5=W5-C1
    C(24)=C(24)-C1                            REMARK    TOTAL USED STORED AS NEGATIVE BALANCE
    C(25)=C(25)+C1
    GOSUB 5210
    C(23)=-C1                            REMARK    ADJUST FIELDS SO CREDIT AMOUNTS WILL
    C(24)=0:C(25)=0                            REMARK    APPEAR IN PROPER CHECK DETAIL FIELDS
    GOTO 6600
6580    W5=W5+C(23)+C(24)+C(25)+C(26)
    GOSUB 5210
6600    F=0
    GOSUB 5000
    GOTO 6300
6660    IF F9=0 THEN 6700
6680    F=1
    GOSUB 5000
    GOSUB 5230
    P(5)=W7
    OPEN "A/P0F130.DAT" AS 7
    X0=7
    GOSUB 3350                            REMARK    SAVE A/P INFORMATION RECORD
    F9=0
    CREATE "A/P0F030.PST" AS 1
    PRINT #1;L2
6700    CONSOLE
    PRINT CLEAR.SCREEN$;"A/P CHECK CALCULATE LOADING MENU"
    CHAIN "A/P000"                            REMARK    CLOSE FILES AND LOAD MENU