Shareware Overload/ShartewareOverload.cdr/database/steel14.zip/TRANSFER.BAS

BASIC Source File | 1983-03-10 | 18KB | 610 lines

3 DEFDBL X
4 DEFINT A-W,Y-Z
5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30),IOPT(30)
10 DIM X$(30),Y$(30)
13 DIM L(15),NREC(15),Z$(30)
14 DIM X(30),CK$(30),SN$(30),SFN(10),DTOPT(10)
16 DIM LEND(30),CL(30)
17 DIM FTA(10),ATF(10),BTF(10),IMAX(10)
18 DIM SU%(40),S!(30),SUM#(40)
22 DIM ORFLG(10),D(10),TFN(10),FLDTCT(10,30,1),KTSUM(30),SUMFN(30)
23 DIM SUMF(10,30),KTSUMAF(30),SAFFN(30),SAFADD(10,30),SAFACCTO(10,30)
24 DIM SAFFLDN(10,30)
25 DIM S#(30)
26 DIM MAX(10),Z%(30),SU#(30),D#(30),EFN(10,30)
35 DIM K$(80)
42 DIM MAXK(30),SUMRN(10,30),SUMFLDN(10,30),MAXSAF(5)
44 DIM SUMAFOPT(10),SUMOPT(10),RNTNBOPT(10),DY(10),FLDTC(10,30,1)
46 DIM SUMFLD(10,30)
60 DIM SAF#(3,200)
61 CH = 29: PRINT FRE(0)
62 GOSUB 50000
70 NE = 0
80 GOSUB 10000
1000 GOTO 18000
2300 REM **************  DISK  SELECTION  ***************
2302 IF HDISK = 2 THEN GOSUB 13000
2303 IF HDISK = 2 THEN GOTO 2360
2304 PRINT ""
2305 PRINT "************  WHICH DISK DRIVE IS THE FILE ON  **************"
2310 PRINT ""
2315 PRINT "                 1 - DISK DRIVE A"
2320 PRINT "                 2 - DISK DRIVE B"
2325 PRINT "                 3 - DISK DRIVE C"
2330 PRINT "                 4 - DISK DRIVE D"
2335 PRINT ""
2340 PRINT "***********  ENTER THE NUMBER THEN PRESS RETURN  ************"
2345 GOSUB 14000
2347 IF DT# < 0 OR DT#>4 GOTO 2345
2350 T = DT#
2355 ON T GOTO 2360,2370,2380,2390
2360 T$ = F$(A)
2365 GOTO 2490
2370 T$ = "B:"+F$(A)
2375 GOTO 2490
2380 T$ = "C:"+F$(A)
2385 GOTO 2490
2390 T$ = "D:"+F$(A)
2490 RETURN
2500 REM *******  OPEN FILE SUBROUTINE  *******
2503 CLOSE #1
2505 OPEN "R",#1,T$,L(A)
2507 D = 0
2510 FOR T = 1 TO NREC(A)
2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T)
2530 D = D + FL(A,T)
2540 NEXT T
2543 GOSUB 7800
2545 RETURN
2550 REM *******   OPEN SECOND FILE  *******
2553 CLOSE #2
2555 OPEN "R",#2,T$,L(B)
2557 D = 0
2560 FOR T = 1 TO NREC(B)
2565 FIELD #2,D AS DY$,FL(B,T) AS Y$(T)
2570 D = D + FL(B,T)
2575 NEXT T
2578 RETURN
2580 REM *******   OPEN THIRD FILE  *******
2582 PRINT C,F$(C),L(C)
2584 OPEN "R",#2,F$(C),L(C)
2586 D = 0
2588 FOR T = 1 TO NREC(C)
2590 FIELD #2,D AS DY$,FL(C,T) AS Z$(T)
2592 D = D + FL(C,T)
2594 NEXT T
2596 RETURN
7800 MRN = LOF(1)/ L(A)
7805 REM MRN = INT(MRN)
7810 RETURN
7900 REM ***** LOF
7910 MRN2 = LOF(3)/82
7920 RETURN
7950 REM ******* LOF
7960 MRNS = LOF(B)/L(B)
7970 RETURN
10000 REM *************  READ SUBROUTINE  *************
10004 GOSUB 10900
10010 OPEN "I",#1,"FFILE"
10020 INPUT #1,MAXF
10030 FOR A = 1 TO MAXF
10040 INPUT #1,A,F$(A),NREC(A),L(A)
10050 FOR N = 1 TO NREC(A)
10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
10070 IF FTY(A,N) = 2 THEN INPUT #1,D,D
10080 NEXT N
10090 NEXT A
10100 CLOSE #1
10110 RETURN
10900 REM  *************  PUT DISK IN DRIVE SUB
10905 IF HDISK = 2 THEN RETURN
10910 GOSUB 13000
10920 PRINT "    ********  PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE  *********"
10930 PRINT ""
10940 PRINT "                     THEN PRESS ANY KEY TO CONTINUE "
10950 PRINT ""
10960 PRINT "    If the program data disk is already in the default disk drive then"
10965 PRINT "                   just press any key to continue."
10970 PRINT ""
10990 IF INKEY$ = "" GOTO 10990
10995 RETURN
11000 REM  ********  LOAD KEYLIST  *********
11010 RETURN
13000 REM *********  CLEAR SCREEN
13010 CLS
13020 RETURN
13100 REM *********  LOCATE
13110 LOCATE LI,1
13120 RETURN
13200 FOR T% = 1 TO 80
13210 PRINT CHR$(8);
13220 NEXT T%
13222 FOR T% = 1 TO 24
13223 PRINT CHR$(11);
13224 NEXT T%
13225 LI = LI - 1
13230 FOR T% = 1 TO LI
13240 PRINT CHR$(0)
13250 NEXT T%
13590 RETURN
13600 REM ****** CHECK FOR ASC0
13610 S4$ = INKEY$
13620 C2 =  ASC(S4$)
13630 IF C2 = 83 THEN C = 1
13640 IF C2 = 82 THEN C = 6
13650 IF C2 = 75 THEN C = 19
13660 IF C2 = 77 THEN C = 4
13670 RETURN
14000 REM *******  INTEGER LESS THEN 100 CHECK  ********
14010 MAX = 2
14020 ACT$ = "1234567890=<>^"
14023 IF NE = 0 THEN ACT$ = "1234567890"
14025 PRINT ">__<";
14030 GOTO 14500
14100 REM *******  INTEGER *******
14110 MAX = 8
14120 ACT$ = "1234567890-+,=<>^"
14123 IF NE = 0 THEN ACT$ = "1234567890-+,"
14125 PRINT ">________<";
14130 GOTO 14500
14200 REM *******  SINGLE PRECISION  *******
14210 MAX = 10
14220 ACT$ = "1234567890-+,.%$=<>^"
14223 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
14225 PRINT ">__________<";
14230 GOTO 14500
14300 REM *******  DOUBLE PRECISION  *******
14310 MAX = 20
14320 ACT$ = "1234567890-+,.%$=<>^"
14323 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
14325 PRINT ">____________________<";
14330 GOTO 14500
14500 REM ********** NUMBER CHECK **********
14505 A$ = ""
14510 K$(20) = " "
14515 KTMAX = 0
14520 FOR T9 = 1 TO MAX
14525 K$(T9) = " "
14530 NEXT T9
14535 DIG$ = "1234567890."
14540 DOTFLG = 0
14541 T2 = MAX + 1
14542 FOR T6 = 1 TO T2
14544 PRINT CHR$(CH);
14546 NEXT T6
14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550
14560 KT = 0
14565 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
14570 KT = KT + 1
14575 REM
14580 W$ = INKEY$
14585 IF W$ = "" GOTO 14580
14590 C = ASC(W$)
14593 IF C = 0 THEN GOSUB 13600
14595 IF C = 13 GOTO 14660
14600 IF C = 17 OR C = 8 GOTO 14860
14605 IF C = 19 GOTO 14690
14610 IF C = 4 GOTO 14710
14615 IF C = 6 GOTO 14730
14620 IF C = 1 GOTO 14790
14625 IF KT > MAX GOTO 14575
14630 IF INSTR(ACT$,W$) = 0 GOTO 14890
14635 K$(KT) = W$
14645 PRINT K$(KT);
14650 IF KT > KTMAX THEN KTMAX = KT
14655 GOTO 14570
14660 REM **********  RETURN  **********
14670 FOR T9 = 1 TO KTMAX
14675 A$ = A$ + K$(T9)
14680 NEXT T9
14681 IF KTMAX = 0 THEN PRINT "1"
14682 IF KTMAX = 0 THEN DT# = 1
14683 IF KTMAX = 0 THEN RETURN
14684 PRINT ""
14685 GOTO 14905
14690 REM ********* MOVE CURSE BACK ********
14695 IF KT = 1 GOTO 14575
14700 KT = KT - 1
14703 PRINT CHR$(CH);
14705 GOTO 14575
14710 REM ********* MOVE CURSER FORWARD *********
14715 IF KT >= MAX GOTO 14575
14716 IF KT > (KTMAX + 1) GOTO 14575
14718 PRINT K$(KT);
14720 KT = KT + 1
14725 GOTO 14575
14730 REM ********** INSERT ***********
14733 IF KT > KTMAX GOTO 14575
14735 X9 = MAX
14740 WHILE X9 > KT
14745 X9 = X9 - 1
14750 K$(X9 + 1) = K$(X9)
14755 WEND
14760 K$(KT) = " "
14767 KTMAX = KTMAX + 1
14769 IF KTMAX > MAX THEN KTMAX = MAX
14770 FOR T9 = KT TO KTMAX
14775 PRINT K$(T9);
14780 NEXT T9
14781 T6 = (KTMAX - KT) + 1
14782 FOR T7 = 1 TO T6
14783 PRINT CHR$(CH);
14784 NEXT T7
14785 GOTO 14575
14790 REM ********** DELETE ***********
14793 IF KT > KTMAX GOTO 14575
14794 IF KTMAX = 1 GOTO 14575
14795 K$(MAX + 1) = ""
14800 X9 = KT
14805 WHILE X9 <= MAX
14810 K$(X9) = K$(X9 + 1)
14815 X9 = X9 + 1
14820 WEND
14830 KTMAX = KTMAX - 1
14835 FOR T9 = KT TO KTMAX
14840 PRINT K$(T9);
14845 NEXT T9
14850 PRINT "_";
14851 T7 = (KTMAX - KT) + 2
14852 FOR T8 = 1 TO T7
14853 PRINT CHR$(CH);
14854 NEXT T8
14855 GOTO 14575
14860 REM ********* BACKSPACE ********
14865 IF KT = 1 GOTO 14575
14870 KT = KT - 1
14875 PRINT CHR$(CH);
14877 K$(KT) = " "
14880 PRINT "_";
14883 PRINT CHR$(CH);
14885 GOTO 14575
14890 REM *******  INPUT NOT ACCEPTABLE  ********
14895 PRINT CHR$(7);
14900 GOTO 14580
14905 REM ********* CLEAR STRINGS ********
14910 MAX = LEN(A$)
14915 D2$ = ""
14920 D1$ = ""
14925 DFLG = 0
14930 FOR Q93 = 1 TO MAX
14935 R$ = MID$(A$,Q93,1)
14940 IF INSTR(DIG$,R$) = 0 GOTO 14975
14945 IF R$ = "." OR DFLG = 1 GOTO 14965
14950 IF DFLG = 1 GOTO 14965
14955 D2$ = D2$ + R$
14960 GOTO 14975
14965 D1$ = D1$ + R$
14970 DFLG = 1
14975 NEXT Q93
14980 DA# = VAL(D2$)
14985 D1# = VAL(D1$)
14990 DT# = DA# + D1#
14995 IF K$(1) = "-" THEN DT# =  -DT#
14997 RETURN
16010 PRINT "***********  MAKE SURE YOUR PRINTER IS ON  **************"
16020 PRINT ""
16030 PRINT "********************  WITH PAPER  ***********************"
16040 PRINT ""
16050 PRINT "**********  PRESS ANY KEY TO START PRINTING  ************"
16055 PRINT ""
16057 PRINT "     *******  PRESS THE LETTER A TO ABORT  *******"
16070 T$ = INKEY$
16073 IF T$ = "" GOTO 16070
16075 PRINT T$
16090 RETURN
16200 REM *********  PRINT OUT FIELDS
16205 T2 = 1
16210 FOR T = 1 TO NREC(A)
16220 PRINT TAB(T2) T;"-";FLDN$(A,T);
16230 IF T MOD 3 = 0 THEN PRINT ""
16235 IF T MOD 3 = 0 THEN T2 = -25
16237 T2 = T2 + 26
16340 NEXT T
16350 RETURN
18000 REM **********  TRANSFER  MENU  **************
18005 IF DTFLG >< 1 THEN GOSUB 19000
18007 GOSUB 13000
18010 PRINT "****************  TRANSFER MENU  ******************"
18020 PRINT ""
18025 PRINT "   0 - EXIT THE PROGRAM"
18030 FOR N = 1 TO MAXS
18040 PRINT "  ";N;"- ";SN$(N)
18050 NEXT N
18060 PRINT ""
18070 PRINT "*******  ENTER THE NUMBER AND PRESS RETURN  *******"
18075 GOSUB 14000
18076 IF DT# <0 OR DT# >MAXS GOTO 18075
18078 IF DT# = 0 THEN GOTO 51000
18080 SOPT = DT#
18085 GOSUB 13000
18090 A = SFN(SOPT)
18092 PRINT F$(A),"SOURCE FILE"
18094 GOSUB 2300
18096 GOSUB 2500
18098 IF DTOPT(SOPT) = 1 THEN GOSUB 21000
18099 GOSUB 13000
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#
18200 PRINT ""
18202 GOSUB 7800
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
18240 RNSF = DT#
18250 IF RNSF > MRN GOTO 18204
18300 SFN = SFN(SOPT)
18500 GOTO 20000
19000 REM ************  OPEN FOR INPUT  **************
19005 GOSUB 10900
19010 OPEN "I",#2,"TFER"
19020 INPUT #2,MAXS
19030 FOR S = 1 TO MAXS
19040 D = 1
19050 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
19060 IF DTOPT(S) = 2 GOTO 19170
19070 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S)
19080 TFN = TFN(S)
19090 FOR N = 1 TO DY(S)
19100 INPUT #2,FLDTC(S,N,D)
19110 IF FLDTC(S,N,D) = 1 GOTO 19130
19120 INPUT #2,FLDTCT(S,N,D)
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
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
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
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
20140 REM ** IF DTOPT(SOPT) = 1 THEN GOSUB 21000
20150 REM *******  START READING LOOP  **********
20160 FOR RN = RNSS TO RNSF
20180 GET #1,RN
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
20230 REM *****  TRANSFER DATA
20240 IF DTOPT(SOPT) = 1 THEN GOSUB 21900
20250 REM *****  ADD ACCORDING TO FIELDS
20260 IF SUMOPT(SOPT) = 1 THEN GOSUB 24000
20270 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 24100
20300 NEXT RN
20500 REM  ******  RESUME FROM ON ERROR
20510 REM ******  MOVE FIELDS TO FILE
20520 IF SUMOPT(SOPT) = 1 THEN GOSUB 25600
20530 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 25800
20590 CLOSE
20600 GOTO 18000
20900 REM ******  CLEAR VARIABLES  ******
20910 FOR N = 1 TO KTSUM
20920 SUM#(N) = 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
20990 NEXT N
20995 NEXT P
20998 RETURN
21000 REM ***********  DATA TRANSFER OPTION  **********
21005 TFN = TFN(SOPT)
21010 B = TFN
21015 GOSUB 13000
21017 PRINT F$(B)," TARGET FILE "
21018 AHLD = A
21019 A = B
21020 GOSUB 2300
21030 GOSUB 2550
21032 A = AHLD
21040 RETURN
21066 FOR K = 1 TO NREC(A)
21068 REM ******** CONVERT EACH RECORD TO DECIMAL  **********
21070 ON FTY(A,K) GOTO 21100,21200,21300,21400,21400
21100 Z$(K) = X$(K)
21110 GOTO 21500
21150 REM *******  START READING LOOP  **********
21200 Z%(K) = CVI(X$(K))
21205 SU#(K) = Z%(K)
21210 GOTO 21500
21300 S!(K) = CVS(X$(K))
21305 SU#(K) = S!(K)
21310 GOTO 21500
21400 D#(K) = CVD(X$(K))
21405 SU#(K) = D#(K)
21410 GOTO 21500
21500 NEXT K
21510 RETURN
21590 REM ******* GET SECOND FILE **********
21595 REM ***** OPEN B ON START UP  ****
21600 IF N <> RNSS GOTO 21700
21605 FLG = 1
21610 FLDOPT = 2
21620 B = TFN
21630 GOSUB 2300
21700 REM *****  RECORD NUMBERING
21705 RNTNBOPT = RNTNBOPT(SOPT)
21710 IF RNTNBOPT = 0 GOTO 21800
21715 REM ******  B RECORD NUMBER = TO A FIELD ******
21720 RN2 = SU#(RNTNBOPT)
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)
22005 REM *****  NO TRASFER  *****
22010 IF FLDTC(SOPT,R,1) = 1 GOTO 23900
22020 IF FTY(B,R) <> 1 GOTO 22100
22030 T = FLDTC(SOPT,R,1) - 1
22040 LSET Y$(R) = Z$(T)
22050 GOTO 23900
22095 REM *****  JUST REPLACE  *****
22100 IF FLDTCT(SOPT,R,1) <> 2 GOTO 22200
22105 T = FLDTC(SOPT,R,1) - 1
22110 LSET Y$(R) = Z$(T)
22120 GOTO 23900
22200 ON FTY(B,R) GOTO 23900,22210,22300,22400,22400
22205 REM ***** INTEGER *****
22210 I%=CVI(Y$(R))
22215 T = FLDTC(SOPT,R,1) - 1
22218 D# = SU#(T)
22220 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D#
22230 I% = I% + D#
22240 LSET Y$(R) = MKI$(I%)
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)
24020 T = SUMF(SOPT,P)
24030 SUM#(P) = SUM#(P) + SU#(T)
24040 NEXT P
24050 RETURN
24100 REM ***** ADD ACCORDING TO FIELDS *****
24110 IF SUMAFOPT = 2 GOTO 24285
24120 FOR P = 1 TO KTSUMAF(SOPT)
24130 T = SAFADD(SOPT,P)
24140 F = SAFACCTO(SOPT,P)
24150 I = SU#(F)
24155 IF I > MAXSAF(P) THEN MAXSAF(P) = I
24160 SAF#(P,I) = SAF#(P,I) + SU#(T)
24170 NEXT P
24285 RETURN
25600 REM ****** MOVE SUMS TO FILES ******
25620 CLOSE
25630 B = SUMFN(SOPT)
25645 GOSUB 13000
25647 PRINT F$(B),"FILE FOR SUMS"
25648 AHLD = A
25649 A = B
25650 GOSUB 2300
25660 GOSUB 2550
25665 A = AHLD
25670 FOR P = 1 TO KTSUM(SOPT)
25700 RN = SUMRN(SOPT,P)
25710 GET 2,RN
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#)
25775 RETURN
25780 LSET Y$(T) = MKS$(S#)
25785 RETURN
25790 LSET Y$(T) = MKD$(S#)
25795 RETURN
25800 REM *******  PUT SUM ACCORDING TO FIELDS IN FILES  *******
25810 CLOSE
25820 B = SAFFN(SOPT)
25823 GOSUB 13000
25825 PRINT F$(B),"FILE FOR SUMS ACCORDINT TO FIELDS "
25827 AHLD = A
25828 A = B
25830 GOSUB 2300
25833 A = AHLD
25835 GOSUB 2550
25850 FOR P = 1 TO KTSUMAF(SOPT)
25852 T = SAFFLDN(SOPT,P)
25860 FOR J = 1 TO MAXSAF(P)
25865 S# = SAF#(P,J)
25870 GET #2,J
25880 ON FTY(B,T) GOSUB 25984,25984,25990,25995,25995
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#)
25986 RETURN
25990 LSET Y$(T) = MKS$(S#)
25992 RETURN
25995 LSET Y$(T) = MKD$(S#)
25997 RETURN
26000 REM ******* ON ERROR ROUTINE ************
26100 EFLG = 1
26200 PRINT "**********  END OF FILE  ***********"
26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26204 IF INKEY$ = "" GOTO 26204
26500 REM *********  ON ERROR SUBROUTINE ***********
26600 PRINT "**********  END OF FILE  ***********"
26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
26620 IF INKEY$ = "" GOTO 26620
26635 EFLG = 1
26640 RETURN
26800 REM **********  ON ERROR GOTO  **************
26900 PRINT "************  RECORD NOT FOUND  *************"
50000 REM **********  INTRO
50010 GOSUB 13000
50100 PRINT "              T R A N S F E R    P R O G R A M    3.0   "
50105 PRINT ""
50110 PRINT "       Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT "        See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "******************  PRESS ANY KEY TO CONTINUE  *******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ******** EXIT
51100 GOSUB 13000
51105 GOSUB 13000
51110 PRINT " -BYE, Have a nice day
51120 END
51200 PRINT "BYE - Have a nice day "
51300 END
SUB 13000
51105 GOSUB 13000
51110 PRINT " -BYE, Have a nice day
51120 END
51