home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug043.ark
/
A_P090.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
11KB
|
361 lines
REMARK ********************************************\
* A/P VENDOR FILE MAINTENANCE (A/P090) *\
* 6/28/79 10:20 AM *\
********************************************
DIM M$(5),S$(2),Y(2),Z(2),G2$(5),G3(5),P(6)
YES=1
WRITTEN$=CHR$(255)
%INCLUDE CURSOR
S$(1)="VENDOR ACTIVITY REPORT":S$(2)="LIST OF VENDORS"
GOTO 6000
%INCLUDE SUBS1
%INCLUDE GENINFO
%INCLUDE READVEND
%INCLUDE WRITEVND
%INCLUDE A/P-INFO
825 IF LINE.COUNT% < 55 AND PAGE.COUNT% > 0 THEN RETURN REMARK LINE PRINTER ROUTINE
PAGE.COUNT%=PAGE.COUNT%+1
PRINT CHR$(12);
PRINT 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
PRINT CHR$(10);" CODE";TAB(17);"NAME";
IF F1=1 THEN PRINT TAB(32);"LAST ACTIVITY CURRENT YEAR LAST YEAR"\
ELSE\
PRINT TAB(38);"ADDRESS";TAB(117);"PHONE NO."
PRINT
LINE.COUNT%=6
RETURN
2000 REMARK ********************************************\
* VENDOR FILE SEARCH ROUTINE 12/78 MAM *\
* ======================================== *\
* THIS SUBROUTINE USES THE 'B' ALGORITHM *\
* FROM KNUTH'S SORTING AND SEARCHING BOOK. *\
* THE ROUTINE FIRST SEARCHES A/P0F110.DAT*\
* AND, IF NO MATCH IS FOUND FOR THE KEY IN *\
* K$, THE ROUTINE THEN SEARCHES A/P0F111 IN*\
* ORDER TO EITHER FIND A NEWLY ADDED RECORD*\
* OR POSITION THE POINTER, L, TO THE LOCA- *\
* TION OF THE RECORD TO INSERT. *\
********************************************
Y2=1:RECORD.COUNT=AP.VENDFILE.EXTENT
2005 IF LEN(K$)<6 THEN K$=K$+" ":GOTO 2005
GOSUB 2060 REMARK PERFORM SEARCH ON A/P0F110.DAT
IF H <> -1 THEN RETURN
Y2=2:RECORD.COUNT=NEW.VENDOR.RECORDS%
GOSUB 2060 REMARK IF A/P0F110 SEARCH FAILS, CHECK A/P0F111...
RETURN
2060 H=0
IF RECORD.COUNT < 1 THEN H=-1:L=1:RETURN
READ #Y2,1;VAR$,VAR1
IF K$ < VAR$ THEN H=-1:L=1:RETURN
IF K$ = VAR$ THEN L=1:RETURN
READ #Y2,RECORD.COUNT;VAR$,VAR1
IF K$ > VAR$ THEN H=-1:L=RECORD.COUNT+1:RETURN
IF K$ = VAR$ THEN L=RECORD.COUNT:RETURN
H=RECORD.COUNT
L=0
2070 M=INT((L+H)/2)
READ #Y2,M;VAR$,VAR1
IF VAR$=K$ THEN L=M:RETURN
IF VAR$ > K$ THEN H=M
IF VAR$ < K$ THEN L=M
IF H=M+1 THEN H=-1:L=M+1:RETURN
GOTO 2070
RETURN
5000 IF F=1 OR F=2 OR F=3 OR F=4 THEN\
X1=331+64*F:X2=24:X3=0:X4=0:GOSUB 345:\ REMARK ENTER VENDOR NAME/ADDR
M$(F+1)=X0$:RETURN
IF F=5 THEN X1=658:GOSUB 673:D=X0:\ REMARK ENTER VENDOR'S LAST ACTIVITY DATE
RETURN
IF F=6 OR F=7 THEN\
X1=664+(F-5)*64:X2=11:X3=-9999999.99:X4=9999999.99:GOSUB 345:\
Y(F-5)=X0:\ REMARK ENTER VENDOR TOTAL FIELDS IN THIS ROUTINE
RETURN
X1=849:GOSUB 210
PRINT " "
IF F=8 THEN\
X1=853:X2=10:X3=0:X4=9999999999:GOSUB 345:\ REMARK ENTER PHONE NUMBER
P9=X0:\
X0=P9:X1=850:GOSUB 760:PRINT REMARK DISPLAY PHONE NUMBER ON CRT
RETURN
5100 FOR I%=2 TO 5
X1=396+(I%-2)*64:GOSUB 210
PRINT M$(I%)
NEXT I%
X1=658:GOSUB 210
X0=D:GOSUB 680.5 REMARK DISPLAY ACTIVITY DATE
PRINT
X1=25:GOSUB 215
PRINT USING MASKA$;Y(1)
X1=25:GOSUB 215
PRINT USING MASKA$;Y(2)
X0=P9:X1=850:GOSUB 760
RETURN
5200 REMARK ********** VENDOR FILE PRINT ROUTINE **********
IF Y9=1 AND MSTR.RECORD$=WRITTEN$ THEN RETURN
IF Y9=2 AND NEW.RECORD$=WRITTEN$ THEN RETURN
GOSUB 3200 REMARK GET VENDOR RECORD
X4$=S$(F1):A1%=76+31*SGN(F1-1) REMARK SET REPORT TITLE & COLUMN WIDTH
GOSUB 825 REMARK CHECK FOR END OF FORM
LINE.COUNT%=LINE.COUNT%+1
PRINT W1$; TAB(9); M$(2); REMARK PRINT VENDOR NUMBER AND NAME
IF F1=2 THEN\ REMARK IF VENDOR LIST, PRINT ADDR & PHONE
PRINT TAB(35); M$(3); TAB(61); M$(4); TAB(87); M$(5); TAB(113); :\
X0=P9:GOSUB 760.5:PRINT
IF F1=1 THEN\ REMARK IF ACTIVITY REPORT,
PRINT TAB(34);:\ REMARK PRINT ACTIVITY DATE & SALES AMOUNTS
X0=D:GOSUB 680.5:\
PRINT TAB(48);: PRINT USING MASKA$; Y(2);: PRINT TAB(62);:\
PRINT USING MASKA$; Y(1):\
Z(2)=Z(2)+Y(2):\ REMARK ADD TO LAST-YEAR TOTALS
Z(1)=Z(1)+Y(1) REMARK ADD TO THIS-YEAR TOTALS
RETURN
REMARK START OF MAIN PROGRAM
6000 MASKA$=" #######.##"
MASKB$=" ##########.##"
OPEN "A/P0F110.DAT" RECL 162 AS 1, "A/P0F130.DAT" AS 3,\
"G/I0F010.DAT" AS 4, "CRT" RECL 1100 AS 19
CREATE "A/P0F111.DAT" RECL 162 AS 2
X0=3:GOSUB 3310 REMARK READ A/P INFO FILE
CLOSE 3
Y9=4:GOSUB 700 REMARK READ G/I FILE INFORMATION
CLOSE 4
CONSOLE
X0=9:GOSUB 260 REMARK DISPLAY CRT MASK
6020 X2=1:X3=0:X4=4 REMARK PROMPT FOR OPERATION CODE
X2$="ENTER OPERATION CODE(0=EXIT;1=ADD;2=CHANGE;3=PRINT;4=YR END)"
GOSUB 665
C=X0+1
IF C=1 THEN GOTO 6290 REMARK IF 'EXIT' WAS SELECTED, BRANCH
IF C=3 THEN GOTO 6120 REMARK GO TO CHANGE RECORD ROUTINE
IF C=4 THEN GOTO 6260 REMARK BRANCH TO THE FILE PRINT ROUTINE
IF C=5 THEN GOTO 6280 REMARK GO TO YEAR-END ROUTINE
6040 GOSUB 265 REMARK REFRESH CRT MASK
X1=30:GOSUB 210
PRINT "ADD "
X1=271:X2=6:X3=0:X4=0:GOSUB 345 REMARK ENTER VENDOR NO.
IF X0$<=" " THEN GOSUB 265:GOTO 6020 REMARK RE-PROMPT OPERATION CODE IF BLANK ENTRY
K$=X0$
GOSUB 2000 REMARK SEARCH A/P0F110 FOR VENDOR
REMARK THEN SEARCH A/P0F111 IN CASE IT
REMARK WAS ENTERED ON THE DATA INPUT FILE.
IF H=-1 THEN GOTO 6100
IF VAR1 > 0 THEN X2$="ALREADY ON FILE":GOSUB 615:GOTO 6040\
ELSE\
RE.USE.DELETED.RECORD=YES:FILE.ASSIGNMENT=Y2
6100 W1$=K$
6100.1 IF LEN(W1$)<6 THEN W1$=W1$+" ":GOTO 6100.1
FOR I1%=1 TO 8
F=I1%
GOSUB 5000
NEXT I1%
GOTO 6160
6110 IF RE.USE.DELETED.RECORD=YES THEN Y9=FILE.ASSIGNMENT:\
X0=L:GOSUB 3250:RE.USE.DELETED.RECORD=0:GOTO 6040
IF L > NEW.VENDOR.RECORDS% THEN GOTO 6115
L%=L
FOR I%=NEW.VENDOR.RECORDS% TO L% STEP -1
READ #2,I%;LINE X0$
PRINT USING "&";#2,I%+1;X0$ REMARK WRITE CUSTFILE AT I%+1
NEXT I%
6115 NEW.VENDOR.RECORDS%=NEW.VENDOR.RECORDS%+1
Y9=2:X0=L:GOSUB 3250
CLOSE 2
OPEN "A/P0F111.DAT" RECL 162 AS 2
REMARK THE FILE IS CLOSED & THEN RE-OPENED TO SAVE THE FCB IN \
A FILE DISASTER SITUATION.
GOTO 6040 REMARK START OVER FOR ANOTHER NEW VENDOR
6120 GOSUB 265 REMARK REFRESH CRT MASK
X1=30:GOSUB 210
PRINT "CHANGE "
6140 X1=271:X2=6:X3=0:X4=0:GOSUB 345 REMARK ENTER VENDOR #
IF X0$ <= " " THEN GOTO 6020 REMARK PROMPT OPERATION CODE IF BLANK ENTRY
K$=X0$
GOSUB 2000
IF H=-1 OR VAR1 = 0 THEN X2$="NOT ON FILE":GOSUB 615:GOTO 6120
X0=L:Y9=Y2:GOSUB 3200 REMARK GET VENDOR RECORD FROM FILE
GOSUB 5100
6160 X2=2:X3=0:X4=99
X2$="ENTER FIELD TO CHANGE (0=NONE, 99=DELETE)"
GOSUB 665
F=X0
IF F=0 AND C=2 THEN GOTO 6110
IF F=0 THEN GOTO 6180
IF F=99 THEN GOTO 6200
GOSUB 5000
GOTO 6160
6180 X0=L
GOSUB 3250
GOTO 6120
6200 X2=3:X3=0:X4=0:X2$="ENTER DELETE CODE":GOSUB 665
IF X0$<>"DEL" THEN 6020
D=0
IF C=2 THEN Y9=2\
ELSE Y9=1
X0=L:GOSUB 3250 REMARK RE-SAVE RECORD WITH A '0' LAST ACTIVITY DATE
X2$="RECORD DELETED":GOSUB 615
GOTO 6020
X2$="NOT ON FILE":GOSUB 615
GOTO 6140
6260 X1=30:GOSUB 210
PRINT "PRINT "
P=0
X2=1:X3=0:X4=2:X2$="ENTER REPORT TYPE (0=NONE, 1=ACTIVITY, 2=LIST) "
GOSUB 665
F1=X0
IF F1=0 THEN GOTO 6020
Z(1)=0
Z(2)=0
CLOSE 1
CLOSE 2
OPEN "A/P0F110.DAT" RECL 162 AS 1, "A/P0F111.DAT" RECL 162 AS 2
LPRINTER WIDTH 131
GOSUB 6800
GOSUB 6810
LINE.COUNT%=66
Y9=0
X0=0
6265 IF MSTR.READ% > AP.VENDFILE.EXTENT AND NEW.READ% > NEW.VENDOR.RECORDS%\
THEN\
GOTO 6270
IF NEW.RECORD$ > MSTR.RECORD$\
OR\
NEW.READ% > NEW.VENDOR.RECORDS%\
THEN\
X0=MSTR.READ%:Y9=1:GOSUB 5200:\
MSTR.RECORD$=WRITTEN$:\
GOSUB 6800
IF NEW.RECORD$=WRITTEN$ THEN GOTO 6265
IF MSTR.RECORD$ > NEW.RECORD$\
OR\
MSTR.READ% > AP.VENDFILE.EXTENT\
THEN\
X0=NEW.READ%:Y9=2:GOSUB 5200:\
NEW.RECORD$=WRITTEN$:\
GOSUB 6810
GOTO 6265
6270 PRINT
NEW.READ%=0
MSTR.READ%=0
IF F1=1 THEN PRINT "TOTALS";TAB(45);:PRINT USING MASKB$;Z(2);Z(1)
PRINT
CONSOLE
GOTO 6260
6280 X1=30:GOSUB 210
PRINT "YR. END"
X2=1:X3=0:X4=1:X2$="DO YOU HAVE A RECENT ACTIVITY REPORT?"
GOSUB 665
IF X0=0 THEN 6260
X2=1:X3=0:X4=1:X2$="O.K. TO DO YEAR END UPDATE?"
GOSUB 665
IF X0 <> 1 THEN GOTO 6020
PRINT "WORKING - DO NOT INTERRUPT"
Y9=1
FOR I%=1 TO AP.VENDFILE.EXTENT
X0=I%
GOSUB 3200
6281 Y(1)=Y(2):Y(2)=0 REMARK RESET TOTALS
GOSUB 3250
NEXT I%
Y9=2
IF NEW.VENDOR.RECORDS%=0 THEN 6285
FOR I%=1 TO NEW.VENDOR.RECORDS%
X0=I%
GOSUB 3200
Y(1)=Y(2):Y(2)=0
GOSUB 3250
NEXT I%
6285 GOSUB 265
GOTO 6020
6290 REMARK END OF MAINLINE CODE, START OF MERGE ROUTINE...
PRINT CURSOR.HOME$:PRINT:PRINT "WORKING... DO NOT INTERRUPT"
IF AP.VENDFILE.EXTENT=0 THEN DELETE 1:\
CLOSE 2:A=RENAME("A/P0F110.DAT","A/P0F111.DAT"):\
OUTPUT.COUNT%=NEW.VENDOR.RECORDS%:GOTO 9000
CLOSE 1,2,19
OPEN "A/P0F110.DAT" RECL 162 AS 1, "A/P0F111.DAT" RECL 162 AS 2
CREATE "WORKFILE.DAT" RECL 162 AS 3
IF NEW.VENDOR.RECORDS% >0 THEN GOTO 6299
X2=1:X3=0:X4=0
X2$="ENTER 'Y' TO REORGANIZE VENDOR FILE; ANY OTHER KEY TO EXIT PROGRAM"
GOSUB 665
IF X0$ <> "Y" THEN GOTO 9005
6299 GOSUB 6800 REMARK GET THE FIRST MASTER RECORD
GOSUB 6810 REMARK GET THE FIRST "NEW" RECORD
6300 IF MSTR.READ% > AP.VENDFILE.EXTENT \
AND NEW.READ% > NEW.VENDOR.RECORDS% THEN GOTO 8999
IF NEW.RECORD$ > MSTR.RECORD$\
OR\
NEW.READ% > NEW.VENDOR.RECORDS%\
THEN \ REMARK IF MASTER RECORD IS LOWER, IT SATISFIES OUTPUT NEEDS
Y9=1:X0=MSTR.READ%:GOSUB 3200:\ REMARK GET THE RECORD
GOSUB 6900:\ REMARK WRITE THE MASTER VENDOR RECORD OUT TO WORKFILE.DAT
MSTR.RECORD$=WRITTEN$:\
GOSUB 6800 REMARK READ ANOTHER RECORD FROM A/P0F110.DAT
IF NEW.RECORD$=WRITTEN$ THEN GOTO 6300
IF MSTR.RECORD$ > NEW.RECORD$\
OR\
MSTR.READ% > AP.VENDFILE.EXTENT\
THEN\
Y9=2:X0=NEW.READ%:GOSUB 3200:\ REMARK GET THE RECORD
GOSUB 6900:\
NEW.RECORD$=WRITTEN$:\
GOSUB 6810
GOTO 6300
6800 IF END #1 THEN 6801
MSTR.READ%=MSTR.READ%+1
READ #1, MSTR.READ%; MSTR.RECORD$, VAR1
IF VAR1 = 0 THEN GOTO 6800 REMARK IF LAST ACTIVITY=0 THEN READ NEXT RCD
RETURN
6801 MSTR.READ%=AP.VENDFILE.EXTENT + 1
MSTR.RECORD$=WRITTEN$
RETURN
6810 REMARK READ RECORD FROM A/P0F111.DAT
IF END #2 THEN 6811
NEW.READ%=NEW.READ%+1
READ #2, NEW.READ%; NEW.RECORD$, VAR1
IF VAR1=0 THEN GOTO 6810 REMARK IF LAST ACTIVITY=0 THEN READ NEXT RCD
RETURN
6811 NEW.READ%=NEW.VENDOR.RECORDS% + 1
NEW.RECORD$=WRITTEN$
RETURN
6900 REMARK WRITE VENDOR RECORD TO WORKFILE
OUTPUT.COUNT%=OUTPUT.COUNT%+1
Y9=3
X0=OUTPUT.COUNT%
GOSUB 3250 REMARK WRITE VENDOR RECORD TO WORKFILE
RETURN
8999 DELETE 1 REMARK DELETE A/P0F110.DAT
DELETE 2 REMARK DELETE A/P0F111.DAT
CLOSE 3 REMARK CLOSE WORKFILE.DAT BEFORE RENAMING IT
A=RENAME("A/P0F110.DAT","WORKFILE.DAT") REMARK WORKFILE BECOMES NEW VENDOR FILE
9000 AP.VENDFILE.EXTENT=OUTPUT.COUNT%
X0=5
OPEN "A/P0F130.DAT" AS X0
GOSUB 3350 REMARK RE-WRITE NEW EXTENT INFO
9005 PRINT CLEAR.SCREEN$;"A/P VENDOR F/M LOADING MENU"
CHAIN "A/P000" REMARK TERMINATE PROGRAM AND CHAIN TO MENU