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