home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug043.ark
/
A_P010.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
13KB
|
420 lines
REMARK **********************************************
REMARK * ACCOUNTS PAYABLE TRANSACTION ENTRY PRGM *
REMARK * (A/P010.BAS) VERS OF 4 PM 1/30/78 *
REMARK **********************************************
DIM C(27),D(27),W$(5),M$(5),A3$(10),P(6),Y(2)
%INCLUDE CURSOR
DATA "INVOICE"," "," ","CR MEMO","DB MEMO","NEW","DELETE",\
"MODIFY"
RESTORE
FOR I%=1 TO 8: READ A3$(I%): NEXT I%
MASKA$=" ######.##"
MASKB$="######"
MASKC$="######.# #######.## "
MASKD$="##) ###### #######.##"
DEF FNR(Z9)=(INT(ABS(Z9)*100+.5)/100)*SGN(Z9) REMARK ROUND TO NEAREST CENT
DEF FND(Z9)=FNR(Z9)*SGN(D2) REMARK USED IN G/L & JOB POSTING AMOUNT VERIFICATIONS
GOTO 6000
%INCLUDE SUBS1
%INCLUDE BINSEARC
%INCLUDE READINV
%INCLUDE WRITEINV
%INCLUDE READVEND
%INCLUDE A/P-INFO
10.60 RETURN REMARK THIS SPACE FOR G/L BINARY SEARCH ROUTINE
.314 RETURN REMARK THIS SPACE FOR G/L EXTENT INFORMATION READ ROUTINE
5000 PRINT CLEAR.SCREEN$;"A/P TRANSACTION ENTRY"
RETURN
5010 IF F=0 OR F>9 THEN GOTO 5040 REMARK BRANCH TO ENTER DATA IN FIELD "F"
ON F GOTO 5040,5050,5060,5070,5080,5090,5100,5110,5120
5040 X1=462:X2=8:X3=0:X4=0:GOSUB 345 REMARK ENTER PURCHASE ORDER NO.
W2$=X0$
RETURN
5050 X1=526:X2=2:X3=0:X4=0:GOSUB 345 REMARK ENTER BUYER
W3$=X0$
RETURN
5060 X1=590:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER CHECK REGISTER NO.
D(25)=X0
RETURN
5070 X1=654:GOSUB 673 REMARK ENTER INVOICE DATE
PRINT
D(23)=X0
RETURN
5080 X1=718:GOSUB 673 REMARK ENTER AGE DATE
PRINT
D(24)=X0
RETURN
5090 IF W1%=4 THEN 5150 REMARK ENTER INVOICE OR DEBIT MEMO AMOUNT
X1=430:X2=9:X3=0:X4=999999.99:GOSUB 345
C(23)=X0
X1=429:GOSUB 210
PRINT USING MASKA$;C(23)
GOSUB 5140
RETURN
5100 X1=498:X2=5:X3=0:X4=100:GOSUB 345 REMARK ENTER DISCOUNT RATE
X1=493:GOSUB 210
C(27)=X0
PRINT USING MASKA$;C(27)
GOSUB 5140
RETURN
5110 X1=622:X2=9:X3=0:X4=999999.99:GOSUB 345 REMARK ENTER FREIGHT AMOUNT
C(25)=FNR(X0)
X1=621:GOSUB 210
PRINT USING MASKA$;C(25)
GOSUB 5140
RETURN
5120 X1=686:X2=9:X3=0:X4=999999.99:GOSUB 345 REMARK ENTER TAX AMOUNT
C(26)=FNR(X0)
X1=685:GOSUB 210
PRINT USING MASKA$;C(26)
GOSUB 5140
RETURN
5140 C(24)=-1*FNR((C(23)*C(27))/100) REMARK RECALCULATE AND DISPLAY DISCOUNT AMOUNT
X1=557:GOSUB 210
PRINT USING MASKA$;C(24)
GOTO 5215
5150 X1=494:X2=9:X3=-1*C(24):X4=999999.99:GOSUB 345 REMARK ENTER CREDIT MEMO AMOUNT
C(23)=FNR(X0)
X1=494:GOSUB 210
PRINT USING MASKA$;C(23)
GOTO 5230
REMARK DISPLAY TRANSACTION MASK AND VALUES
5200 IF W1%=4 THEN 5220 REMARK CREDIT MEMO TRANSACTIONS AT LINE 5220
X0=2:GOSUB 260
GOSUB 5375
GOSUB 5250
IF N=1 THEN RETURN REMARK DON'T DISPLAY IF NEW TRANSACTION
X1=493:GOSUB 210
PRINT USING MASKA$;C(27)
FOR A1%=24 TO 26
PRINT LEFT$(X9$,45); REMARK PRINT NON-DESTRUCTIVE SPACES
PRINT USING MASKA$;C(A1%)
NEXT A1%
5215 X1=749:GOSUB 210
PRINT USING MASKA$;C(23)+C(24)+C(25)+C(26)
N1=1
RETURN
REMARK DISPLAY CREDIT MEMO TRANSACTIONS
5220 X0=13:GOSUB 260 REMARK GET CRT MASK #13
GOSUB 5375
GOSUB 5250
IF N=1 THEN RETURN
X1=558:GOSUB 210
PRINT USING MASKA$;C(24)
X1=622:GOSUB 210
PRINT USING MASKA$;C(25)
5230 X1=686:GOSUB 210
PRINT USING MASKA$;C(23)+C(24)
N1=1
RETURN
5250 X1=266:GOSUB 210 REMARK DISPLAY VENDOR DATA
PRINT W1$
X1=7:GOSUB 215
PRINT M$(2)
X1=15:GOSUB 215
PRINT USING MASKB$;W0
IF N=1 THEN PRINT:RETURN REMARK DON'T DISPLAY UNENTERED VALUES
X1=15:GOSUB 215
PRINT W2$
IF W1%=4 THEN X1=494 \
ELSE X1=429
GOSUB 210
PRINT USING MASKA$;C(23)
X1=527:GOSUB 210
PRINT W3$
X1=15:GOSUB 215
PRINT USING MASKB$;D(25)
X1=15:GOSUB 215
X0=D(23):GOSUB 680.5:PRINT
X1=15:GOSUB 215
X0=D(24):GOSUB 680.5:PRINT
RETURN
5375 X1=40:GOSUB 210 REMARK DISPLAY TYPE AND OPERATION DESCRIPTIONS
PRINT A3$(W2%+5);" ";A3$(W1%),""
RETURN
REMARK THIS ROUTINE CONTROLS THE SEQUENTIAL ENTRY OF \
G/L AND JOB POSTING AMOUNTS FOR INVOICE CREATION.
5400 FOR I%=G TO G1
GOSUB 5410
IF D(I%)=0 THEN RETURN
NEXT I%
RETURN
5410 IF I%>11 THEN 5450
X1=(I%-1)*64+326:X2=7:X3=0:X4=99999.9:GOSUB 345 REMARK ENTER G/L NUMBER
D(I%)=X0
IF X0=0 THEN 5445
GOTO 5440 REMARK BYPASS THIS SECTION UNLESS G/L PROGRAMS INSTALLED
5420 REMARK INSERT G/L POSTING INQUIRY ROUTINES HERE...
Y2=5
K1=X0
GOSUB 10.60
IF H <> -1 THEN RETURN
X2$="INVALID G/L ACCOUNT NO.":GOSUB 615
GOTO 5410
5440 X1=(I%-1)*64+338:X2=10:X3=-999999.99:X4=999999.99:GOSUB 345 REMARK ENTER DISTRIBUTION AMOUNT
X0=FNR(X0)
5445 D1=D1+X0-C(I%) REMARK ACCUMULATE G/L AMOUNT TO TOTAL \
AND DISPLAY ACCOUNT AND AMOUNT
C(I%)=X0
X1=(I%-1)*64+325:GOSUB 210
PRINT USING MASKC$;D(I%),C(I%)
RETURN
5450 X1=(I%-12)*64+358:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER JOB NUMBER
D(I%)=X0
IF X0<>0 THEN \ REMARK ENTER DISTRIBUTION AMOUNT
X1=(I%-12)*64+371:X2=10:X3=-999999.99:X4=999999.99:GOSUB 345:\
X0=FNR(X0)
D2=D2+X0-C(I%) REMARK ACCUMULATE JOB AMOUNT TO TOTAL
C(I%)=X0
X1=(I%-12)*64+350:GOSUB 210
PRINT USING MASKD$;I%,D(I%),C(I%) REMARK DISPLAY ACCOUNT AND AMOUNT
RETURN
5460 IF W1%=4 THEN D0=C(23)\ REMARK CALCULATE TOTAL
ELSE D0=C(23)+C(24)+C(25)+C(26)
IF FND(D1)<>D2 THEN 5465 REMARK CHECK G/L AND JOB TOTALS AND DISTRIBUTION
IF D1+D2<>FNR(D0) + FND(D0) THEN 5465
PRINT CURSOR.HOME$;
PRINT:PRINT:PRINT
PRINT TAB(64);
IF N1<=1 THEN RETURN
N1=0
GOTO 5460
5465 IF N1=1 THEN \ REMARK ROUTINE TO CORRECT OUT-OF-BALANCE DISTRIBUTION
N1=2:\
GOSUB 5520:\
F=0
5470 IF D1<>D0 THEN 5480
X0=39:X0$="JOB":X2=D0-D2:GOSUB 5490 REMARK USE SUBROUTINES TO CORRECT JOB TOTALS
IF D2 <> FND(D0) THEN 5470
PRINT CURSOR.HOME$;
PRINT:PRINT:PRINT
PRINT TAB(64)
GOTO 5460
5480 X0=6:X0$="G/L":X2=D0-D1:GOSUB 5490 REMARK USE SUBROUTINES TO CORRECT G/L TOTALS
IF D1<>D0 THEN 5480
GOTO 5460
5490 IF X2=0 THEN RETURN REMARK THIS SUBROUTINE DISPLAYS \
G/L OR JOB POSTING DISCREPANCY AMOUNTS
X1=192:GOSUB 210
PRINT TAB(X0);X0$;" DIST OFF";
PRINT USING MASKA$;X2;TAB(64)
N1=2
GOSUB 5950
RETURN
5520 IF N1+F=5 THEN RETURN REMARK REDISPLAY G/L AND JOB DISTRIBUTION MASK AND TOTALS
X0=3:GOSUB 260
GOSUB 5375
X1=320:GOSUB 210
FOR I%=1 TO 11
X1=6:GOSUB 215
IF D(I%)=0 THEN X1=26:GOSUB 215\
ELSE\
PRINT USING MASKC$;D(I%),C(I%);
IF D(I%+11)>0 THEN PRINT USING MASKD$; I%+11,D(I%+11),C(I%+11)\
ELSE PRINT
NEXT I%
IF F=3 THEN 5950
RETURN
5550 X0=W2%
X0%=L
FILE.NO=2:GOSUB 3000 REMARK GET INVOICE RECORD FROM A/P0F120
D1=C(1)+C(2)+C(3)+C(4)+C(5)+C(6)+C(7)+C(8)+C(9)+C(10)+C(11)
D2=C(12)+C(13)+C(14)+C(15)+C(16)+C(17)+C(18)+C(19)+C(20)+C(21)+C(22)
W2%=X0
IF W1%=4 THEN F1=6 \
ELSE F1=9
RETURN
5600 TRANSACTION.RCD.COUNT%=TRANSACTION.RCD.COUNT%+1 REMARK SAVE TRANSACTION ON TRANSACTION FILE
FILE.NO=3
X0%=TRANSACTION.RCD.COUNT%
GOSUB 3050 REMARK WRITE TRANSACTION RCD TO A/P0F020
REMARK THIS FILE MUST BE CLOSED AND RE-OPENED IN \
ORDER TO APPEND TO IT AND MAINTAIN \
PROPER FILE INFORMATION ON THE FCB.
CLOSE 3,4
OPEN "A/P0F020.DAT" RECL 580 AS 3, "A/P0F130.DAT" AS 4
X2$="RECORDED":GOSUB 615
SORT%=0
X0=4: GOSUB 3350
IF TRANSACTION.RCD.COUNT% < MAX.TRANSACTION.RCDS% THEN RETURN\
ELSE\ REMARK ABEND THE PROGRAM, CLOSE THE FILE, CHAIN THE MENU
PRINT CLEAR.SCREEN$;"TRANSACTION FILE FULL - RUN A/P UPDATE":\
PRINT "KEY <RETURN> TO EXIT":INPUT ""; LINE X0$:\
GOTO 6400
5700 X2$="TRANSACTION CANCELLED" REMARK IGNORE LAST ENTERED TRANSACTION
GOSUB 615
RETURN
5800 GOSUB 5200 REMARK REDISPLAY TRANSACTION MASK AND VALUES. ALLOW CHANGES
GOSUB 5900
RETURN
5900 X2=1:X3=0:X4=F1:X2$="ENTER FIELD TO CHANGE(0=NONE)":GOSUB 665 REMARK ALLOW CHANGES TO FIELDS ON THE INVOICE SCREEN
F=X0
IF F=0 THEN RETURN
GOSUB 5010
GOTO 5900
5950 X2=2:X3=0:X4=22:X2$="ENTER FIELD TO CHANGE(0=NONE)":GOSUB 665 REMARK ALLOW CHANGES TO G/L AND JOB DISTRIBUTION FIELDS
IF X0=0 THEN RETURN
I%=X0
GOSUB 5410
IF N1=2 THEN RETURN
GOTO 5950
REMARK START OF MAIN PROGRAM
6000 OPEN "A/P0F110.DAT" RECL 162 AS 1 REMARK OPEN VENDOR FILE
OPEN "A/P0F120.DAT" RECL 580 AS 2 REMARK OPEN INVOICE FILE
OPEN "A/P0F020.DAT" RECL 580 AS 3 REMARK OPEN TRANSACTION FILE
OPEN "A/P0F130.DAT" AS 4 REMARK OPEN A/P INFORMATION FILE
OPEN "CRT" RECL 1100 AS 19
X0=4
GOSUB 3310 REMARK GET A/P GENERAL INFORMATION
MAX.TRANSACTION.RCDS%=200 REMARK SET MAXIMUM FILE LENGTH FOR TRANSACTION FILE
GOTO 6100 REMARK SKIP OPENING G/L FILE FOR NOW
OPEN "G/L0F110.DAT" RECL 157 AS 5
OPEN "G/L0F130.DAT" AS 6
FILE.NO%=6:GOSUB .314 REMARK RETRIEVE G/L EXTENT INFORMATION
6100 GOSUB 5000 REMARK DISPLAY PROGRAM TITLE
X2=1:X3=0:X4=5:X2$="OPERATION 0=EXIT; 1=NEW INV; 2=DEL; 3=MOD;" REMARK REQUEST OPERATION CODE AND BRANCH TO APPROPRIATE AREA
X2$=X2$+" 4=CREDIT; 5=DEBIT"
GOSUB 665
W1%=X0
W2%=W1%
IF X0=0 THEN 6400
IF X0=2 OR X0=3 THEN GOTO 6120
W2%=1
IF W1%=4 THEN F1=6 \
ELSE F1=9
6120 F=0
6160 GOSUB 5000 REMARK DISPLAY PROGRAM TITLE
GOSUB 5375 REMARK DISPLAY TYPE & OPERATION DESCRIPTIONS
IF F>0 THEN 6220
X1=256:GOSUB 210
PRINT "VENDOR"
X1=266:X2=6:X3=0:X4=0:GOSUB 345 REMARK REQUEST VENDOR NO.
IF X0$ <=" " THEN 6100
IF W1$=X0$ THEN 6220
W1$=X0$
RECORD.COUNT=AP.VENDFILE.EXTENT
Y2=1
XYZ$=W1$+" "
K$=LEFT$(XYZ$,6):GOSUB 1060 REMARK SEARCH FOR VENDOR RCD
IF H=-1 OR VAR1=0 THEN \
X2$="NOT ON FILE":\
GOSUB 615:\
W1$=" ":\
GOTO 6160
X0=L:Y9=1:GOSUB 3200 REMARK GET VENDOR RECORD
6220 X1=256:GOSUB 210 REMARK DISPLAY VENDOR DATA
PRINT "VENDOR ";W1$
X1=384:GOSUB 210
FOR K%=2 TO 5
X1=21:GOSUB 215
PRINT M$(K%)
NEXT K%
FOR I%=1 TO 27 REMARK ZERO TRANSACTION RECORD VARIABLES
D(I%)=0
C(I%)=0
NEXT I%
D1=0
D2=0
N=0
W$=""
6240 GOSUB 5375
X1=320:GOSUB 210
PRINT "INVOICE # "
X1=330:X2=6:X3=0:X4=999999:GOSUB 345 REMARK REQUEST INVOICE NUMBER
IF X0=0 THEN 6120
W0=X0
XYZ$=W1$+" " REMARK LET'S GET THE INVOICE # CHECKED.
ZYX$="000000"+X0$
K$=LEFT$(XYZ$,6)+RIGHT$(ZYX$,6)
Y2=2
RECORD.COUNT=AP.INVOICE.EXTENT
GOSUB 1060
IF H <>-1 THEN 6260
IF W2%=1 THEN 6300 REMARK INVOICE NOT ON FILE - OKAY IF NEW INVOICE TRANSACTION
X2$="NOT ON FILE":GOSUB 615
GOTO 6240
6260 X0=L
IF W2%=2 THEN GOTO 6330 REMARK BRANCH TO DELETE ROUTINE
IF W2%=3 THEN GOTO 6310 REMARK BRANCH TO MODIFY ROUTINE
X2$="ALREADY ON FILE":GOSUB 615 REMARK NEW INVOICE MUST NOT BE ON FILE
GOTO 6240
6300 N=1 REMARK NEW INVOICE OR DEBIT MEMO ENTRY
GOSUB 5200 REMARK DISPLAY MASK AND VALUES
FOR F=1 TO F1
GOSUB 5010 REMARK ENTER FIELD VALUES
NEXT F
GOSUB 5900 REMARK ALLOW CHANGES TO ENTRIES
GOTO 6350
REMARK MODIFY EXISTING INVOICE RECORD
6310 GOSUB 5550 REMARK RETRIEVE INVOICE
GOSUB 5200 REMARK DISPLAY INVOICE FIELD VALUES
GOSUB 5900 REMARK ALLOW CHANGES
GOTO 6380
REMARK DELETE EXISTING INVOICE RECORD
6330 GOSUB 5550 REMARK RETRIEVE INVOICE
GOSUB 5200 REMARK DISPLAY INVOICE FIELD VALUES
X2=3:X3=0:X4=0:X2$="ENTER DELETE CODE":GOSUB 665
IF X0$="DEL" THEN GOSUB 5600
GOSUB 5000
GOTO 6220
6350 X0=3:GOSUB 260 REMARK G/L AND JOB DISTRIBUTION ENTRY
GOSUB 5375
G=1:G1=11:GOSUB 5400 REMARK ENTER G/L DISTRIBUTION
G=12:G1=22:GOSUB 5400 REMARK ENTER JOB DISTRIBUTION
GOSUB 5950 REMARK ALLOW CHANGES
N1=0
6380 GOSUB 5460 REMARK CALCULATE INVOICE TOTAL
X0=4:GOSUB 260 REMARK DISPLAY ACTION MASK
GOSUB 5375 REMARK DISPLAY TYPE AND OPERATION
X1=140:X2=1:X3=1:X4=4:GOSUB 345 REMARK ENTER ACTION CODE
F=X0
N=F
IF F=1 THEN GOSUB 5600:GOTO 6160 REMARK WRITE THE TRANSACTION RCD
IF F=2 THEN GOSUB 5800:GOTO 6380 REMARK DISPLAY TRANSACTION DATA AND \
GO BACK TO ACTION CODE MASK
IF F=3 THEN GOSUB 5520:N1=1:GOTO 6380 REMARK DISPLAY G/L DATA AND GO BACK TO ACTION CODE MASK
IF F=4 THEN GOSUB 5700:GOTO 6160 REMARK CANCEL TRANSACTION AND GO BACK TO VENDOR NUMBER ENTRY
GOTO 6380 REMARK DEFAULT FALL-THROUGH
6400 PRINT CLEAR.SCREEN$;"A/P TRANSACTION ENTRY LOADING MENU" REMARK EXIT PROGRAM ROUTINE
CHAIN "A/P000"