home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug087.ark / NAMENTRY.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-10-20  |  8.3 KB  |  277 lines
  1.      rem This is the Company Name Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      RESTORE
  5.     DIM T%(20),A(16),D$(8),N(2,2),DATE1$(8)
  6. 500 BIZMII.FLAG=0
  7. 505 Z5$="b:nm"
  8. 506 Z6$="b:nmback"
  9.     Z7$="b:nmsize"
  10. 510 X$=" "
  11. 515 repeat$="------------------------"
  12. 516 fill$="                         "
  13. 520 DIM Z$(5,5),N(2,20)
  14. 530 DIM K$(6,20)
  15. 540 K$(6,1)="1 - NEW ENTRY":K$(6,2)="2 - EXAMINE EXISTING ENTRY"
  16. 550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
  17. 560 K$(6,4)="4 - DELETE EXISTING ENTRY"
  18. 570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
  19. 580 K$(6,7)="7 - BACK-UP AND SORT FILE":K$(6,8)="8 - LIST FILE"
  20. 590 K$(6,9)="9 - FINISHED"
  21. 1000 REM THIS IS THE NAME ENTRY PROGRAM
  22. 1005 PRINT clear$
  23. 1010 PRINT
  24. 1075 K$(1,1)="TAG":K$(1,2)="REFERENCE NUMBER":K$(1,3)="NAME"
  25. 1080 K$(1,4)="COMPANY":K$(1,5)="ADDRESS":K$(1,6)="CITY":K$(1,7)="STATE"
  26. 1085 K$(1,8)="ZIP CODE":K$(1,9)="PHONE (AAA) NNN NNNN"
  27. 1086 K$(1,10)="FEDERAL TAX ID #":K$(1,11)="STATE TAX ID #"
  28. 1090 N(1,1)=4:N(1,2)=10:N(1,3)=24:N(1,4)=24:N(1,5)=24:N(1,6)=17
  29. 1095 N(1,7)=2:N(1,8)=5:N(1,9)=14:N(1,10)=20:N(1,11)=20
  30. 1100 K$(2,1)="1 - TAG":K$(2,2)="2 - REFERENCE NUMBER":K$(2,3)="3 - NAME"
  31. 1105 K$(2,4)="4 - COMPANY":K$(2,5)="5 - ADDRESS":K$(2,6)="6 - CITY"
  32. 1110 K$(2,7)="7 - STATE":K$(2,8)="8 - ZIP CODE"
  33. 1115 K$(2,9)="9 - PHONE (AAA) NNN NNNN"
  34. 1116 K$(2,10)="10- FEDERAL TAX ID #":K$(2,11)="11- STATE TAX ID #"
  35. 1117 K$(2,12)="12- NONE"
  36.     print clear$:print
  37.  
  38. 1500    if end #1 then 6000
  39.     if end #2 then 15000
  40.         open z5$ recl 170 as 1
  41.         close 1
  42.         open z7$ as 2
  43.         read #2;z2,z3
  44.         close 2
  45.  
  46. 1600    REM
  47. 1620    PRINT CLEAR$
  48.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  49.     PRINT "COMPANY NAME ENTRY PROGRAM"
  50.     PRINT "--------------------------"
  51.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  52.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  53.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  54.     PRINT
  55.  
  56. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  57. 1655 PRINT
  58. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  59. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  60. 1670 PRINT "THE CORRESPONDING NUMBER."
  61. 1675 PRINT
  62. 1680 INPUT Z
  63.     IF Z<1 OR Z>9 then 1620
  64. 1682 IF Z=1 THEN new$="N"
  65. 1685 ON Z go sub 2000,3000,4000,5000,6000,7000,8000,9000,10000
  66. 1690 N(2,1)=0:N(2,2)=0:N$="":new$=""
  67. 1700 FOR Z=1 TO 10:K$(3,Z)="":NEXT Z
  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. 2040 FOR Z=3 TO 11 
  81.     PRINT CUR$
  82. 2045 PRINT TAB(30);left$(repeat$,n(1,z))
  83.     PRINT UP$;
  84. 2050 PRINT K$(1,Z);TAB(30);
  85. 2055 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. 2060 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,I)
  88.     PRINT CLEAR$
  89. 2065 NEXT Z
  90. 2066 N$=""
  91. 2070 FOR Z=3 TO 11:N$=N$+K$(3,Z):NEXT Z
  92. 2100 Z1=Z2
  93. 2105 PRINT clear$:PRINT
  94. 2110 PRINT "RECORD NUMBER";Z1:PRINT
  95. 2115 FOR Z=1 TO 2
  96. 2120 PRINT K$(2,Z);TAB(30);N(2,Z)
  97. 2125 NEXT Z
  98. 2130 FOR Z=3 TO 12
  99. 2135 PRINT K$(2,Z);TAB(30);K$(3,Z)
  100. 2140 NEXT Z
  101. 2145 PRINT
  102. 2150 PRINT "IF AN ITEM IS TO BE CHANGED, TYPE THE APPROPRIATE NUMBER."
  103. 2155 PRINT:INPUT Z
  104. 2160 PRINT
  105. 2165 IF Z>11 THEN 2216
  106. 2170 IF Z<1 THEN 2105
  107. 2175 IF Z>2 THEN 2200
  108. 2180 PRINT TAB(30);left$(repeat$,n(1,z))
  109.     PRINT UP$;
  110. 2185 PRINT K$(1,Z);TAB(30);
  111. 2190 INPUT N(2,Z)
  112. 2195 GOTO 2225
  113. 2200 PRINT TAB(30);left$(repeat$,n(1,z))
  114.     PRINT UP$;
  115. 2205 PRINT K$(1,Z);TAB(30);
  116. 2210 input line K$(3,Z)
  117.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  118. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,I)
  119. 2216 N$=""
  120. 2220 FOR I=3 TO 11:N$=N$+K$(3,I):NEXT I
  121. 2225 INPUT "ANY MORE CHANGES";line temp$
  122. 2230 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2105
  123. 2235 PRINT
  124. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  125. 2245 PRINT
  126. 2250 IF left$(temp$,1)="y" OR left$(temp$,1)="Y" THEN 2280
  127. 2255 IF left$(temp$,1)<>"n" AND left$(temp$,1)<>"N" THEN 2235
  128. 2260 PRINT clear$:PRINT
  129. 2270 PRINT "*** RECORD NOT ENTERED ***":PRINT:PRINT
  130. 2275 FOR Z=1 TO 200:NEXT Z:RETURN
  131. 2280 open z5$ recl 170 as 1
  132.      print #1,z1;N(2,1),N(2,2),N$
  133.      close 1
  134. 2295 IF new$="N" THEN Z2=Z2+1:open z7$ as 1:print #1;z2,z3:close 1
  135. 2300 RETURN
  136. 3000 PRINT clear$:PRINT
  137. 3005 INPUT "RECORD NUMBER";Z1
  138. 3010 IF Z1>=Z2 THEN 3000
  139. 3012 IF Z1<1 THEN RETURN
  140.      open z5$ recl 170 as 1
  141.      read #1,z1;N(2,1),N(2,2),N$
  142.      close 1
  143. 3030 PRINT
  144. 3035 FOR Z=1 TO 2
  145. 3040 PRINT K$(1,Z);TAB(30);N(2,Z)
  146. 3045 NEXT Z
  147. 3046 Z9=1
  148. 3050 FOR Z=3 TO 11
  149. 3055 PRINT K$(1,Z);TAB(30);MID$(N$,Z9,N(1,Z))
  150. 3060 Z9=Z9+N(1,Z)
  151. 3065 NEXT Z
  152. 3070 PRINT
  153. 3075 PRINT "FOR A NEW RECORD NUMBER, TYPE N - RETURN.":PRINT
  154. 3080 PRINT "IF FINISHED, TYPE F - RETURN.":PRINT
  155. 3085 input line temp$
  156. 3090 IF left$(temp$,1)="n" OR left$(temp$,1)="N" THEN 3000
  157. 3095 RETURN
  158. 4000 PRINT clear$:PRINT
  159. 4005 N$=""
  160. 4010 INPUT "RECORD NUMBER";Z1
  161. 4015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  162. 4020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  163. 4025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  164.      open z5$ recl 170 as 1
  165.      read #1,z1;N(2,1),N(2,2),N$
  166.      close 1
  167. 4045 IF N(2,1)=0 THEN PRINT "*** DELETED RECORD ***":GOTO 1620
  168. 4050 Z9=1
  169. 4055 FOR Z=3 TO 11
  170. 4060 K$(3,Z)=MID$(N$,Z9,N(1,Z))
  171. 4065 Z9=Z9+N(1,Z)
  172. 4070 NEXT Z
  173. 4075 GOTO 2105
  174. 5000 PRINT clear$:PRINT
  175. 5010 INPUT "RECORD NUMBER";Z1
  176. 5015 IF Z1<1 THEN PRINT "*** NO SUCH RECORD ***":GOTO 1620
  177. 5020 IF Z1>Z3 THEN PRINT "*** OUT OF RANGE ***":GOTO 1620
  178. 5025 IF Z1>=Z2 THEN PRINT "NO RECORD NUMBER";Z1:GOTO 1620
  179.      open z5$ recl 170 as 1
  180.      read #1,z1;N(2,1),N(2,2),N$
  181.      close 1
  182. 5045 PRINT "RECORD NUMBER";Z1
  183. 5050 PRINT
  184. 5055 FOR Z=1 TO 2
  185. 5060 PRINT K$(1,Z);TAB(30);N(2,Z)
  186. 5065 NEXT Z
  187. 5070 Z9=1
  188. 5075 FOR Z=3 TO 11
  189. 5080 PRINT K$(1,Z);TAB(30);MID$(N$,Z9,N(1,Z))
  190. 5085 Z9=Z9+N(1,Z)
  191. 5090 NEXT Z
  192. 5095 PRINT
  193. 5100 INPUT "IS RECORD TO BE DELETED (MUST BE yes TO DELETE)";line temp$
  194. 5105 IF left$(temp$,1)="n" OR left$(temp$,1)="N" THEN RETURN
  195. 5110 IF temp$<>"yes" AND temp$<>"YES" THEN 5095
  196. 5115 N(2,1)=0
  197.      open z5$ recl 170 as 1
  198.      print #1,z1;N(2,1),N(2,2),N$
  199.      close 1
  200. 5135 RETURN
  201. 6000 PRINT clear$:PRINT
  202. 6005 PRINT "IF YOU HAVE ARRIVED HERE, AND HAVE A NAME-ENTRY 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 line temp$
  209. 6040 IF left$(temp$,1)="c" OR left$(temp$,1)="C" THEN INITIALIZE:GOTO 1500
  210. 6045 PRINT clear$:PRINT
  211. 6050 INPUT "NUMBER OF RECORDS DESIRED";Z3
  212. 6055 PRINT
  213. 6060 N(2,1)=0:N(2,2)=0
  214.      for z=1 to 150:n$=n$+" ":next z
  215.      create z5$ recl 170 as 1
  216. 6070 FOR Z1=1 TO Z3+2
  217.      print #1,z1;N(2,1),N(2,2),N$
  218.      next z1
  219.      close 1
  220. 6095 PRINT clear$:PRINT
  221. 6100 PRINT "NAME ENTRY FILE CREATED AND CLEARED.":PRINT
  222. 6105 PRINT Z3;"RECORDS CREATED.":PRINT
  223. 6110 input "TO CONTINUE, TYPE RETURN.";line temp$
  224.     Z2=1
  225.     create z7$ as 1:print #1;Z2,Z3:close 1
  226. 6115 GOTO 1500
  227. 7000 INPUT "ARE YOU SURE !!! (YES OR NO)";line temp$
  228. 7007 IF temp$<>"yes" AND temp$<>"YES" THEN RETURN
  229.      N(2,1)=0:N(2,2)=0
  230.      for z=1 to 150:n$=n$+" ":next z
  231.      open z5$ recl 170 as 1
  232.      FOR Z1=1 TO Z3+2
  233.      print #1,z1;N(2,1),N(2,2),N$
  234.      next z1
  235.      close 1
  236. 7035 PRINT clear$:PRINT
  237. 7040 PRINT "NAME ENTRY 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 "nmsort"
  244. 9000 PRINT clear$:PRINT
  245.      lprinter
  246.      open z5$ recl 170 as 1
  247. 9015 FOR Z1=1 TO Z2-1
  248.      read #1,z1;N(2,1),N(2,2),N$
  249. 9025 FOR Z=1 TO 2:PRINT K$(1,Z);TAB(30);N(2,Z):NEXT Z
  250. 9030 Z9=1
  251. 9035 FOR Z=3 TO 11:PRINT K$(1,Z);TAB(30);MID$(N$,Z9,N(1,Z))
  252. 9040 Z9=Z9+N(1,Z):NEXT Z:PRINT
  253. 9045 NEXT Z1
  254. 9050 PRINT chr$(12)
  255. 9055 close 1
  256.      console
  257. 9065 RETURN
  258. 10000 print clear$:print:print "Replace disk #5 in drive A."
  259.       print "Type return to continue."
  260.       input line temp$
  261.       initialize
  262.       chain "bizmii"
  263. 15000 PRINT clear$:PRINT:PRINT "CHECKING FILE LENGTH"
  264.     PRINT:PRINT "*** PLEASE WAIT ***"
  265.     open z5$ recl 170 as 1
  266.     z3=(size(z5$)*block.size)/170
  267.     for z2=1 to z3
  268.     read #1,z2;n(2,1),n(2,2)
  269.     if n(2,2)=0 then 15300
  270.     next z2
  271. 15300    z3=int(z3)-2
  272.     close 1
  273.     create z7$ as 1
  274.     print #1;z2,z3
  275.     close 1
  276.     GOTO 1500
  277.