home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug089.ark / VPENTRY.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  11.4 KB  |  327 lines
  1.      rem This is the Vendor Information Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim n(2,20),k$(6,20)
  5.      z5$="b:vp":z6$=z5$+"back":z7$=z5$+"size"
  6.      repeat$="--------------------------------"
  7.      fill$="                                "
  8.      delim$="":for z=1 to 72:delim$=delim$+"=":delim1$=delim1$+"*":next z
  9.      l$="##,###,###.##"
  10.      RESTORE
  11. 540 K$(6,1)="1 - NEW ENTRY":K$(6,2)="2 - EXAMINE EXISTING ENTRY"
  12. 550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
  13. 560 K$(6,4)="4 - DELETE EXISTING ENTRY"
  14. 570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
  15. 580 K$(6,7)="7 - BACK-UP AND SORT FILE":K$(6,8)="8 - LIST FILE"
  16. 590 K$(6,9)="9 - FINISHED"
  17.      print clear$:print
  18. 1100 K$(1,1)="TAG":K$(1,2)="ACCOUNT NUMBER":K$(1,3)="NAME (ATTENTION)"
  19. 1105 K$(1,4)="COMPANY":K$(1,5)="ADDRESS":K$(1,6)="CITY":K$(1,7)="STATE"
  20. 1110 K$(1,8)="ZIP CODE":K$(1,9)="PHONE (AAA) NNN NNNN"
  21. 1130 K$(1,10)="NAME (ATTENTION)":K$(1,11)="COMPANY":K$(1,12)="ADDRESS"
  22. 1135 K$(1,13)="CITY":K$(1,14)="STATE":K$(1,15)="ZIP CODE"
  23. 1140 K$(1,16)="PHONE (AAA) NNN NNNN"
  24. 1145 K$(1,17)="DATE OF LAST PMNT MM/DD/YY"
  25. 1150 K$(2,1)="AMOUNT OF LAST PAYMENT":K$(2,2)="TOTAL Y-TO-D PAYMENTS"
  26. 1155 K$(2,3)="CURRENT CHARGES":K$(2,4)="30-60 DAY CHARGES"
  27. 1160 K$(2,5)="61-90 DAY CHARGES":K$(2,6)="OVER 90 DAY CHARGES"
  28. 1165 K$(3,1)=" 1 - TAG":K$(3,2)=" 2 - ACCOUNT NO.":K$(3,3)=" 3 - NAME"
  29. 1170 K$(3,4)=" 4 - COMP":K$(3,5)=" 5 - ADDR":K$(3,6)=" 6 - CITY"
  30. 1175 K$(3,7)=" 7 - STA":K$(3,8)=" 8 - ZIP"
  31. 1180 K$(3,9)=" 9 - PHO"
  32. 1185 K$(3,10)="10 - NAME":K$(3,11)="11 - COMP":K$(3,12)="12 - ADDR"
  33. 1190 K$(3,13)="13 - CITY":K$(3,14)="14 - STA":K$(3,15)="15 - ZIP"
  34. 1195 K$(3,16)="16 - PHO"
  35. 1200 K$(3,17)="17 - DATE OF LAST PMNT"
  36. 1205 K$(4,1)="18 - AMOUNT OF LAST PAYMENT"
  37. 1210 K$(4,2)="19 - TOTAL Y-TO-D PAYMENTS"
  38. 1215 K$(4,3)="20 - CURRENT CHARGES":K$(4,4)="21 - 30-60 DAY CHARGES"
  39. 1220 K$(4,5)="22 - 61-90 DAY CHARGES":K$(4,6)="23 - OVER 90 DAY CHARGES"
  40. 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
  41. 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
  42. 1310 N(0,13)=17:N(0,14)=2:N(0,15)=5:N(0,16)=14:N(0,17)=8
  43. 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
  44.     print clear$:print
  45.  
  46. 1500    if end #1 then 6000
  47.     if end #2 then 15000
  48.         open z5$ recl 384 as 1
  49.         close 1
  50.         open z7$ as 2
  51.         read #2;z2,z3
  52.         close 2
  53.  
  54. 1600    REM
  55. 1620    PRINT CLEAR$
  56.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  57.     PRINT "VENDOR INFORMATION ENTRY PROGRAM"
  58.         PRINT      "--------------------------------"
  59.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  60.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  61.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  62.     PRINT
  63.  
  64. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  65. 1655 PRINT
  66. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  67. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  68. 1670 PRINT "THE CORRESPONDING NUMBER."
  69. 1675 PRINT
  70. 1680 INPUT Z
  71.     IF Z<1 OR Z>9 then 1620
  72. 1682 IF Z=1 THEN new$="N"
  73. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  74. 1690 FOR Z=1 TO 20:N(2,Z)=0:NEXT Z
  75. 1695 N$="":new$=""
  76. 1700 FOR Z=1 TO 20:K$(5,Z)="":NEXT Z
  77. 1705 GOTO 1600
  78. 2000 IF Z2>Z3 THEN RETURN
  79. 2001 PRINT CLEAR$:PRINT
  80. 2005 PRINT "RECORD NUMBER";z2:PRINT
  81. 2015 FOR Z=1 TO 2
  82.     PRINT CUR$
  83. 2020 PRINT TAB(30);left$(repeat$,n(0,z))
  84.     PRINT UP$;
  85. 2025 PRINT K$(1,Z);TAB(30);
  86. 2030 INPUT N(2,Z):PRINT chr$(13)
  87.     PRINT CLEAR$
  88. 2035 NEXT Z
  89. 2040 FOR Z=3 TO 17
  90.     PRINT CUR$
  91. 2045 PRINT TAB(30);left$(repeat$,n(0,z))
  92.     PRINT UP$;
  93. 2050 PRINT K$(1,Z);TAB(30);
  94. 2055 INPUT line K$(5,Z):PRINT chr$(13)
  95.     if len(k$(5,z))>n(0,z) then k$(5,z)=left$(k$(5,z),n(0,z))
  96. 2060 I=(N(0,Z)-LEN(K$(5,Z))):K$(5,Z)=K$(5,Z)+left$(fill$,i)
  97.     PRINT CLEAR$
  98. 2065 NEXT Z
  99. 2066 N$=""
  100. 2070 FOR Z=3 TO 17:N$=N$+K$(5,Z):NEXT Z
  101. 2100 Z1=Z2
  102. 2105 PRINT clear$;
  103. 2110 PRINT "RECORD NUMBER";z1
  104. 2115 PRINT K$(3,1);TAB(11);N(2,1);TAB(40);K$(3,2);TAB(57);N(2,2)
  105. 2124 PRINT "BILL TO";TAB(40);"SHIP TO"
  106. 2126 PRINT delim$
  107. 2128 FOR Z=3 TO 9
  108. 2130 PRINT K$(3,Z);TAB(11);K$(5,Z);TAB(40);K$(3,Z+7);TAB(50);K$(5,Z+7)
  109. 2132 NEXT Z
  110. 2134 Z=17:PRINT delim$
  111. 2136 PRINT K$(3,Z);TAB(40);K$(5,Z)
  112. 2141 FOR Z=18 TO 23:PRINT K$(4,Z-17);TAB(30);:print using l$;n(2,z-15):NEXT Z
  113. 2142 PRINT "24 - NONE"
  114. 2145 PRINT
  115. 2150 INPUT "IF AN ITEM IS TO BE CHANGED, TYPE THE NUMBER ";Z
  116. 2165 IF Z>23 THEN 2216
  117. 2170 IF Z<1 THEN 2105
  118. 2175 IF Z>2 AND Z<18 THEN 2200
  119. 2176 IF Z>17 THEN 2220
  120.     CL=18:CC=50:GOSUB 50:PRINT CUR2$;
  121. 2180 PRINT left$(repeat$,n(0,z))
  122.     CL=20:GOSUB 50:PRINT CUR2$;
  123. 2185 PRINT K$(1,Z)
  124.     CL=18:CC=48:GOSUB 50:PRINT CUR2$;
  125. 2190 INPUT N(2,Z)
  126. 2195 GOTO 2225
  127. 2200 CL=18:CC=50:GOSUB 50:PRINT CUR2$; :PRINT left$(repeat$,n(0,z))
  128.     CL=20:CC=50:GOSUB 50:PRINT CUR2$;
  129. 2205 PRINT K$(1,Z);
  130.     CL=18:CC=48:GOSUB 50:PRINT CUR2$;
  131. 2210 INPUT line K$(5,Z)
  132.     if len(k$(5,z))>n(0,z) then k$(5,z)=left$(k$(5,z),n(0,z))
  133. 2215 I=(N(0,Z)-LEN(K$(5,Z))):K$(5,Z)=K$(5,Z)+left$(fill$,i)
  134. 2216 N$=""
  135. 2217 FOR I=3 TO 17:N$=N$+K$(5,I):NEXT I
  136. 2218 GOTO 2225
  137. 2220 CL=18:CC=50:GOSUB 50:PRINT CUR2$; :PRINT left$(repeat$,n(1,z-17))
  138.     CL=20:CC=50:GOSUB 50:PRINT CUR2$;
  139. 2221 PRINT K$(4,Z-17)
  140.     CL=18:CC=48:GOSUB 50:PRINT CUR2$;
  141. 2222 INPUT N(2,Z-15)
  142. 2225 CL=22:CC=50:GOSUB 50:PRINT CUR2$;
  143.     INPUT "ANY MORE CHANGES";line temp$
  144. 2230 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2105
  145. 2235    PRINT CUR2$;
  146. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  147. 2245 REM
  148. 2250 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2280
  149. 2255 IF left$(temp$,1)<>"n" AND left$(temp$,1)<>"N" THEN 2235
  150. 2260 PRINT clear$:PRINT
  151. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  152. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  153. 2280 open z5$ recl 384 as 1
  154.      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)
  155.      close 1
  156. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  157. 2300 RETURN
  158. 3000 PRINT clear$:PRINT
  159. 3005 INPUT "RECORD NUMBER";Z1
  160. 3010 IF Z1>=Z2 THEN 3000
  161. 3012 IF Z1<1 THEN RETURN
  162. 3020 open z5$ recl 384 as 1
  163.      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)
  164.      close 1
  165. 3022 Z9=1:FOR Z=3 TO 17:K$(5,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
  166. 3030 PRINT MID$(K$(3,1),6,30);TAB(11);N(2,1);TAB(40);MID$(K$(3,2),6,30);
  167. 3032 PRINT TAB(55);N(2,2)
  168. 3034 PRINT "BILL TO";TAB(40);"SHIP TO"
  169. 3036 PRINT delim$
  170. 3038 FOR Z=3 TO 9
  171. 3040 PRINT MID$(K$(3,Z),6,30);TAB(11);K$(5,Z);TAB(40);MID$(K$(3,Z+7),6,30);
  172. 3042 PRINT TAB(50);K$(5,Z+7)
  173. 3044 NEXT Z
  174. 3046 Z=17:PRINT delim$
  175. 3048 PRINT MID$(K$(3,Z),6,30);TAB(40);K$(5,Z)
  176. 3050 FOR Z=18 TO 23:PRINT MID$(K$(4,Z-17),6,30);TAB(30);
  177. 3052 print using l$;n(2,z-15):NEXT Z
  178. 3054 PRINT
  179. 3075 PRINT "FOR NEW RECORD, TYPE N-RETURN , OTHERWISE F-RETURN"
  180. 3085 INPUT line temp$
  181. 3090 IF ucase$(temp$)="N" THEN 3000
  182. 3095 RETURN
  183. 4000 PRINT clear$:PRINT
  184. 4005 N$=""
  185. 4010 INPUT "RECORD NUMBER";Z1
  186. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  187. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  188. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";z1:GOTO 1620
  189. 4030 open z5$ recl 384 as 1
  190.      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)
  191.      close 1
  192. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  193. 4050 Z9=1
  194. 4055 FOR Z=3 TO 17
  195. 4060 K$(5,Z)=MID$(N$,Z9,N(0,Z))
  196. 4065 Z9=Z9+N(0,Z)
  197. 4070 NEXT Z
  198. 4075 GOTO 2105
  199. 5000 PRINT clear$:PRINT
  200. 5010 INPUT "RECORD NUMBER";Z1
  201. 5015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  202. 5020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  203. 5025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";z1:GOTO 1620
  204. 5030 open z5$ recl 384 as 1
  205.      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)
  206.      close 1
  207. 5045 PRINT "RECORD NUMBER";z1
  208. 5048 Z9=1:FOR Z=3 TO 17:K$(5,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
  209. 5050 PRINT MID$(K$(3,1),6,30);TAB(11);N(2,1);TAB(40);MID$(K$(3,2),6,30);
  210. 5052 PRINT TAB(55);N(2,2)
  211. 5054 PRINT "BILL TO";TAB(40);"SHIP TO"
  212. 5056 PRINT delim$
  213. 5058 FOR Z=3 TO 9
  214. 5060 PRINT MID$(K$(3,Z),6,30);TAB(11);K$(5,Z);TAB(40);MID$(K$(3,Z+7),6,30);
  215. 5062 PRINT TAB(50);K$(5,Z+7)
  216. 5064 NEXT Z
  217. 5066 Z=17:PRINT delim$
  218. 5068 PRINT MID$(K$(3,Z),6,30);TAB(40);K$(5,Z)
  219. 5070 FOR Z=18 TO 23:PRINT MID$(K$(4,Z-17),6,30);TAB(30);
  220. 5072 PRINT :print using l$;n(2,z-15):NEXT Z
  221. 5074 PRINT
  222. 5100 INPUT "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
  223. 5105 IF left$(temp$,1)="n" OR left$(temp$,1)="N" THEN RETURN
  224. 5110 IF ucase$(temp$)<>"YES" THEN 5100
  225. 5115 N(2,1)=0
  226. 5120 open z5$ recl 384 as 1
  227.      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)
  228.      close 1
  229. 5135 RETURN
  230. 6000 PRINT clear$:PRINT
  231. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A VENDOR FILE"
  232. 6010 PRINT "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
  233. 6015 PRINT "TYPE THE LETTER C FOLLOWED BY A RETURN TO CONTINUE."
  234. 6020 PRINT
  235. 6025 PRINT "IF YOU WISH TO CREATE A NEW FILE, TYPE THE LETTER N"
  236. 6030 PRINT "FOLLOWED BY RETURN.":PRINT
  237. 6035 INPUT line temp$
  238. 6040 IF ucase$(temp$)="C" THEN initialize:GOTO 1500
  239. 6045 PRINT clear$:PRINT
  240. 6050 INPUT "NUMBER OF RECORDS DESIRED";z3
  241. 6055 PRINT
  242. 6060 n$="":for z=1 to 228:n$=n$+" ":next z:for i=1 to 20:n(2,i)=0:next i
  243. 6055 create z5$ recl 384 as 1
  244. 6070 FOR Z1=1 TO z3+2
  245.      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)
  246. 6085 NEXT Z1
  247. 6090 close 1
  248. 6092 Z1=Z1+1
  249. 6095 PRINT clear$:PRINT
  250. 6100 PRINT "VENDOR FILE CREATED AND CLEARED.":PRINT
  251. 6105 PRINT z3;"RECORDS CREATED.":PRINT
  252. 6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
  253.     Z2=1
  254.     create z7$ as 1:print #1;Z2,Z3:close 1
  255. 6115 GOTO 1500
  256. 7000 INPUT "ARE YOU SURE !!! (YES OR NO)";line temp$
  257. 7007 IF ucase$(temp$)<>"YES" THEN RETURN
  258.      n$="":for z=1 to 228:n$=n$+" ":next z:for i=1 to 20:n(2,i)=0:next i
  259.      open z5$ recl 384 as 1
  260. 7010 FOR Z1=1 TO Z3+2
  261.      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)
  262. 7025 NEXT Z1
  263. 7030 close 1
  264. 7035 PRINT clear$:PRINT
  265. 7040 PRINT "VENDOR FILE CLEARED!":PRINT
  266. 7045 PRINT "TO CONTINUE, TYPE RETURN."
  267. 7050 INPUT line temp$
  268.     Z2=1
  269.     open z7$ as 1:print #1;Z2,Z3:close 1
  270. 7060 RETURN
  271. 8000 chain "vpsort"
  272. 9000 PRINT clear$:PRINT
  273.     print "Do you want the entire file (Yes or No)?":input line temp$
  274.     IF ucase$(temp$)="Y" then first=1:last=z2-1:GOTO 9005
  275.  
  276.     IF ucase$(temp$)<>"N" then 9000
  277.  
  278. 9001    print clear$:print
  279.         input "Enter first record number to print - ";first
  280.         input "Enter last record to print         - ";last
  281.     IF last>z2-1 then 9001
  282.     IF first>last then 9001
  283.     IF first<1 then 9001
  284. 9005 lprinter
  285.      open z5$ recl 384 as 1
  286. 9015 FOR Z1=first TO last
  287.      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)
  288. 9022 Z9=1
  289. 9023 FOR Z=3 TO 17:K$(5,Z)=MID$(N$,Z9,N(0,Z)):Z9=Z9+N(0,Z):NEXT Z
  290. 9024 print delim1$:print:print "RECORD NO.";z1:print
  291. 9025 print MID$(K$(3,1),6,30);TAB(11);N(2,1);TAB(40);MID$(K$(3,2),6,30);
  292. 9030 print TAB(55);N(2,2)
  293. 9031 print
  294. 9035 print "BILL TO";TAB(40);"SHIP TO"
  295. 9040 print delim$
  296. 9041 print
  297. 9045 FOR Z=3 TO 9
  298. 9050 print MID$(K$(3,Z),6,30);TAB(11);K$(5,Z);TAB(40);MID$(K$(3,Z+7),6,30);
  299. 9055 print TAB(50);K$(5,Z+7)
  300. 9060 NEXT Z
  301. 9061 print
  302. 9065 Z=17:print delim$
  303. 9070 print MID$(K$(3,Z),6,30);TAB(40);K$(5,Z)
  304. 9075 FOR Z=18 TO 23:print MID$(K$(4,Z-17),6,30);TAB(30);
  305. 9080 print using l$;n(2,z-15):NEXT Z
  306. 9085 print
  307. 9100 print chr$(12)
  308. 9105 NEXT Z1
  309. 9110 CLOSE 1
  310. 9115 console
  311. 9120 RETURN
  312. 10000 CHAIN "master3"
  313. 15000    print clear$:print:print "CHECKING FILE LENGTH"
  314.     PRINT:PRINT "*** PLEASE WAIT ***"
  315.     open z5$ recl 384 as 1
  316.     z3=(size(z5$)*block.size)/384
  317.     for z2=1 to z3
  318.     read #1,z2;n(2,1),n(2,2)
  319.     if n(2,2)=0 then 15300
  320.     next z2
  321. 15300    z3=int(z3)-2
  322.     close 1
  323.     create z7$ as 1
  324.     print #1;z2,z3
  325.     close 1
  326.     GOTO 1500
  327.