home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug043.ark
/
A_P030.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
12KB
|
361 lines
REMARK #################################################
REMARK # A/P UPDATE PROGRAM (A/P030) #
REMARK # VERS. OF 11.20 AM 6/25/79 #
REMARK #################################################
%INCLUDE CURSOR
DIM C(27),D(27),B(6,5),C5(27),D5(27),G2$(5),G3(5),B1(2,6),Y(2),M$(5)
DIM P(5)
DEF FNF(X9)=X9-INT(X9/10)*10 REMARK STRIP OFF TENS DIGIT
GOTO 6000
DATA "INVOICE","DELETE","MODIFY","CREDIT MEMO","DEBIT MEMO"
%INCLUDE SUBS1
%INCLUDE GENINFO
%INCLUDE A/P-INFO
%INCLUDE BINSEARC
%INCLUDE READINV
%INCLUDE WRITEINV
%INCLUDE READVEND
%INCLUDE WRITEVND
.314 RETURN REMARK THESE LINE NUMBERS FOR G/L SUBROUTINES
.315 RETURN
3650 RETURN
825 IF LINE.COUNT%<55 THEN RETURN REMARK LINE PRINTER ROUTINE
PAGE.COUNT%=PAGE.COUNT%+1
PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";
X0=G3(1):GOSUB 680.5
PRINT
PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";PAGE.COUNT%
PRINT
IF LINE.COUNT%<>100 THEN\
PRINT " R# VENDOR INV # DESCRIPTION TRANSACTION ERROR"
PRINT
LINE.COUNT%=6
RETURN
REMARK CHECK EXISTENCE OF INVOICE RECORD FOR TRANSACTION
4100 IF J%=1 AND TRAN.KEY$=INV.KEY$ THEN \ REMARK RECORD SHOULD BE AND IS ON FILE
INVOICE.POINTER%=INVOICE.POINTER%+1:\
RETURN
IF J%=2 AND TRAN.KEY$<>INV.KEY$ THEN RETURN REMARK RECORD SHOULD NOT BE AND IS NOT ON FILE
4140 X4$="A/P UPDATE REPORT":A1=60:GOSUB 825 REMARK PRINT TRANSACTION ON ERROR REPORT
B1(2,A%)=B1(2,A%)+1
PRINT USING MASKA$;R%;W1$;W0;
PRINT TAB(23);W2$;TAB(37);
RESTORE
FOR I%=1 TO A%
READ A$
NEXT I%
PRINT A$;
IF J%=1 THEN PRINT TAB(50);"NOT ON FILE"
IF J%=2 THEN PRINT TAB(50);"DUPLICATE"
IF J%=3 THEN PRINT TAB(50);"DOUBLE TRANSACTION"
J%=0
LINE.COUNT%=LINE.COUNT%+1
RETURN
4200 IF I2<12 THEN \ REMARK ACCUMULATE G/L DISTRIBUTION TOTAL
B8=B8+C(I2):\
RETURN:\ REMARK SKIP IF G/L NOT IMPLEMENTED
P1=D(I2):\
P4=W0:\
P5=C(I2):\ REMARK ALSO, ADD TO G/L POSTING FILE
EXTERNAL.POSTING.EXTENT%=EXTERNAL.POSTING.EXTENT%+1:\
FILE.NO%=5:RECORD.NO%=EXTERNAL.POSTING.EXTENT%:GOSUB 3650\
ELSE\
B9=B9+C(I2) REMARK OR, ACCUMULATE JOB DISTRIBUTION TOTAL
RETURN
4300 PRINT USING MASKB$;P1; REMARK PRINT G/L POSTING, AND ADD TO G/L POSTING FILE
PRINT " ";D$;TAB(30);
PRINT USING MASKC$;P5
RETURN REMARK SKIP WITHOUT G/L PROGRAMS
P4=0
EXTERNAL.POSTING.EXTENT%=EXTERNAL.POSTING.EXTENT%+1
FILE.NO%=5:RECORD.NO%=EXTERNAL.POSTING.EXTENT%:GOSUB 3650
RETURN
REMARK ACCUMULATE TRANSACTION AMOUNTS TO G/L POSTING TOTALS
5000 IF W1%=4 THEN B(A%,1)=B(A%,1)+F*(C(23)+C(24)):RETURN REMARK FOR CREDIT MEMOS
FOR A1=1 TO 4 REMARK FOR INVOICES OR DEBIT MEMOS
IF C(22+A1)<>0 THEN B(A%,A1)=B(A%,A1)+F*C(22+A1)
NEXT A1
IF D(25)<>0 THEN \
D1=-(C(23)+C(24)+C(25)+C(26))*F:\
B2=B2+D1:\
B7=B7+D1
RETURN
REMARK RETRIEVE EXISTING INVOICE DATA
5300 READ #3,INVOICE.POINTER%-1; XX$,XX,YY$,ZZ$,W1%,F5,D5(1),D5(2),D5(3),\
D5(4),D5(5),D5(6),D5(7),D5(8),D5(9),D5(10),D5(11),D5(12),D5(13),\
D5(14),D5(15),D5(16),D5(17),D5(18),D5(19),D5(20),D5(21),D5(22),D5(23),\
D5(24),D5(25),D5(26),D5(27),C5(1),C5(2),C5(3),C5(4),C5(5),C5(6),\
C5(7),C5(8),C5(9),C5(10),C5(11),C5(12),C5(13),C5(14),C5(15),C5(16),\
C5(17),C5(18),C5(19),C5(20),C5(21),C5(22),C5(23),C5(24),C5(25),\
C5(26),C5(27)
RETURN
5400 IF W1%=4 THEN F=-F REMARK CHANGE SIGN OF "F" ON CREDIT MEMOS
RETURN
REMARK START OF MAINLINE CODE
6000 MASKA$="### / / ######"
MASKB$="#####.#"
MASKC$=" ########.##"
MASKD$="###"
OPEN "G/I0F010.DAT" AS 1, "A/P0F110.DAT" RECL 162 AS 2,\
"A/P0F120.DAT" RECL 580 AS 3, "A/P0F020.DAT" RECL 580 AS 4,\
"A/P0F130.DAT" AS 6
CREATE "WORKFILE.DAT" RECL 580 AS 7
Y9=1:GOSUB 700 REMARK RETRIEVE G/I FILE DATA
X0=6:GOSUB 3310 REMARK RETRIEVE A/P INFORMATION FILE DATA
P2=1 REMARK SET G/L POSTING SOURCE CODE
P3=(INT(G3(1)/100))/100 REMARK SET G/L POSTING DATE
INVOICE.POINTER%=1
6010 MAX.POSTING.RECORDS = 3600
6020 MAX.INVOICE.RECORDS = 100
E$=" "
W0$=" "
GOTO 6040 REMARK SKIP UNLESS G/L PROGRAMS IMPLEMENTED
OPEN "G/L0F020.DAT" RECL 36 AS 5,"G/L0F130.DAT" AS 8
GOSUB .314
6040 PRINT CLEAR.SCREEN$;"A/P UPDATE"
IF SORT%=0 THEN \
PRINT:PRINT:PRINT:\
PRINT"THE TRANSACTION FILE IS NOT SORTED. TRANSACTION":\
PRINT"PRINT MUST BE RUN BEFORE PROCEEDING WITH THE UPDATE"
PRINT CURSOR.HOME$
PRINT "KEY RETURN TO BEGIN; ENTER 'END' TO EXIT"
INPUT LINE A$
IF SORT%=0 AND A$="END" THEN CHAIN "A/P02A"
IF SORT%=0 THEN GOTO 6040
IF A$="END" THEN GOTO 6680
PRINT "PROCESSING...DO NOT INTERRUPT"
PRINT
LINE.COUNT%=66
LPRINTER
6080 IF EXTERNAL.POSTING.EXTENT%+DIRECT.POSTING.EXTENT% > \ REMARK CHECK FOR G/L POSTING FILE OVERFLOW
MAX.POSTING.RECORDS THEN E$="G/L"
IF R% THEN \ REMARK RESAVE THE TRANSACTION MARKED 'USED'
W2%=W2%+10:\
FILE.NO=4:X0%=R%:GOSUB 3050
IF E$<>" " THEN GOSUB 6740:GOTO 6540
R%=R%+1 REMARK INCREMENT TRANSACTION FILE COUNTER
IF R%>TRANSACTION.RCD.COUNT% THEN 6540 REMARK BRANCH AT END OF TRANSACTION FILE
FILE.NO=4:X0%=R%:GOSUB 3000 REMARK RETRIEVE TRANSACTION RECORD
Y2=3
RECORD.COUNT=AP.INVOICE.EXTENT
XYZ$=W1$+" ":ZYX$="000000"+STR$(W0)
NEW.KEY$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
IF NEW.KEY$=TRAN.KEY$ THEN \ REMARK IF DUPLICATE TRANSACTION, PRINT ON ERROR REPORT
J%=3:\
GOSUB 4140:\
GOTO 6080
TRAN.KEY$=NEW.KEY$
IF AP.INVOICE.EXTENT=0 THEN INV.KEY$="ZZZZZZZZZZZZ"
IF INV.KEY$="ZZZZZZZZZZZZ" THEN 6100 REMARK IF THE LAST INVOICE RECORD HAS BEEN READ, BRANCH
K$=TRAN.KEY$
GOSUB 1060 REMARK LOCATE NEXT INVOICE RECORD
IF INVOICE.POINTER% > AP.INVOICE.EXTENT THEN \
INVOICE.POINTER% = INVOICE.POINTER% - 1
IF INVOICE.POINTER%=L THEN 6090 REMARK IF NEXT INVOICE HAS NOT CHANGED, BRANCH
FOR I%=INVOICE.POINTER% TO L-1
FILE.NO=3:X0%=I%:GOSUB 3000 REMARK COPY UNCHANGED INVOICES TO WORKFILE
INVOICE.POINTER%=INVOICE.POINTER%+1
IF W1%=-1 THEN 6085
GOSUB 6900
6085 NEXT I%
IF E$<>" " THEN GOSUB 6740:GOTO 6540
IF L>AP.INVOICE.EXTENT THEN INV.KEY$="ZZZZZZZZZZZZ":GOTO 6095
6090 FILE.NO=3:X0%=INVOICE.POINTER%:GOSUB 3000 REMARK READ NEXT INVOICE FROM INVOICE FILE
XYZ$=W1$+" ":ZYX$="000000"+STR$(W0)
INV.KEY$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
IF W1%=-1 AND INV.KEY$=TRAN.KEY$ THEN 6080
6095 FILE.NO=4:X0%=R%:GOSUB 3000 REMARK RE-LOAD TRANSACTION DATA
6100 CONSOLE
PRINT CURSOR.HOME$:PRINT:PRINT:PRINT"UPDATING: ";W1$;" ";W0
LPRINTER
IF W2%>9 THEN 6080 REMARK IF TRANSACTION IS VOID, SKIP IT
IF W2%=1 THEN A%=W1%\ REMARK SET COMPOSITE TRANSACTION TYPE AND OPERATION
ELSE A%=W2%
ON A% GOTO 6160,6360,6400,6160,6160 REMARK BRANCH ON TRANSACTION TYPE AND OPERATION
REMARK NEW INVOICE, CREDIT MEMO, OR DEBIT MEMO
6160 J%=2:GOSUB 4100 REMARK MAKE SURE INVOICE DOES NOT ALREADY EXIST
F=1
IF J%=0 THEN 6080 REMARK IF INVOICE ALREADY EXISTS, GET NEXT TRANSACTION
6180 GOSUB 6900 REMARK SAVE TRANSACTION ON WORKFILE
B1(1,A%)=B1(1,A%)+1
GOSUB 5400 REMARK CHANGE SIGNS, IF CREDIT MEMO
FOR I%=1 TO 22
IF C(I%)<>0 THEN C(I%)=C(I%)*F:I2=I%:GOSUB 4200 REMARK POST G/L EXPENSE ACCOUNT DISTRIBUTIONS
NEXT I%
6260 GOSUB 5000 REMARK ACCUMULATE OTHER G/L ACCOUNT POSTINGS
IF B7=0 THEN 6080 REMARK IF NO CHANGE IN VENDOR TOTALS, GET NEXT TRANSACTION
IF W0$=" " THEN 6280
IF W0$=W1$ THEN 6320 REMARK IF VENDOR HAS CHANGED...
X0$=W1$
W1$=W0$
Y9=2:X0=VENDOR.POINTER:GOSUB 3250 REMARK SAVE LAST VENDOR'S DATA
W1$=X0$
6280 XYZ$=W1$+" "
Y2=2
K$=LEFT$(XYZ$,6)
RECORD.COUNT=AP.VENDFILE.EXTENT
GOSUB 1060 REMARK LOCATE NEXT VENDOR'S DATA
IF H=-1 OR VAR1=0 THEN:\
W0$=" ":\
PRINT W1$;"NOT ON VENDOR FILE":\
GOTO 6340\
ELSE\
Y9=2:X0=L:GOSUB 3200:\ REMARK RETRIEVE NEXT VENDOR'S DATA
VENDOR.POINTER=L:\
W0$=W1$
6320 Y(2)=Y(2)-B7:D=D(23)
6340 B7=0
GOTO 6080
REMARK OPERATION IS DELETE
6360 J%=1:GOSUB 4100 REMARK MAKE SURE INVOICE ALREADY EXISTS
F=-1
IF J%=0 THEN 6080 REMARK IF INVOICE DOES NOT EXIST, GET NEXT TRANSACTION
GOSUB 5300 REMARK RETRIEVE INVOICE DATA
IF FNF(F5)=2 OR D5(25)<>0 THEN 6380 REMARK DO NOT DELETE AN ALREADY DELETED OR CLOSED INVOICE
IF W1%<>4 OR C(24)=0 THEN 6180
6380 J%=2
GOSUB 4140 REMARK PRINT TRANSACTION ON ERROR REPORT
GOTO 6080
REMARK OPERATION IS MODIFY
6400 J%=1:GOSUB 4100 REMARK MAKE SURE INVOICE ALREADY EXISTS
IF J%=0 THEN 6080 REMARK IF IT DOES NOT, GET NEXT TRANSACTION
F=1
GOSUB 5300 REMARK RETRIEVE INVOICE DATA
IF FNF(F5)=2 THEN 6180 REMARK IF THE INVOICE IS DELETE-FLAGGED,\
THE TRANSACTION EFFECTIVELY BECOMES A NEW INVOICE
GOSUB 5400 REMARK REVERSE SIGN, IF CREDIT MEMO
GOSUB 5000 REMARK ACCUMULATE TRANSACTION TOTALS TO G/L POSTING AMOUNTS
GOSUB 6900 REMARK SAVE TRANSACTION ON WORKFILE
B1(1,A%)=B1(1,A%)+1
IF W1%=4 THEN \
FOR I%=1 TO 22:\
C(I%)=-C(I%):\
C5(I%)=-C5(I%):\
NEXT I%
FOR I%=1 TO 22 REMARK ADJUST G/L DISTRIBUTIONS IF THEY HAVE BEEN MODIFIED
IF D(I%)=D5(I%) THEN 6480
I2=I%:GOSUB 4200
D(I%)=D5(I%)
C(I%)=-C5(I%)
GOTO 6520
6480 C(I%)=C(I%)-C5(I%)
IF C(I%)<>0 THEN I2=I%:GOSUB 4200
6520 NEXT I%
FOR I%=1 TO 4 REMARK BACK OUT OLD INVOICE AMOUNTS FROM TOTALS
C(22+I%)=C5(22+I%)
NEXT I%
D(25)=D5(25)
F=-1
GOSUB 5400
GOTO 6260
REMARK END OF PROGRAM - PRINT TOTALS
6540 IF INVOICE.POINTER% >= AP.INVOICE.EXTENT THEN 6555
FOR I%=INVOICE.POINTER% TO AP.INVOICE.EXTENT REMARK COPY THE REST OF THE INVOICE FILE TO THE WORKFILE
FILE.NO=3:X0%=I%:GOSUB 3000
INVOICE.POINTER%=INVOICE.POINTER%+1
IF W1%<>-1 THEN GOSUB 6900
NEXT I%
6555 IF E$<>" " THEN GOTO 6560
DELETE 4 REMARK ERASE TRANSACTION FILE
CREATE "A/P0F020.DAT" RECL 580 AS 4
TRANSACTION.RCD.COUNT%=0
6560 CLOSE 7 REMARK CLOSE WORKFILE BEFORE RENAMING
DELETE 3 REMARK ERASE INVOICE FILE
A=RENAME ("A/P0F120.DAT","WORKFILE.DAT")
CLOSE 6
OPEN "A/P0F130.DAT" AS 6
AP.INVOICE.EXTENT=OUTPUT.COUNT%
X0=6:GOSUB 3350
LPRINTER
LINE.COUNT%=100
B6=0:B4=0
IF W0$<>" " THEN W1$=W0$:Y9=2:X0=VENDOR.POINTER:GOSUB 3250 REMARK SAVE FINAL VENDOR'S DATA
X4$="A/P UPDATE REPORT":A1=115:GOSUB 825
PRINT:PRINT:PRINT TAB(61);"AMOUNT DISCOUNT ";
PRINT " FREIGHT TAXES TOTAL ERRORS"
RESTORE
FOR B0=1 TO 5
READ X0$
PRINT TAB(12);
PRINT USING MASKD$;B1(1,B0);
PRINT " ";
PRINT X0$;" TRANSACTIONS";TAB(55);
B6=B6+B1(1,B0)
B5=0
FOR I%=1 TO 4
PRINT USING MASKC$;B(B0,I%);
B(6,I%)=B(6,I%)+B(B0,I%)
B5=B5+B(B0,I%)
NEXT I%
PRINT USING MASKC$;B5;
PRINT " ";B1(2,B0)
NEXT B0
PRINT:PRINT:PRINT TAB(12);
PRINT USING MASKD$;B6;
PRINT " TRANSACTIONS";TAB(55);
FOR I%=1 TO 4
PRINT USING MASKC$;B(6,I%);
B4=B4+B(6,I%)
NEXT I%
PRINT USING MASKC$;B4
PRINT:PRINT:PRINT TAB(9);"G/L POSTINGS":PRINT REMARK PRINT G/L TOTALS, AND ADD TO G/L POSTING FILE
W0=0
P1=2:P5=B2:D$="CASH":GOSUB 4300
P1=2020:P5=B4+B2:D$="ACCT PAYABLE":GOSUB 4300
PRINT TAB(9);"ALL OTHERS";TAB(30);
PRINT USING MASKC$;B8
PRINT:PRINT:PRINT "TOTAL JOB POSTINGS";TAB(30);
PRINT USING MASKC$;B9
GOTO 6680 REMARK IF G/L NOT IMPLEMENTED, SKIP
CLOSE 8 REMARK SAVE CHANGED G/L EXTENT INFORMATION
OPEN "G/L0F130.DAT" AS 8
FILE.NO%=8:GOSUB .315
6680 CONSOLE
PRINT CLEAR.SCREEN$;"A/P UPDATE LOADING MENU"
CHAIN "A/P000"
6740 CONSOLE
PRINT "PROGRAM TERMINATED DUE TO ";E$;
PRINT " FILE FILLED TO LIMIT."
PRINT "ENTER 'RETURN' TO CONTINUE"
6741 IF CONSTAT% THEN PRINT:RETURN ELSE GOTO 6741
6900 OUTPUT.COUNT%=OUTPUT.COUNT%+1 REMARK SUBROUTINE TO ADD A RECORD TO THE WORKFILE
IF OUTPUT.COUNT% + AP.INVOICE.EXTENT - INVOICE.POINTER% >= \
MAX.INVOICE.RECORDS - 1 THEN E$="INVOICE"
FILE.NO=7
X0%=OUTPUT.COUNT%
GOSUB 3050
RETURN