home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / steel14.zip / MAIN.BAS < prev    next >
BASIC Source File  |  1980-01-01  |  50KB  |  1,814 lines
  1. 2 PRINT FRE(0)
  2. 3 DEFDBL X         
  3. 4 DEFINT A-W,Y-Z
  4. 5 DIM F$(15),FLDN$(15,28),FTY(15,28),FL(15,28),IOPT(28)
  5. 6 DIM PROMPT$(28),IFN(28),IFLD(28),IRNFLD(28),NOS(28),ADDFLD(28,6)
  6. 7 DIM SUBX(28),SUBY(28),MULX(28),MULY(28)
  7. 8 DIM XKEY(28),YKEY(28),CMOPT(28),MAXMIN(28,6)
  8. 9 DIM KC(28),CFLD(28)             
  9. 10 DIM X$(28),Y$(28)
  10. 13 DIM L(15),NREC(15),Z$(28),KT(28)
  11. 14 DIM X(28),CK$(28),SN$(28)
  12. 16 DIM KEYLIST(15,28),L$(10,50),LEND(28),CL(28)
  13. 18 DIM SU%(28),S!(10)
  14. 20 DIM XL(40)
  15. 21 DIM TX(6,28)
  16. 25 DIM S#(28)
  17. 26 DIM MAX(10),Z%(10)
  18. 30 DIM GFLG(28)
  19. 35 DIM K$(80)
  20. 40 DIM FS(30),PP(30),MS(30),MIND#(30),MAXD#(30),TAX#(30),PCT!(30),OVR#(30)
  21. 42 DIM MAXK(10)
  22. 44 DIM SCRN(40),LE(28),CE(28),LEK(28),CEK(28),SW$(18)
  23. 46 DIM REALFLG(28)
  24. 50 DIM SUMF(28),SUM#(28)
  25. 52 DIM SHOW(30),MAXC#(30),MINC#(30)
  26. 54 DIM MAXC(28),MINC(28),MFLG(28)
  27. 61 CH = 29
  28. 62 GOSUB 50000
  29. 63 GOSUB 16800
  30. 65 GOSUB 27000
  31. 80 GOSUB 10000
  32. 90 GOSUB 29000
  33. 95 GOSUB 60000
  34. 100 REM
  35. 400 GOSUB 13000
  36. 402 IF KD < 5 THEN GOSUB 11000
  37. 403 ROPEN = 0
  38. 404 GOSUB 13000
  39. 406 TWOOPEN = 0
  40. 410 PRINT "******  INPUT AND OUTPUT OPTIONS  --  WHAT FILE DO YOU WANT:  *****"
  41. 420 PRINT ""
  42. 425 PRINT " 0  - *** EXIT THE PROGRAM ***"
  43. 430 FOR I = 1 TO MAXF
  44. 440 PRINT I;TAB(5) " - ";F$(I)
  45. 450 NEXT I
  46. 460 PRINT ""
  47. 470 PRINT "***** ENTER THE NUMBER OF THE FILE YOU WANT THEN PRESS RETURN *****"
  48. 475 GOSUB 14000
  49. 477 IF DT# < 0 OR DT#>MAXF  GOTO 475
  50. 480 A = DT#
  51. 482 IF A = 0 GOTO 51000
  52. 483 GOSUB 13000
  53. 484 PRINT "FILE : "; F$(A)
  54. 485 GOSUB 2300
  55. 490 GOSUB 2500
  56. 491 CSCR = 2
  57. 492 IF SCRN(A) <> 0 THEN GOSUB 28000 ELSE RPT = 0
  58. 493 IF MFLG(A) = 2 THEN GOSUB 29070
  59. 494 GOSUB 40020
  60. 495 IF REALFLG(A) = 2 THEN GOSUB 60070
  61. 500 IF REALFLG(A) = 2 THEN GOSUB 60200
  62. 530 GOTO 3000
  63. 1905 MATCH = 1
  64. 2300 REM DISK  SELECTION
  65. 2302 IF HDISK = 2 THEN GOSUB 13000
  66. 2303 IF HDISK = 2 THEN GOTO 2360
  67. 2304 PRINT ""
  68. 2305 PRINT "************  WHICH DISK DRIVE IS THE FILE ON  **************"
  69. 2310 PRINT ""
  70. 2312 PRINT "                 0 - BACK TO CHOICE OF FILES"
  71. 2315 PRINT "                 1 - DISK DRIVE A"
  72. 2320 PRINT "                 2 - DISK DRIVE B"
  73. 2325 PRINT "                 3 - DISK DRIVE C"
  74. 2330 PRINT "                 4 - DISK DRIVE D"
  75. 2335 PRINT ""
  76. 2340 PRINT "***********  ENTER THE NUMBER THEN PRESS RETURN  ************"
  77. 2345 GOSUB 14000
  78. 2347 IF DT# < 0 OR DT#>4 GOTO 2345
  79. 2350 T = DT# 
  80. 2352 IF T = 0 THEN 100
  81. 2355 ON T GOTO 2360,2370,2380,2390
  82. 2360 T$ = F$(A)
  83. 2365 GOTO 2490
  84. 2370 T$ = "B:"+F$(A)
  85. 2375 GOTO 2490
  86. 2380 T$ = "C:"+F$(A)
  87. 2385 GOTO 2490
  88. 2390 T$ = "D:"+F$(A)
  89. 2490 RETURN
  90. 2500 REM OPEN FILE 
  91. 2503 CLOSE #1
  92. 2505 OPEN "R",#1,T$,L(A)
  93. 2507 D = 0
  94. 2510 FOR T = 1 TO NREC(A)
  95. 2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T)
  96. 2530 D = D + FL(A,T)
  97. 2540 NEXT T
  98. 2543 GOSUB 7800
  99. 2545 RETURN
  100. 2550 REM OPEN SECOND FILE
  101. 2553 CLOSE #2
  102. 2555 OPEN "R",#2,T$,L(B)
  103. 2557 D = 0
  104. 2560 FOR T = 1 TO NREC(B)
  105. 2565 FIELD #2,D AS DY$,FL(B,T) AS Y$(T)
  106. 2570 D = D + FL(B,T)
  107. 2575 NEXT T
  108. 2578 RETURN
  109. 2580 REM OPEN THIRD FILE
  110. 2581 CLOSE #3
  111. 2584 OPEN "R",#3,T$,L(C)
  112. 2586 D = 0
  113. 2588 FOR T = 1 TO NREC(C)
  114. 2590 FIELD #3,D AS DY$,FL(C,T) AS Z$(T)
  115. 2592 D = D + FL(C,T)
  116. 2594 NEXT T
  117. 2596 RETURN
  118. 3000 REM SECOND MENU 
  119. 3010 GOSUB 13000
  120. 3011 SFLG = 0
  121. 3012 PRINT "FILE : ";F$(A);TAB(57)"MAXIMUM RECORD :";MRN
  122. 3015 CALFLG = 0
  123. 3020 PRINT "*******************  WHAT DO YOU WANT TO DO WITH THE FILE  *******************"
  124. 3030 PRINT ""
  125. 3035 PRINT " 0 - CHANGE FILES  "
  126. 3040 PRINT " 1 - READ A SPECIFIC RECORD"
  127. 3050 PRINT " 2 - PRINT ON PAPER ALL OR SEVERAL SEQUENTIAL RECORDS"
  128. 3060 PRINT " 3 - SCAN SEVERAL RECORDS IN A FILE"
  129. 3070 PRINT " 4 - SEARCH A FILE"  
  130. 3080 PRINT " 5 - NEW ENTRY"
  131. 3090 PRINT " 6 - SEARCH A SORTED FILE"
  132. 3202 PRINT " 7 - RECALCULATE ALL THE RECORDS IN THE FILE"
  133. 3207 PRINT ""
  134. 3210 PRINT "*************  ENTER THE NUMBER OF THE OPTION THEN PRESS ENTER  ***************"
  135. 3212 SPRT = 5
  136. 3215 GOSUB 14000
  137. 3218 IF DT# < 0 OR DT#>7 GOTO 3215
  138. 3220 N = DT#
  139. 3225 IF N = 0 THEN CLOSE 
  140. 3227 IF N = 0 THEN GOTO 400
  141. 3230 ON N GOTO 8000,5000,4000,18000,3700,17000,47000
  142. 3600 GOTO 18000
  143. 3700 GOSUB 13000
  144. 3720 GOTO 7000
  145. 4000 REM SCAN ALL RECORDS
  146. 4005 GOSUB 13000
  147. 4007 GOSUB 7800
  148. 4008 GOSUB 4100
  149. 4009 GOSUB 13000
  150. 4010 PRINT "************  SCAN ALL SEQUENTIAL RECORDS SUBPROGRAM  ************"
  151. 4011 PRINT ""
  152. 4012 PRINT "               WHAT RECORD DO YOU WANT TO START AT ?  "       
  153. 4013 PRINT ""
  154. 4014 PRINT "                Enter zero to return to file options "
  155. 4015 PRINT ""
  156. 4016 PRINT "***********  ENTER THE RECORD NUMBER THEN PRESS RETURN  ***********"
  157. 4018 GOSUB 14100
  158. 4020 RN = DT#
  159. 4022 IF RN = 0 THEN GOTO 3010
  160. 4032 IF INKEY$ <> "" GOTO 4600
  161. 4035 IF RN > MRN GOTO 26000
  162. 4040 GET #1,RN
  163. 4050 GOSUB 4300
  164. 4060 RN = RN + 1
  165. 4070 GOTO 4032
  166. 4100 REM ****  GET FIELDS TO DISPLAY
  167. 4110 FOR T = 1 TO NREC(A)
  168. 4120 GOSUB 13000
  169. 4124 PRINT "*******************  SCAN SUBROUTINE  **********************"
  170. 4126 PRINT ""
  171. 4130 PRINT "FIELD NUMBER : ";T;" - "; FLDN$(A,T)
  172. 4140 PRINT ""
  173. 4150 PRINT "*****  DO YOU WANT THIS FIELD DISPLAYED WHILE SCANNING  *****"
  174. 4160 PRINT ""
  175. 4170 PRINT "             1 - NO, Do not show this field "
  176. 4180 PRINT "             2 - YES, Show this field "
  177. 4190 PRINT ""
  178. 4200 PRINT "************  Enter the number then press return  ***********"
  179. 4210 GOSUB 14000
  180. 4220 IF DT# < 1 OR DT# > 2 THEN 4210
  181. 4230 SHOW(T) = DT#
  182. 4240 NEXT T
  183. 4250 RETURN
  184. 4300 REM ****  PRINT FIELDS 
  185. 4305 PRINT "RECORD NUMBER ";RN
  186. 4310 FOR Q = 1 TO NREC(A)
  187. 4320 IF SHOW(Q) = 2 THEN GOSUB 12030
  188. 4330 NEXT Q
  189. 4340 RETURN
  190. 4600 REM 
  191. 4604 PRINT "******************  PAUSE SUBROUTINE  **********************"
  192. 4608 PRINT " 1 - CONTINUE SCANING "
  193. 4610 PRINT " 0 - BACK TO FILE OPTIONS "
  194. 4625 PRINT "***********  ENTER THE NUMBER THEN PRESS RETURN  ***********"    
  195. 4628 GOSUB 14000
  196. 4635 IF DT# = 0 THEN GOTO 3010
  197. 4640 GOTO 4040
  198. 5000 REM 
  199. 5005 GOSUB 13000
  200. 5010 PRINT "************  PRINT ON PAPER ALL SEQUENTIAL RECORDS  *************"
  201. 5011 PRINT ""
  202. 5012 PRINT "          WHAT RECORD DO YOU WANT TO START PRINTING AT ?"
  203. 5013 PRINT ""
  204. 5014 PRINT "               Enter zero to return to file options "
  205. 5015 PRINT ""
  206. 5016 PRINT "***********  ENTER THE RECORD NUMBER THEN PRESS RETURN  **********"
  207. 5018 GOSUB 14100
  208. 5020 RN = DT#
  209. 5021 IF RN = 0 GOTO 3010
  210. 5022 PRINT "**************  DO YOU WANT THIS RECORD PRINTED IN  **************"
  211. 5023 PRINT "                   1 - EXPANDED FORM "
  212. 5024 PRINT "                   2 - CONDENSED FORM "
  213. 5025 PRINT "**************  ENTER THE NUMBER THEN PRESS RETURN  **************"
  214. 5026 GOSUB 14000
  215. 5027 IF DT# < 1 OR DT#>2 GOTO 5026
  216. 5030 PFLG = DT#
  217. 5031 IF PFLG = 2 THEN GOSUB 12880
  218. 5032 IF PFLG = 2 THEN GOSUB 12900
  219. 5033 GOSUB 16000
  220. 5036 REM
  221. 5038 IF INKEY$ <> "" GOTO 5600
  222. 5039 IF RN > MRN GOTO 26000
  223. 5040 REM
  224. 5041 GET #1,RN
  225. 5050 IF PFLG = 1 THEN GOSUB 12200
  226. 5060 IF PFLG = 2 THEN GOSUB 12500
  227. 5510 RN = RN + 1
  228. 5520 GOTO 5036
  229. 5600 REM 
  230. 5602 GOSUB 13000
  231. 5604 PRINT "******************  PAUSE SUBROUTINE  **********************"
  232. 5606 PRINT ""
  233. 5608 PRINT " 1 - CONTINUE PRINTING "
  234. 5610 PRINT " 0 - BACK TO FILE OPTIONS"
  235. 5620 PRINT ""
  236. 5625 PRINT "***********  ENTER THE NUMBER THEN PRESS RETURN  ***********"    
  237. 5628 GOSUB 14000
  238. 5630 IF DT# = 0  THEN GOTO 3010
  239. 5640 GOTO 5040
  240. 5725 REM
  241. 6000 REM 
  242. 7000 REM 
  243. 7010 GOSUB 13000
  244. 7012 PRINT ""
  245. 7014 PRINT "FILE NAME: ";F$(A)
  246. 7020 PRINT "********************  NEW RECORD ENTRY  ********************"
  247. 7022 PRINT ""
  248. 7024 PRINT "*******************  WHAT RECORD NUMBER ?  *****************"
  249. 7030 PRINT ""
  250. 7031 GOSUB 7800
  251. 7032 PRINT "**********  Enter zero to return to file options  **********"
  252. 7033 PRINT ""
  253. 7034 PRINT "---- MAXIMUM RECORD NUMBER  CURRENTLY = ";MRN
  254. 7035 PRINT "---- ENTER A NUMBER FROM 1 TO ";MRN +1        
  255. 7036 PRINT ""
  256. 7038 PRINT "********  ENTER THE RECORD NUMBER THEN PRESS RETURN  *******"
  257. 7040 GOSUB 14100
  258. 7042 IF DT# <0 OR DT# >(MRN +1) GOTO 7040
  259. 7045 RN = DT#
  260. 7046 GOSUB 13000
  261. 7048 IF RN = 0 GOTO 3010
  262. 7200 GOSUB 40000
  263. 7205 IF RN > MRN THEN MRN = RN
  264. 7210 GOTO 7010
  265. 7800 MRN = LOF(1)/ L(A)
  266. 7805 REM MRN = INT(MRN)
  267. 7810 RETURN
  268. 7900 REM ***** LOF
  269. 7910 MRN2 = LOF(3)/82
  270. 7920 RETURN
  271. 7950 REM ******* LOF
  272. 7960 MRNS = LOF(2)/L(B)
  273. 7970 RETURN
  274. 8000 REM 
  275. 8010 GOSUB 13000
  276. 8020 PRINT "********************  READ A SINGLE RECORD  *******************"
  277. 8030 PRINT ""
  278. 8040 PRINT "FILE NAME: ";F$(A)
  279. 8042 PRINT ""
  280. 8043 PRINT "MINIMUM RECORD NUMBER : 1   MAXIMIM RECORD NUMBER : ";MRN
  281. 8044 PRINT ""
  282. 8045 PRINT "******* ENTER THE NUMBER OF THE RECORD THEN PRESS RETURN ******"
  283. 8046 PRINT ""
  284. 8048 PRINT "***********  ENTER ZERO TO RETURN TO FILE OPTIONS  ************"
  285. 8049 GOSUB 7800
  286. 8050 GOSUB 14100
  287. 8052 RN = DT#
  288. 8057 IF RN = 0 THEN GOTO 3010
  289. 8058 GOSUB 13000
  290. 8059 IF RN > MRN GOTO 26800
  291. 8060 GET #1,RN
  292. 8500 GOSUB 12000
  293. 8510 LI = 20
  294. 8515 GOSUB 13100
  295. 8520 PRINT "*****************************    OPTIONS :    ********************************"      
  296. 8530 PRINT " 1 - READ THE NEXT RECORD        3 - CORRECT THIS RECORD  5 - SHOW SUBRECORDS  "
  297. 8532 PRINT " 2 - PRINT THIS RECORD ON PAPER  4 - READ ANOTHER RECORD  0 - TO FILE OPTIONS  "
  298. 8535 PRINT "******************  Enter the number then press return  **********************"
  299. 8537 SPRT = 5
  300. 8540 GOSUB 14000
  301. 8542 IF DT# <0 OR DT# > 5  GOTO 8510
  302. 8550 B = DT#
  303. 8552 IF B = 3 THEN GOSUB 9000
  304. 8554 IF B = 3 THEN GOTO 8510
  305. 8555 IF SFLG > 0 AND B = 1 THEN GOTO 18380
  306. 8556 IF B = 1 THEN RN = RN + 1
  307. 8560 IF B = 5 AND RPT <> 2 THEN 8580
  308. 8562 ON B GOTO 8058,8600,9000,8000,20000
  309. 8564 REM
  310. 8570 GOTO 3010
  311. 8580 LI = 24
  312. 8585 GOSUB 13100
  313. 8590 PRINT TAB(10) "SUBRECORDS ARE NOT SET UP ON THIS FILE";
  314. 8595 GOTO 8510
  315. 8600 REM  PRINT SINGLE RECORD 
  316. 8610 GOSUB 16000
  317. 8680 GOSUB 12200 
  318. 8920 GOTO 8000
  319. 9000 REM 
  320. 9005 LI = 20
  321. 9007 GOSUB 13100
  322. 9010 PRINT "*******************  CORRECT RECORD SUBROUTINE  *******************           "
  323. 9020 PRINT "          0 - TO FILE OPTION -- DONE WITH CORRECTIONS                         "    
  324. 9022 PRINT "          1 TO ";NREC(A);"THE FIELD YOU WANT TO CHANGE                    " 
  325. 9025 PRINT "***************  ENTER THE NUMBER THEN PRESS RETURN  **************           "
  326. 9028 SPRT = 5
  327. 9030 GOSUB 14000
  328. 9031 IF DT# <0 OR DT# >NREC(A)  GOTO 9030
  329. 9033 T = DT#
  330. 9040 IF T = 0 THEN GOTO 3010
  331. 9045 D = T
  332. 9046 IF REALFLG(A) = 2 AND T = TGTRN THEN GOSUB 61300
  333. 9047 Q = T
  334. 9048 LI = 20
  335. 9049 GOSUB 13100
  336. 9050 PRINT "******  FIELD NUMBER: ";D;" FIELD NAME: ";FLDN$(A,D);" ******         "
  337. 9060 PRINT "***********  ENTER THE CORRECTION THEN PRESS RETURN  **************           "
  338. 9062 PRINT "                                                                             "
  339. 9063 PRINT "                                                                             "
  340. 9064 PRINT "                                                                             ";
  341. 9066 LI = 22
  342. 9068 GOSUB 13100
  343. 9070 ON FTY(A,D) GOTO 9100,9150,9200,9250,9250
  344. 9100 GOSUB 15000
  345. 9105 I$ = A$
  346. 9110 LSET X$(D) = I$
  347. 9120 GOTO 9290
  348. 9150 GOSUB 14100
  349. 9151 T2 = KEYLIST(A,D) 
  350. 9152 T3 = MAXK(T2)
  351. 9153 REM IF KY(A,D) = 2 AND ( DT# < 1 OR DT# > T3) GOTO 9150
  352. 9154 IF MFLG(A) = 2 THEN GOSUB 29190
  353. 9155 I% = DT#
  354. 9157 I# = I%
  355. 9160 LSET X$(D) = MKI$(I%)
  356. 9165 X(D) = I%
  357. 9170 GOTO 9290
  358. 9200 GOSUB 14200
  359. 9203 IF MFLG(A) = 2 THEN GOSUB 29190
  360. 9205 I! = DT#
  361. 9207 I# = I!
  362. 9210 LSET X$(D) = MKS$(I!)
  363. 9220 GOTO 9290
  364. 9250 GOSUB 14300
  365. 9253 IF MFLG(A) = 2 THEN GOSUB 29190
  366. 9255 I# = DT#
  367. 9260 LSET X$(D) = MKD$(I#)
  368. 9290 PUT #1,RN
  369. 9291 N = D
  370. 9294 IF REALFLG(A) = 2 AND N = FLD1 THEN GOSUB 61000
  371. 9295 IF REALFLG(A) = 2 AND N = FLD2 THEN GOSUB 61200
  372. 9296 IF REALFLG(A) = 2 AND N = TGTRN THEN GOSUB 61400
  373. 9297 IF REALFLG(A) = 2 AND N = TGTRN THEN GOSUB 60300
  374. 9298 IF GFLG(Q) = 1 THEN  GOSUB 46000 ELSE GOSUB 44500
  375. 9299 RETURN   
  376. 10000 REM READ FFILE 
  377. 10010 OPEN "I",#1,"FFILE"
  378. 10020 INPUT #1,MAXF
  379. 10030 FOR A = 1 TO MAXF
  380. 10040 INPUT #1,A,F$(A),NREC(A),L(A)
  381. 10050 FOR N = 1 TO NREC(A)
  382. 10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
  383. 10070 IF FTY(A,N) = 2 THEN INPUT #1,D,KEYLIST(A,N)
  384. 10075 IF D >< 2 THEN KEYLIST(A,N) = 0
  385. 10080 NEXT N
  386. 10090 NEXT A
  387. 10100 CLOSE #1
  388. 10110 RETURN
  389. 10900 REM  PUT DISK IN DRIVE SUB
  390. 10905 IF HDISK = 2 THEN RETURN
  391. 10910 GOSUB 13000
  392. 10920 PRINT "    ********  PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE  *********"
  393. 10930 PRINT ""
  394. 10940 PRINT "                     THEN PRESS ANY KEY TO CONTINUE "
  395. 10950 PRINT ""
  396. 10960 PRINT "    If the program data disk is already in the default disk drive then"
  397. 10965 PRINT "                     just press any key to continue."
  398. 10970 PRINT ""
  399. 10990 IF INKEY$ = "" GOTO 10990
  400. 10992 GOSUB 13000
  401. 10993 PRINT "  READING INFORMATION, PLEASE WAIT "
  402. 10995 RETURN
  403. 11000 REM  LOAD KEYLIST
  404. 11010 GOSUB 13000
  405. 11100 A = 10
  406. 11105 PRINT "FILE : KEYLIST "
  407. 11110 GOSUB 2300
  408. 11120 GOSUB 2500
  409. 11130 FOR T = 1 TO 10000
  410. 11140 IF T > MRN GOTO 11900
  411. 11150 GET #1,T
  412. 11160 T1 = CVI(X$(1))
  413. 11170 T2 = CVI(X$(2))
  414. 11180 L$(T1,T2) = X$(3)
  415. 11185 IF T2 > MAXK(T1) THEN MAXK(T1) = T2
  416. 11190 NEXT T
  417. 11900 KD = 5
  418. 11935 CLOSE #1
  419. 11937 PRINT FRE(0)
  420. 11940 RETURN
  421. 12000 REM ******  PRINT SUBROUTINE  *****
  422. 12010 PRINT "*************  FILE : ";F$(A);"- ";"RECORD NUMBER: ";RN;" *************"
  423. 12015 IF CSCR = 1 GOTO 34000
  424. 12020 FOR Q = 1 TO NREC(A)
  425. 12022 GOSUB 12025
  426. 12023 NEXT Q
  427. 12024 RETURN
  428. 12025 IF Q MOD 19 = 0 THEN GOSUB 12170
  429. 12030 PRINT Q; TAB(5) FLDN$(A,Q);     
  430. 12040 ON FTY(A,Q) GOSUB 12050,12070,12100,12130,12142
  431. 12045 RETURN
  432. 12050 PRINT TAB(26) X$(Q)
  433. 12060 RETURN
  434. 12070 I%=CVI(X$(Q))
  435. 12072 X(N) = I%
  436. 12075 PRINT TAB(25) I%;
  437. 12080 IF KEYLIST(A,Q) = 0 THEN PRINT ""
  438. 12082 IF KEYLIST(A,Q) = 0 THEN GOTO 12150
  439. 12084 T1 = KEYLIST(A,Q)
  440. 12085 IF I% < 0 THEN I% = 0
  441. 12086 W$ = L$(T1,I%)
  442. 12090 PRINT TAB(30) "key: ";W$
  443. 12095 RETURN 
  444. 12100 I!=CVS(X$(Q))
  445. 12110 PRINT TAB(25) I!
  446. 12120 RETURN 
  447. 12130 I#=CVD(X$(Q))
  448. 12135 X(Q) = I#
  449. 12140 PRINT TAB(25)  I#
  450. 12141 RETURN 
  451. 12142 I#=CVD(X$(Q))
  452. 12144 PRINT TAB(26);
  453. 12146 PRINT USING "**$########.##";I#
  454. 12147 X(Q) = I#
  455. 12148 RETURN
  456. 12150 RETURN
  457. 12152 IF Q < 20 THEN RETURN
  458. 12153 PRINT""
  459. 12154 PRINT ""
  460. 12155 PRINT ""
  461. 12156 PRINT ""
  462. 12157 PRINT ""
  463. 12160 RETURN
  464. 12170 PRINT "***  MORE FIELDS, PRESS ANY KEY TO CONTINUE  ***"
  465. 12180 IF INKEY$ = "" GOTO 12180
  466. 12190 RETURN
  467. 12200 REM * LINE PRINT
  468. 12210 LPRINT ""
  469. 12220 PRINT "RECORD NUMBER: ";RN 
  470. 12230 LPRINT "RECORD NUMBER: ";RN;
  471. 12235 IF CSCR = 1 THEN GOTO 35000 ELSE LPRINT "" 
  472. 12240 FOR Q = 1 TO NREC(A)
  473. 12260 LPRINT Q;TAB(5) FLDN$(A,Q);     
  474. 12270 ON FTY(A,Q) GOTO 12280,12310,12350,12390,12425
  475. 12280 REM
  476. 12290 LPRINT TAB(26) X$(Q)
  477. 12300 GOTO 12480
  478. 12310 I%=CVI(X$(Q))
  479. 12314 LPRINT TAB(25) I%;
  480. 12318 IF KEYLIST(A,Q) = 0 THEN LPRINT ""
  481. 12320 IF KEYLIST(A,Q) = 0 THEN GOTO 12480
  482. 12322 T1 = KEYLIST(A,Q)
  483. 12324 W$ = L$(T1,I%)
  484. 12328 LPRINT TAB(30) "key: ";W$
  485. 12330 GOTO 12480
  486. 12340 GOTO 12480
  487. 12350 I!=CVS(X$(Q))
  488. 12370 LPRINT TAB(25) I!
  489. 12380 GOTO 12480
  490. 12390 I#=CVD(X$(Q))
  491. 12410 LPRINT TAB(25)  I#
  492. 12420 GOTO 12480
  493. 12425 I#=CVD(X$(Q))
  494. 12450 LPRINT TAB(26);
  495. 12460 LPRINT USING "**$########.##";I#
  496. 12480 NEXT Q
  497. 12490 RETURN
  498. 12500 PRINT ""
  499. 12510 LPRINT ""
  500. 12530 LPRINT "RECORD # ";RN;" ";
  501. 12540 FOR Q = 1 TO NREC(A)
  502. 12547 IF LEND(Q)= 5 THEN LPRINT ""
  503. 12548 T2 = CL(Q)
  504. 12570 ON FTY(A,Q) GOTO 12590,12610,12730,12770,12810
  505. 12590 LPRINT TAB(T2) X$(Q);
  506. 12600 GOTO 12860
  507. 12610 I%=CVI(X$(Q))
  508. 12630 LPRINT TAB(T2)I%;
  509. 12660 IF KEYLIST(A,Q) = 0 THEN GOTO 12860
  510. 12670 T1 = KEYLIST(A,Q)
  511. 12680 W$ = L$(T1,I%)
  512. 12685 T1 = CL(Q) + 11
  513. 12700 LPRINT TAB(T1)"key: ";W$;
  514. 12720 GOTO 12860
  515. 12730 I!=CVS(X$(Q))
  516. 12750 LPRINT TAB(T2)I!;
  517. 12760 GOTO 12860
  518. 12770 I#=CVD(X$(Q))
  519. 12790 LPRINT TAB(T2)I#;
  520. 12800 GOTO 12860
  521. 12810 I#=CVD(X$(Q))
  522. 12840 LPRINT TAB(T2) "";
  523. 12850 LPRINT USING "**$########,.##";I#;
  524. 12860 NEXT Q
  525. 12870 RETURN
  526. 12880 PRINT " HOW MANY COLUMNS ARE THERE ON YOUR PRINTER "
  527. 12890 GOSUB 14100
  528. 12892 COLM = DT#
  529. 12895 RETURN
  530. 12900 REM ******* TAB CONTROL *******
  531. 12901 C = 15
  532. 12902 FOR T = 1 TO NREC(A)
  533. 12903 LEND(T) = 0
  534. 12905 CL(T)= C 
  535. 12906 GOSUB 12910
  536. 12907 IF C > COLM THEN GOSUB 12970
  537. 12908 NEXT T
  538. 12909 RETURN
  539. 12910 ON FTY(A,T) GOTO 12920,12930,12940,12950,12950
  540. 12920 C = C + FL(A,T) + 1
  541. 12925 RETURN     
  542. 12930 C = C + 7
  543. 12933 IF KEYLIST(A,T) > 0 THEN C = C + 30
  544. 12935 RETURN
  545. 12940 C = C + 9
  546. 12945 RETURN    
  547. 12950 C = C + 16
  548. 12952 RETURN
  549. 12970 CL(T)= 1
  550. 12972 C =1
  551. 12974 LEND(T) = 5
  552. 12975 GOSUB 12910
  553. 12980 RETURN
  554. 13000 REM  CLEAR SCREEN
  555. 13010 CLS
  556. 13020 RETURN
  557. 13050 REM  LOCATE - TAB SET IN PROGRAM
  558. 13060 GOTO 13110
  559. 13100 REM  LOCATE - TAB EQUALS ONE
  560. 13105 TB = 1
  561. 13110 LOCATE LI,TB
  562. 13120 RETURN
  563. 13600 REM CHECK FOR ASC0
  564. 13610 S4$ = INKEY$
  565. 13620 C2 =  ASC(S4$)
  566. 13630 IF C2 = 83 THEN C = 1
  567. 13640 IF C2 = 82 THEN C = 6
  568. 13650 IF C2 = 75 THEN C = 19
  569. 13660 IF C2 = 77 THEN C = 4 
  570. 13670 RETURN
  571. 14000 REM INTEGER LESS THEN 100 CHECK
  572. 14010 MAX = 2
  573. 14020 ACT$ = " 1234567890=<>^"
  574. 14023 IF NE = 0 THEN ACT$ = " 1234567890"
  575. 14025 PRINT ">__<";
  576. 14030 GOTO 14500
  577. 14100 REM INTEGER
  578. 14110 MAX = 8
  579. 14120 ACT$ = " 1234567890-+,=<>^"
  580. 14123 IF NE = 0 THEN ACT$ = " 1234567890-+,"
  581. 14125 PRINT ">________<";
  582. 14130 GOTO 14500
  583. 14200 REM  SINGLE PRECISION
  584. 14210 MAX = 10
  585. 14220 ACT$ = " 1234567890-+,.%$=<>^"
  586. 14223 IF NE = 0 THEN ACT$ = " 1234567890+-,.%$"
  587. 14225 PRINT ">__________<";
  588. 14230 GOTO 14500
  589. 14300 REM DOUBLE PRECISION
  590. 14310 MAX = 20
  591. 14320 ACT$ = " 1234567890-+,.%$=<>^"
  592. 14323 IF NE = 0 THEN ACT$ = " 1234567890+-,.%$"
  593. 14325 PRINT ">____________________<";
  594. 14330 GOTO 14500
  595. 14500 REM NUMBER CHECK
  596. 14505 A$ = ""
  597. 14510 K$(20) = " "
  598. 14515 KTMAX = 0
  599. 14520 FOR T9 = 1 TO MAX
  600. 14525 K$(T9) = " "
  601. 14530 NEXT T9
  602. 14535 DIG$ = "1234567890."
  603. 14540 DOTFLG = 0
  604. 14541 T2 = MAX + 1
  605. 14542 FOR T6 = 1 TO T2
  606. 14544 PRINT CHR$(CH);
  607. 14546 NEXT T6
  608. 14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550
  609. 14560 KT = 0
  610. 14565 REM 
  611. 14570 KT = KT + 1
  612. 14575 REM     
  613. 14580 W$ = INKEY$
  614. 14585 IF W$ = "" GOTO 14580
  615. 14590 C = ASC(W$)
  616. 14593 IF C = 0 THEN GOSUB 13600
  617. 14595 IF C = 13 GOTO 14660
  618. 14600 IF C = 17 OR C = 8 GOTO 14860
  619. 14605 IF C = 19 GOTO 14690
  620. 14610 IF C = 4 GOTO 14710
  621. 14615 IF C = 6 GOTO 14730
  622. 14620 IF C = 1 GOTO 14790
  623. 14625 IF KT > MAX GOTO 14575
  624. 14630 IF INSTR(ACT$,W$) = 0 GOTO 14890
  625. 14635 K$(KT) = W$
  626. 14645 PRINT K$(KT);
  627. 14650 IF KT > KTMAX THEN KTMAX = KT
  628. 14655 GOTO 14570
  629. 14660 REM * RETURN
  630. 14670 FOR T9 = 1 TO KTMAX
  631. 14675 A$ = A$ + K$(T9)
  632. 14676 IF K$(T9) = "^" GOTO 15830
  633. 14677 IF K$(T9) = ">" GOTO 15950
  634. 14678 IF K$(T9) = "=" GOTO 15800
  635. 14679 IF K$(T9) = "<" GOTO 15900
  636. 14680 NEXT T9
  637. 14681 IF KTMAX = 0 THEN PRINT "1";
  638. 14682 IF KTMAX = 0 THEN DT# = 1
  639. 14684 IF SPRT >< 5 THEN PRINT ""
  640. 14685 SPRT = 0
  641. 14686 IF KTMAX = 0 THEN RETURN
  642. 14687 GOTO 14905
  643. 14689 GOTO 14905
  644. 14690 REM * MOVE CURSE BACK
  645. 14695 IF KT = 1 GOTO 14575
  646. 14700 KT = KT - 1
  647. 14703 PRINT CHR$(CH);
  648. 14705 GOTO 14575
  649. 14710 REM * MOVE CURSER FORWARD
  650. 14715 IF KT >= MAX GOTO 14575
  651. 14716 IF KT > (KTMAX + 1) GOTO 14575
  652. 14718 PRINT K$(KT);
  653. 14720 KT = KT + 1
  654. 14725 GOTO 14575
  655. 14730 REM * INSERT
  656. 14733 IF KT > KTMAX GOTO 14575
  657. 14735 X9 = MAX
  658. 14740 WHILE X9 > KT
  659. 14745 X9 = X9 - 1
  660. 14750 K$(X9 + 1) = K$(X9)
  661. 14755 WEND 
  662. 14760 K$(KT) = " "
  663. 14767 KTMAX = KTMAX + 1
  664. 14769 IF KTMAX > MAX THEN KTMAX = MAX
  665. 14770 FOR T9 = KT TO KTMAX
  666. 14775 PRINT K$(T9);
  667. 14780 NEXT T9
  668. 14781 T6 = (KTMAX - KT) + 1
  669. 14782 FOR T7 = 1 TO T6
  670. 14783 PRINT CHR$(CH);
  671. 14784 NEXT T7
  672. 14785 GOTO 14575
  673. 14790 REM * DELETE 
  674. 14793 IF KT > KTMAX GOTO 14575
  675. 14794 IF KTMAX = 1 GOTO 14575
  676. 14795 K$(MAX + 1) = ""
  677. 14800 X9 = KT 
  678. 14805 WHILE X9 <= MAX
  679. 14810 K$(X9) = K$(X9 + 1)
  680. 14815 X9 = X9 + 1
  681. 14820 WEND 
  682. 14830 KTMAX = KTMAX - 1
  683. 14835 FOR T9 = KT TO KTMAX
  684. 14840 PRINT K$(T9);
  685. 14845 NEXT T9
  686. 14850 PRINT "_";
  687. 14851 T7 = (KTMAX - KT) + 2
  688. 14852 FOR T8 = 1 TO T7
  689. 14853 PRINT CHR$(CH);
  690. 14854 NEXT T8
  691. 14855 GOTO 14575
  692. 14860 REM BACKSPACE
  693. 14865 IF KT = 1 GOTO 14575
  694. 14870 KT = KT - 1
  695. 14875 PRINT CHR$(CH);
  696. 14877 K$(KT) = " " 
  697. 14880 PRINT "_";
  698. 14883 PRINT CHR$(CH);
  699. 14885 GOTO 14575
  700. 14890 REM INPUT NOT ACCEPTABLE
  701. 14895 PRINT CHR$(7);
  702. 14900 GOTO 14580
  703. 14905 REM * CLEAR STRINGS
  704. 14910 MAX = LEN(A$)
  705. 14915 D2$ = ""
  706. 14920 D1$ = ""
  707. 14925 DFLG = 0
  708. 14930 FOR Q93 = 1 TO MAX
  709. 14935 R$ = MID$(A$,Q93,1)
  710. 14940 IF INSTR(DIG$,R$) = 0 GOTO 14975
  711. 14945 IF R$ = "." OR DFLG = 1 GOTO 14965
  712. 14950 IF DFLG = 1 GOTO 14965
  713. 14955 D2$ = D2$ + R$
  714. 14960 GOTO 14975
  715. 14965 D1$ = D1$ + R$
  716. 14970 DFLG = 1
  717. 14975 NEXT Q93
  718. 14980 DA# = VAL(D2$)
  719. 14985 D1# = VAL(D1$)
  720. 14990 DT# = DA# + D1#
  721. 14995 IF K$(1) = "-" THEN DT# =  -DT#   
  722. 14997 RETURN
  723. 15000 REM * ALPHANUMERIC CHECK
  724. 15010 MAX = FL(A,Q)
  725. 15020 GOTO 15040
  726. 15030 REM * MAX SET IN PROGRAM
  727. 15040 A$ = ""
  728. 15050 PRINT ">"; 
  729. 15060 FOR N9 = 1 TO MAX
  730. 15065 K$(N9) = ""
  731. 15070 PRINT "_";
  732. 15080 NEXT N9
  733. 15090 PRINT "<";
  734. 15100 T2 = MAX + 1
  735. 15110 FOR T4 = 1 TO T2
  736. 15120 PRINT CHR$(CH);
  737. 15125 NEXT T4
  738. 15130 KT = 0
  739. 15135 KTMAX = 1
  740. 15140 REM * CHECK ALFANUMERIC INPUT FOR LENGTH
  741. 15150 KT = KT + 1
  742. 15160 PRINT TAB(KT+1)"";
  743. 15170 K$ = INKEY$
  744. 15180 IF K$ = "" GOTO 15170
  745. 15190 C = ASC(K$)
  746. 15195 IF C = 0 THEN GOSUB 13600
  747. 15200 IF C = 13 GOTO 15310
  748. 15210 IF C = 17 OR C = 8 GOTO 15710
  749. 15220 IF C = 19 GOTO 15370
  750. 15230 IF C = 4  GOTO 15410
  751. 15240 IF C = 6 GOTO 15450
  752. 15250 IF C = 1 GOTO 15570
  753. 15260 IF KT > MAX GOTO 15160
  754. 15270 K$(KT) = K$
  755. 15290 PRINT K$(KT);
  756. 15295 IF KT > KTMAX THEN KTMAX = KT
  757. 15300 GOTO 15150
  758. 15310 REM * RETURN
  759. 15320 FOR T9 = 1 TO MAX
  760. 15330 A$ = A$ + K$(T9)
  761. 15332 IF K$(T9) = "^" GOTO 15830
  762. 15333 IF K$(T9) = ">" GOTO 15950
  763. 15335 IF K$(T9) = "=" GOTO 15850
  764. 15338 IF K$(T9) = "<" GOTO 15900
  765. 15340 NEXT T9
  766. 15350 PRINT "" 
  767. 15360 RETURN  
  768. 15370 REM * MOVE CURSE BACK
  769. 15380 IF KT = 1 GOTO 15160
  770. 15385 KT = KT - 1
  771. 15390 PRINT CHR$(CH);
  772. 15400 GOTO 15160
  773. 15410 REM * MOVE CURSER FORWARD
  774. 15420 IF KT >= MAX GOTO 15160
  775. 15425 IF KT >  KTMAX  GOTO 15160
  776. 15427 PRINT K$(KT);
  777. 15430 KT = KT + 1
  778. 15440 GOTO 15160
  779. 15450 REM INSERT*
  780. 15460 X9 = MAX
  781. 15470 WHILE X9 > KT
  782. 15480 X9 = X9 - 1
  783. 15490 K$(X9 + 1) = K$(X9)
  784. 15500 WEND 
  785. 15510 K$(KT) = " "
  786. 15520 KTMAX = KTMAX + 1
  787. 15525 IF KTMAX > MAX THEN KTMAX = MAX
  788. 15530 FOR T9 = KT TO KTMAX
  789. 15540 PRINT K$(T9);
  790. 15550 NEXT T9
  791. 15552 T6 = (KTMAX - KT) +1
  792. 15554 FOR T7 = 1 TO T6
  793. 15556 PRINT CHR$(CH);
  794. 15558 NEXT T7
  795. 15560 GOTO 15160
  796. 15570 REM *DELETE
  797. 15575 IF KT > KTMAX GOTO 15170
  798. 15578 IF KTMAX = 1 GOTO 15160
  799. 15580 K$(MAX + 1) = ""
  800. 15590 X9 = KT 
  801. 15600 WHILE X9 <= KTMAX
  802. 15610 K$(X9) = K$(X9 + 1)
  803. 15620 X9 = X9 + 1
  804. 15630 WEND 
  805. 15650 KTMAX = KTMAX - 1
  806. 15660 FOR T9 = KT TO KTMAX
  807. 15670 PRINT K$(T9);
  808. 15680 NEXT T9
  809. 15690 PRINT "_";
  810. 15692 T7 = (KTMAX - KT) + 2
  811. 15694 FOR T6 = 1 TO T7
  812. 15696 PRINT CHR$(CH);
  813. 15698 NEXT T6
  814. 15700 GOTO 15160
  815. 15710 REM * BACKSPACE
  816. 15720 IF KT = 1 GOTO 15160
  817. 15725 K$(KT) = " "
  818. 15730 KT = KT - 1
  819. 15735 K$(KT) = " "
  820. 15740 PRINT CHR$(CH);
  821. 15750 PRINT "_";
  822. 15755 PRINT CHR$(CH);
  823. 15760 GOTO 15160
  824. 15800 REM * SAME ENTRY AS LAST RECORD
  825. 15810 DT# = X(N)
  826. 15820 RETURN
  827. 15830 REM * SAME ENTRY AS LAST RECORD OVER ONE COLUMN
  828. 15835 DT# = X(N + 1)
  829. 15840 RETURN
  830. 15850 REM * SAME ENTRY AS LAST RECORD ALFANUMERIC
  831. 15860 A$ = CK$(N)
  832. 15870 RETURN
  833. 15900 REM RESTART DATA ENTRY*
  834. 15910 REFLG = 1
  835. 15915 IF NE = 0 GOTO 15340
  836. 15920 RETURN
  837. 15950 REM * ABORT NEW DATA ENTRY
  838. 15960 IF NE = 0 GOTO 15340
  839. 15970 ABORTFLG = 1
  840. 15980 RETURN
  841. 16000 GOSUB 13000
  842. 16010 PRINT "***********  MAKE SURE YOUR PRINTER IS ON  **************"
  843. 16020 PRINT ""
  844. 16030 PRINT "********************  WITH PAPER  ***********************"
  845. 16040 PRINT ""
  846. 16050 PRINT "**********  PRESS ANY KEY TO START PRINTING  ************"
  847. 16055 PRINT ""
  848. 16057 PRINT "     *******  PRESS THE LETTER A TO ABORT  *******"
  849. 16070 T$ = INKEY$
  850. 16073 IF T$ = "" GOTO 16070
  851. 16075 PRINT T$
  852. 16085 IF T$ = "A" OR T$ = "a" THEN GOTO 3010
  853. 16090 RETURN
  854. 16200 REM * PRINT OUT FIELDS
  855. 16205 T2 = 1
  856. 16210 FOR T = 1 TO NREC(A)
  857. 16220 PRINT TAB(T2) T;"-";FLDN$(A,T);
  858. 16230 IF T MOD 2 = 0 THEN PRINT ""
  859. 16235 IF T MOD 2 = 0 THEN T2 = -25
  860. 16237 T2 = T2 + 26
  861. 16340 NEXT T
  862. 16350 RETURN
  863. 16800 REM *  HARD DISK OPTION
  864. 16810 GOSUB 13000
  865. 16820 PRINT "****************  ARE YOU USING A HARD DISK  *******************"
  866. 16830 PRINT ""
  867. 16840 PRINT "          1 - NO , I AM USING FLOPPY DISKS"
  868. 16845 PRINT ""
  869. 16850 PRINT "          2 - YES, I AM USING A HARD DISK"
  870. 16852 PRINT "               with all my files on the hard disk"
  871. 16854 PRINT "               and the hard disk is the default drive"
  872. 16860 PRINT ""
  873. 16870 PRINT "*************  ENTER THE NUMBER THEN PRESS RETURN  *************"
  874. 16880 GOSUB 14000
  875. 16890 IF DT#<1 OR DT#>2 GOTO 16880
  876. 16900 HDISK = DT#
  877. 16910 RETURN
  878. 17000 REM
  879. 17005 RNB = 0
  880. 17010 GOSUB 13000
  881. 17020 PRINT "******************  SEARCH A SORTED FILE  *******************"
  882. 17030 PRINT ""
  883. 17040 GOSUB 16200 
  884. 17060 PRINT ""
  885. 17070 PRINT "***********  ENTER ZERO TO RETURN TO INITIAL MENU  **********"
  886. 17080 PRINT ""
  887. 17090 PRINT "************  WHAT FIELD IS THIS FILE SORTED BY  ************"
  888. 17100 GOSUB 14000
  889. 17101 IF DT# <0 OR DT# >NREC(A)  GOTO 17100
  890. 17105 SF = DT#
  891. 17110 IF SF = 0 GOTO 3010
  892. 17120 PRINT "*********  WHAT VALUE DO YOU WANT TO SEARCH FOR ?  **********"
  893. 17130 PRINT FLDN$(A,SF);"=" 
  894. 17150 ON FTY(A,SF) GOTO 17160,17200,17250,17300,17300
  895. 17160 MAX = FL(A,SF)
  896. 17162 GOSUB 15030
  897. 17164 SV$ = A$
  898. 17166 LN = LEN(A$)
  899. 17170 GOTO 17350 
  900. 17200 GOSUB 14100
  901. 17202 SV% = DT#
  902. 17205 SV$ = MKI$(SV%)
  903. 17210 GOTO 17350
  904. 17250 GOSUB 14200
  905. 17252 SV! = DT#
  906. 17255 SV$ = MKS$(SV!)
  907. 17260 GOTO 17350 
  908. 17300 GOSUB 14300
  909. 17305 SV$ = MKD$(DT#)
  910. 17350 REM START SEARCH*
  911. 17360 RN = 8192
  912. 17365 I!= RN    
  913. 17368 IF RN > MRN GOTO 17800
  914. 17370 GET #1,RN
  915. 17375 I!= I!/ 2
  916. 17376 IF FTY(A,SF) = 1 THEN XT$ = LEFT$(X$(SF),LN) ELSE XT$=X$(SF)
  917. 17377 IF I!< 1  THEN GOTO 17900
  918. 17378 IF XT$ = SV$ THEN RNB = RN
  919. 17380 IF XT$ < SV$ THEN GOTO 17500
  920. 17390 RN = RN - I!
  921. 17400 GOTO 17368
  922. 17500 RN = RN + I!
  923. 17510 GOTO 17368
  924. 17600 REM
  925. 17610 GOTO 8057
  926. 17800 REM ON ERROR ROUTINE 
  927. 17801 I!= I!/ 2
  928. 17802 IF I!< 1 GOTO 17900
  929. 17805 RN = RN - I!
  930. 17810 GOTO 17368
  931. 17900 IF XT$ = SV$ THEN GOTO 17950
  932. 17902 IF RNB > 0 THEN RN = RNB
  933. 17904 IF RNB > 0 THEN GOTO 8057 
  934. 17906 PRINT " RECORD NOT FOUND "
  935. 17910 GOTO 17000
  936. 17950 PRINT "RN = ";RN
  937. 17960 GOTO 8057
  938. 18000 REM 
  939. 18005 SFLG = 1
  940. 18010 GOSUB 13000
  941. 18020 PRINT "*********************  SEARCH  FILE  ***********************"
  942. 18030 PRINT ""
  943. 18040 GOSUB 16200 
  944. 18060 PRINT ""
  945. 18070 PRINT "***********  ENTER ZERO TO RETURN TO INITIAL MENU  **********"
  946. 18080 PRINT ""
  947. 18090 PRINT "*************  WHICH FIELD DO YOU WANT TO SEARCH  ***********"
  948. 18100 GOSUB 14000
  949. 18101 IF DT# <0 OR DT# >NREC(A)  GOTO 18100
  950. 18105 SF = DT#
  951. 18110 IF SF = 0 GOTO 3010
  952. 18120 PRINT "*********  WHAT VALUE DO YOU WANT TO SEARCH FOR ?  **********"
  953. 18130 PRINT FLDN$(A,SF);"=" 
  954. 18150 ON FTY(A,SF) GOTO 18160,18200,18250,18300,18300
  955. 18160 MAX = FL(A,SF)
  956. 18162 GOSUB 15030
  957. 18164 SV$ = A$
  958. 18166 LN = LEN(A$)
  959. 18170 GOTO 18350 
  960. 18200 GOSUB 14100
  961. 18202 SV% = DT#
  962. 18205 SV$ = MKI$(SV%)
  963. 18210 GOTO 18350
  964. 18250 GOSUB 14200
  965. 18252 SV! = DT#
  966. 18255 SV$ = MKS$(SV!)
  967. 18260 GOTO 18350 
  968. 18300 GOSUB 14300
  969. 18305 SV$ = MKD$(DT#)
  970. 18350 REM * START SEARCH
  971. 18360 GOSUB 18800
  972. 18365 FOR RN = RNSS TO MRN 
  973. 18370 GET #1,RN
  974. 18376 IF FTY(A,SF) = 1 THEN XT$ = LEFT$(X$(SF),LN) ELSE XT$=X$(SF)
  975. 18378 IF XT$ = SV$ THEN GOTO 8057
  976. 18380 NEXT RN
  977. 18390 GOTO 3010
  978. 18800 REM *  GET STARTING AND ENDING FILE
  979. 18803 PRINT ""
  980. 18805 PRINT "MINIMUM RECORD NUMBER = 1  MAXIMUM RECORD NUMBER = ";MRN
  981. 18810 PRINT "******  WHICH RECORD NUMBER DO YOU WANT TO START THE SEARCH AT  ******"
  982. 18820 GOSUB 14100
  983. 18830 IF DT#<1 OR DT#>MRN THEN 18820
  984. 18840 RNSS = DT#
  985. 18900 RETURN
  986. 20000 REM *****  GET UPPER LIMIT 
  987. 20010 GOSUB 20050
  988. 20020 GOSUB 20400
  989. 20030 GOTO 21000
  990. 20050 RNU = RN
  991. 20060 TESTH$ = TEST$
  992. 20100 WHILE TEST$ = TESTH$
  993. 20110 RNU = RNU - 1
  994. 20115 IF RNU = 0 THEN GOTO 20140
  995. 20120 GET #1,RNU
  996. 20130 WEND
  997. 20140 RNU = RNU + 1
  998. 20200 REM * GET LOWER LIMIT 
  999. 20250 RNL = RN
  1000. 20290 GET #1,RNL
  1001. 20300 WHILE TEST$ = TESTH$
  1002. 20310 RNL = RNL + 1
  1003. 20315 IF RNL > MRN THEN GOTO 20340
  1004. 20320 GET #1,RNL
  1005. 20330 WEND
  1006. 20340 RNL = RNL - 1
  1007. 20350 RETURN
  1008. 20400 REM * SET SUMS TO ZERO
  1009. 20410 FOR T = 1 TO 28
  1010. 20420 SUM#(T) = 0
  1011. 20430 NEXT T
  1012. 20450 RETURN
  1013. 21000 REM *  PRINT REPIOTIOUS FIELDS
  1014. 21050 OFFSET = -1
  1015. 21100 FOR TH = RNU TO RNL
  1016. 21105 OFFSET = OFFSET + 1
  1017. 21110 GET #1,TH
  1018. 21120 T2 = LSTE + 1
  1019. 21130 FOR N = T2 TO NREC(A)
  1020. 21140 GOSUB 34110
  1021. 21150 NEXT N
  1022. 21160 NEXT TH
  1023. 21180 LI = 1
  1024. 21182 TB = 47
  1025. 21185 GOSUB 13050
  1026. 21190 PRINT "RECORDS";RNU;" TO ";RNL;"  *******"
  1027. 21195 RN = RNL
  1028. 21200 GOTO 8510
  1029. 26000 REM 
  1030. 26100 EFLG = 1
  1031. 26200 PRINT "**********  END OF FILE  ***********"
  1032. 26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
  1033. 26204 IF INKEY$ = "" GOTO 26204
  1034. 26210 GOTO  3010
  1035. 26500 REM 
  1036. 26600 PRINT "**********  END OF FILE  ***********"
  1037. 26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
  1038. 26620 IF INKEY$ = "" GOTO 26620
  1039. 26635 EFLG = 1
  1040. 26640 RETURN        
  1041. 26800 REM 
  1042. 26900 PRINT "******  RECORD NUMBER REQUESTED DOES NOT EXIST  ******"
  1043. 26910 GOTO 8020
  1044. 27000 REM * READ SCREEN TEST
  1045. 27005 GOSUB 10900
  1046. 27010 OPEN "I",#1,"SCTEST"
  1047. 27020 FOR T = 1 TO 40
  1048. 27030 INPUT #1,SCRN(T)
  1049. 27040 NEXT T
  1050. 27050 CLOSE #1
  1051. 27060 RETURN
  1052. 27070 REM * READ SCREEN DESCRIPTION
  1053. 27071 GOSUB 10900
  1054. 27072 A$ = STR$(A)
  1055. 27074 A$ = MID$(A$,2)
  1056. 27076 A$ = "SCREEN" + A$
  1057. 27080 OPEN "I",#2,A$
  1058. 27090 FOR T = 1 TO 18 
  1059. 27100 INPUT #2,SW$(T)
  1060. 27110 NEXT T
  1061. 27120 FOR T = 1 TO NREC(A)
  1062. 27130 INPUT #2,LE(T),CE(T)
  1063. 27140 IF FTY(A,T) = 2 THEN INPUT #2,LEK(T),CEK(T)
  1064. 27150 NEXT T
  1065. 27160 INPUT #2,RPT
  1066. 27170 IF RPT = 2 THEN GOSUB 27200
  1067. 27180 CLOSE #2
  1068. 27190 RETURN
  1069. 27200 INPUT #2,LSTE
  1070. 27210 T2 = LSTE + 1
  1071. 27220 FOR T = T2 TO NREC(A)
  1072. 27230 INPUT #2,SUMF(T)
  1073. 27240 NEXT T
  1074. 27245 H = 0
  1075. 27250 FOR T = 1 TO LSTE
  1076. 27260 H = FL(A,T) + H
  1077. 27270 NEXT T
  1078. 27280 FIELD #1,H AS TEST$
  1079. 27300 RETURN
  1080. 28000 REM 
  1081. 28100 GOSUB 13000
  1082. 28110 PRINT "**********  DO YOU WANT TO USE THE STANDARD OR YOUR CUSTOM SCREEN  **********"
  1083. 28115 PRINT ""
  1084. 28120 PRINT "                        1 - USE THE CUSTOM SCREEN"
  1085. 28125 PRINT ""
  1086. 28130 PRINT "                        2 - USE THE STANDARD SCREEN"
  1087. 28135 PRINT ""
  1088. 28140 PRINT "*******************  ENTER THE NUMBER THEN PRESS RETURN  ********************"
  1089. 28200 GOSUB 14000
  1090. 28210 IF DT# < 1 OR DT# > 2 THEN 28200
  1091. 28220 CSCR = DT#
  1092. 28230 IF CSCR = 1 THEN GOSUB 27070
  1093. 28300 RETURN
  1094. 29000 REM * READ IDEX SUBROUTINE
  1095. 29010 OPEN "I",#1,"IDEX"
  1096. 29020 FOR T = 1 TO MAXF
  1097. 29030 INPUT #1,D,D,D,MFLG(T)
  1098. 29040 NEXT T
  1099. 29050 CLOSE #1
  1100. 29060 RETURN
  1101. 29070 REM * READ MAX MIN DATA
  1102. 29080 A$ = STR$(A)
  1103. 29090 A$ = MID$(A$,2)
  1104. 29100 A$ = "MAXMIN" + A$
  1105. 29110 OPEN "I",#2,A$
  1106. 29120 FOR T = 1 TO NREC(A)
  1107. 29130 INPUT #2,MAXC#(T),MINC#(T)
  1108. 29140 NEXT T
  1109. 29150 CLOSE #2
  1110. 29160 RETURN
  1111. 29190 N = D
  1112. 29200 REM * CHECK MAX LIMITS
  1113. 29210 IF DT# < MINC#(N) OR DT# > MAXC#(N) THEN GOSUB 29300
  1114. 29220 RETURN
  1115. 29300 PRINT CHR$(7);
  1116. 29310 PRINT CHR$(7);
  1117. 29329 RETURN
  1118. 30000 REM * PRINT OVERLAY
  1119. 30005 GOSUB 20400
  1120. 30010 OFFSET = 0
  1121. 30100 FOR T = 1 TO 18
  1122. 30110 PRINT SW$(T)
  1123. 30120 NEXT T
  1124. 30130 RETURN
  1125. 31000 REM * PRINT FIELDS
  1126. 31010 X(N) = I#
  1127. 31100 IF LE(N) = 0 THEN RETURN
  1128. 31110 LI = LE(N) + 1 + OFFSET
  1129. 31115 TB = CE(N)
  1130. 31120 GOSUB 13050
  1131. 31130 ON FTY(A,N) GOSUB 32000,32100,32100,32100,32200
  1132. 31140 IF KEYLIST(A,N) > 0 THEN GOSUB 33000
  1133. 31145 IF SUMF(N) = 2 THEN GOSUB 39200
  1134. 31150 RETURN
  1135. 32000 REM STRINGS *
  1136. 32010 PRINT I$
  1137. 32020 RETURN
  1138. 32100 PRINT I#
  1139. 32110 RETURN
  1140. 32200 REM *$$$$
  1141. 32210 PRINT USING "**$########.##";I#
  1142. 32220 RETURN
  1143. 33000 REM * PRINT KEYS
  1144. 33100 IF LEK(N) = 0 THEN RETURN
  1145. 33110 LI = LEK(N) + 1 + OFFSET
  1146. 33120 REM
  1147. 33130 TB = CEK(N)
  1148. 33140 GOSUB 13050
  1149. 33150 T1 = KEYLIST(A,N)
  1150. 33160 PRINT L$(T1,I#)
  1151. 33170 RETURN
  1152. 34000 REM * PRINT FIELDS
  1153. 34050 GOSUB 30000
  1154. 34100 FOR N = 1 TO NREC(A)
  1155. 34102 GOSUB 34110
  1156. 34104 NEXT N
  1157. 34110 ON FTY(A,N) GOSUB 34200,34300,34500,34600,34600
  1158. 34120 GOSUB 31000
  1159. 34140 RETURN
  1160. 34200 I$ =  X$(N)
  1161. 34250 RETURN  
  1162. 34300 I#=CVI(X$(N))
  1163. 34310 X(N) = I#
  1164. 34350 RETURN
  1165. 34500 I#=CVS(X$(N))
  1166. 34550 RETURN
  1167. 34600 I#=CVD(X$(N))
  1168. 34610 X(N) = I#
  1169. 34650 RETURN
  1170. 35000 REM * PRINT OVERLAY
  1171. 35010 EFLG = 0
  1172. 35030 IF RPT = 2 THEN LPRINT "AND SUBRECORDS" ELSE LPRINT ""
  1173. 35050 GOSUB 20400
  1174. 35100 FOR T = 1 TO 18
  1175. 35110 LPRINT SW$(T);
  1176. 35115 GOSUB 35200
  1177. 35117 IF EFLG = 1 THEN RETURN
  1178. 35120 NEXT T
  1179. 35130 RETURN
  1180. 35200 REM * LPRINT FIELDS
  1181. 35210 FOR T2 = 1 TO NREC(A)
  1182. 35220 IF LE(T2) = T THEN GOSUB 36000
  1183. 35300 IF LEK(T2) = T THEN GOSUB 39000
  1184. 35400 NEXT T2
  1185. 35410 LPRINT ""
  1186. 35500 RETURN
  1187. 35600 REM * LPRINT REPEATING FIELDS
  1188. 35650 GOSUB 20050
  1189. 35655 T3 = LSTE + 1
  1190. 35657 RN = RNL
  1191. 35660 FOR TH = RNU TO RNL
  1192. 35665 GET #1,TH
  1193. 35670 FOR N = T3 TO NREC(A)
  1194. 35675 T2 = N
  1195. 35680 GOSUB 36100
  1196. 35685 IF SUMF(N) = 2 THEN SUM#(N) = SUM#(N) + I#
  1197. 35687 IF FTY(A,N) = 2 AND LEK(N) > 0 THEN GOSUB 39000
  1198. 35690 NEXT N
  1199. 35700 LPRINT ""
  1200. 35710 NEXT TH
  1201. 35750 REM * LPRINT SUMS
  1202. 35755 EFLG = 1
  1203. 35760 FOR N = LSTE TO NREC(A)
  1204. 35770 IF SUMF(N) = 2 THEN GOSUB 35900
  1205. 35780 NEXT N
  1206. 35790 RETURN
  1207. 35900 REM 
  1208. 35905 TB = CE(N)
  1209. 35906 LPRINT TAB(TB);
  1210. 35907 IF FTY(A,N) = 5 THEN GOTO 35950
  1211. 35910 LPRINT TAB(TB) SUM#(N);
  1212. 35920 RETURN
  1213. 35950 LPRINT USING "**$########.##";SUM#(N);
  1214. 35960 RETURN
  1215. 36000 REM * LPRINT FIELDS
  1216. 36050 N = T2
  1217. 36060 IF RPT = 2 AND N > LSTE THEN GOTO 35600
  1218. 36100 ON FTY(A,T2) GOSUB 34200,34300,34500,34600,34600
  1219. 36200 GOTO 37000
  1220. 37000 REM * PRINT FIELDS
  1221. 37115 TB = CE(T2)
  1222. 37125 LPRINT TAB(TB) "";
  1223. 37130 ON FTY(A,T2) GOSUB 38010,38100,38100,38100,38200
  1224. 37150 RETURN
  1225. 38000 REM STRINGS *
  1226. 38010 LPRINT I$;
  1227. 38020 RETURN
  1228. 38100 LPRINT I#;
  1229. 38110 RETURN
  1230. 38200 REM * $$$$
  1231. 38210 LPRINT USING "**$########.##";I#;
  1232. 38220 RETURN
  1233. 39000 REM  * PRINT KEYS
  1234. 39010 ON FTY(A,T2) GOSUB 34200,34300,34500,34600,34600
  1235. 39090 N = T2
  1236. 39130 TB = CEK(T2)
  1237. 39140 LPRINT TAB(TB) "";
  1238. 39150 T1 = KEYLIST(A,T2)
  1239. 39160 LPRINT L$(T1,I#);
  1240. 39170 RETURN
  1241. 39200 REM * PRINT TOTALS
  1242. 39300 SUM#(N) = SUM#(N) + I#
  1243. 39310 LI = 19
  1244. 39320 GOSUB 13050
  1245. 39330 IF FTY(A,N) = 5 THEN GOTO 39600
  1246. 39400 PRINT SUM#(N);
  1247. 39410 RETURN
  1248. 39600 REM $$$$$
  1249. 39610 PRINT USING "**$########.##";SUM#(N);
  1250. 39620 RETURN
  1251. 40000 REM * NEW INPUT
  1252. 40002 ABORTFLG = 0
  1253. 40008 IF REALFLG(A) = 2 THEN GOSUB 60200
  1254. 40010 GOSUB 13000
  1255. 40015 IF DATAIN = 1 GOTO 40500
  1256. 40017 GOSUB 40020
  1257. 40018 GOTO 40500
  1258. 40020 REM  READ INPUT DATA 
  1259. 40021 GOSUB 49000
  1260. 40022 GOSUB 10900
  1261. 40025 A$ = STR$(A)
  1262. 40027 A$ = MID$(A$,2)
  1263. 40030 N$ = "IPUTD"+A$
  1264. 40040 OPEN "I",#2,N$     
  1265. 40050 INPUT #2,NREC(A)
  1266. 40060 FOR N3= 1 TO NREC(A)
  1267. 40062 N = N3
  1268. 40070 INPUT #2,IOPT(N)
  1269. 40080 ON IOPT(N) GOTO 40090,40120,40150,40210,40240,40270,40430,40370,40370,40430,40430,40430,40210
  1270. 40085 GOTO 40450
  1271. 40090 REM OPERATOR ENTRY*
  1272. 40100 INPUT #2,PROMPT$(N)
  1273. 40110 GOTO 40450
  1274. 40120 REM GET FROM ANOTHER FILE*
  1275. 40130 INPUT #2,IFN(N),IFLD(N),IRNFLD(N)
  1276. 40132 GFLG(IFN(N)) = 1
  1277. 40134 GFLG(IFLD(N)) = 1
  1278. 40136 GFLG(IRNFLD(N)) = 1
  1279. 40140 GOTO 40450
  1280. 40150 REM ADD PREVIOUS FIELDS*
  1281. 40160 INPUT #2,NOS(N)
  1282. 40170 FOR T = 1 TO NOS(N)
  1283. 40180 INPUT #2,ADDFLD(N,T)
  1284. 40185 GFLG(ADDFLD(N,T)) = 1
  1285. 40190 NEXT T
  1286. 40200 GOTO 40450
  1287. 40210 REM SUBTRACT PREVIOUS FIELDS*
  1288. 40220 INPUT #2, SUBX(N),SUBY(N)
  1289. 40222 GFLG(SUBX(N)) = 1
  1290. 40224 GFLG(SUBY(N)) = 1
  1291. 40230 GOTO 40450
  1292. 40240 REM MULTIPLY FIELDS*
  1293. 40250 INPUT #2, MULX(N),MULY(N)
  1294. 40252 GFLG(MULX(N)) = 1
  1295. 40254 GFLG(MULY(N)) = 1
  1296. 40260 GOTO 40450
  1297. 40270 REM GET FROM A TABLE*
  1298. 40280 INPUT #2,TX(1,N),TX(2,N),TX(3,N),TX(4,N),TX(5,N),TX(6,N)
  1299. 40282 GFLG(TX(2,N)) = 1
  1300. 40283 GFLG(TX(4,N)) = 1
  1301. 40284 GFLG(TX(5,N)) = 1
  1302. 40285 GFLG(TX(6,N)) = 1
  1303. 40290 TTBL = 5
  1304. 40310 GOTO 40450
  1305. 40370 REM MAXIMUM*
  1306. 40380 INPUT #2,NOS(N)
  1307. 40390 FOR T = 1 TO NOS(N)
  1308. 40400 INPUT #2,MAXMIN(N,T)
  1309. 40405 GFLG(MAXMIN(N,T)) = 1
  1310. 40410 NEXT T
  1311. 40420 GOTO 40450
  1312. 40430 REM CONSTANT*
  1313. 40440 INPUT #2,KC(N),CFLD(N)
  1314. 40445 GFLG(CFLD(N)) = 1
  1315. 40450 NEXT N3   
  1316. 40460 CLOSE #2
  1317. 40470 DATAIN = 1
  1318. 40480 RETURN
  1319. 40500 REM OPEN SECOND FILE*
  1320. 40505 IF TWOOPEN = 1 THEN 40637
  1321. 40507 TWOOPEN = 1
  1322. 40510 FOR T = 1 TO NREC(A)
  1323. 40520 IF IOPT(T) = 2 GOTO 40600
  1324. 40530 NEXT T
  1325. 40540 GOTO 40640
  1326. 40600 B = IFN(T)
  1327. 40602 AHLD = A
  1328. 40604 A = B
  1329. 40610 PRINT F$(B), " SECOND FILE FOR CUSTOM INPUT "
  1330. 40620 GOSUB 2300
  1331. 40625 A = AHLD
  1332. 40630 GOSUB 2550
  1333. 40635 GOSUB 7950
  1334. 40637 IF TAXIN = 1 THEN 41000
  1335. 40638 TAXIN = 1
  1336. 40640 FOR T = 1 TO NREC(A)
  1337. 40650 IF IOPT(T) = 6 GOTO 40800
  1338. 40660 NEXT T
  1339. 40670 GOTO 41000
  1340. 40800 GOSUB 45000
  1341. 41000 REM CUSTOM INPUT ROUTINE*
  1342. 41010 GOSUB 13000
  1343. 41012 OFFSET = 0
  1344. 41014 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61300
  1345. 41015 PRINT "*****************  FILE NAME :";F$(A);"  ";"RECORD NUMBER :";RN;" ****************"
  1346. 41030 IF CSCR = 1 THEN GOSUB 30000
  1347. 41080 LI = 25
  1348. 41082 GOSUB 13100
  1349. 41085 PRINT "[ = SAME AS LAST RECORD , < BACK UP , > ABORT THIS RECORD , ^ EQUALLAST OVER 1]";
  1350. 41087 GOTO 41130
  1351. 41092 LI = 20
  1352. 41093 GOSUB 13100
  1353. 41094 PRINT "                                                                              "
  1354. 41095 PRINT "                                                                              "
  1355. 41096 PRINT "                                                                              "
  1356. 41097 PRINT "                                                                              "
  1357. 41100 PRINT "                                                                             "; 
  1358. 41110 LI = 20
  1359. 41115 GOSUB 13100
  1360. 41120 PRINT "ON FIELD NUMBER : ";N;" FIELD NAME : ";FLDN$(A,N);" : "
  1361. 41125 RETURN
  1362. 41130 N = 1 
  1363. 41133 WHILE N <= NREC(A)
  1364. 41135 REFLG = 0
  1365. 41137 IF N < 1 THEN N = 1
  1366. 41140 ON IOPT(N) GOSUB 41200,41400,41600,41800,42000,42200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000
  1367. 41150 GOSUB 43800
  1368. 41155 N = N + 1
  1369. 41160 WEND
  1370. 41165 GOTO 44910
  1371. 41170 REM * BACK UP FIELDS UNTIL IOPT = 1
  1372. 41175 N = N - 1
  1373. 41180 IF N < 1 THEN 41133
  1374. 41185 IF IOPT(N) <> 1 THEN 41175
  1375. 41190 GOTO 41133
  1376. 41200 REM *  OPERATOR ENTRY
  1377. 41202 NE = 1
  1378. 41205 GOSUB 41092
  1379. 41210 PRINT PROMPT$(N)
  1380. 41215 REFLG = 0
  1381. 41220 IF FTY(A,N) = 1 GOTO 41300
  1382. 41230 ON FTY(A,N) GOSUB 15000,14100,14200,14300,14300
  1383. 41234 IF REFLG = 1 THEN GOTO 41170
  1384. 41235 IF ABORTFLG = 1 GOTO 7000 
  1385. 41236 IF MFLG(A) = 2 AND FTY(A,N) <> 1 THEN GOSUB 29200
  1386. 41237 T2 = KEYLIST(A,N)
  1387. 41238 T3 = MAXK(T2)
  1388. 41239 REM  IF KY(A,N) = 2 AND (DT# < 1 OR DT# > T3) GOTO 41230
  1389. 41240 I# = DT# 
  1390. 41245 NE = 0
  1391. 41250 RETURN     
  1392. 41298 REFLG = 0
  1393. 41300 Q = N    
  1394. 41302 GOSUB 15000
  1395. 41303 IF ABORTFLG = 1 GOTO 7000
  1396. 41304 I$ = A$
  1397. 41306 NE = 0
  1398. 41308 IF REFLG = 1 GOTO 41170
  1399. 41310 RETURN    
  1400. 41400 REM GET FROM ANOTHER FILE*
  1401. 41402 FLD = IFLD(N)
  1402. 41404 T = IRNFLD(N)
  1403. 41406 RN2= X(T)
  1404. 41407 IF RN2 > MRNS THEN GOTO 48000
  1405. 41408 GET #2,RN2
  1406. 41409 B = IFN(N)
  1407. 41420 ON FTY(B,FLD) GOTO 41422,41460,41500,41550,41550
  1408. 41422 I$ = Y$(FLD)
  1409. 41430 RETURN      
  1410. 41460 Y$ = Y$(FLD)
  1411. 41465 I% = CVI(Y$)
  1412. 41467 I# = I%
  1413. 41470 RETURN     
  1414. 41500 I! = CVS(Y$(FLD))
  1415. 41505 I# = I!
  1416. 41510 RETURN     
  1417. 41550 I# = CVD(Y$(FLD))
  1418. 41560 GOTO 43800
  1419. 41600 REM ADD PREVIOUS FIELDS*
  1420. 41605 I# = 0
  1421. 41610 FOR T = 1 TO NOS(N)
  1422. 41620 T2 = ADDFLD(N,T)
  1423. 41630 I# = I# + X(T2)
  1424. 41640 NEXT T
  1425. 41650 RETURN    
  1426. 41800 REM SUBTRACT FIELDS
  1427. 41810 T1 = SUBX(N)
  1428. 41820 T2 = SUBY(N)
  1429. 41830 IF IOPT(N) = 4 THEN I# = X(T1) - X(T2) ELSE I# = X(T1)/X(T2)
  1430. 41840 RETURN    
  1431. 42000 REM MULTIPLY FIELDS
  1432. 42010 T1 = MULX(N)
  1433. 42020 T2 = MULY(N)
  1434. 42030 I# = X(T1) * X(T2)
  1435. 42040 RETURN     
  1436. 42200 REM GET FROM A TABLE
  1437. 42210 ON TX(1,N) GOSUB 42400,42450
  1438. 42220 ON TX(3,N) GOSUB 42500,42550
  1439. 42230 Y = TX(5,N)
  1440. 42240 MSS = X(Y)
  1441. 42250 Y = TX(6,N)
  1442. 42260 PAY# = X(Y)
  1443. 42270 GOSUB 45500
  1444. 42272 I# = TTAX#
  1445. 42290 RETURN     
  1446. 42400 FSS = TX(2,N)
  1447. 42410 RETURN
  1448. 42450 Y = TX(2,N)
  1449. 42460 FSS = X(Y)
  1450. 42470 RETURN
  1451. 42500 PPS = TX(4,N)
  1452. 42510 RETURN
  1453. 42550 Y = TX(4,N)
  1454. 42560 PPS = X(Y)
  1455. 42570 RETURN
  1456. 42600 REM CONSTANT
  1457. 42610 I# = KC(N)
  1458. 42620 RETURN    
  1459. 42800 REM MAXIMUM
  1460. 42802 T2 = MAXMIN(N,1)
  1461. 42804 I# = X(T2)
  1462. 42810 FOR T = 2 TO NOS(N)
  1463. 42820 T2 = MAXMIN(N,T)
  1464. 42830 IF X(T2) > I# THEN I# = X(T2)
  1465. 42840 NEXT T
  1466. 42850 RETURN        
  1467. 43000 REM MINIMUM*
  1468. 43002 T2 = MAXMIN(N,1)
  1469. 43004 I# = X(T2)
  1470. 43010 FOR T = 2 TO NOS(N)
  1471. 43020 T2 = MAXMIN(N,T)
  1472. 43030 IF X(T2) < I#  THEN I# = X(T2)
  1473. 43040 NEXT T
  1474. 43050 RETURN       
  1475. 43200 REM MULTIPLY BY A CONSTANT*
  1476. 43210 T = CFLD(N)
  1477. 43220 I# = KC(N) * X(T)
  1478. 43230 RETURN    
  1479. 43400 REM ADD A CONSTANT*
  1480. 43410 T = CFLD(N)
  1481. 43420 I# = KC(N) + X(T)
  1482. 43430 RETURN    
  1483. 43600 REM SUBTRACT A CONSTANT
  1484. 43610 T = CFLD(N)
  1485. 43620 I# = X(T) - KC(N)
  1486. 43630 RETURN     
  1487. 43800 REM LSET
  1488. 43810 ON FTY(A,N) GOTO 43900,44000,44100,44200,44200
  1489. 43900 REM STRING*
  1490. 43910 LSET X$(N) = I$
  1491. 43920 CK$(N) = I$
  1492. 43990 GOTO 44400
  1493. 44000 REM INTEGER *           
  1494. 44020 LSET X$(N) = MKI$(I#)
  1495. 44030 GOTO 44400
  1496. 44100 REM SINGLE PRECISION* 
  1497. 44110 I! = I#
  1498. 44120 LSET X$(N) = MKS$(I#)
  1499. 44130 GOTO 44400
  1500. 44200 REM DOUBLE PRECISION*
  1501. 44210 LSET X$(N) = MKD$(I#)
  1502. 44400 X(N) = I#
  1503. 44410 IF CALFLG = 5 THEN RETURN
  1504. 44500 IF CSCR = 1 THEN GOSUB 31000
  1505. 44501 IF CSCR = 1 THEN GOTO 44900
  1506. 44502 IF N < 19 THEN HT = N + 1 
  1507. 44503 IF N >= 19 THEN HT = N MOD 18 + 2
  1508. 44504 LI = HT
  1509. 44505 GOSUB 13100
  1510. 44506 IF N <18 GOTO 44510
  1511. 44507 PRINT "                                                                              ";
  1512. 44508 GOSUB 13100   
  1513. 44510 PRINT N;TAB(5) FLDN$(A,N);    
  1514. 44515 IF KEYLIST(A,N) > 0 GOTO 44800
  1515. 44520 IF FTY(A,N) = 1 GOTO 44600
  1516. 44525 IF FTY(A,N) = 5 GOTO 44700
  1517. 44530 PRINT TAB(25) I#
  1518. 44535 X(N) = I#
  1519. 44540 GOTO 44900
  1520. 44600 PRINT TAB(26) I$
  1521. 44610 GOTO 44900
  1522. 44700 PRINT TAB(26);
  1523. 44710 PRINT USING "**$########.##";I#
  1524. 44715 X(N) = I#
  1525. 44720 GOTO 44900
  1526. 44800 REM KEYLIST
  1527. 44810 T1 = KEYLIST(A,N)
  1528. 44820 W$ = L$(T1,I#)
  1529. 44830 PRINT TAB(25) I#;
  1530. 44835 X(N) = I#
  1531. 44840 PRINT TAB(30) "key  ";W$
  1532. 44900 RETURN 
  1533. 44910 PUT #1,RN
  1534. 44912 IF REALFLG(A) = 2 THEN GOSUB 60300
  1535. 44913 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61400
  1536. 44915 IF RN > MRN THEN MRN = RN
  1537. 44920 LI = 20
  1538. 44925 GOSUB 13100
  1539. 44930 PRINT "***********************  OPTIONS :  ************************                  "
  1540. 44940 PRINT "   1 - ENTER NEXT RECORD          3 - CORRECT THIS RECORD                     "
  1541. 44950 PRINT "   2 - ENTER ANOTHER RECORD       4 - ENTER A SUBRECORD                       "
  1542. 44960 PRINT "***************  0 - RETURN TO FILE OPTIONS   **************                  "
  1543. 44962 SPRT = 5
  1544. 44965 GOSUB 14000
  1545. 44967 IF DT# <0 OR DT# >4 GOTO 44920
  1546. 44970 TH = DT#
  1547. 44975 IF TH = 2 THEN RETURN
  1548. 44980 IF TH = 0 THEN GOTO 3010
  1549. 44985 IF TH = 3 THEN GOSUB 9000 
  1550. 44987 IF TH = 3 THEN GOTO 44920
  1551. 44988 IF TH = 4 AND RPT <> 2 THEN 44996
  1552. 44989 IF TH = 4 THEN GOTO 52000
  1553. 44990 RN = RN + 1
  1554. 44995 GOTO 41000
  1555. 44996 LI = 24
  1556. 44997 GOSUB 13100
  1557. 44998 PRINT TAB(10) "SUBRECORDS ARE NOT SET UP ON THIS FILE";
  1558. 44999 GOTO 44920
  1559. 45000 REM 
  1560. 45001 IF HDISK = 2 THEN GOTO 45010
  1561. 45002 GOSUB 13000
  1562. 45004 PRINT "      PUT THE FLOPPY DISK WITH THE TAX SCHEDULE ON IT IN"
  1563. 45005 PRINT "                IN THE DEFAULT DISK DRIVE "
  1564. 45006 PRINT ""
  1565. 45007 PRINT "         ****  THEN PRESS ANY KEY TO CONTINUE  ****   "
  1566. 45008 IF INKEY$ = "" THEN GOTO 45008
  1567. 45010 OPEN "R",#3,"TAXSCH",82
  1568. 45015 FIELD #3,40 AS D$,2 AS FD$,2 AS PP$,2 AS MS$,8 AS MIN$,8 AS MAX$,8 AS TX$,4 AS PCT$,8 AS OVR$
  1569. 45018 GOSUB 7900
  1570. 45020 FOR T7 = 1 TO 1000
  1571. 45040 IF T7 > MRN2 GOTO 45160
  1572. 45050 GET #3,T7
  1573. 45070 FS(T7) = CVI(FD$)
  1574. 45080 PP(T7) = CVI(PP$)
  1575. 45090 MS(T7) = CVI(MS$)
  1576. 45100 MIND#(T7) = CVD(MIN$)
  1577. 45110 MAXD#(T7) = CVD(MAX$)
  1578. 45120 TAX#(T7) = CVD(TX$)
  1579. 45130 PCT!(T7) = CVS(PCT$)
  1580. 45140 OVR#(T7) = CVD(OVR$)
  1581. 45150 NEXT T7
  1582. 45160 REM
  1583. 45170 GOTO 45200
  1584. 45200 REM
  1585. 45210 TMAX = T7 - 1
  1586. 45215 CLOSE #3
  1587. 45218 TTBL = 5
  1588. 45220 RETURN
  1589. 45230 REM
  1590. 45240 REM
  1591. 45250 REM
  1592. 45260 REM
  1593. 45270 REM
  1594. 45500 REM
  1595. 45510 FOR T7 = 1 TO TMAX
  1596. 45520 IF FS(T7) = FSS THEN GOTO 45530 ELSE GOTO 45610
  1597. 45530 IF PP(T7) = PPS THEN GOTO 45540 ELSE GOTO 45610
  1598. 45540 IF MS(T7) = MSS THEN GOTO 45550 ELSE GOTO 45610
  1599. 45550 IF PAY# < MIND#(T7) GOTO 45610
  1600. 45560 IF PAY# > MAXD#(T7) GOTO 45610
  1601. 45570 PAYEX# = PAY# - OVR#(T7)
  1602. 45580 TXE# = PAYEX# * PCT!(T7) / 100
  1603. 45590 TTAX# = TAX#(T7) + TXE#
  1604. 45600 GOTO 45680
  1605. 45610 NEXT T7
  1606. 45620 PRINT "++++++  PROPER TAX TABLE NOT FOUND  ++++++"
  1607. 45630 PRINT "CHECK : FEDERAL OR STATE NUMBER ";FSS
  1608. 45640 PRINT "        PAY PERIOD NUMBER       ";PPS
  1609. 45650 PRINT "        MARRIED/SINGLE NUMBER   ";MSS
  1610. 45660 PRINT "        PAY                     ";PAY
  1611. 45670 PRINT "*****  PRESS ANY KEY TO CONTINUE  ******"
  1612. 45672 IF INKEY$ = "" GOTO 45672
  1613. 45674 GOTO 3010
  1614. 45680 REM RETURNS TTAX*
  1615. 45690 RETURN 
  1616. 46000 REM CROSS CHECK FIELD
  1617. 46010 IF DATAIN >< 1 THEN GOSUB 40020
  1618. 46020 REM
  1619. 46030 REM
  1620. 46100 GET #1,RN
  1621. 46130 FOR N2= 1 TO NREC(A)
  1622. 46133 N = N2
  1623. 46135 REM
  1624. 46140 ON IOPT(N) GOSUB 46200,46200,41600,41800,42000,46200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000
  1625. 46145 REM 
  1626. 46150 GOSUB 43800
  1627. 46160 NEXT N2
  1628. 46162 PUT #1,RN
  1629. 46165 RETURN    
  1630. 46200 ON FTY(A,N) GOTO 46220,46300,46400,46500,46500
  1631. 46220 I$ = X$(N)
  1632. 46230 RETURN
  1633. 46300 I% = CVI(X$(N))
  1634. 46310 I# = I%
  1635. 46320 RETURN
  1636. 46400 I! = CVS(X$(N))
  1637. 46410 I# = I!
  1638. 46420 RETURN
  1639. 46500 I# = CVD(X$(N))
  1640. 46510 RETURN
  1641. 47000 REM
  1642. 47050 CALFLG = 5
  1643. 47100 GOSUB 13000
  1644. 47110 PRINT "*******  RECALCULATE THE FIELDS IN A FILE OPTION  *******"
  1645. 47120 PRINT ""
  1646. 47130 PRINT "         Use only if you know what you are doing "
  1647. 47140 PRINT ""
  1648. 47150 PRINT "MINIMUM RECORD NUMBER : 1   MAXIMUM RECORD NUMBER : ";MRN
  1649. 47160 PRINT ""
  1650. 47190 PRINT "***********  DO YOU WANT TO USE THIS OPTION  ************"
  1651. 47200 PRINT "          1 - NO, RETURN TO FILE OPTION"
  1652. 47300 PRINT "          2 - YES, I WANT TO USE THIS OPTION "
  1653. 47310 PRINT "*********  Enter the number then Press Return  **********"
  1654. 47320 GOSUB 14000
  1655. 47330 IF DT# < 1 OR DT# > 2 THEN 47320
  1656. 47340 IF DT# = 1 THEN 3010
  1657. 47400 FOR RN = 1 TO MRN
  1658. 47430 GOSUB 46000 : PRINT "ON RECORD ";RN
  1659. 47450 NEXT RN
  1660. 47470 GOTO 3010
  1661. 48000 REM
  1662. 48100 REM
  1663. 48110 PRINT " ++++++  ERROR   +++++++"
  1664. 48120 PRINT "RECORD NUMBER  ";RN2;" IN FILE ";F$(B);" DOES NOT EXIST"
  1665. 48140 PRINT "YOU PROBABLY ENTERED FIELD ";IRNFLD(N);" WRONG"
  1666. 48160 PRINT "*********  PRESS ANY KEY TO CONTINUE  ********"
  1667. 48170 IF INKEY$ = "" GOTO 48170
  1668. 48180 GOTO 40000
  1669. 49000 REM * SET GFLG TO ZERO
  1670. 49100 FOR T = 1 TO 28
  1671. 49110 GFLG(T) = 0
  1672. 49120 NEXT T
  1673. 49130 RETURN
  1674. 50000 REM INTRO
  1675. 50010 GOSUB 13000
  1676. 50100 PRINT "                  M A I N     P R O G R A M    3.0   "
  1677. 50105 PRINT ""
  1678. 50110 PRINT "         Copyright 1984 by Potomac Pacific Engineering Inc."
  1679. 50120 PRINT ""
  1680. 50130 PRINT "This program is licensed FREE to all users with some restrictions "
  1681. 50140 PRINT "YOU MUST READ THE LICENSE CONDITIONS PRIOR TO USING THIS PROGRAM"
  1682. 50165 PRINT "        See the manual for more information on the license."
  1683. 50167 PRINT ""
  1684. 50950 PRINT "*****************  PRESS ANY KEY TO CONTINUE  ******************";
  1685. 50960 IF INKEY$ = "" GOTO 50960
  1686. 50970 RETURN
  1687. 51000 REM *******  DONE
  1688. 51100 CLOSE
  1689. 51105 GOSUB 13000
  1690. 51110 PRINT " -BYE, Have a nice day
  1691. 51120 END
  1692. 52000 REM *  SUB RECORD INPUT
  1693. 52010 LI = 1
  1694. 52015 TB = 60
  1695. 52020 GOSUB 13110
  1696. 52030 PRINT "ON SUBRECORD ";(RN+1)
  1697. 52100 OFFSET = OFFSET + 1
  1698. 52110 RN = RN + 1
  1699. 52115 IF REALFLG(A) = 2 AND RN <= MRN THEN GOSUB 61300
  1700. 52120 T2 = LSTE + 1
  1701. 52130 FOR N = T2 TO NREC(A)
  1702. 52135 REFLG = 0
  1703. 52140 ON IOPT(N) GOSUB 41200,41400,41600,41800,42000,42200,42600,42800,43000,43200,43400,43600,41800,53000,54000,55000,56000,57000,58000,59000
  1704. 52150 GOSUB 43800
  1705. 52160 NEXT N 
  1706. 52165 GOTO 44910
  1707. 53000 REM  SPACE FOR CUSTOM INPUT OPTION # 14
  1708. 53990 RETURN
  1709. 54000 REM  SPACE FOR CUSTOM INPUT OPTION # 15
  1710. 54990 RETURN
  1711. 55000 REM SPACE FOR CUSTOM INPUT OPTION # 16
  1712. 55990 RETURN
  1713. 56000 REM SPACE FOR CUSTOM INPUT OPTION # 17
  1714. 56990 RETURN
  1715. 57000 REM SPACE FOR CUSTOM INPUT OPTION # 18
  1716. 57990 RETURN
  1717. 58000 REM SPACE FOR CUSTOM INPUT OPTION # 19
  1718. 58990 RETURN
  1719. 59000 REM SPACE FOR CUSTOM INPUT OPTION # 20
  1720. 59990 RETURN
  1721. 60000 REM *READ REALTIME OPTIONS
  1722. 60010 OPEN "I",#1,"REALTIME"
  1723. 60020 FOR T = 1 TO MAXF
  1724. 60030 INPUT #1,REALFLG(T)
  1725. 60040 NEXT T
  1726. 60050 CLOSE #1
  1727. 60060 RETURN
  1728. 60070 REM * READ REALTIME DATA
  1729. 60080 A$ = STR$(A)
  1730. 60090 A$ = MID$(A$,2)
  1731. 60100 A$ = "REAL" + A$
  1732. 60110 OPEN "I",#3,A$
  1733. 60120 INPUT #3,TFILE,FLD1,FLD2,TFLD1,TFLD2,TFLD3,TFLD4,ADSUB1,ADSUB2,ADSUB3,ADSUB4,TGTRN
  1734. 60130 CLOSE #3
  1735. 60140 RETURN
  1736. 60200 REM * OPEN REALTIME FILE
  1737. 60202 IF ROPEN = 5 THEN RETURN
  1738. 60205 GOSUB 13000
  1739. 60210 AHLD = A
  1740. 60220 A = TFILE
  1741. 60230 C = TFILE
  1742. 60235 PRINT F$(C);"   FILE FOR REALTIME TRANSFER "
  1743. 60240 GOSUB 2300
  1744. 60245 C = TFILE
  1745. 60250 GOSUB 2580
  1746. 60260 A = AHLD
  1747. 60265 ROPEN = 5
  1748. 60270 RETURN
  1749. 60300 REM * PUT DATA ON REALTIME FILE
  1750. 60310 IF REALFLG(A) >< 2 THEN RETURN
  1751. 60330 REM *** CONTINUE
  1752. 60340 IF ROPEN < 5 THEN GOSUB 60200
  1753. 60400 T3 = X(TGTRN)
  1754. 60410 GET #3,T3
  1755. 60415 IF CTK = 5 THEN 60600
  1756. 60420 T1# = CVD(Z$(TFLD1))
  1757. 60430 T2# = X(FLD1)
  1758. 60440 IF ADSUB1 = 2 THEN T2# = -1 * T2#
  1759. 60450 LSET Z$(TFLD1) = MKD$(T1# + T2#)
  1760. 60460 IF TFLD2 = 0 THEN 60600
  1761. 60520 T1# = CVD(Z$(TFLD2))
  1762. 60540 IF ADSUB2 = 2 THEN T2# = -1 * T2#
  1763. 60550 LSET Z$(TFLD2) = MKD$(T1# + T2#)
  1764. 60600 REM * SECOND TRANSFER
  1765. 60605 IF CTK = 4 THEN 60900
  1766. 60610 IF FLD2 = 0 THEN 60900
  1767. 60620 T1# = CVD(Z$(TFLD3))
  1768. 60630 T2# = X(FLD2)
  1769. 60640 IF ADSUB3 = 2 THEN T2# = -1 * T2#
  1770. 60650 LSET Z$(TFLD3) = MKD$(T1# + T2#)
  1771. 60660 IF TFLD4 = 0 THEN 60900
  1772. 60720 T1# = CVD(Z$(TFLD4))
  1773. 60740 IF ADSUB4 = 2 THEN T2# = -1 * T2#
  1774. 60750 LSET Z$(TFLD4) = MKD$(T1# + T2#)
  1775. 60900 PUT #3,T3
  1776. 60920 CTK = 1
  1777. 60980 RETURN
  1778. 61000 REM *  CORECT DATA ON REALTIME FILE
  1779. 61050 CTK = 4
  1780. 61060 XHLD1 = X(N)
  1781. 61100 X(N) = I# - X(N)
  1782. 61120 GOSUB 60300
  1783. 61130 X(N) = XHLD1
  1784. 61140 RETURN
  1785. 61200 XHLD1 = X(N)
  1786. 61205 X(N) = I# - X(N)
  1787. 61215 CTK = 5
  1788. 61220 GOSUB 60300
  1789. 61230 X(N) = XHLD1
  1790. 61240 RETURN
  1791. 61300 REM * CORRECT REALTIME FILE FOR OVERWRITE
  1792. 61330 GET #1,RN
  1793. 61340 X1# = CVD(X$(FLD1))
  1794. 61345 IF FLD2 = 0 THEN 61355
  1795. 61350 X2# = CVD(X$(FLD2))
  1796. 61355 X3# = CVI(X$(TGTRN))
  1797. 61360 RETURN
  1798. 61400 REM ***
  1799. 61410 XHLD1 = X(FLD1)
  1800. 61415 IF FLD2 = 0 THEN 61425
  1801. 61420 XHLD2 = X(FLD2)
  1802. 61425 XHLD3 = X(TGTRN)
  1803. 61430 X(FLD1) = -X1#
  1804. 61440 X(FLD2) = -X2#
  1805. 61445 X(TGTRN) = X3#
  1806. 61450 GOSUB 60300
  1807. 61460 X(FLD1) = XHLD1
  1808. 61465 IF FLD2 = 0 THEN 61475
  1809. 61470 X(FLD2) = XHLD2
  1810. 61475 X(TGTRN) = XHLD3
  1811. 61480 RETURN
  1812. GOSUB 60300
  1813. 61460 X(FLD1) = XHLD1
  1814. 61465 IF FLD2 = 0 THEN 6