home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
dbsteel3.zip
/
REMARKST.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-01-21
|
10KB
|
272 lines
18000 REM ********** TRANSFER MENU **************
18005 IF DTFLG >< 1 THEN GOSUB 19000 / IF TRANSFER DATA NOT IN MEMORY THEN
18007 GOSUB 13000 / CLEAR SCREEN
18010 PRINT "**************** TRANSFER MENU ******************"
18020 PRINT ""
18025 PRINT " 0 - EXIT THE PROGRAM"
18030 FOR N = 1 TO MAXS / FOR ALL TRANSFERS
18040 PRINT " ";N;"- ";SN$(N) / PRINT THE TRANSFER NAME
18050 NEXT N
18060 PRINT ""
18070 PRINT "******* ENTER THE NUMBER AND PRESS RETURN *******"
18075 GOSUB 14000 / INPUT INTEGER < 100 SUBROUTINE
18076 IF DT# <0 OR DT# >MAXS GOTO 18075 / IF OUT OF RANGE REENTER
18078 IF DT# = 0 THEN GOTO 51000 / END PROGRAM
18080 SOPT = DT# / TRANSFER OPTION EQUALS THE VALUE RETURNED FROM THE INPUT SUBROUTINE
18085 GOSUB 13000 / CLEAR SCREEN
18090 A = SFN(SOPT) / SOURCE FILE NUMBER = A
18092 PRINT F$(A),"SOURCE FILE"
18094 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON SUBROUTINE
18096 GOSUB 2500 / OPEN SOURCE FILE
18098 IF DTOPT(SOPT) = 1 THEN GOSUB 21000 / IF DIRECT TRANSFER OPTION
18099 GOSUB 13000 / CLEAR SCREEN
18100 PRINT ""
18110 PRINT "***** WHAT RECORD NUMBER DO YOU WANT TO START AT *****"
18120 PRINT ""
18130 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN *********"
18135 GOSUB 14200
18136 IF DT# <1 OR DT# >10000 GOTO 18135
18140 RNSS = DT# / RECORD NUMBER START TRANSFER
18200 PRINT ""
18202 GOSUB 7800 / GET THE MAXIMUM RECORD NUMBER
18204 PRINT "THE HIGHEST NUMBERED RECORD IS ";MRN
18210 PRINT "******** WHICH IS THE LAST RECORD YOU WANT TO TRANSFER ********"
18220 PRINT ""
18230 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN **************"
18235 GOSUB 14200
18236 IF DT# <1 OR DT# >MRN GOTO 18235 / IF OUT OF RANGE THEN REENTER
18240 RNSF = DT# / RECORD NUMBER SOURCE FINISH = VALUE RETURNED FROM THE SUBROUTINE
18250 IF RNSF > MRN GOTO 18204
18300 SFN = SFN(SOPT) / SOURCE FILE NUMBER
18500 GOTO 20000
19000 REM ************ OPEN FOR INPUT **************
19005 GOSUB 10900 / PUT PROGRAM DATA DISK IN PROMPT
19010 OPEN "I",#2,"TFER" / TRNASFER FILE
19020 INPUT #2,MAXS / MAXIMUM NUMBER OF TRANSFERS
19030 FOR S = 1 TO MAXS / FOR ALL TRANSFERS
19040 D = 1 / PRESENTLY DUMMY
19050 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
19060 IF DTOPT(S) = 2 GOTO 19170 / IF DIRECT TRANSFER OPTION
19070 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S)
19080 TFN = TFN(S) / TARGET FILE NUMBER
19090 FOR N = 1 TO DY(S) / FOR ALL FIELDS
19100 INPUT #2,FLDTC(S,N,D) / FIELD TO CHANGE
19110 IF FLDTC(S,N,D) = 1 GOTO 19130
19120 INPUT #2,FLDTCT(S,N,D) / FIELD TARGET CHANGE TYPE
19130 NEXT N
19140 IF D = 2 GOTO 19170
19150 IF D(S) = 2 THEN D = 2
19160 IF D(S) = 2 GOTO 19090
19170 IF SUMOPT(S) = 2 GOTO 19220 / IF TRANSFER SUM OPTION
19180 INPUT #2,KTSUM(S),SUMFN(S)
19190 FOR K = 1 TO KTSUM(S)
19200 INPUT #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K)
19210 NEXT K
19220 IF SUMAFOPT(S) = 2 GOTO 19270 / IF SUBTOTAL TRANSFER OPTION
19230 INPUT #2, KTSUMAF(S),SAFFN(S)
19240 FOR K = 1 TO KTSUMAF(S)
19250 INPUT #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),DY
19260 NEXT K
19270 NEXT S
19280 CLOSE #2
19285 DTFLG = 1 / DATA IN FLAG SET TO YES
19290 RETURN
20000 REM ****** DATA TRANSFER PROGRAM ******
20095 REM ***** INITIALIZE SUMS TO ZERO *****
20100 GOSUB 20900
20105 PRINT "*** INITIALIXE SUMS
20110 REM *** OPEN SOURCE FILE ****
20112 GOSUB 13000 / CLEAR SCREEN
20140 REM ** IF DTOPT(SOPT) = 1 THEN GOSUB 21000 / IF DIRECT TRANSFER OPTION
20150 REM ******* START READING LOOP **********
20160 FOR RN = RNSS TO RNSF / FOR RECORD NUMBER START TO FINISH
20180 GET #1,RN / GET THE RECORD FROM DISK
20195 REM ******* CONVERT STRINGS TO INTEGERS
20200 GOSUB 21066
20205 PRINT "*** READING RECORD NUMBER ";RN
20210 REM ******* RECORD NUMBERING
20220 IF DTOPT(SOPT) = 1 THEN GOSUB 21700 / IF DIRECT TRANSFER OPTION
20230 REM ***** TRANSFER DATA
20240 IF DTOPT(SOPT) = 1 THEN GOSUB 21900 / IF DIRECT TRANSFER OPTION
20250 REM ***** ADD ACCORDING TO FIELDS
20260 IF SUMOPT(SOPT) = 1 THEN GOSUB 24000 / IF SUM TRANSFER OPTION
20270 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 24100 /IF SUM ACCORDING TO FIELD OPTION
20300 NEXT RN
20500 REM ****** RESUME FROM ON ERROR
20510 REM ****** MOVE FIELDS TO FILE
20520 IF SUMOPT(SOPT) = 1 THEN GOSUB 25600 / IF SUM TRANSFER OPTION
20530 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 25800 / IF SUBTOTAL TRANSFER OPTION
20590 CLOSE
20600 GOTO 18000 / BACK TO TRANSFER MENU
20900 REM ****** CLEAR VARIABLES ******
20910 FOR N = 1 TO KTSUM
20920 SUM#(N) = 0 / INITIALIZE SUMS TO 0
20930 NEXT N
20950 IF SUMAFOPT = 2 GOTO 20998
20960 FOR P = 1 TO KTSUMAF
20970 FOR N = 1 TO MAX(P)
20980 SAF#(P,N) = 0 / INITIALIZE SUBTOTOAL TO 0
20990 NEXT N
20995 NEXT P
20998 RETURN
21000 REM *********** DATA TRANSFER OPTION **********
21005 TFN = TFN(SOPT) / TARGET FILE NUMBER
21010 B = TFN / TARGET FILE NUMBER
21015 GOSUB 13000 / CLEAR SCREEN
21017 PRINT F$(B)," TARGET FILE "
21018 AHLD = A
21019 A = B
21020 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON SUBROUTINE
21030 GOSUB 2550 / OPEN TARGET FILE
21032 A = AHLD
21040 RETURN
21066 FOR K = 1 TO NREC(A) / FOR ALL FIELDS
21068 REM ******** CONVERT EACH RECORD TO DECIMAL **********
21070 ON FTY(A,K) GOTO 21100,21200,21300,21400,21400 / ON FIELD TYPE GOTO
21100 Z$(K) = X$(K) / STRINGS
21110 GOTO 21500
21150 REM ******* START READING LOOP **********
21200 Z%(K) = CVI(X$(K)) / CONVERT INTEGERS
21205 SU#(K) = Z%(K)
21210 GOTO 21500
21300 S!(K) = CVS(X$(K)) / CONVERT SINGLE PRECISION
21305 SU#(K) = S!(K)
21310 GOTO 21500
21400 D#(K) = CVD(X$(K)) / CONVERT DOUBLE PRECISION
21405 SU#(K) = D#(K)
21410 GOTO 21500
21500 NEXT K / NEXT FIELD
21510 RETURN
21590 REM ******* GET SECOND FILE **********
21595 REM ***** OPEN B ON START UP ****
21600 IF N <> RNSS GOTO 21700 / IF NOT THE FIRST RECORD TRANSFERED THEN SKIP
21605 FLG = 1
21610 FLDOPT = 2
21620 B = TFN / TARGET FILE NUMBER
21630 GOSUB 2300 / OPEN TARGET FILE
21700 REM ***** RECORD NUMBERING
21705 RNTNBOPT = RNTNBOPT(SOPT)
21710 IF RNTNBOPT = 0 GOTO 21800 / EQUALS SOURCE RECORD NUMBER OPTION
21715 REM ****** B RECORD NUMBER = TO A FIELD ******
21720 RN2 = SU#(RNTNBOPT) / EQUALS THE VALUE OF THIS FIELD
21730 RETURN
21790 REM ****** B RECORD NUMBER INCREMENTS FROM 1 *******
21800 RN2 = RN
21810 RETURN
21900 REM ****** GET SECOND RECORD ******
21905 PRINT "TRANSFERING TO RECORD ";RN2
21910 GET #2,RN2
22000 FOR R = 1 TO NREC(B) / FOR ALL RECORDS
22005 REM ***** NO TRASFER *****
22010 IF FLDTC(SOPT,R,1) = 1 GOTO 23900 / IF NO TRANSFER
22020 IF FTY(B,R) <> 1 GOTO 22100 / IF NOT A STRING
22030 T = FLDTC(SOPT,R,1) - 1 / TARGET FIELD NUMBER
22040 LSET Y$(R) = Z$(T) / REPLACE
22050 GOTO 23900
22095 REM ***** JUST REPLACE *****
22100 IF FLDTCT(SOPT,R,1) <> 2 GOTO 22200 / IF TYPE CHANGE IS NOT A REPLACEMENT
22105 T = FLDTC(SOPT,R,1) - 1 / TARGET FIELD NUMBER
22110 LSET Y$(R) = Z$(T) / REPLACE
22120 GOTO 23900
22200 ON FTY(B,R) GOTO 23900,22210,22300,22400,22400 / ON FIELD TYPE GOTO
22205 REM ***** INTEGER *****
22210 I%=CVI(Y$(R)) / CONVERT TO NUMBER
22215 T = FLDTC(SOPT,R,1) - 1 / TARGET FIELD NUMBER
22218 D# = SU#(T)
22220 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D# /IF SUBTRACT THEN MAKE NEGITIVE
22230 I% = I% + D# / ADD
22240 LSET Y$(R) = MKI$(I%) / COVERT TO STRING
22250 GOTO 23900
22300 REM ** SINGLE PRECISION **
22310 I!=CVS(Y$(R))
22315 T = FLDTC(SOPT,R,1) - 1
22318 D# = SU#(T)
22320 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#
22330 I! = I! + D#
22340 LSET Y$(R) = MKS$(I!)
22350 GOTO 23900
22400 REM ** DOUBLE PRECISION **
22407 Y$ = Y$(R)
22410 I#=CVD(Y$)
22415 T = FLDTC(SOPT,R,1) - 1
22416 D# = SU#(T)
22420 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#
22430 I# = I# + D#
22440 LSET Y$(R) = MKD$(I#)
22450 GOTO 23900
22990 REM ****** FINISH TRANSFER LOOP ******
23900 NEXT R
23910 PUT #2,RN2
23912 RETURN
24000 REM ******** SUM OPTION *******
24010 FOR P = 1 TO KTSUM(SOPT) / FOR ALL FIELDS TO ADD
24020 T = SUMF(SOPT,P) / FIELD TO ADD
24030 SUM#(P) = SUM#(P) + SU#(T) / ADD
24040 NEXT P
24050 RETURN
24100 REM ***** ADD ACCORDING TO FIELDS *****
24110 IF SUMAFOPT = 2 GOTO 24285
24120 FOR P = 1 TO KTSUMAF(SOPT) / FOR ALL FIELDS TO SUBTOTAL
24130 T = SAFADD(SOPT,P) / FIELD TO SUBTOTAL
24140 F = SAFACCTO(SOPT,P) / SUBTOTAL ON THIS FIELD
24150 I = SU#(F)
24155 IF I > MAXSAF(P) THEN MAXSAF(P) = I /MAXIMUM VALUE OF FIELD SUBTOTALED ON
24160 SAF#(P,I) = SAF#(P,I) + SU#(T) / ADD SUBTOTALS
24170 NEXT P
24285 RETURN
25600 REM ****** MOVE SUMS TO FILES ******
25620 CLOSE
25630 B = SUMFN(SOPT)
25645 GOSUB 13000 / CLEAR SCREEN
25647 PRINT F$(B),"FILE FOR SUMS"
25648 AHLD = A
25649 A = B
25650 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON
25660 GOSUB 2550 / OPEN FILE
25665 A = AHLD
25670 FOR P = 1 TO KTSUM(SOPT) / FOR ALL SUMS
25700 RN = SUMRN(SOPT,P) / RECORD NUMBER TO TRANSFER SUMS TO
25710 GET 2,RN / GET RECORD NUMBER TO TRANSFER SUMS TO
25720 T = SUMFLDN(SOPT,P)
25725 S# = SUM#(P)
25727 PRINT "SUM";S#;" FIELD ";T
25730 ON FTY(B,T) GOSUB 25790,25772,25780,25790,25790
25750 PUT #2,RN
25760 NEXT P
25770 RETURN
25772 LSET Y$(T) = MKI$(S#) / INTEGER SUMS
25775 RETURN
25780 LSET Y$(T) = MKS$(S#) / SINGLE PRECISION SUMS
25785 RETURN
25790 LSET Y$(T) = MKD$(S#) / DOUBLE PRECISON SUMS
25795 RETURN
25800 REM ******* PUT SUM ACCORDING TO FIELDS IN FILES *******
25810 CLOSE
25820 B = SAFFN(SOPT)
25823 GOSUB 13000 / CLEAR SCREEN
25825 PRINT F$(B),"FILE FOR SUMS ACCORDINT TO FIELDS "
25827 AHLD = A
25828 A = B
25830 GOSUB 2300 / WHICH DISK DRIVE IS THE FILE ON
25833 A = AHLD
25835 GOSUB 2550 / OPEN THE FILE
25850 FOR P = 1 TO KTSUMAF(SOPT) / FOR EACH FIELD SUBTOTALED
25852 T = SAFFLDN(SOPT,P)
25860 FOR J = 1 TO MAXSAF(P) / FOR 1 TO THE MAXIMUM VALUE SUBTOTALED ON FIELD
25865 S# = SAF#(P,J)
25870 GET #2,J
25880 ON FTY(B,T) GOSUB 25984,25984,25990,25995,25995 / ON FIELD TYPE
25890 PUT #2,J
25895 PRINT P,J,S#,A,T
25900 NEXT J
25910 NEXT P
25980 CLOSE
25982 RETURN
25984 LSET Y$(T) = MKI$(S#) / INTEGER SUBTOTALS
25986 RETURN
25990 LSET Y$(T) = MKS$(S#) / SINGLE PRECISION SUBTOTALS
25992 RETURN
25995 LSET Y$(T) = MKD$(S#) / DOUBLE PRECISION SUBTOTALS
25997 RETURN
= MKS$(S#) / SINGLE PRECISION SUBTOTALS
25992 R