home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG089.ARK
/
VPENTRY.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
12KB
|
327 lines
rem This is the Vendor Information Entry Program
%INCLUDE ALL.BAS
dim n(2,20),k$(6,20)
z5$="b:vp":z6$=z5$+"back":z7$=z5$+"size"
repeat$="--------------------------------"
fill$=" "
delim$="":for z=1 to 72:delim$=delim$+"=":delim1$=delim1$+"*":next z
l$="##,###,###.##"
RESTORE
540 K$(6,1)="1 - NEW ENTRY":K$(6,2)="2 - EXAMINE EXISTING ENTRY"
550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
560 K$(6,4)="4 - DELETE EXISTING ENTRY"
570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
580 K$(6,7)="7 - BACK-UP AND SORT FILE":K$(6,8)="8 - LIST FILE"
590 K$(6,9)="9 - FINISHED"
print clear$:print
1100 K$(1,1)="TAG":K$(1,2)="ACCOUNT NUMBER":K$(1,3)="NAME (ATTENTION)"
1105 K$(1,4)="COMPANY":K$(1,5)="ADDRESS":K$(1,6)="CITY":K$(1,7)="STATE"
1110 K$(1,8)="ZIP CODE":K$(1,9)="PHONE (AAA) NNN NNNN"
1130 K$(1,10)="NAME (ATTENTION)":K$(1,11)="COMPANY":K$(1,12)="ADDRESS"
1135 K$(1,13)="CITY":K$(1,14)="STATE":K$(1,15)="ZIP CODE"
1140 K$(1,16)="PHONE (AAA) NNN NNNN"
1145 K$(1,17)="DATE OF LAST PMNT MM/DD/YY"
1150 K$(2,1)="AMOUNT OF LAST PAYMENT":K$(2,2)="TOTAL Y-TO-D PAYMENTS"
1155 K$(2,3)="CURRENT CHARGES":K$(2,4)="30-60 DAY CHARGES"
1160 K$(2,5)="61-90 DAY CHARGES":K$(2,6)="OVER 90 DAY CHARGES"
1165 K$(3,1)=" 1 - TAG":K$(3,2)=" 2 - ACCOUNT NO.":K$(3,3)=" 3 - NAME"
1170 K$(3,4)=" 4 - COMP":K$(3,5)=" 5 - ADDR":K$(3,6)=" 6 - CITY"
1175 K$(3,7)=" 7 - STA":K$(3,8)=" 8 - ZIP"
1180 K$(3,9)=" 9 - PHO"
1185 K$(3,10)="10 - NAME":K$(3,11)="11 - COMP":K$(3,12)="12 - ADDR"
1190 K$(3,13)="13 - CITY":K$(3,14)="14 - STA":K$(3,15)="15 - ZIP"
1195 K$(3,16)="16 - PHO"
1200 K$(3,17)="17 - DATE OF LAST PMNT"
1205 K$(4,1)="18 - AMOUNT OF LAST PAYMENT"
1210 K$(4,2)="19 - TOTAL Y-TO-D PAYMENTS"
1215 K$(4,3)="20 - CURRENT CHARGES":K$(4,4)="21 - 30-60 DAY CHARGES"
1220 K$(4,5)="22 - 61-90 DAY CHARGES":K$(4,6)="23 - OVER 90 DAY CHARGES"
1300 N(0,1)=4:N(0,2)=10:N(0,3)=24:N(0,4)=24:N(0,5)=24:N(0,6)=17
1305 N(0,7)=2:N(0,8)=5:N(0,9)=14:N(0,10)=24:N(0,11)=24:N(0,12)=24
1310 N(0,13)=17:N(0,14)=2:N(0,15)=5:N(0,16)=14:N(0,17)=8
1315 N(1,1)=12:N(1,2)=12:N(1,3)=12:N(1,4)=12:N(1,5)=12:N(1,6)=12
print clear$:print
1500 if end #1 then 6000
if end #2 then 15000
open z5$ recl 384 as 1
close 1
open z7$ as 2
read #2;z2,z3
close 2
1600 REM
1620 PRINT CLEAR$
if z2>z3 then print "*** OUT OF RECORD SPACE ***"
PRINT "VENDOR INFORMATION ENTRY PROGRAM"
PRINT "--------------------------------"
PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
PRINT ;TAB(30);Z2-1;" RECORDS USED"
PRINT
1650 PRINT "THIS IS A LIST OF OPERATIONS."
1655 PRINT
1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
1670 PRINT "THE CORRESPONDING NUMBER."
1675 PRINT
1680 INPUT Z
IF Z<1 OR Z>9 then 1620
1682 IF Z=1 THEN new$="N"
1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
1690 FOR Z=1 TO 20:N(2,Z)=0:NEXT Z
1695 N$="":new$=""
1700 FOR Z=1 TO 20:K$(5,Z)="":NEXT Z
1705 GOTO 1600
2000 IF Z2>Z3 THEN RETURN
2001 PRINT CLEAR$:PRINT
2005 PRINT "RECORD NUMBER";z2:PRINT
2015 FOR Z=1 TO 2
PRINT CUR$
2020 PRINT TAB(30);left$(repeat$,n(0,z))
PRINT UP$;
2025 PRINT K$(1,Z);TAB(30);
2030 INPUT N(2,Z):PRINT chr$(13)
PRINT CLEAR$
2035 NEXT Z
2040 FOR Z=3 TO 17
PRINT CUR$
2045 PRINT TAB(30);left$(repeat$,n(0,z))
PRINT UP$;
2050 PRINT K$(1,Z);TAB(30);
2055 INPUT line K$(5,Z):PRINT chr$(13)
if len(k$(5,z))>n(0,z) then k$(5,z)=left$(k$(5,z),n(0,z))
2060 I=(N(0,Z)-LEN(K$(5,Z))):K$(5,Z)=K$(5,Z)+left$(fill$,i)
PRINT CLEAR$
2065 NEXT Z
2066 N$=""
2070 FOR Z=3 TO 17:N$=N$+K$(5,Z):NEXT Z
2100 Z1=Z2
2105 PRINT clear$;
2110 PRINT "RECORD NUMBER";z1
2115 PRINT K$(3,1);TAB(11);N(2,1);TAB(40);K$(3,2);TAB(57);N(2,2)
2124 PRINT "BILL TO";TAB(40);"SHIP TO"
2126 PRINT delim$
2128 FOR Z=3 TO 9
2130 PRINT K$(3,Z);TAB(11);K$(5,Z);TAB(40);K$(3,Z+7);TAB(50);K$(5,Z+7)
2132 NEXT Z
2134 Z=17:PRINT delim$
2136 PRINT K$(3,Z);TAB(40);K$(5,Z)
2141 FOR Z=18 TO 23:PRINT K$(4,Z-17);TAB(30);:print using l$;n(2,z-15):NEXT Z
2142 PRINT "24 - NONE"
2145 PRINT
2150 INPUT "IF AN ITEM IS TO BE CHANGED, TYPE THE NUMBER ";Z
2165 IF Z>23 THEN 2216
2170 IF Z<1 THEN 2105
2175 IF Z>2 AND Z<18 THEN 2200
2176 IF Z>17 THEN 2220
CL=18:CC=50:GOSUB 50:PRINT CUR2$;
2180 PRINT left$(repeat$,n(0,z))
CL=20:GOSUB 50:PRINT CUR2$;
2185 PRINT K$(1,Z)
CL=18:CC=48:GOSUB 50:PRINT CUR2$;
2190 INPUT N(2,Z)
2195 GOTO 2225
2200 CL=18:CC=50:GOSUB 50:PRINT CUR2$; :PRINT left$(repeat$,n(0,z))
CL=20:CC=50:GOSUB 50:PRINT CUR2$;
2205 PRINT K$(1,Z);
CL=18:CC=48:GOSUB 50:PRINT CUR2$;
2210 INPUT line K$(5,Z)
if len(k$(5,z))>n(0,z) then k$(5,z)=left$(k$(5,z),n(0,z))
2215 I=(N(0,Z)-LEN(K$(5,Z))):K$(5,Z)=K$(5,Z)+left$(fill$,i)
2216 N$=""
2217 FOR I=3 TO 17:N$=N$+K$(5,I):NEXT I
2218 GOTO 2225
2220 CL=18:CC=50:GOSUB 50:PRINT CUR2$; :PRINT left$(repeat$,n(1,z-17))
CL=20:CC=50:GOSUB 50:PRINT CUR2$;
2221 PRINT K$(4,Z-17)
CL=18:CC=48:GOSUB 50:PRINT CUR2$;
2222 INPUT N(2,Z-15)
2225 CL=22:CC=50:GOSUB 50:PRINT CUR2$;
INPUT "ANY MORE CHANGES";line temp$
2230 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2105
2235 PRINT CUR2$;
2240 INPUT "IS RECORD TO BE ENTERED";line temp$
2245 REM
2250 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2280
2255 IF left$(temp$,1)<>"n" AND left$(temp$,1)<>"N" THEN 2235
2260 PRINT clear$:PRINT
2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
2275 FOR Z=1 TO 200:NEXT Z:RETURN
2280 open z5$ recl 384 as 1
print #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
close 1
2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
2300 RETURN
3000 PRINT clear$:PRINT
3005 INPUT "RECORD NUMBER";Z1
3010 IF Z1>=Z2 THEN 3000
3012 IF Z1<1 THEN RETURN
3020 open z5$ recl 384 as 1
read #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
close 1
3022 Z9=1:FOR Z=3 TO 17:K$(5,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
3030 PRINT MID$(K$(3,1),6,30);TAB(11);N(2,1);TAB(40);MID$(K$(3,2),6,30);
3032 PRINT TAB(55);N(2,2)
3034 PRINT "BILL TO";TAB(40);"SHIP TO"
3036 PRINT delim$
3038 FOR Z=3 TO 9
3040 PRINT MID$(K$(3,Z),6,30);TAB(11);K$(5,Z);TAB(40);MID$(K$(3,Z+7),6,30);
3042 PRINT TAB(50);K$(5,Z+7)
3044 NEXT Z
3046 Z=17:PRINT delim$
3048 PRINT MID$(K$(3,Z),6,30);TAB(40);K$(5,Z)
3050 FOR Z=18 TO 23:PRINT MID$(K$(4,Z-17),6,30);TAB(30);
3052 print using l$;n(2,z-15):NEXT Z
3054 PRINT
3075 PRINT "FOR NEW RECORD, TYPE N-RETURN , OTHERWISE F-RETURN"
3085 INPUT line temp$
3090 IF ucase$(temp$)="N" THEN 3000
3095 RETURN
4000 PRINT clear$:PRINT
4005 N$=""
4010 INPUT "RECORD NUMBER";Z1
4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";z1:GOTO 1620
4030 open z5$ recl 384 as 1
read #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
close 1
4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
4050 Z9=1
4055 FOR Z=3 TO 17
4060 K$(5,Z)=MID$(N$,Z9,N(0,Z))
4065 Z9=Z9+N(0,Z)
4070 NEXT Z
4075 GOTO 2105
5000 PRINT clear$:PRINT
5010 INPUT "RECORD NUMBER";Z1
5015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
5020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
5025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";z1:GOTO 1620
5030 open z5$ recl 384 as 1
read #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
close 1
5045 PRINT "RECORD NUMBER";z1
5048 Z9=1:FOR Z=3 TO 17:K$(5,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
5050 PRINT MID$(K$(3,1),6,30);TAB(11);N(2,1);TAB(40);MID$(K$(3,2),6,30);
5052 PRINT TAB(55);N(2,2)
5054 PRINT "BILL TO";TAB(40);"SHIP TO"
5056 PRINT delim$
5058 FOR Z=3 TO 9
5060 PRINT MID$(K$(3,Z),6,30);TAB(11);K$(5,Z);TAB(40);MID$(K$(3,Z+7),6,30);
5062 PRINT TAB(50);K$(5,Z+7)
5064 NEXT Z
5066 Z=17:PRINT delim$
5068 PRINT MID$(K$(3,Z),6,30);TAB(40);K$(5,Z)
5070 FOR Z=18 TO 23:PRINT MID$(K$(4,Z-17),6,30);TAB(30);
5072 PRINT :print using l$;n(2,z-15):NEXT Z
5074 PRINT
5100 INPUT "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
5105 IF left$(temp$,1)="n" OR left$(temp$,1)="N" THEN RETURN
5110 IF ucase$(temp$)<>"YES" THEN 5100
5115 N(2,1)=0
5120 open z5$ recl 384 as 1
print #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
close 1
5135 RETURN
6000 PRINT clear$:PRINT
6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A VENDOR FILE"
6010 PRINT "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
6015 PRINT "TYPE THE LETTER C FOLLOWED BY A RETURN TO CONTINUE."
6020 PRINT
6025 PRINT "IF YOU WISH TO CREATE A NEW FILE, TYPE THE LETTER N"
6030 PRINT "FOLLOWED BY RETURN.":PRINT
6035 INPUT line temp$
6040 IF ucase$(temp$)="C" THEN initialize:GOTO 1500
6045 PRINT clear$:PRINT
6050 INPUT "NUMBER OF RECORDS DESIRED";z3
6055 PRINT
6060 n$="":for z=1 to 228:n$=n$+" ":next z:for i=1 to 20:n(2,i)=0:next i
6055 create z5$ recl 384 as 1
6070 FOR Z1=1 TO z3+2
print #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
6085 NEXT Z1
6090 close 1
6092 Z1=Z1+1
6095 PRINT clear$:PRINT
6100 PRINT "VENDOR FILE CREATED AND CLEARED.":PRINT
6105 PRINT z3;"RECORDS CREATED.":PRINT
6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
Z2=1
create z7$ as 1:print #1;Z2,Z3:close 1
6115 GOTO 1500
7000 INPUT "ARE YOU SURE !!! (YES OR NO)";line temp$
7007 IF ucase$(temp$)<>"YES" THEN RETURN
n$="":for z=1 to 228:n$=n$+" ":next z:for i=1 to 20:n(2,i)=0:next i
open z5$ recl 384 as 1
7010 FOR Z1=1 TO Z3+2
print #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
7025 NEXT Z1
7030 close 1
7035 PRINT clear$:PRINT
7040 PRINT "VENDOR FILE CLEARED!":PRINT
7045 PRINT "TO CONTINUE, TYPE RETURN."
7050 INPUT line temp$
Z2=1
open z7$ as 1:print #1;Z2,Z3:close 1
7060 RETURN
8000 chain "vpsort"
9000 PRINT clear$:PRINT
print "Do you want the entire file (Yes or No)?":input line temp$
IF ucase$(temp$)="Y" then first=1:last=z2-1:GOTO 9005
IF ucase$(temp$)<>"N" then 9000
9001 print clear$:print
input "Enter first record number to print - ";first
input "Enter last record to print - ";last
IF last>z2-1 then 9001
IF first>last then 9001
IF first<1 then 9001
9005 lprinter
open z5$ recl 384 as 1
9015 FOR Z1=first TO last
read #1,z1;n(2,1),n(2,2),n$,n(2,3),n(2,4),n(2,5),n(2,6),n(2,7),n(2,8)
9022 Z9=1
9023 FOR Z=3 TO 17:K$(5,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
9024 print delim1$:print:print "RECORD NO.";z1:print
9025 print MID$(K$(3,1),6,30);TAB(11);N(2,1);TAB(40);MID$(K$(3,2),6,30);
9030 print TAB(55);N(2,2)
9031 print
9035 print "BILL TO";TAB(40);"SHIP TO"
9040 print delim$
9041 print
9045 FOR Z=3 TO 9
9050 print MID$(K$(3,Z),6,30);TAB(11);K$(5,Z);TAB(40);MID$(K$(3,Z+7),6,30);
9055 print TAB(50);K$(5,Z+7)
9060 NEXT Z
9061 print
9065 Z=17:print delim$
9070 print MID$(K$(3,Z),6,30);TAB(40);K$(5,Z)
9075 FOR Z=18 TO 23:print MID$(K$(4,Z-17),6,30);TAB(30);
9080 print using l$;n(2,z-15):NEXT Z
9085 print
9100 print chr$(12)
9105 NEXT Z1
9110 CLOSE 1
9115 console
9120 RETURN
10000 CHAIN "master3"
15000 print clear$:print:print "CHECKING FILE LENGTH"
PRINT:PRINT "*** PLEASE WAIT ***"
open z5$ recl 384 as 1
z3=(size(z5$)*block.size)/384
for z2=1 to z3
read #1,z2;n(2,1),n(2,2)
if n(2,2)=0 then 15300
next z2
15300 z3=int(z3)-2
close 1
create z7$ as 1
print #1;z2,z3
close 1
GOTO 1500