home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / steel34.zip / REMARKST.BAS < prev    next >
BASIC Source File  |  1980-01-01  |  10KB  |  272 lines
  1. 18000 REM **********  TRANSFER  MENU  **************
  2. 18005 IF DTFLG >< 1 THEN GOSUB 19000 / IF TRANSFER DATA NOT IN MEMORY THEN
  3. 18007 GOSUB 13000 / CLEAR SCREEN
  4. 18010 PRINT "****************  TRANSFER MENU  ******************"
  5. 18020 PRINT ""
  6. 18025 PRINT "   0 - EXIT THE PROGRAM"
  7. 18030 FOR N = 1 TO MAXS / FOR ALL TRANSFERS 
  8. 18040 PRINT "  ";N;"- ";SN$(N) / PRINT THE TRANSFER NAME
  9. 18050 NEXT N
  10. 18060 PRINT ""
  11. 18070 PRINT "*******  ENTER THE NUMBER AND PRESS RETURN  *******"
  12. 18075 GOSUB 14000 / INPUT INTEGER < 100 SUBROUTINE
  13. 18076 IF DT# <0 OR DT# >MAXS GOTO 18075 / IF OUT OF RANGE REENTER
  14. 18078 IF DT# = 0 THEN GOTO 51000 / END PROGRAM
  15. 18080 SOPT = DT# / TRANSFER OPTION EQUALS THE VALUE RETURNED FROM THE INPUT SUBROUTINE
  16. 18085 GOSUB 13000 / CLEAR SCREEN
  17. 18090 A = SFN(SOPT) / SOURCE FILE NUMBER = A
  18. 18092 PRINT F$(A),"SOURCE FILE"
  19. 18094 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON SUBROUTINE
  20. 18096 GOSUB 2500 / OPEN SOURCE FILE
  21. 18098 IF DTOPT(SOPT) = 1 THEN GOSUB 21000 / IF DIRECT TRANSFER OPTION 
  22. 18099 GOSUB 13000 / CLEAR SCREEN
  23. 18100 PRINT ""
  24. 18110 PRINT "*****  WHAT RECORD NUMBER DO YOU WANT TO START AT  *****"
  25. 18120 PRINT ""
  26. 18130 PRINT "*********  ENTER THE NUMBER THEN PRESS RETURN  *********"
  27. 18135 GOSUB 14200
  28. 18136 IF DT# <1 OR DT# >10000  GOTO 18135
  29. 18140 RNSS = DT# / RECORD NUMBER START TRANSFER
  30. 18200 PRINT "" 
  31. 18202 GOSUB 7800 / GET THE MAXIMUM RECORD NUMBER
  32. 18204 PRINT "THE HIGHEST NUMBERED RECORD IS ";MRN
  33. 18210 PRINT "********  WHICH IS THE LAST RECORD YOU WANT TO TRANSFER  ********"
  34. 18220 PRINT ""
  35. 18230 PRINT "*************  ENTER THE NUMBER THEN PRESS RETURN  **************"
  36. 18235 GOSUB 14200
  37. 18236 IF DT# <1 OR DT# >MRN GOTO 18235 / IF OUT OF RANGE THEN REENTER
  38. 18240 RNSF = DT# / RECORD NUMBER SOURCE FINISH = VALUE RETURNED FROM THE SUBROUTINE
  39. 18250 IF RNSF > MRN GOTO 18204
  40. 18300 SFN = SFN(SOPT) / SOURCE FILE NUMBER
  41. 18500 GOTO 20000
  42. 19000 REM ************  OPEN FOR INPUT  **************
  43. 19005 GOSUB 10900 / PUT PROGRAM DATA DISK IN PROMPT
  44. 19010 OPEN "I",#2,"TFER" / TRNASFER FILE
  45. 19020 INPUT #2,MAXS / MAXIMUM NUMBER OF TRANSFERS
  46. 19030 FOR S = 1 TO MAXS  / FOR ALL TRANSFERS
  47. 19040 D = 1 / PRESENTLY DUMMY
  48. 19050 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
  49. 19060 IF DTOPT(S) = 2 GOTO 19170 / IF DIRECT TRANSFER OPTION
  50. 19070 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S)
  51. 19080 TFN = TFN(S) / TARGET FILE NUMBER
  52. 19090 FOR N = 1 TO DY(S) / FOR ALL FIELDS
  53. 19100 INPUT #2,FLDTC(S,N,D) / FIELD TO CHANGE
  54. 19110 IF FLDTC(S,N,D) = 1 GOTO 19130
  55. 19120 INPUT #2,FLDTCT(S,N,D) / FIELD TARGET CHANGE TYPE
  56. 19130 NEXT N
  57. 19140 IF D = 2 GOTO 19170
  58. 19150 IF D(S) = 2 THEN D = 2
  59. 19160 IF D(S) = 2 GOTO 19090
  60. 19170 IF SUMOPT(S) = 2 GOTO 19220 / IF TRANSFER SUM OPTION
  61. 19180 INPUT #2,KTSUM(S),SUMFN(S) 
  62. 19190 FOR K = 1 TO KTSUM(S)
  63. 19200 INPUT #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K)
  64. 19210 NEXT K
  65. 19220 IF SUMAFOPT(S) = 2 GOTO 19270 / IF SUBTOTAL TRANSFER OPTION
  66. 19230 INPUT #2, KTSUMAF(S),SAFFN(S)
  67. 19240 FOR K = 1 TO KTSUMAF(S)
  68. 19250 INPUT #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),DY
  69. 19260 NEXT K
  70. 19270 NEXT S
  71. 19280 CLOSE #2
  72. 19285 DTFLG = 1 / DATA IN FLAG SET TO YES
  73. 19290 RETURN
  74. 20000 REM ******  DATA TRANSFER PROGRAM  ******
  75. 20095 REM *****  INITIALIZE SUMS TO ZERO *****
  76. 20100 GOSUB 20900
  77. 20105 PRINT "*** INITIALIXE SUMS
  78. 20110 REM *** OPEN SOURCE FILE ****
  79. 20112 GOSUB 13000 / CLEAR SCREEN
  80. 20140 REM ** IF DTOPT(SOPT) = 1 THEN GOSUB 21000 / IF DIRECT TRANSFER OPTION
  81. 20150 REM *******  START READING LOOP  **********
  82. 20160 FOR RN = RNSS TO RNSF / FOR RECORD NUMBER START TO FINISH
  83. 20180 GET #1,RN / GET THE RECORD FROM DISK
  84. 20195 REM *******  CONVERT STRINGS TO INTEGERS 
  85. 20200 GOSUB 21066
  86. 20205 PRINT "***  READING RECORD NUMBER ";RN 
  87. 20210 REM *******  RECORD NUMBERING
  88. 20220 IF DTOPT(SOPT) = 1 THEN GOSUB 21700 / IF DIRECT TRANSFER OPTION 
  89. 20230 REM *****  TRANSFER DATA
  90. 20240 IF DTOPT(SOPT) = 1 THEN GOSUB 21900 / IF DIRECT TRANSFER OPTION
  91. 20250 REM *****  ADD ACCORDING TO FIELDS 
  92. 20260 IF SUMOPT(SOPT) = 1 THEN GOSUB 24000 / IF SUM TRANSFER OPTION
  93. 20270 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 24100 /IF SUM ACCORDING TO FIELD OPTION 
  94. 20300 NEXT RN
  95. 20500 REM  ******  RESUME FROM ON ERROR
  96. 20510 REM ******  MOVE FIELDS TO FILE
  97. 20520 IF SUMOPT(SOPT) = 1 THEN GOSUB 25600 / IF SUM TRANSFER OPTION 
  98. 20530 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 25800 / IF SUBTOTAL TRANSFER OPTION
  99. 20590 CLOSE 
  100. 20600 GOTO 18000 / BACK TO TRANSFER MENU
  101. 20900 REM ******  CLEAR VARIABLES  ******
  102. 20910 FOR N = 1 TO KTSUM 
  103. 20920 SUM#(N) = 0 / INITIALIZE SUMS TO 0
  104. 20930 NEXT N
  105. 20950 IF SUMAFOPT = 2 GOTO 20998
  106. 20960 FOR P = 1 TO KTSUMAF
  107. 20970 FOR N = 1 TO MAX(P)
  108. 20980 SAF#(P,N) = 0  / INITIALIZE SUBTOTOAL TO 0
  109. 20990 NEXT N
  110. 20995 NEXT P
  111. 20998 RETURN
  112. 21000 REM ***********  DATA TRANSFER OPTION  **********
  113. 21005 TFN = TFN(SOPT) / TARGET FILE NUMBER
  114. 21010 B = TFN / TARGET FILE NUMBER
  115. 21015 GOSUB 13000 / CLEAR SCREEN
  116. 21017 PRINT F$(B)," TARGET FILE " 
  117. 21018 AHLD = A
  118. 21019 A = B
  119. 21020 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON SUBROUTINE
  120. 21030 GOSUB 2550 / OPEN TARGET FILE
  121. 21032 A = AHLD
  122. 21040 RETURN
  123. 21066 FOR K = 1 TO NREC(A) / FOR ALL FIELDS
  124. 21068 REM ******** CONVERT EACH RECORD TO DECIMAL  **********
  125. 21070 ON FTY(A,K) GOTO 21100,21200,21300,21400,21400 / ON FIELD TYPE GOTO
  126. 21100 Z$(K) = X$(K) / STRINGS
  127. 21110 GOTO 21500
  128. 21150 REM *******  START READING LOOP  **********
  129. 21200 Z%(K) = CVI(X$(K)) / CONVERT INTEGERS
  130. 21205 SU#(K) = Z%(K)
  131. 21210 GOTO 21500
  132. 21300 S!(K) = CVS(X$(K)) / CONVERT SINGLE PRECISION 
  133. 21305 SU#(K) = S!(K)
  134. 21310 GOTO 21500
  135. 21400 D#(K) = CVD(X$(K)) / CONVERT DOUBLE PRECISION
  136. 21405 SU#(K) = D#(K)
  137. 21410 GOTO 21500
  138. 21500 NEXT K / NEXT FIELD
  139. 21510 RETURN                 
  140. 21590 REM ******* GET SECOND FILE **********
  141. 21595 REM ***** OPEN B ON START UP  ****
  142. 21600 IF N <> RNSS GOTO 21700 / IF NOT THE FIRST RECORD TRANSFERED THEN SKIP
  143. 21605 FLG = 1
  144. 21610 FLDOPT = 2
  145. 21620 B = TFN / TARGET FILE NUMBER
  146. 21630 GOSUB 2300 / OPEN TARGET FILE
  147. 21700 REM *****  RECORD NUMBERING
  148. 21705 RNTNBOPT = RNTNBOPT(SOPT)
  149. 21710 IF RNTNBOPT = 0 GOTO 21800 / EQUALS SOURCE RECORD NUMBER OPTION
  150. 21715 REM ******  B RECORD NUMBER = TO A FIELD ******
  151. 21720 RN2 = SU#(RNTNBOPT) / EQUALS THE VALUE OF THIS FIELD
  152. 21730 RETURN    
  153. 21790 REM ****** B RECORD NUMBER INCREMENTS FROM 1 *******
  154. 21800 RN2 = RN 
  155. 21810 RETURN   
  156. 21900 REM ****** GET SECOND RECORD  ******
  157. 21905 PRINT "TRANSFERING TO RECORD ";RN2 
  158. 21910 GET #2,RN2
  159. 22000 FOR R = 1 TO NREC(B) / FOR ALL RECORDS
  160. 22005 REM *****  NO TRASFER  *****
  161. 22010 IF FLDTC(SOPT,R,1) = 1 GOTO 23900 / IF NO TRANSFER
  162. 22020 IF FTY(B,R) <> 1 GOTO 22100 / IF NOT A STRING
  163. 22030 T = FLDTC(SOPT,R,1) - 1 / TARGET FIELD NUMBER
  164. 22040 LSET Y$(R) = Z$(T) / REPLACE 
  165. 22050 GOTO 23900
  166. 22095 REM *****  JUST REPLACE  *****
  167. 22100 IF FLDTCT(SOPT,R,1) <> 2 GOTO 22200 / IF TYPE CHANGE IS NOT A REPLACEMENT
  168. 22105 T = FLDTC(SOPT,R,1) - 1 / TARGET FIELD NUMBER
  169. 22110 LSET Y$(R) = Z$(T) / REPLACE 
  170. 22120 GOTO 23900
  171. 22200 ON FTY(B,R) GOTO 23900,22210,22300,22400,22400 / ON FIELD TYPE GOTO
  172. 22205 REM ***** INTEGER *****
  173. 22210 I%=CVI(Y$(R)) / CONVERT TO NUMBER
  174. 22215 T = FLDTC(SOPT,R,1) - 1 / TARGET FIELD NUMBER
  175. 22218 D# = SU#(T)
  176. 22220 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D# /IF SUBTRACT THEN MAKE NEGITIVE
  177. 22230 I% = I% + D#  / ADD
  178. 22240 LSET Y$(R) = MKI$(I%) / COVERT TO STRING
  179. 22250 GOTO 23900
  180. 22300 REM ** SINGLE PRECISION **
  181. 22310 I!=CVS(Y$(R))
  182. 22315 T = FLDTC(SOPT,R,1) - 1
  183. 22318 D# = SU#(T)
  184. 22320 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#   
  185. 22330 I! = I! + D#   
  186. 22340 LSET Y$(R) = MKS$(I!)
  187. 22350 GOTO 23900
  188. 22400 REM ** DOUBLE PRECISION **
  189. 22407 Y$ = Y$(R)
  190. 22410 I#=CVD(Y$)   
  191. 22415 T = FLDTC(SOPT,R,1) - 1
  192. 22416 D# = SU#(T)
  193. 22420 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#   
  194. 22430 I# = I# + D#   
  195. 22440 LSET Y$(R) = MKD$(I#)
  196. 22450 GOTO 23900
  197. 22990 REM ****** FINISH TRANSFER LOOP ******
  198. 23900 NEXT R
  199. 23910 PUT #2,RN2
  200. 23912 RETURN
  201. 24000 REM ******** SUM OPTION *******
  202. 24010 FOR P = 1 TO KTSUM(SOPT) / FOR ALL FIELDS TO ADD
  203. 24020 T = SUMF(SOPT,P) / FIELD TO ADD
  204. 24030 SUM#(P) = SUM#(P) + SU#(T) / ADD
  205. 24040 NEXT P
  206. 24050 RETURN
  207. 24100 REM ***** ADD ACCORDING TO FIELDS *****
  208. 24110 IF SUMAFOPT = 2 GOTO 24285
  209. 24120 FOR P = 1 TO KTSUMAF(SOPT) / FOR ALL FIELDS TO SUBTOTAL
  210. 24130 T = SAFADD(SOPT,P)  / FIELD TO SUBTOTAL 
  211. 24140 F = SAFACCTO(SOPT,P) / SUBTOTAL ON THIS FIELD
  212. 24150 I = SU#(F)    
  213. 24155 IF I > MAXSAF(P) THEN MAXSAF(P) = I /MAXIMUM VALUE OF FIELD SUBTOTALED ON
  214. 24160 SAF#(P,I) = SAF#(P,I) + SU#(T) / ADD SUBTOTALS
  215. 24170 NEXT P
  216. 24285 RETURN 
  217. 25600 REM ****** MOVE SUMS TO FILES ******
  218. 25620 CLOSE
  219. 25630 B = SUMFN(SOPT)
  220. 25645 GOSUB 13000 / CLEAR SCREEN
  221. 25647 PRINT F$(B),"FILE FOR SUMS"
  222. 25648 AHLD = A
  223. 25649 A = B
  224. 25650 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON
  225. 25660 GOSUB 2550 / OPEN FILE
  226. 25665 A = AHLD
  227. 25670 FOR P = 1 TO KTSUM(SOPT) / FOR ALL SUMS
  228. 25700 RN = SUMRN(SOPT,P) / RECORD NUMBER TO TRANSFER SUMS TO
  229. 25710 GET 2,RN / GET RECORD NUMBER TO TRANSFER SUMS TO
  230. 25720 T = SUMFLDN(SOPT,P) 
  231. 25725 S# = SUM#(P)
  232. 25727 PRINT "SUM";S#;" FIELD ";T
  233. 25730 ON FTY(B,T) GOSUB  25790,25772,25780,25790,25790
  234. 25750 PUT #2,RN
  235. 25760 NEXT P
  236. 25770 RETURN
  237. 25772 LSET Y$(T) = MKI$(S#) / INTEGER SUMS
  238. 25775 RETURN
  239. 25780 LSET Y$(T) = MKS$(S#) / SINGLE PRECISION SUMS
  240. 25785 RETURN
  241. 25790 LSET Y$(T) = MKD$(S#) / DOUBLE PRECISON SUMS
  242. 25795 RETURN
  243. 25800 REM *******  PUT SUM ACCORDING TO FIELDS IN FILES  *******
  244. 25810 CLOSE
  245. 25820 B = SAFFN(SOPT)
  246. 25823 GOSUB 13000 / CLEAR SCREEN
  247. 25825 PRINT F$(B),"FILE FOR SUMS ACCORDINT TO FIELDS "
  248. 25827 AHLD = A
  249. 25828 A = B
  250. 25830 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON
  251. 25833 A = AHLD
  252. 25835 GOSUB 2550 / OPEN THE FILE 
  253. 25850 FOR P = 1 TO KTSUMAF(SOPT) / FOR EACH FIELD SUBTOTALED
  254. 25852 T = SAFFLDN(SOPT,P)
  255. 25860 FOR J = 1 TO MAXSAF(P) / FOR 1 TO THE MAXIMUM VALUE SUBTOTALED ON FIELD
  256. 25865 S# = SAF#(P,J)
  257. 25870 GET #2,J
  258. 25880 ON FTY(B,T) GOSUB 25984,25984,25990,25995,25995 / ON FIELD TYPE 
  259. 25890 PUT #2,J
  260. 25895 PRINT P,J,S#,A,T
  261. 25900 NEXT J
  262. 25910 NEXT P
  263. 25980 CLOSE
  264. 25982 RETURN       
  265. 25984 LSET Y$(T) = MKI$(S#) / INTEGER SUBTOTALS
  266. 25986 RETURN
  267. 25990 LSET Y$(T) = MKS$(S#) / SINGLE PRECISION SUBTOTALS
  268. 25992 RETURN
  269. 25995 LSET Y$(T) = MKD$(S#) / DOUBLE PRECISION SUBTOTALS
  270. 25997 RETURN
  271. = MKS$(S#) / SINGLE PRECISION SUBTOTALS
  272. 25992 R