home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug087.ark / RGENTRY.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-10-20  |  10.2 KB  |  303 lines
  1.      rem This is the Raw Goods Inventory Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      RESTORE
  5. 520 L$="$##,###.###"
  6. 525 U$="##########"
  7. 530 DIM K$(6,20),n(2,20)
  8.      repeat$="-------------------------------"
  9.      fill$="                               "
  10.      z5$="b:rg"
  11.      z6$="b:rgback":z7$=z5$+"size"
  12. 535 FOR Z=1 TO 72:delim$=delim$+"=":NEXT Z
  13. 540 K$(6,1)="1 - NEW ENTRY":K$(6,2)="2 - EXAMINE EXISTING ENTRY"
  14. 550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
  15. 560 K$(6,4)="4 - DELETE EXISTING ENTRY"
  16. 570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
  17. 580 K$(6,7)="7 - BACK-UP AND SORT FILE":K$(6,8)="8 - LIST FILE"
  18. 590 K$(6,9)="9 - FINISHED"
  19.      print clear$:print
  20.      for z=1 to 19:read k$(1,z):next z
  21.      for z=1 to 20:read k$(2,z):next z
  22.      for z=1 to 19:read n(1,z):next z
  23.      data Tag,Acct Number,Item #,Part #,Description,Location(shelf-bin)
  24.      data Date of Last Issue,Date of Last Receipt,Vendor Code,Vendor Tag #
  25.      data Unit Cost,Selling Price,Quan on Hand,Quan on Order,Quan Issued M-T-D
  26.      data Quan Issued Q-T-D,Quan Issued Y-T-D,Min Quan (stock),Max Quan (stock)
  27.      data 1 - Tag,2 - Acct Number,3 - Item #,4 - Part #,5 - Description
  28.      data 6 - Loc (shelf-bin),7 - Date of Last Issue,8 - Date Last Receipt
  29.      data 9 - Vendor Code,10- Vendor Tag #,11- Unit Cost,12- Selling Price
  30.      data 13- Quan on hand,14- Quan on Order,15- Quan Issued M-T-D
  31.      data 16- Quan Issued Q-T-D,17- Quan Issued Y-T-D,18- Min Quan (stock)
  32.      data 19- Max Quan (stock),20- None
  33.      data 4,10,7,12,24,24,8,8,10,4,12,12,8,8,10,10,10,10,10
  34.     print clear$:print
  35.  
  36. 1500    if end #1 then 6000
  37.     if end #2 then 15000
  38.         open z5$ recl 256 as 1
  39.         close 1
  40.         open z7$ as 2
  41.         read #2;z2,z3
  42.         close 2
  43.  
  44. 1600    REM
  45. 1620    PRINT CLEAR$
  46.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  47.     PRINT "RAW GOODS INVENTORY ENTRY PROGRAM"
  48.         PRINT      "---------------------------------"
  49.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  50.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  51.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  52.     PRINT
  53.  
  54. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  55. 1655 PRINT
  56. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  57. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  58. 1670 PRINT "THE CORRESPONDING NUMBER."
  59. 1675 PRINT
  60. 1680 INPUT Z
  61.     IF Z<1 OR Z>9 then 1620
  62. 1682 IF Z=1 THEN new$="N"
  63. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  64. 1690 FOR Z=1 TO 20:N(2,Z)=0:NEXT Z:N$=""
  65. 1700 FOR Z=1 TO 20:K$(3,Z)="":NEXT Z
  66. 1702 new$=""
  67. 1705 GOTO 1600
  68. 2000 IF Z2>Z3 THEN RETURN
  69. 2001 PRINT CLEAR$:PRINT
  70. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  71. 2015 FOR Z=1 TO 2
  72.     PRINT CUR$
  73. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  74.     PRINT UP$;
  75. 2025 PRINT K$(1,Z);TAB(30);
  76. 2030 INPUT N(2,Z):PRINT chr$(13)
  77.     PRINT CLEAR$
  78. 2035 NEXT Z
  79. 2036 FOR Z=3 TO 9
  80.     PRINT CUR$
  81. 2037 PRINT TAB(30);left$(repeat$,n(1,z))
  82.     PRINT UP$;
  83. 2038 PRINT K$(1,Z);TAB(30);
  84. 2039 INPUT line K$(3,Z):PRINT chr$(13)
  85.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  86. 2040 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  87.     PRINT CLEAR$
  88. 2045 NEXT Z
  89. 2065 FOR Z=10 TO 19
  90.     PRINT CUR$
  91. 2070 PRINT TAB(30);left$(repeat$,n(1,z))
  92.     PRINT UP$;
  93. 2075 PRINT K$(1,Z);TAB(30);
  94. 2080 INPUT N(2,Z):PRINT chr$(13)
  95.     PRINT CLEAR$
  96. 2085 NEXT Z
  97. 2090 N$=""
  98. 2095 FOR Z=3 TO 9:N$=N$+K$(3,Z):NEXT Z
  99. 2100 Z1=Z2
  100. 2105 PRINT clear$;
  101. 2110 PRINT "RECORD NUMBER";Z1;TAB(31);"RAW GOODS ENTRY"
  102. 2115 FOR Z=1 TO 2
  103. 2116 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  104. 2118 NEXT Z
  105. 2120 FOR Z=3 TO 9
  106. 2122 PRINT K$(2,Z);TAB(30);K$(3,Z)
  107. 2124 NEXT Z
  108. 2126 Z=10:PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  109. 2128 FOR Z=11 TO 12
  110. 2130 PRINT K$(2,Z);TAB(30);:print using l$;n(2,z)
  111. 2132 NEXT Z
  112. 2134 FOR Z=13 TO 19
  113. 2136 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  114. 2138 NEXT Z
  115. 2140 PRINT K$(2,20)
  116. 2163 PRINT"TO MAKE A CHANGE, TYPE THE APPROPRIATE #."
  117. 2164 INPUT Z
  118. 2165 IF Z>19 THEN 2216
  119. 2170 IF Z<1 THEN 2105
  120. 2175 IF Z>2 AND Z<10 THEN 2200
  121.     CL=10:CC=50:GOSUB 50:PRINT CUR2$;
  122. 2180 PRINT left$(repeat$,n(1,z))
  123.     CL=12:GOSUB 50:PRINT CUR2$;
  124. 2185 PRINT K$(1,Z)
  125.     CL=10:CC=48:GOSUB 50:PRINT CUR2$;
  126. 2190 INPUT N(2,Z)
  127. 2195 GOTO 2225
  128. 2200    CL=10:CC=50:GOSUB 50:PRINT CUR2$;
  129.     PRINT left$(repeat$,n(1,z))
  130.     CL=12:GOSUB 50:PRINT CUR2$;
  131. 2205 PRINT K$(1,Z)
  132.     CL=10:CC=48:GOSUB 50:PRINT CUR2$;
  133. 2210 INPUT line K$(3,Z)
  134.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  135. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  136. 2216 N$=""
  137. 2220 FOR Z=3 TO 9:N$=N$+K$(3,Z):NEXT Z
  138. 2225 CL=15:CC=55:GOSUB 50:PRINT CUR2$;
  139.     INPUT "ANY MORE CHANGES";line temp$
  140. 2230 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2105
  141. 2235    PRINT CUR2$;
  142. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  143. 2245 PRINT
  144. 2250 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2280
  145. 2255 IF left$(temp$,1)<>"n" AND left$(temp$,1)<>"N" THEN 2235
  146. 2260 PRINT clear$:PRINT
  147. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  148. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  149. 2280 open z5$ recl 256 as 1
  150.      print #1,z1;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  151.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  152.      close 1
  153. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  154. 2300 RETURN
  155. 3000 PRINT clear$:PRINT
  156. 3005 INPUT "RECORD NUMBER";Z1
  157. 3010 IF Z1>=Z2 THEN 3000
  158. 3012 IF Z1<1 THEN RETURN
  159. 3015 open z5$ recl 256 as 1
  160.      read #1,z1;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  161.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  162. 3022 Z9=1:FOR Z=3 TO 9:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):next z
  163. 3025 close 1
  164. 3105 GOSUB 11000
  165. 3170 PRINT"FOR A NEW RECORD, TYPE N - TYPE F IF FINISHED.":INPUT line temp$
  166. 3190 IF ucase$(temp$)="N" THEN 3000
  167. 3195 RETURN
  168. 4000 PRINT clear$:PRINT
  169. 4005 N$=""
  170. 4010 INPUT "RECORD NUMBER";Z1
  171. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  172. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  173. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  174. 4030 open z5$ recl 256 as 1
  175.      read #1,z1;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  176.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  177. 4036 Z9=1:FOR Z=3 TO 9:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  178. 4040 close 1
  179. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  180. 4075 GOTO 2105
  181. 5000 PRINT clear$:PRINT
  182. 5010 INPUT "RECORD NUMBER";Z1
  183. 5015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  184. 5020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  185. 5025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  186. 5030 open z5$ recl 256 as 1
  187.      read #1,z1;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  188.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  189. 5036 Z9=1:FOR Z=3 TO 9:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  190. 5040 close 1
  191. 5105 GOSUB 11000
  192. 5200 INPUT "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
  193. 5205 IF left$(temp$,1)="n" OR left$(temp$,1)="N" THEN RETURN
  194. 5210 IF ucase$(temp$)<>"YES" THEN 5200
  195. 5215 N(2,1)=0
  196. 5220 open z5$ recl 256 as 1
  197.      print #1,z1;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  198.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  199. 5230 close 1
  200. 5235 RETURN
  201. 6000 PRINT clear$:PRINT
  202. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A RAW GOODS FILE"
  203. 6010 PRINT "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
  204. 6015 PRINT "TYPE THE LETTER C FOLLOWED BY A RETURN TO CONTINUE."
  205. 6020 PRINT
  206. 6025 PRINT "IF YOU WISH TO CREATE A NEW FILE, TYPE THE LETTER N"
  207. 6030 PRINT "FOLLOWED BY RETURN.":PRINT
  208. 6035 INPUT temp$
  209. 6040 IF ucase$(temp$)="C" THEN GOTO 1500
  210. 6045 PRINT clear$:PRINT
  211. 6050 INPUT "NUMBER OF RECORDS DESIRED";z3
  212. 6055 PRINT
  213. 6060 n$="":for z=1 to 80:n$=n$+" ":next z:FOR Z=1 TO 20:N(2,Z)=0:NEXT Z
  214. 6065 create z5$ recl 256 as 1
  215. 6070 FOR Z1=1 TO z3+2
  216.      print #1,z1;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  217.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  218. 6085 NEXT Z1
  219. 6090 close 1
  220. 6095 PRINT clear$:PRINT
  221. 6100 PRINT "RAW GOODS FILE CREATED AND CLEARED.":PRINT
  222. 6105 PRINT z3;"RECORDS CREATED.":PRINT
  223. 6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
  224.     Z2=1
  225.     create z7$ as 1:print #1;Z2,Z3:close 1
  226. 6115 GOTO 1500
  227. 7000 z2=z3:n$="":for z=1 to 80:n$=n$+" ":next z:FOR Z=1 TO 20:N(2,Z)=0:NEXT Z
  228. 7006 INPUT "ARE YOU SURE !!! (YES OR NO)";line temp$
  229. 7007 IF ucase$(temp$)<>"YES" THEN RETURN
  230.      open z5$ recl 256 as 1
  231. 7010 FOR Z1=1 TO z3+2
  232.      print #1,z1;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  233.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  234. 7025 NEXT Z1
  235. 7030 close 1
  236. 7035 PRINT clear$:PRINT
  237. 7040 PRINT "RAW GOODS FILE CLEARED!":PRINT
  238. 7045 PRINT "TO CONTINUE, TYPE RETURN."
  239. 7050 INPUT line temp$
  240.     Z2=1
  241.     open z7$ as 1:print #1;Z2,Z3:close 1
  242. 7060 RETURN
  243. 8000 chain "rgsort"
  244. 9000 lprinter
  245. 9005 PRINT clear$:PRINT
  246. 9010 open z5$ recl 256 as 1
  247. 9015 FOR I=1 TO Z2-1
  248.      READ #1,i;n(2,1),n(2,2),n$,n(2,10),n(2,11),n(2,12),\
  249.           n(2,13),n(2,14),n(2,15),n(2,16),n(2,17),n(2,18),n(2,19)
  250. 9035 Z9=1:FOR Z=3 TO 9:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  251. 9110 print "RECORD NUMBER";i;TAB(31);"RAW GOODS ENTRY"
  252. 9115 FOR Z=1 TO 2
  253. 9116 print K$(2,Z);TAB(30);:print using u$;n(2,z)
  254. 9118 NEXT Z
  255. 9120 FOR Z=3 TO 9
  256. 9122 print K$(2,Z);TAB(30);K$(3,Z)
  257. 9124 NEXT Z
  258. 9126 Z=10:print K$(2,Z);TAB(30);:print using u$;n(2,z)
  259. 9128 FOR Z=11 TO 12
  260. 9130 print K$(2,Z);TAB(30);:print using l$;n(2,z)
  261. 9132 NEXT Z
  262. 9134 FOR Z=13 TO 19
  263. 9136 print K$(2,Z);TAB(30);:print using u$;n(2,z)
  264. 9138 NEXT Z
  265. 9145 print chr$(12)
  266. 9150 NEXT I
  267.     CLOSE 1
  268.      print chr$(12):for z=1 to 100:next z:print chr$(12)
  269. 9155 console
  270. 9900 RETURN
  271. 10000 CHAIN "master4"
  272. 11000 PRINT clear$:PRINT
  273. 11110 PRINT "RECORD NUMBER";Z1;TAB(31);"RAW GOODS ENTRY"
  274. 11115 FOR Z=1 TO 2
  275. 11116 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  276. 11118 NEXT Z
  277. 11120 FOR Z=3 TO 9
  278. 11122 PRINT K$(2,Z);TAB(30);K$(3,Z)
  279. 11124 NEXT Z
  280. 11126 Z=10:PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  281. 11128 FOR Z=11 TO 12
  282. 11130 PRINT K$(2,Z);TAB(30);:print using l$;n(2,z)
  283. 11132 NEXT Z
  284. 11134 FOR Z=13 TO 19
  285. 11136 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  286. 11138 NEXT Z
  287. 11140 RETURN
  288. 15000    print clear$:print:print "CHECKING FILE LENGTH"
  289.     PRINT:PRINT "*** PLEASE WAIT ***"
  290.     open z5$ recl 256 as 1
  291.     IF END#1 THEN 15300
  292.     z3=(size(z5$)*block.size)/256
  293.     for z2=1 to z3
  294.     read #1,z2;n(2,1),n(2,2)
  295.     if n(2,2)=0 then 15300
  296.     next z2
  297. 15300    z3=int(z3)-2
  298.     close 1
  299.     create z7$ as 1
  300.     print #1;z2,z3
  301.     close 1
  302.     GOTO 1500
  303.