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 / VPJOTRAN.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  13KB  |  361 lines
  1.      rem This is the Purchase Order Entry Program 
  2.      rem The CP/MUG version does not include VPJOSORT, so \
  3.      do not select function 7.
  4.  
  5. %INCLUDE ALL.BAS
  6.      dim n(2,20),k$(4,20),g(10),q(10)
  7.      l$="$$##,###.##":u$="##########":v$="####"
  8.      repeat$="--------------------------------"
  9.      fill$="                                "
  10.      z5$="b:po":z6$=z5$+"back":z7$=z5$+"size"
  11.      RESTORE
  12.      for z=1 to 70:delim1$=delim1$+"*":delim2$=delim2$+"=":next z
  13. fmt1$ ="Rec No. ####  1 - Tag  ########     2 - A/P Account No.  ##########"
  14. fmt2$ ="3 - Pur Ord No.   ##########        4 - Buyer     /             /"
  15. fmt3$ ="5 - Vend Inv No. /               /  6 - Req. Date        /         /"
  16. fmt4$ ="7 - Carrier (Via) /       /         8 - FOB Point /         /"
  17. fmt5$ ="9 - Terms  /         /              10- Tax Code  !  Flags  /   /"
  18. fmt6$ ="12- Vendor   Rec No. ####           13- Shipping Chgs $##########.##"
  19. fmt7$ ="     Item Record No     Quantity         Item Record No     Quantity"
  20. fmt8$ ="No 1          ####    ##########    No 2          ####    ##########"
  21. fmt9$ ="No 3          ####    ##########    No 4          ####    ##########"
  22. fmt10$="No 5          ####    ##########    No 6          ####    ##########"
  23. fmt11$="No 7          ####    ##########    No 8          ####    ##########"
  24. fmt12$="No 9          ####    ##########    No 10         ####    ##########"
  25. 540 K$(4,1)="1 - NEW ENTRY":K$(4,2)="2 - EXAMINE EXISTING ENTRY"
  26. 550 K$(4,3)="3 - MODIFY EXISTING ENTRY"
  27. 560 K$(4,4)="4 - DELETE EXISTING ENTRY"
  28. 570 K$(4,5)="5 - CREATE NEW FILE":K$(4,6)="6 - CLEAR EXISTING FILE"
  29. 580 K$(4,7)="7 - BACK-UP AND SORT FILE":K$(4,8)="8 - LIST FILE"
  30. 590 K$(4,9)="9 - FINISHED"
  31.      print clear$:print
  32. 1100 K$(1,1)="TAG":K$(1,2)="A/P ACCT #":K$(1,3)="PUR ORD #"
  33. 1105 K$(1,4)="BUYER":K$(1,5)="VEND INV. #":K$(1,6)="REQUIRED DATE"
  34. 1110 K$(1,7)="CARRIER (VIA)":K$(1,8)="FOB POINT":K$(1,9)="TERMS (1,2, OR 3)"
  35. 1130 K$(1,10)="TAX CODE":K$(1,11)="FLAGS"
  36. 1132 K$(1,12)="VENDOR REC #"
  37. 1135 K$(1,13)="SHIPPING CHARGES"
  38. 1200 K$(2,1)="1 - TAG":K$(2,2)="2 - A/P ACCT #":K$(2,3)="3 - PUR ORD #"
  39. 1205 K$(2,4)="4 - BUYER":K$(2,5)="5 - VEND INV #"
  40. 1206 K$(2,6)="6 - REQUIRED DATE":K$(2,7)="7 - CARRIER(VIA)"
  41. 1210 K$(2,8)="8 - FOB POINT":K$(2,9)="9 - TERMS (1,2, OR 3)"
  42. 1230 K$(2,10)="10- TAX CODE":K$(2,11)="11- FLAGS"
  43. 1232 K$(2,12)="12- VENDOR REC #"
  44. 1235 K$(2,13)="13- SHIPPING CHARGES"
  45. 1300 N(1,1)=8:N(1,2)=10:N(1,3)=10:N(1,4)=14:N(1,5)=10:N(1,6)=8
  46. 1305 N(1,7)=8:N(1,8)=10:N(1,9)=10:N(1,10)=1:N(1,11)=4:N(1,12)=4
  47. 1310 N(1,13)=12:G(0)=4:Q(0)=10
  48.     print clear$:print
  49.  
  50. 1500    if end #1 then 6000
  51.     if end #2 then 15000
  52.         open z5$ recl 384 as 1
  53.         close 1
  54.         open z7$ as 2
  55.         read #2;z2,z3
  56.         close 2
  57.  
  58. 1600    REM
  59. 1620    PRINT CLEAR$
  60.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  61.     PRINT "PURCHASE ORDER ENTRY PROGRAM"
  62.         PRINT      "----------------------------"
  63.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  64.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  65.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  66.     PRINT
  67.  
  68. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  69. 1655 PRINT
  70. 1660 FOR Z=1 TO 9:PRINT K$(4,Z):NEXT Z:PRINT
  71. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  72. 1670 PRINT "THE CORRESPONDING NUMBER."
  73. 1675 PRINT
  74. 1680 INPUT Z
  75.     IF Z<1 OR Z>9 then 1620
  76. 1682 IF Z=1 THEN new$="N"
  77. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  78. 1690 FOR Z=1 TO 20:N(2,Z)=0:N(0,Z)=0:NEXT Z
  79. 1695 N$="":new$=""
  80. 1700 FOR Z=1 TO 20:K$(3,Z)="":NEXT Z
  81.      for z=1 to 10:g(z)=0:q(z)=0:next z
  82. 1720 GOTO 1600
  83. 2000 IF Z2>Z3 THEN RETURN
  84. 2001 PRINT CLEAR$:PRINT
  85. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  86. 2015 FOR Z=1 TO 2
  87.     PRINT CUR$
  88. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  89.     PRINT UP$;
  90. 2025 PRINT K$(1,Z);TAB(30);
  91. 2030 INPUT N(2,Z):PRINT chr$(13)
  92.     PRINT CLEAR$
  93. 2035 NEXT Z
  94. 2036 Z=0:GOSUB 24000
  95. 2040 FOR Z=4 TO 10
  96.     PRINT CUR$
  97. 2042 PRINT TAB(30);left$(repeat$,n(1,z))
  98.     PRINT UP$;
  99. 2044 PRINT K$(1,Z);TAB(30);
  100. 2046 INPUT line K$(3,Z):PRINT chr$(13)
  101.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  102. 2048 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  103.     PRINT CLEAR$
  104. 2050 NEXT Z
  105. 2052 N$=""
  106. 2054 FOR Z=4 TO 10:N$=N$+K$(3,Z):NEXT Z
  107. 2056 FOR Z=12 TO 13
  108.     PRINT CUR$
  109. 2058 PRINT TAB(30);left$(repeat$,n(1,z))
  110.     PRINT UP$;
  111. 2060 PRINT K$(1,Z);TAB(30);
  112. 2062 INPUT N(2,Z):PRINT chr$(13)
  113.     PRINT CLEAR$
  114. 2064 NEXT Z
  115. 2066 FOR Z=1 TO 10
  116.     PRINT CUR$
  117. 2068 PRINT TAB(30);left$(repeat$,g(0))
  118.     PRINT UP$;
  119. 2070 PRINT "FINISHED GOODS REC # ";TAB(30);
  120. 2072 INPUT G(Z):PRINT chr$(13)
  121.     PRINT CLEAR$
  122.     PRINT CUR$
  123. 2074 PRINT TAB(30);left$(repeat$,q(0))
  124.     PRINT UP$;
  125. 2076 PRINT "QUANTITY ";TAB(30);
  126. 2078 INPUT Q(Z):PRINT chr$(13)
  127. 2080 PRINT:INPUT "IS THIS THE LAST ITEM? ";line temp$
  128. 2082 IF left$(temp$,1)="y" or left$(temp$,1)="Y" THEN 2100
  129.     PRINT CLEAR$
  130. 2084 NEXT Z
  131. 2100 Z1=Z2
  132. 2105 PRINT clear$;
  133. 2110 GOSUB 20000
  134. 2115 PRINT "IF A FINISHED GOODS REC # OR QUANTITY IS TO BE CHANGED"
  135. 2116 PRINT "TYPE # - RETURN. OTHERWISE TYPE THE NUMBER PRECEEDING AN ENTRY"
  136. 2117 PRINT "FOLLOWED BY RETURN.":PRINT
  137. 2118 PRINT "IF YOU ARE FINISHED, TYPE 14 - RETURN";
  138. 2119 INPUT line temp$
  139. 2120 IF temp$="#" THEN GOSUB 25000
  140. 2125 Z=VAL(temp$)
  141. 2150 IF Z>13 THEN 2216
  142. 2160 IF Z=3 THEN GOSUB 24000
  143. 2177 IF Z<1 THEN 2105
  144. 2178 IF Z>3 AND Z<12 THEN 2200
  145. 2180 PRINT TAB(30);left$(repeat$,n(1,z))
  146.     PRINT UP$;
  147. 2185 PRINT K$(1,Z);TAB(30);
  148. 2190 INPUT N(2,Z)
  149. 2195 GOTO 2225
  150. 2200 PRINT TAB(30);left$(repeat$,n(1,z))
  151.     PRINT UP$;
  152. 2205 PRINT K$(1,Z);TAB(30);
  153. 2210 INPUT line K$(3,Z)
  154.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  155. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  156. 2216 N$=""
  157. 2217 FOR I=4 TO 11:N$=N$+K$(3,I):NEXT I
  158. 2225 INPUT "ANY MORE CHANGES";line temp$
  159. 2230 IF left$(temp$,1)="y" or left$(temp$,1)="Y" THEN 2105
  160. 2235 PRINT
  161. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  162. 2245 PRINT
  163. 2250 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2280
  164. 2255 IF left$(temp$,1)<>"n" AND left$(temp$,1)<>"N" THEN 2235
  165. 2260 PRINT clear$:PRINT
  166. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  167. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  168. 2280 open z5$ recl 384 as 1
  169.      print #1,z1;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  170.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  171.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  172.      close 1
  173. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  174. 2300 RETURN
  175. 3000 PRINT clear$:PRINT:INPUT "RECORD NUMBER";Z1:PRINT clear$:PRINT
  176. 3003 IF Z1>=Z2 THEN 3000
  177. 3004 IF Z1<1 THEN RETURN
  178. 3005 open z5$ recl 384 as 1
  179.      read #1,z1;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  180.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  181.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  182. 3008 Z9=1:FOR Z=4 TO 11:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  183. 3009 CLOSE 1
  184. 3015 PRINT clear$:PRINT
  185. 3020 GOSUB 20000
  186. 3075 PRINT "FOR NEW RECORD, TYPE N-RETURN , OTHERWISE F-RETURN"
  187. 3085 INPUT line temp$
  188. 3090 IF ucase$(temp$)="N" THEN 3000
  189. 3095 RETURN
  190. 4000 PRINT clear$:PRINT
  191. 4005 N$=""
  192. 4010 INPUT "RECORD NUMBER";Z1
  193. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  194. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  195. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  196. 4030 open z5$ recl 384 as 1
  197.      read #1,z1;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  198.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  199.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  200.      close 1
  201. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  202. 4050 Z9=1
  203. 4055 FOR Z=4 TO 11
  204. 4060 K$(3,Z)=MID$(N$,Z9,N(1,Z))
  205. 4065 Z9=Z9+N(1,Z)
  206. 4070 NEXT Z
  207. 4075 GOTO 2105
  208. 5000 PRINT clear$:PRINT:INPUT "RECORD NUMBER";Z1:PRINT clear$:PRINT
  209. 5002 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  210. 5004 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  211. 5005 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  212. 5006 open z5$ recl 384 as 1
  213.      read #1,z1;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  214.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  215.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  216.      close 1
  217. 5010 Z9=1:FOR Z=4 TO 11:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  218. 5015 PRINT clear$:PRINT
  219. 5020 GOSUB 20000
  220. 5100 INPUT "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
  221. 5105 IF left$(temp$,1)="n" OR left$(temp$,1)="N" THEN RETURN
  222. 5110 IF ucase$(temp$)<>"YES" THEN 5100
  223. 5115 N(2,1)=0
  224. 5120 open z5$ recl 384 as 1
  225.      print #1,z1;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  226.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  227.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  228. 5130 close 1
  229. 5135 RETURN
  230. 6000 PRINT clear$:PRINT
  231. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A PUR ORD REG 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 150:n$=n$+" ":next z
  243.      for z=1 to 20:n(2,z)=0:n(0,z)=0:next z
  244. 6062 FOR Z=1 TO 10:G(Z)=0:Q(Z)=0:NEXT Z
  245. 6065 create z5$ recl 384 as 1
  246. 6070 FOR Z1=1 TO z3+2
  247.      print #1,z1;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  248.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  249.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  250. 6085 NEXT Z1
  251. 6090 close 1
  252. 6095 PRINT clear$:PRINT
  253. 6100 PRINT "PUR ORD REG FILE CREATED AND CLEARED.":PRINT
  254. 6105 PRINT z3;"RECORDS CREATED.":PRINT
  255. 6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
  256.     Z2=1
  257.     create z7$ as 1:print #1;Z2,Z3:close 1
  258. 6115 GOTO 1500
  259. 7000 INPUT "ARE YOU SURE !!! (YES OR NO)";line temp$
  260. 7007 IF ucase$(temp$)<>"YES" THEN RETURN
  261. 7008 n$="":for z=1 to 150:n$=n$+" ":next z
  262.      for z=1 to 20:n(2,z)=0:n(0,z)=0:next z
  263.      for z=1 to 10:g(z)=0:q(z)=0:next z
  264.      open z5$ recl 384 as 1
  265. 7010 FOR Z1=1 TO z3+2
  266.      print #1,z1;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  267.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  268.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  269. 7025 NEXT Z1
  270. 7030 close 1
  271. 7035 PRINT clear$:PRINT
  272. 7040 PRINT "PUR ORD REG FILE CLEARED!":PRINT
  273. 7045 PRINT "TO CONTINUE, TYPE RETURN."
  274. 7050 INPUT line temp$
  275.     Z2=1
  276.     open z7$ as 1:print #1;Z2,Z3:close 1
  277. 7060 RETURN
  278. 8000 chain "vpjosort"
  279. 9000 PRINT clear$:PRINT
  280. 9100 lprinter
  281. 9105 open z5$ recl 384 as 1
  282. 9110 FOR I=1 TO Z2-1
  283.      read #1,i;N(2,1),N(2,2),N(2,3),N$,N(2,12),N(2,13),\
  284.           G(1),Q(1),G(2),Q(2),G(3),Q(3),G(4),Q(4),G(5),Q(5),\
  285.           G(6),Q(6),G(7),Q(7),G(8),Q(8),G(9),Q(9),G(10),Q(10)
  286. 9140 Z9=1:FOR Z=4 TO 11:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  287.      print using fmt1$;i,n(2,1),n(2,2)
  288.      print using fmt2$;n(2,3),k$(3,4)
  289.      print using fmt3$;k$(3,5),k$(3,6)
  290.      print using fmt4$;k$(3,7),k$(3,8)
  291.      print using fmt5$;k$(3,9),k$(3,10),k$(3,11)
  292.      print using fmt6$;n(2,12),n(2,13)
  293.      print delim2$
  294.      print fmt7$
  295.      print using fmt8$;g(1),q(1),g(2),q(2)
  296.      print using fmt9$;g(3),q(3),g(4),q(4)
  297.      print using fmt10$;g(5),q(5),g(6),q(6)
  298.      print using fmt11$;g(7),q(7),g(8),q(8)
  299.      print using fmt12$;g(9),q(9),g(10),q(10)
  300.      print
  301. 9800 NEXT I
  302. 9995 RETURN
  303. 10000 CHAIN "master3"
  304. 15000    print clear$:print:print "CHECKING FILE LENGTH"
  305.     PRINT:PRINT "*** PLEASE WAIT ***"
  306.     open z5$ recl 384 as 1
  307.     z3=(size(z5$)*block.size)/384
  308.     for z2=1 to z3
  309.     read #1,z2;n(2,1),n(2,2)
  310.     if n(2,2)=0 then 15300
  311.     next z2
  312. 15300    z3=int(z3)-2
  313.     close 1
  314.     create z7$ as 1
  315.     print #1;z2,z3
  316.     close 1
  317.     GOTO 1500
  318. 20000 print using fmt1$;z1,n(2,1),n(2,2)
  319.      print using fmt2$;n(2,3),k$(3,4)
  320.      print using fmt3$;k$(3,5),k$(3,6)
  321.      print using fmt4$;k$(3,7),k$(3,8)
  322.      print using fmt5$;k$(3,9),k$(3,10),k$(3,11)
  323.      print using fmt6$;n(2,12),n(2,13)
  324.      print delim2$
  325.      print fmt7$
  326.      print using fmt8$;g(1),q(1),g(2),q(2)
  327.      print using fmt9$;g(3),q(3),g(4),q(4)
  328.      print using fmt10$;g(5),q(5),g(6),q(6)
  329.      print using fmt11$;g(7),q(7),g(8),q(8)
  330.      print using fmt12$;g(9),q(9),g(10),q(10)
  331.      print
  332. 20250 RETURN
  333. 24000 open "b:poe" as 1
  334.       read #1;n(2,3)
  335.       close 1
  336. 24030 IF N(2,3)<>0 THEN 24800
  337.     PRINT CUR$
  338. 24040 PRINT TAB(30);left$(repeat$,n(1,3))
  339.     PRINT UP$;
  340. 24050 PRINT K$(1,3);TAB(30);
  341. 24060 INPUT N(2,3):PRINT chr$(13)
  342.     PRINT CLEAR$
  343. 24070 GOTO 24995
  344. 24800 IF Z=3 THEN 24995
  345. 24900 A=N(2,3)+1
  346. 24910 open "b:poe" as 1
  347.       print #1;a
  348.       close 1
  349. 24995 RETURN
  350. 25000 INPUT "ENTER PUR ORD ITEM # ";Z
  351. 25010 PRINT TAB(30);left$(repeat$,g(0))
  352.     PRINT UP$;
  353. 25020 PRINT "FINISHED GOODS REC # ";TAB(30);
  354. 25030 INPUT G(Z):PRINT chr$(13)
  355. 25040 PRINT TAB(30);left$(repeat$,q(0))
  356.     PRINT UP$;
  357. 25050 PRINT "QUANTITY ";TAB(30);
  358. 25060 INPUT Q(Z):PRINT chr$(13)
  359. 25070 temp$="14"
  360. 25995 RETURN
  361.