home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug087.ark / FGENTRY.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-10-20  |  10.3 KB  |  302 lines
  1.      rem This is the Finished 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:fg"
  11.      z6$="b:fgback":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.      restore
  35.     print clear$:print
  36.  
  37. 1500    if end #1 then 6000
  38.     if end #2 then 15000
  39.         open z5$ recl 256 as 1
  40.         close 1
  41.         open z7$ as 2
  42.         read #2;z2,z3
  43.         close 2
  44.  
  45. 1600    REM
  46. 1620     PRINT CLEAR$
  47.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  48.     PRINT "FINISHED GOODS INVENTORY ENTRY PROGRAM"
  49.         PRINT      "--------------------------------------"
  50.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  51.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  52.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  53.     PRINT
  54.  
  55. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  56. 1655 PRINT
  57. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  58. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  59. 1670 PRINT "THE CORRESPONDING NUMBER."
  60. 1675 PRINT
  61. 1680 INPUT Z
  62.     IF Z<1 OR Z>9 then 1620
  63. 1682 IF Z=1 THEN new$="N"
  64. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  65. 1690 FOR Z=1 TO 20:N(2,Z)=0:NEXT Z:N$=""
  66. 1700 FOR Z=1 TO 20:K$(3,Z)="":NEXT Z
  67. 1702 new$=""
  68. 1705 GOTO 1600
  69. 2000 IF Z2>Z3 THEN RETURN
  70. 2001 PRINT CLEAR$:PRINT
  71. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  72. 2015 FOR Z=1 TO 2
  73.     PRINT CUR$
  74. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  75.     PRINT UP$;
  76. 2025 PRINT K$(1,Z);TAB(30);
  77. 2030 INPUT N(2,Z):PRINT chr$(13)
  78.     PRINT CLEAR$
  79. 2035 NEXT Z
  80. 2036 FOR Z=3 TO 9
  81.     PRINT CUR$
  82. 2037 PRINT TAB(30);left$(repeat$,n(1,z))
  83.     PRINT UP$;
  84. 2038 PRINT K$(1,Z);TAB(30);
  85. 2039 INPUT line K$(3,Z):PRINT chr$(13)
  86.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  87. 2040 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  88.     PRINT CLEAR$
  89. 2045 NEXT Z
  90. 2065 FOR Z=10 TO 19
  91.     PRINT CUR$
  92. 2070 PRINT TAB(30);left$(repeat$,n(1,z))
  93.     PRINT UP$;
  94. 2075 PRINT K$(1,Z);TAB(30);
  95. 2080 INPUT N(2,Z):PRINT chr$(13)
  96.     PRINT CLEAR$
  97. 2085 NEXT Z
  98. 2090 N$=""
  99. 2095 FOR Z=3 TO 9:N$=N$+K$(3,Z):NEXT Z
  100. 2100 Z1=Z2
  101. 2105 PRINT clear$;
  102. 2110 PRINT "RECORD NUMBER";Z1;TAB(31);"FINISHED GOODS ENTRY"
  103. 2115 FOR Z=1 TO 2
  104. 2116 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  105. 2118 NEXT Z
  106. 2120 FOR Z=3 TO 9
  107. 2122 PRINT K$(2,Z);TAB(30);K$(3,Z)
  108. 2124 NEXT Z
  109. 2126 Z=10:PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  110. 2128 FOR Z=11 TO 12
  111. 2130 PRINT K$(2,Z);TAB(30);:print using l$;n(2,z)
  112. 2132 NEXT Z
  113. 2134 FOR Z=13 TO 19
  114. 2136 PRINT K$(2,Z);TAB(30);:print using u$;n(2,z)
  115. 2138 NEXT Z
  116. 2140 PRINT K$(2,20)
  117. 2163 PRINT"TO MAKE A CHANGE, TYPE THE APPROPRIATE #."
  118. 2164 INPUT Z
  119. 2165 IF Z>19 THEN 2216
  120. 2170 IF Z<1 THEN 2105
  121. 2175 IF Z>2 AND Z<10 THEN 2200
  122.     CL=10:CC=50:GOSUB 50:PRINT CUR2$;
  123. 2180 PRINT left$(repeat$,n(1,z))
  124.     CL=12:GOSUB 50:PRINT CUR2$;
  125. 2185 PRINT K$(1,Z)
  126.     CL=10:CC=48:GOSUB 50:PRINT CUR2$;
  127. 2190 INPUT N(2,Z)
  128. 2195 GOTO 2225
  129. 2200 CL=10:CC=50:GOSUB 50:PRINT CUR2$; :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=14:CC=50: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 FINISHED 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 initialize: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 "FINISHED 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 "FINISHED 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 "fgsort"
  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);"FINISHED 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.      print chr$(12):for z=1 to 100:next z:print chr$(12)
  268. 9155 console
  269.      close 1
  270. 9900 RETURN
  271. 10000 CHAIN "master4"
  272. 11000 PRINT clear$:PRINT
  273. 11110 PRINT "RECORD NUMBER";Z1;TAB(31);"FINISHED 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.     z3=(size(z5$)*block.size)/256
  292.     for z2=1 to z3
  293.     read #1,z2;n(2,1),n(2,2)
  294.     if n(2,2)=0 then 15300
  295.     next z2
  296. 15300    z3=int(z3)-2
  297.     close 1
  298.     create z7$ as 1
  299.     print #1;z2,z3
  300.     close 1
  301.     GOTO 1500
  302.