home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / steel24.zip / REMARKS1.BAS < prev    next >
BASIC Source File  |  1980-01-01  |  19KB  |  376 lines
  1. 2 PRINT FRE(0) / PRINTS MEMORY AVAILABLE
  2. 3 DEFDBL X  / VARIABLES STARTING WITH X ARE DOUBLE PRECISION
  3. 4 DEFINT A-W,Y-Z / ALL OTHER VARIABLES ARE INTEGERS
  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 / CH IS THE ASCII CODE THAT MOVES CURSER BACK ONE SPACE
  28. 62 GOSUB 50000 / PRINT INTRO ON SCREEN
  29. 63 GOSUB 16800 / HARD DISK OPTION 
  30. 65 GOSUB 27000 / READ CUSTOM SCREEN FLAG
  31. 80 GOSUB 10000 / READ FFILE (FILE DESCRIPTION)
  32. 90 GOSUB 29000 / READ LIMITS FLAG
  33. 95 GOSUB 60000 / READ REALTIME DATA FLAG OPTION
  34. 100 REM
  35. 400 GOSUB 13000 / CLEAR SCREEN
  36. 402 IF KD < 5 THEN GOSUB 11000 / READ KEYLIST IF NOT ALREADY IN MEMORY
  37. 403 ROPEN = 0 / FLAG, REALTIME TRANSFER FILE IS CLOSED
  38. 404 GOSUB 13000 / CLEAR SCREEN
  39. 406 TWOOPEN = 0 / FLAG, FILE TO GET DATA FROM IS CLOSED
  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 / STARTS LOOP PRINTING FILE NAMES
  44. 440 PRINT I;TAB(5) " - ";F$(I) / PRINTS FILE NUMBER AND NAME
  45. 450 NEXT I / END LOOP PRINTING FILE NAME
  46. 460 PRINT ""
  47. 470 PRINT "***** ENTER THE NUMBER OF THE FILE YOU WANT THEN PRESS RETURN *****"
  48. 475 GOSUB 14000 / INPUT INTEGER LESS THEN 100
  49. 477 IF DT# < 0 OR DT#>MAXF  GOTO 475 / CHECKS THAT OPTION NUMBER IS IN LIMITS
  50. 480 A = DT# / SETS A = TO VALUE RETURNED FROM 14000 SUBROUTINE
  51. 482 IF A = 0 GOTO 51000 / GOTO END PROGRAM
  52. 483 GOSUB 13000 / CLEAR SCREEN
  53. 484 PRINT "FILE : "; F$(A) /PRINTS FILE NAME
  54. 485 GOSUB 2300 / GETS DISK DRIVE NUMBER
  55. 490 GOSUB 2500 / OPENS FILE AS FILE NUMBER 1
  56. 491 CSCR = 2 / FLAG, DO NOT USE CUSTOM SCREEN
  57. 492 IF SCRN(A) <> 0 THEN GOSUB 28000 ELSE RPT = 0 / IF SCREEN FLAG  YES THEN READ CUSTOM SCREEN DESCRIPTION ELSE REPEATING OPTION = 0
  58. 493 IF MFLG(A) = 2 THEN GOSUB 29070 / IF THERE ARE LIMITS THEN READ THE LIMITS
  59. 494 GOSUB 40020 / READ INPUT OPTIONS FOR THIS FILE
  60. 495 IF REALFLG(A) = 2 THEN GOSUB 60070 / IF REALTIME TRANSFERS THEN READ REALTIME DESCRIPTION
  61. 500 IF REALFLG(A) = 2 THEN GOSUB 60200 / IF REALTIME TRANSFERS THEN OPEN REALTIME TRANSFER FILE
  62. 530 GOTO 3000 / GOTO FILE OPTIONS
  63. 1905 MATCH = 1 / INITIALIZE 
  64. 2300 REM DISK  SELECTION
  65. 2302 IF HDISK = 2 THEN GOSUB 13000 / IF USING HARDDISK OPTION THE CLEAR SCREEN
  66. 2303 IF HDISK = 2 THEN GOTO 2360 / IF USING HARD DISK THEN USE DEFAULT DRIVE
  67. 2304 PRINT ""
  68. 2305 PRINT "************  WHICH DISK DRIVE IS THE FILE ON  **************"
  69. 2310 PRINT ""
  70. 2312 PRINT "                 0 - BACK TO CHOISE 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 / INPUT INTEGER LESS THEN 100 SUBROUTINE
  78. 2347 IF DT# < 0 OR DT#>4 GOTO 2345 / IF OPTION OUT OF RANGE THEN REPROMPT
  79. 2350 T = DT#  / DT# IS RETURNED FROM 14000
  80. 2352 IF T = 0 THEN 100 / TO CHOICE OF FILES
  81. 2355 ON T GOTO 2360,2370,2380,2390 / ON DISK DRIVE NUMBER GOTO
  82. 2360 T$ = F$(A) / USE DEFAULT DRIVE
  83. 2365 GOTO 2490
  84. 2370 T$ = "B:"+F$(A) / USE DRIVE B
  85. 2375 GOTO 2490
  86. 2380 T$ = "C:"+F$(A) / USE DRIVE C
  87. 2385 GOTO 2490
  88. 2390 T$ = "D:"+F$(A) / USE DRIVE D
  89. 2490 RETURN
  90. 2500 REM OPEN FILE 
  91. 2503 CLOSE #1 / CLOSE FILE TO PREVENT ERRORS
  92. 2505 OPEN "R",#1,T$,L(A) / OPENS RANDOM ACCESS FILE AS FILE #1, FILE NAME = T$, WITH LENGTH L
  93. 2507 D = 0
  94. 2510 FOR T = 1 TO NREC(A) / START FIELDING LOOP,NREC(A) IS THE NUMBER OF FIELDS IN THE FILE
  95. 2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T) / DY$ IS A DUMMY, FL(A,T) IS THE LENTH OF THE FIELD, X$(T) IS THE T'TH FIELD
  96. 2530 D = D + FL(A,T) / LENGTH OF THE DUMMY VARIABLE
  97. 2540 NEXT T / END FIELDING LOOP
  98. 2543 GOSUB 7800 / GET THE MAXIMUM RECORD NUMBER
  99. 2545 RETURN
  100. 2550 REM OPEN SECOND FILE / SAME AS THE ABOVE SUBROUTINE EXCEPT THAT FILE 2 IS OPENED, 
  101. 2553 CLOSE #2 / CLOSE FILE TO PREVENT ERRORS
  102. 2555 OPEN "R",#2,T$,L(B) / OPEN RANDOM ACCESS FILE AS FILE #2, FILE NAME T$, WITH LENGTH L
  103. 2557 D = 0
  104. 2560 FOR T = 1 TO NREC(B) / START FIELDING LOOP, NREC(A) IS THE NUMBER OF FIELDS IN THE FILE
  105. 2565 FIELD #2,D AS DY$,FL(B,T) AS Y$(T) / DY$ IS A DUMMY, FL(A,T) IS THE LENGTH OF THE FIELD
  106. 2570 D = D + FL(B,T) / LENGTH OF THE DUMMY VARIABLE
  107. 2575 NEXT T
  108. 2578 RETURN
  109. 2580 REM OPEN THIRD FILE / SAME AS 2500 SUBROUTINE EXCPT THAT FILE 3 IS OPENED
  110. 2581 CLOSE #3 / CLOSE THIRD FILE TO PREVENT ERRORS
  111. 2584 OPEN "R",#3,T$,L(C) / OPEN RANDOM ACCESS FILE
  112. 2586 D = 0 / INITIALIZE TO 0
  113. 2588 FOR T = 1 TO NREC(C) / START FIELDING LOOP NREC(A) IS THE NUMBER OF FIELDS IN THE FILE
  114. 2590 FIELD #3,D AS DY$,FL(C,T) AS Z$(T) / Z$(T) = T'TH FIELD IN THIRD FILE
  115. 2592 D = D + FL(C,T) / LENGTH OF THE DUMMY VARIABLE
  116. 2594 NEXT T
  117. 2596 RETURN
  118. 3000 REM SECOND MENU 
  119. 3010 GOSUB 13000 / CLEAR SCREEN
  120. 3011 SFLG = 0 / INITIALIZE SEARCH FLAG TO 0
  121. 3012 PRINT "FILE : ";F$(A);TAB(57)"MAXIMUM RECORD :";MRN / PRINTS FILE NAME AND MAXIMUM RECORD NUMBER
  122. 3015 CALFLG = 0 / INITIALIZE RECALCULATE FLAG TO 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 / SURPRESS PRINTING AFTER OPTION IS ENTERED
  136. 3215 GOSUB 14000 / INPUT INTERGER < 100 SUBROUTINE
  137. 3218 IF DT# < 0 OR DT#>7 GOTO 3215 / IF OPTION OUR OF RANGE THEN REPROMPT
  138. 3220 N = DT# / DT# IS RETURNED FROM 14000
  139. 3225 IF N = 0 THEN CLOSE / IF CHANGING FILES THEN CLOSE ALL FILES
  140. 3227 IF N = 0 THEN GOTO 400 / IF CHANGING FILES BACK TO CHOISE OF FILE
  141. 3230 ON N GOTO 8000,5000,4000,18000,3700,17000,47000 / ON OPTION GOTO
  142. 3600 GOTO 18000 / SEARCH A FILE
  143. 3700 GOSUB 13000 / CLEAR SCREEN
  144. 3720 GOTO 7000 / GOTO NEW ENTRY
  145. 4000 REM SCAN ALL RECORDS
  146. 4005 GOSUB 13000 / CLEAR SCREEN
  147. 4007 GOSUB 7800 / GET MAXIMUM RECORD NUMBER
  148. 4008 GOSUB 4100 / INPUT FIELDS TO DISPLAY SUBROUTINE
  149. 4009 GOSUB 13000 / CLEAR SCREEN
  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 / INPUT INTEGER SUBROUTINE
  158. 4020 RN = DT# / RECORD NUMBER = VALUE RETURNED BY THE ABOVE SUBROUTINE
  159. 4022 IF RN = 0 THEN GOTO 3010 / IF OPTION = 0 THEN BACK TO FILE OPTIONS
  160. 4032 IF INKEY$ <> "" GOTO 4600 / IF ANY KEY IS PRESSED THEN PAUSE SUBROUTINE
  161. 4035 IF RN > MRN GOTO 26000 / IF RECORD NUMBER > MAXIMUM RECORD NUMBER THEN TO END OF FILE SUBROUTINE
  162. 4040 GET #1,RN / GET RECORD NUMBER RN FROM DISK
  163. 4050 GOSUB 4300 / PRINT THE FIELDS 
  164. 4060 RN = RN + 1 / INCREMENT RECORD NUMBER
  165. 4070 GOTO 4032 / DO IT AGAIN
  166. 4100 REM ****  GET FIELDS TO DISPLAY
  167. 4110 FOR T = 1 TO NREC(A) / FOR EACH FIELD ASK IF YOU WANT IT DISPLAYED
  168. 4120 GOSUB 13000 / CLEAR SCREEEN
  169. 4124 PRINT "*******************  SCAN SUBROUTINE  **********************"
  170. 4126 PRINT ""
  171. 4130 PRINT "FIELD NUMBER : ";T;" - "; FLDN$(A,T) / PRINTS FIELD NAME
  172. 4140 PRINT ""
  173. 4150 PRINT "*****  DO YOU WANT THIS FIELD DISPALYED 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 / INPUT INTEGER < 100 SUBROUTINE
  180. 4220 IF DT# < 1 OR DT# > 2 THEN 4210 / IF OPTION OUT OF LIMITS THEN REPROMPT
  181. 4230 SHOW(T) = DT# / SHOW(T) IS THE OPTION CHOSEN FOR THE T'TH VARIABLE
  182. 4240 NEXT T / END LOOP
  183. 4250 RETURN
  184. 4300 REM ****  PRINT FIELDS 
  185. 4305 PRINT "RECORD NUMBER ";RN
  186. 4310 FOR Q = 1 TO NREC(A) / START LOOP PRINTING OUT THE FIELDS
  187. 4320 IF SHOW(Q) = 2 THEN GOSUB 12030 / IF THE FIELD IS TO BE PRINTED THEN GOTO THE PRINT SUBROUTINE
  188. 4330 NEXT Q / END LOOP PRINTING OUT THE FIELDS
  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 / INPUT INTEGER < 100 SUBROUTINE
  196. 4635 IF DT# = 0 THEN GOTO 3010 / IF OPTION = 0 THEN BACK TO FILE OPTIONS
  197. 4640 GOTO 4040 / CONTINE SCANNING
  198. 5000 REM 
  199. 5005 GOSUB 13000 / CLEAR SCREEN
  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 / INPUT INTEGER SUBROUTINE 
  208. 5020 RN = DT# / RECORD NUMBER EQUALS VALUE RETURNED FROM THE INPUT SUBROUTINE
  209. 5021 IF RN = 0 GOTO 3010 / IF OPTION = 0 THEN BACK TO FILE OPTIONS
  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 / INPUT INTEGER SUBROUTINE 
  215. 5027 IF DT# < 1 OR DT#>2 GOTO 5026 / IF OPTION OUT OF RANGE THE REPROMPT
  216. 5030 PFLG = DT# / PRINT FLAG = VALUE RETURNED FROM INPUT SUBROUTINE
  217. 5031 IF PFLG = 2 THEN GOSUB 12880 / IF PRINT IN CONDENSED FORM THEN ASK FOR NUMBER OF COLUMS ON PRINTER
  218. 5032 IF PFLG = 2 THEN GOSUB 12900 / IF PRINT IN CONDENSED FORM THEN COMPUTE WHERE TO PRINT FIELDS
  219. 5033 GOSUB 16000 / TURN YOUR PRINTER ON PROMPT
  220. 5036 REM
  221. 5038 IF INKEY$ <> "" GOTO 5600 / GOTO PAUSE SUBROUTINE IF ANY KEY IS PRESSED
  222. 5039 IF RN > MRN GOTO 26000 / IF RECORD NUMBER EXCEEDS MAXIMUM THE GOTO END OF FILE SUBROUTINE
  223. 5040 REM
  224. 5041 GET #1,RN / GET RECORD NUMBER RN
  225. 5050 IF PFLG = 1 THEN GOSUB 12200 / IF PRINT IN EXPANDED FORM THEN PRINT USING 12200 SUBROUTINE
  226. 5060 IF PFLG = 2 THEN GOSUB 12500 / IF PRINT IN CONDENSED FORM THEN PRINT USING 12500 SUBROUTINE
  227. 5510 RN = RN + 1 / INCREMENT RECORD NUMBER
  228. 5520 GOTO 5036 / START OVER AND PRINT NEXT RECORD
  229. 5600 REM 
  230. 5602 GOSUB 13000 / CLEAR SCREEN
  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 / INPUT INTEGER < 100 SUBROUTINE
  238. 5630 IF DT# = 0  THEN GOTO 3010 / IF OPTION 0 THEN BACK TO FILE OPTIONS
  239. 5640 GOTO 5040 / CONTINUE PRINTING
  240. 5725 REM
  241. 6000 REM 
  242. 7000 REM / START ON NEW RECORD ENTERY
  243. 7010 GOSUB 13000 / CLEAR SCREEN
  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 / INPUT INTEGER SUBROUTINE
  258. 7042 IF DT# <0 OR DT# >(MRN +1) GOTO 7040 / IF OPTION OUT OF RANGE REPROMPT
  259. 7045 RN = DT# / RECORD NUMBER = VALUE RETURED FROM INPUT SUBROUTINE
  260. 7046 GOSUB 13000 / CLEAR SCREEN
  261. 7048 IF RN = 0 GOTO 3010 / IF OPTION 0 THEN RETURN TO FILE OPTIONS
  262. 7200 GOSUB 40000 / CONTINUE WITH NEW ENTRY
  263. 7205 IF RN > MRN THEN MRN = RN / IF RECORD NUMBER > MAXIMUM RECORD NUMBER THEN  LET MAXIMUM RECORD NUMBER = THE RECORD NUMBER
  264. 7210 GOTO 7010 / BACK  TO NEW ENTRY
  265. 7800 MRN = LOF(1)/ L(A) / COMPUTES MAXIMUM RECORD NUMBER OF FILE 1
  266. 7805 REM MRN = INT(MRN)
  267. 7810 RETURN
  268. 7900 REM ***** LOF
  269. 7910 MRN2 = LOF(3)/82 / MAXIMUM RECORD NUMBER OF TAX FILE
  270. 7920 RETURN
  271. 7950 REM ******* LOF
  272. 7960 MRNS = LOF(2)/L(B) / MAXIMUM RECORD NUMBER OF SECOND FILE
  273. 7970 RETURN
  274. 8000 REM 
  275. 8010 GOSUB 13000 / CLEAR SCREEN
  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 / GET MAXIMUM RECORD NUMBER
  286. 8050 GOSUB 14100 / INPUT INTEGER SUBROUTINE
  287. 8052 RN = DT# / RECORD NUMBER = VALUE RETURED FROM INPUT SUBROUTINE
  288. 8057 IF RN = 0 THEN GOTO 3010 / IF OPTION 0 BACK TO FILE OPTIONS
  289. 8058 GOSUB 13000 / CLEAR SCREEN
  290. 8059 IF RN > MRN GOTO 26800 / IF RECORD NUMBER EXCEEDS MAXIMUM RECORD NUMBER THE GOTO END OF FILE SUBROUTINE
  291. 8060 GET #1,RN / GET RECORD NUMBER RN
  292. 8500 GOSUB 12000 / PRINT THE RECORD ON THE SCREEN SUBROUTINE
  293. 8510 LI = 20 / LINE = 20, 
  294. 8515 GOSUB 13100 / LOCATE SUBROUTINE
  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 / SURPRESS PRINTING AFTER OPTION IS ENTERED
  300. 8540 GOSUB 14000 / INPUT INTEGER < 100 SUBROUTINE
  301. 8542 IF DT# <0 OR DT# > 5  GOTO 8510 / IF OPTION OUT OF LIMITS THEN REPROMPT
  302. 8550 B = DT# / B = VALUE RETURNED FROM THE ABOVE SUBROUTINE
  303. 8552 IF B = 3 THEN GOSUB 9000 / IF OPTION 3 THEN CORRECT A RECORD SUBROUTINE
  304. 8554 IF B = 3 THEN GOTO 8510 / IF OPTION 3 ASK FOR ANOTHER OPTION
  305. 8555 IF SFLG > 0 AND B = 1 THEN GOTO 18380 / IF SEARCHING FOR SPECIFIC VALUES AND YOU WANT TO SEE THE NEXT RECORD THEN CONTINUE SEARCH
  306. 8556 IF B = 1 THEN RN = RN + 1 / IF SEE NEXT RECORD OPTION THEN INCREMENT RECORD NUMBER
  307. 8560 IF B = 5 AND RPT <> 2 THEN 8580 / IF REQUEST FOR SHOW SUBRECORDS AND SUBRECRDS DO NOT EXIST THEN 8580
  308. 8562 ON B GOTO 8058,8600,9000,8000,20000 / ON THE OPTION GOTO
  309. 8564 REM
  310. 8570 GOTO 3010 / TO FILE OPTIONS
  311. 8580 LI = 24 / LINE = 24
  312. 8585 GOSUB 13100 / LOCATE SUBROUTINE
  313. 8590 PRINT TAB(10) "SUBRECORDS ARE NOT SET UP ON THIS FILE";
  314. 8595 GOTO 8510 / ASK FOR ANOTHER OPTION
  315. 8600 REM  PRINT SINGLE RECORD 
  316. 8610 GOSUB 16000 / TURN YOUR PRINTER ON PROMPT
  317. 8680 GOSUB 12200 / PRINT RECORD ON PAPER EXPANDED FORM SUBROUTINE
  318. 8920 GOTO 8000 / BACK TO START OF SHOW A SINGLE RECORD
  319. 9000 REM 
  320. 9005 LI = 20 / LINE = 20
  321. 9007 GOSUB 13100 / LOCATE SUBROUTINE
  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 / SURPRESS PRINTING AFTER OPTION
  327. 9030 GOSUB 14000 / INPUT INTEGER SUBROUTINE
  328. 9031 IF DT# <0 OR DT# >NREC(A)  GOTO 9030 / IF OPTION EXCEENDS LIMITS REPROMPT
  329. 9033 T = DT# / T = FIELD YOU WANT TO CORRECT
  330. 9040 IF T = 0 THEN GOTO 3010 / IF OPION = 0 THEN FILE OPTIONS
  331. 9045 D = T / D ASLO EQUALS THE FIELD TO CORRECT
  332. 9046 IF REALFLG(A) = 2 AND T = TGTRN THEN GOSUB 61300 / IF THERE IS REALTIME TRANSFERS FOR THIS FILE AND THE RECORD TO BE CHANGED IS THE POINTER TO THE TARGET RECORD NUMBER THEN GOSUB 61300
  333. 9047 Q = T / Q ALSO EQUALS FIELD TO BE CORRECTED
  334. 9048 LI = 20 / LINE = 20
  335. 9049 GOSUB 13100 / LOCATE SUBROUTINE
  336. 9050 PRINT "******  FIELD NUMBER: ";D;" FIELD NAME: ";FLDN$(A,D);" ******         "
  337. 9060 PRINT "***********  ENTER THE CORRECTION THEN PRESS RETURN  **************           "
  338. 9062 PRINT "                                                                             " / CLEARS THESE LINES
  339. 9063 PRINT "                                                                             "
  340. 9064 PRINT "                                                                             ";
  341. 9066 LI = 22 / LINE = 22
  342. 9068 GOSUB 13100 / LOCATE SUBROUTINE
  343. 9070 ON FTY(A,D) GOTO 9100,9150,9200,9250,9250 / ON THE FIELD TYPE OF THE FIELD TO CORRECT GOTO 
  344. 9100 GOSUB 15000 / INPUT STRING SUBROUTINE
  345. 9105 I$ = A$ / I$ = THE VALUE RETURED FROM THE INPUT SUBROUTINE
  346. 9110 LSET X$(D) = I$ / SET FILE BUFFER FOR THE FIELD TO I$
  347. 9120 GOTO 9290  
  348. 9150 GOSUB 14100 / INPUT INTEGER SUBROUTINE
  349. 9151 T2 = KEYLIST(A,D) / T2 = THE KEYLIST FOR THIS FIELD IF ANY
  350. 9152 T3 = MAXK(T2) / T3 = THE MAXIMUM VALUE FOR THE KEYLIST
  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 / IF LIMITS THEN CHECK FOR LIMIT
  353. 9155 I% = DT# 
  354. 9157 I# = I%
  355. 9160 LSET X$(D) = MKI$(I%) / SET THE FILE BUFFER FOR THIS FIELD TO I%
  356. 9165 X(D) = I% 
  357. 9170 GOTO 9290
  358. 9200 GOSUB 14200 / INPUT SINGLE PRECISION NUMBER SUBROUTINE
  359. 9203 IF MFLG(A) = 2 THEN GOSUB 29190 / IF LIMITS THEN CHECK IF NUMBER IS IN RANGE 
  360. 9205 I! = DT# / I! = VALUE RETURNED FROM SUBROUTINE
  361. 9207 I# = I!  
  362. 9210 LSET X$(D) = MKS$(I!) / SET FILE BUFFER TO !
  363. 9220 GOTO 9290
  364. 9250 GOSUB 14300 / INPUT SUBROUTINE FOR INTEGERS
  365. 9253 IF MFLG(A) = 2 THEN GOSUB 29190 / IF LIMITS THEN CHECK IF NUMBER IS IN RANGE 
  366. 9255 I# = DT#
  367. 9260 LSET X$(D) = MKD$(I#) / SET FILE BUFFER TO !
  368. 9290 PUT #1,RN / PUT THE RECORD ON THE DISK
  369. 9291 N = D  / N ALSO EQUALS THE FIELD TO CORRCT
  370. 9294 IF REALFLG(A) = 2 AND N = FLD1 THEN GOSUB 61000 / CORRECT REALTIME TRANSFER FILE
  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 / IF VALUE OF THE FIELD AFFECTS OTHER FIELDS THEN RECALCULATE THE RECORD ELSE JUST PRINT ON THE SCREEN 
  375. 9299 RETURN   
  376. 44500 / IF VALUE OF THE FIELD AFFECTS OTHER FIELDS THEN RECALCULATE THE RECORD ELSE JU