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

BASIC Source File | 1983-03-10 | 26KB | 781 lines

4 DEFINT A-W,Y-Z
5 DIM F$(17),FLDN$(17,30),FTY(17,30),FL(17,30),IOPT(30)
13 DIM L(17),NREC(17)
14 DIM SN$(30),SFN(30),DTOPT(10)
21 DIM TX(10,10)
22 DIM D(10),TFN(10),FLDTCT(10,50,1),KTSUM(10),SUMFN(10)
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(5,30),Z%(10),SU#(30),D#(30),EFN(10,30)
35 DIM K$(80)
42 DIM SUM(30),MAXK(10),SUMRN(10,30),SUMFLDN(10,30),MAXSAF(5)
44 DIM SUMAFOPT(30),SUMOPT(30),RNTNBOPT(10),DY(30),FLDTC(10,50,1)
46 DIM SUMFLD(10,30)
50 D = 1
70 CH = 29
75 PRINT "MEMORY FREE",FRE(0)
80 GOSUB 52000
100 GOSUB 50000
200 GOTO 20000
500 REM ******* CLS
510 CLS
520 RETURN
20000 REM  **********  TRANSFER PROGRAM  *********
20010 GOSUB 500
20100 GOSUB 24620
20120 GOSUB 500
20130 HLD = 0
20140 PRINT "************  DATA TRANSFER DESCRIPTION MENU  **************"
20160 PRINT ""
20180 PRINT "    0 - EXIT  "
20190 PRINT ""
20200 PRINT "    1 - ENTER A TRANSFER DESCRIPTION"
20210 PRINT ""
20220 PRINT "    2 - READ A SINGLE TRANSFER DESCRIPTION"
20230 PRINT ""
20240 PRINT "    3 - PRINT ON PAPER ONE TRANSFER DESCRIPTION "
20260 PRINT ""
20280 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  ************"
20300 GOSUB 60000
20302 IF DT# <0 OR DT#> 3 GOTO 20300
20310 T = DT#
20315 IF T = 0 GOTO 51000
20320 ON T GOTO 20340,20420,20640
20340 REM ***  ENTER A TRANSFER DESCRIPTION  ***
20360 GOSUB 20820
20380 GOSUB 24020
20400 GOTO 20120
20420 REM ***  READ A SINGE TRANSFER DESCRIPTION  ***
20440 GOSUB 500
20460 PRINT "*******  WHICH TRANSFER DESCRIPTION DO YOU WANT TO SEE  *******"
20480 FOR T = 1 TO MAXS
20500 PRINT T;"- ";SN$(T)
20520 NEXT T
20540 PRINT "************  ENTER THE NUMBER THEN PRESS RETURN  *************"
20560 GOSUB 60000
20562 IF DT# <1 OR DT#> MAXS GOTO 20560
20570 S = DT#
20580 GOSUB 25220
20600 PRINT "*******  PRESS ANY KEY TO CONTINUE  *******"
20610 IF INKEY$ = "" THEN GOTO 20610
20620 GOTO 20120
20640 REM ***  PRINT ON PAPER ONE TRANSFER DESCRIPTION  ***
20660 PRINT "*****  WHAT TRANSFER DESCRIPTION DO YOU WANT PRINTED  *****"
20680 FOR T = 1 TO MAXS
20700 PRINT T;"- ";SN$(T)
20720 NEXT T
20740 PRINT "**********  ENTER THE NUMBER THEN PRESS RETURN  ***********"
20760 GOSUB 60000
20762 IF DT# <1 OR DT#> MAXS GOTO 20760
20770 S = DT#
20780 GOSUB 26500
20800 GOTO 20120
20820 REM ************  NEW TRANSFER ENTRY  *************
20840 GOSUB 500
20860 PRINT "****************  NEW TRANSFER DATA ENTRY  ****************"
20880 PRINT ""
20900 PRINT "*****  WHAT NUMBER IS THIS DATA TRANSFER OPTION  *****"
20920 FOR T = 1 TO MAXS
20940 PRINT T;"-";SN$(T)
20960 NEXT T
20980 PRINT " ------ ENTER A NUMBER FROM 1 TO ";MAXS+1;" ------"
21000 PRINT "*********  ENTER ZERO TO RETURN TO FIRST MENU  ********"
21020 GOSUB 60000
21022 IF DT# <0 OR DT#> MAXS +1 GOTO 21020
21026 IF DT# = 0 GOTO 20000
21030 S = DT#
21040 IF S > MAXS +1 THEN GOTO 20840
21060 IF S > MAXS THEN MAXS = S
21080 PRINT "****  WHAT NAME DO YOU WANT TO GIVE THIS TRANSFER  ****"
21090 MAX = 40
21100 GOSUB 62030
21110 SN$(S) = A$
21120 GOSUB 500
21130 PRINT "*************  WHICH FILE IS THE SOURCE FILE  *************"
21140 FOR T = 1 TO MAXF
21160 PRINT T;"-";F$(T)
21180 NEXT T
21200 PRINT "*****  ENTER THE SOURCE FILE NUMBER THEN PRESS RETURN  *****"
21210 GOSUB 60000
21212 IF DT# <1 OR DT#> MAXF GOTO 21210
21215 SFN(S) = DT#
21220 SFN = SFN(S)
21230 DY(SFN) = NREC(SFN)
21240 PRINT "*********  DIRECT DATA TRANSFER OPTION  **********"
21260 PRINT "             1 - TRANSFER"
21280 PRINT "             2 - NO TRNASFER"
21290 PRINT "******  ENTER THE NUMBER THEN PRESS RETURN  ******"
21300 GOSUB 60000
21302 IF DT# <1 OR DT#> 2  GOTO 21300
21310 DTOPT(S) = DT#
21320 IF DTOPT(S) = 2 GOTO 22040
21340 GOSUB 500
21350 PRINT "***************  WHICH FILE IS THE TARGET FILE  *************"
21360 FOR T = 1 TO MAXF
21380 PRINT T;"-";F$(T)
21400 NEXT T
21410 PRINT "******  ENTER THE TARGET FILE NUMBER THEN PRESS RETURN  ******"
21420 GOSUB 60000
21422 IF DT# <1 OR DT#> MAXF GOTO 21420
21430 TFN(S) = DT#
21440 TFN = TFN(S)
21460 GOSUB 500
21480 PRINT "************  RECORD NUMBERING FOR TARGET OPTION  ************"
21500 PRINT "    0 - EQUALS SOURCE FILE NUMBER "
21510 PRINT "    Record Number of target is = to the value of source field :"
21520 FOR T = 1 TO NREC(SFN)
21540 PRINT "   ";T;"-";FLDN$(SFN,T)
21560 NEXT T
21580 PRINT "***************  ENTER NUMBER THEN PRESS RETURN  **************"
21590 GOSUB 60000
21592 IF DT# <0 OR DT#> NREC(SFN) GOTO 21590
21594 IF FTY(SFN,DT#) = 1 GOTO 21590
21600 RNTNBOPT(S) = DT#
21620 D = 1
21640 FOR N = 1 TO NREC(TFN)
21660 GOSUB 500
21680 PRINT "FIELD #";N;" ";FLDN$(TFN,N)
21700 PRINT "*************  FIELD TARGET CHANGE  *************"
21720 PRINT "     1 -DO NOT CHANGE "
21730 PRINT "     Change with source field :"
21740 FOR T = 1 TO NREC(SFN)
21760 PRINT "    ";T+1;"-";FLDN$(SFN,T)
21780 NEXT T
21800 PRINT "*****  ENTER THE NUMBER THEN PRESS RETURN  ******"
21810 T4 = NREC(SFN) + 1
21820 GOSUB 60000
21822 IF DT# <1 OR DT#> T4  GOTO 21820
21823 IF DT# = 1 GOTO 21830
21824 T2 = DT#
21827 IF FTY(SFN,T2-1) >< FTY(TFN,N) GOTO 21820
21830 FLDTC(S,N,D) = DT#
21840 IF FLDTC(S,N,D) = 1 GOTO 21980
21860 PRINT "******************  TYPE OF CHANGE  *****************"
21880 PRINT "      1 - ADD       -source field and target field"
21900 PRINT "      2 - REPLACE   -target field equals source field"
21920 PRINT "      3 - SUBTRACT  -target field minus source field"
21940 PRINT "*******  ENTER THE NUMBER THEN PRESS RETURN  ********"
21950 GOSUB 60000
21952 IF DT# <1 OR DT#> 3 GOTO 21950
21954 IF FTY(TFN,N) = 1 AND DT# >< 2 GOTO 21950
21960 FLDTCT(S,N,D) = DT#
21980 NEXT N
22000 IF D = 2 GOTO 22040
22020 GOSUB 500
22040 REM ******** SUM OPTION *******
22080 PRINT "**********  SUM ACCORDING TO FIELD OPTION  ***********"
22100 PRINT "                 1 - SUM"
22120 PRINT "                 2 - DO NOT SUM"
22130 PRINT "********  ENTER THE NUMBER THEN PRESS RETURN  ********"
22140 GOSUB 60000
22142 IF DT# <1 OR DT#> 2 GOTO 22140
22150 SUMOPT(S) = DT#
22160 IF SUMOPT(S) = 2 GOTO 22720
22180 GOSUB 500
22200 A = SFN(S)
22220 GOSUB 23400
22240 PRINT "*****  HOW MANY FIELDS DO YOU WANT SUMMED  *****"
22260 PRINT "*****  ENTER THE NUMBER THEN PRESS RETURN  *****"
22280 GOSUB 60000
22282 IF DT# <1 OR DT#> NREC(SFN) GOTO 22280
22290 KTSUM(S) = DT#
22300 FOR K = 1 TO KTSUM(S)
22320 GOSUB 500
22340 GOSUB 23400
22360 PRINT "WHICH FIELD IS THE ";K;"th FIELD YOU WANT SUMED"
22380 GOSUB 60000
22382 IF DT# <1 OR DT#> NREC(SFN) GOTO 22280
22384 IF FTY(SFN,DT#) = 1 GOTO 22280
22390 SUMF(S,K) = DT#
22400 GOSUB 500
22410 PRINT "*******  WHICH FILE DO YOU WANT THIS SUM SENT TO  *******"
22415 PRINT "The file must be the same for all sums."
22420 PRINT ""
22440 FOR N = 1 TO MAXF
22460 PRINT "FILE NUMBER ";N;" FILE NAME ";F$(N)
22480 NEXT N
22500 PRINT ""
22520 PRINT "*******  WHICH FILE DO YOU WANT THIS SUM SENT TO  *******"
22540 GOSUB 60000
22542 IF DT# <1 OR DT#> MAXF GOTO 22540
22545 IF (HLD > 0) AND (DT# <> HLD) GOTO 22540
22547 HLD = DT#
22550 SUMFN(S) = DT#
22560 PRINT "***  WHICH RECORD NUMBER DO YOU WANT THE SUM SENT TO  ***"
22565 GOSUB 60000
22567 IF DT# <1 GOTO 22565
22570 SUMRN(S,K) = DT#
22580 GOSUB 500
22590 PRINT "*******  WHICH FIELD DO YOU WANT THIS SUM SENT TO  ********"
22600 SFN = SFN(S)
22620 FOR P = 1 TO NREC(HLD)
22640 PRINT "FIELD #";P;FLDN$(HLD,P)
22660 NEXT P
22680 PRINT "*****  WHICH FIELD NUMBER DO YOU WANT THE SUM SENT TO  *****"
22685 GOSUB 60000
22687 IF DT# <1 OR DT#> NREC(HLD) GOTO 22685
22688 IF FTY(HLD,DT#) = 1 GOTO 22685
22690 SUMFLDN(S,K) = DT#
22700 NEXT K
22720 REM *********  SUM ACCORDING TO ANOTHER FIELD OPTION  **********
22740 GOSUB 500
22760 PRINT "*******  SUM WITH SUBTOTALS BY ANOTHER FIELD  ******"
22780 PRINT "              1 - SUM"
22800 PRINT "              2 - DO NOT SUM"
22810 PRINT "********  ENTER THE NUMBER THEN PRESS RETURN  ******"
22815 GOSUB 60000
22816 IF DT# <1 OR DT#> 2  GOTO 22815
22820 SUMAFOPT(S) = DT#
22840 IF SUMAFOPT(S) = 2 THEN GOTO 23380
22860 FOR T = 1 TO NREC(SFN)
22880 PRINT T;"-";FLDN$(SFN,T)
22900 NEXT T
22910 PRINT "******  NUMBER OF FIELDS YOU WANT ADDED  ******"
22920 GOSUB 60000
22922 IF DT# <1 OR DT#> NREC(SFN) GOTO 22920
22930 KTSUMAF(S) = DT#
22940 FOR K = 1 TO KTSUMAF(S)
22960 GOSUB 500
22980 SFN = SFN(S)
23000 PRINT ""
23020 FOR N = 1 TO NREC(SFN)
23040 PRINT "FIELD # ";N;" ";FLDN$(SFN,N)
23060 NEXT N
23080 PRINT ""
23100 PRINT "**************  WHAT FIELD DO YOU WANT SUMMED  ****************"
23105 GOSUB 60000
23107 IF DT# <1 OR DT#> NREC(SFN) GOTO 23105
23108 IF FTY(SFN,DT#) = 1 GOTO 23105
23110 SAFADD(S,K) = DT#
23120 PRINT "****  WHAT FIELD DO YOU WANT THE SUBTOTALS GROUPED BY  ******"
23125 GOSUB 60000
23127 IF DT#< 1 OR DT# >NREC(SFN) GOTO 23125
23128 IF FTY(SFN,DT#) >< 2 GOTO 23125
23130 SAFACCTO(S,K) = DT#
23140 GOSUB 500
23160 PRINT ""
23180 FOR A = 1 TO MAXF
23200 PRINT "FILE # ";A;" ";F$(A)
23220 NEXT A
23240 PRINT ""
23260 PRINT "***********  WHAT FILE DO YOU WANT THE SUM IN  *********"
23265 GOSUB 60000
23267 IF DT#< 1 OR DT# >MAXF  GOTO 23265
23268 IF HLD > 0 AND DT# >< HLD GOTO 23265
23269 HLD = DT#
23270 SAFFN(S) = DT#
23280 A = SAFFN(S)
23300 GOSUB 23400
23320 PRINT "***********  WHAT FIELD DO YOU WANT THE SUM IN  *********"
23325 GOSUB 60000
23327 IF DT#< 1 OR DT# >NREC(A) GOTO 23325
23328 IF FTY(A,DT#) = 1 GOTO 23325
23330 SAFFLDN(S,K) = DT#
23360 NEXT K
23380 RETURN
23400 PRINT "-------------------------------------------------------------------------------"
23420 PRINT "FILE NUMBER : ";A
23440 PRINT "FILE NAME : "; F$(A)
23460 PRINT "NUMBER OF FIELDS : ";NREC(A)
23480 PRINT "RECORD LENGTH : ";L(A)
23500 FOR N = 1 TO NREC(A)
23520 PRINT  N ;TAB(5);FLDN$(A,N);
23540 ON FTY(A,N) GOTO 23560,23600,23640,23680,23690
23560 PRINT "  STRING WITH MAXIMUM LENGTH ";FL(A,N)
23580 GOTO 23700
23600 PRINT "  INTEGER "
23620 GOTO 23700
23640 PRINT "  SINGLE PRECISION "
23660 GOTO 23700
23680 PRINT "  DOUBLE PRECISION "
23685 GOTO 23700
23690 PRINT "  DOLLAR AND CENTS AMOUNT "
23700 REM ***
23720 NEXT N
23740 PRINT "-------------------------------------------------------------------------------"
23760 RETURN
23780 REM *************  READ SUBROUTINE  *************
23800 OPEN "I",#1,"FFILE"
23820 INPUT #1,MAXF
23840 FOR A = 1 TO MAXF
23860 INPUT #1,A,F$(A),NREC(A),L(A)
23880 FOR N = 1 TO NREC(A)
23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
23920 IF FTY(A,N) = 2 THEN INPUT #1,D,D
23940 NEXT N
23960 NEXT A
23980 CLOSE #1
24000 RETURN
24020 REM ************  OPEN FOR OUTPUT  **************
24040 OPEN "O",#2,"TFER"
24060 WRITE #2,MAXS
24080 FOR S = 1 TO MAXS
24100 D = 1
24120 WRITE #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
24140 IF DTOPT(S) = 2 GOTO 24360
24160 WRITE #2,RNTNBOPT(S),D(S),TFN(S),NREC(TFN)
24180 TFN = TFN(S)
24200 FOR N = 1 TO NREC(TFN)
24220 WRITE #2,FLDTC(S,N,D)
24240 IF FLDTC(S,N,D) = 1 GOTO 24280
24260 WRITE #2,FLDTCT(S,N,D)
24280 NEXT N
24300 IF D = 2 GOTO 24360
24320 IF D(S) = 2 THEN D = 2
24340 IF D(S) = 2 GOTO 24200
24360 IF SUMOPT(S) = 2 GOTO 24460
24380 WRITE #2,KTSUM(S),SUMFN(S)
24400 FOR K = 1 TO KTSUM(S)
24420 WRITE #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K)
24440 NEXT K
24460 IF SUMAFOPT(S) = 2 GOTO 24560
24480 WRITE #2, KTSUMAF(S),SAFFN(S)
24500 FOR K = 1 TO KTSUMAF(S)
24520 WRITE #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),MAX(S,K)
24540 NEXT K
24560 NEXT S
24580 CLOSE #2
24600 RETURN
24620 REM ************  OPEN FOR INPUT  **************
24640 OPEN "I",#2,"TFER"
24660 INPUT #2,MAXS
24680 FOR S = 1 TO MAXS
24700 D = 1
24720 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S)
24740 IF DTOPT(S) = 2 GOTO 24960
24760 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S)
24780 TFN = TFN(S)
24800 FOR N = 1 TO DY(S)
24820 INPUT #2,FLDTC(S,N,D)
24840 IF FLDTC(S,N,D) = 1 GOTO 24880
24860 INPUT #2,FLDTCT(S,N,D)
24880 NEXT N
24900 IF D = 2 GOTO 24960
24920 IF D(S) = 2 THEN D = 2
24940 IF D(S) = 2 GOTO 24800
24960 IF SUMOPT(S) = 2 GOTO 25060
24980 INPUT #2,KTSUM(S),SUMFN(S)
25000 FOR K = 1 TO KTSUM(S)
25020 INPUT #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K)
25040 NEXT K
25060 IF SUMAFOPT(S) = 2 GOTO 25160
25080 INPUT #2, KTSUMAF(S),SAFFN(S)
25100 FOR K = 1 TO KTSUMAF(S)
25120 INPUT #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),MAX(S,K)
25140 NEXT K
25160 NEXT S
25180 CLOSE #2
25200 RETURN
25220 REM ************ PRINT OUT INF0 **************
25240 PRINT "NUMBER OF DIFFERENT TRANSFER: ";MAXS
25260 PRINT "TRANSFER NUMBER: ";S
25280 PRINT "TRANSFER NAME : ";SN$(S)
25300 PRINT "SOURCE FILE NUMBER :";SFN(S);"   ";F$(SFN(S))
25320 PRINT "THIS TRANSFER CONTAINS :"
25340 IF DTOPT(S) = 1 THEN PRINT "--DIRECT TRANSFER "
25360 IF DTOPT(S) = 2 THEN PRINT "--NO DIRECT TRANSFER "
25380 IF SUMOPT(S) = 1 THEN PRINT "--SUM FIELDS"
25400 IF SUMOPT(S) = 2 THEN PRINT "--DO NOT SUM FIELDS"
25420 IF SUMAFOPT(S) = 1 THEN PRINT "--SUM ACCORDING TO ANOTHER FIELD "
25440 IF SUMAFOPT(S) = 2 THEN PRINT "--DO NOT SUM ACCORDING TO ANOTHER FIELD "
25460 IF DTOPT(S) = 2 GOTO 25900
25480 SFN = SFN(S)
25500 PRINT "******  DIRECT TRANSFER  ******"
25520 PRINT "TARGET RECORD NUMBER ";
25540 IF RNTNBOPT(S) = 0 THEN GOTO 25620
25560 T1 = RNTNBOPT(S)
25580 PRINT "= SOURCE FILE FIELD ";RNTNBOPT(S);"- ";FLDN$(SFN,T1)
25600 GOTO 25640
25620 PRINT "AUTOMATICALLY INCREMENTS "
25640 PRINT "TARGET FILE NUMBER :";TFN(S);"  ";F$(TFN(S))
25660 TFN = TFN(S)
25680 FOR N = 1 TO DY(S)
25700 PRINT "FIELD ";N;"-";
25720 IF FLDTC(S,N,1) = 1 THEN PRINT "- NO CHANGE"
25740 IF FLDTC(S,N,1) = 1 GOTO 25880
25760 T1 = FLDTC(S,N,1)-1
25780 IF FLDTC(S,N,1) = 1 GOTO 25880
25800 PRINT "- CHANGED BY SOURCE FIELD ";T1;"- ";FLDN$(SFN,T1);
25820 IF FLDTCT(S,N,1) = 1 THEN PRINT " - ADDED TO "
25840 IF FLDTCT(S,N,1) = 2 THEN PRINT " - REPLACED BY"
25860 IF FLDTCT(S,N,1) = 3 THEN PRINT " - SUBTRACT FROM "
25880 NEXT N
25900 IF SUMOPT(S) = 2 GOTO 26140
25920 PRINT "*******  SUM FIELDS  *******"
25940 PRINT "NUMBER OF SUMS ";KTSUM(S)
25960 PRINT "ALL SUMS GO TO THIS FILE ";SUMFN(S);" ";F$(SUMFN(S))
25980 TFN = SUMFN(S)
26000 FOR K = 1 TO KTSUM(S)
26020 PRINT "******  SUM NUMBER ";K;" *******"
26040 PRINT " FIELD SUMMED = ";SUMF(S,K);FLDN$(SFN,T1)
26060 PRINT " RECORD WHERE SUM GOES ";SUMRN(S,K)
26080 T1 = SUMFLDN(S,K)
26100 PRINT " FIELD WHERE SUM GOES ";SUMFLDN(S,K);" ";FLDN$(TFN,T1)
26120 NEXT K
26140 IF SUMAFOPT(S) = 2 GOTO 26460
26160 PRINT "*******  SUM FIELDS ACCORDING TO ANOTHER FIELD  *******"
26180 PRINT "NUMBER OF SUMS BY ANOTHER FIELD  ";KTSUMAF(S)
26200 T1 = SAFFN(S)
26220 PRINT "ALL SUMS GO TO THIS FILE ";SAFFN(S);F$(T1)
26240 TFN = SAFFN(S)
26260 FOR K = 1 TO KTSUMAF(S)
26280 PRINT "******  SUMS NUMBER ";K;" *******"
26300 T1 = SAFADD(S,K)
26320 PRINT "SUM THIS FIELD ";SAFADD(S,K);" ";FLDN$(SFN,T1)
26340 T1 = SAFACCTO(S,K)
26360 PRINT "BY THIS FIELD  ";SAFACCTO(S,K);" ";FLDN$(SFN,T1)
26380 T1 = SAFFLDN(S,K)
26400 PRINT "SUM GOES TO THIS FIELD ";SAFFLDN(S,K);" ";FLDN$(TFN,T1)
26440 NEXT K
26460 REM ***
26480 RETURN
26500 REM ************ PRINT OUT INF0 **************
26520 LPRINT "NUMBER OF DIFFERENT TRANSFER: ";MAXS
26540 LPRINT "TRANSFER NUMBER: ";S
26560 LPRINT "TRANSFER NAME : ";SN$(S)
26580 LPRINT "SOURCE FILE NUMBER :";SFN(S);"   ";F$(SFN(S))
26600 LPRINT "THIS TRANSFER CONTAINS :"
26620 IF DTOPT(S) = 1 THEN LPRINT "--DIRECT TRANSFER "
26640 IF DTOPT(S) = 2 THEN LPRINT "--NO DIRECT TRANSFER "
26660 IF SUMOPT(S) = 1 THEN LPRINT "--SUM FIELDS"
26680 IF SUMOPT(S) = 2 THEN LPRINT "--DO NOT SUM FIELDS"
26700 IF SUMAFOPT(S) = 1 THEN LPRINT "--SUM ACCORDING TO ANOTHER FIELD "
26720 IF SUMAFOPT(S) = 2 THEN LPRINT "--DO NOT SUM ACCORDING TO ANOTHER FIELD "
26740 IF DTOPT(S) = 2 GOTO 27180
26760 SFN = SFN(S)
26780 LPRINT "******  DIRECT TRANSFER  ******"
26800 LPRINT "TARGET RECORD NUMBER ";
26820 IF RNTNBOPT(S) = 0 THEN GOTO 26900
26840 T1 = RNTNBOPT(S)
26860 LPRINT "= SOURCE FILE FIELD ";RNTNBOPT(S);"- ";FLDN$(SFN,T1)
26880 GOTO 26920
26900 LPRINT "AUTOMATICALLY INCREMENTS "
26920 LPRINT "TARGET FILE NUMBER :";TFN(S);"  ";F$(TFN(S))
26940 TFN = TFN(S)
26960 FOR N = 1 TO DY(S)
26980 LPRINT "FIELD ";N;"-";
27000 IF FLDTC(S,N,1) = 1 THEN LPRINT "- NO CHANGE"
27020 IF FLDTC(S,N,1) = 1 GOTO 27160
27040 T1 = FLDTC(S,N,1)-1
27060 IF FLDTC(S,N,1) = 1 GOTO 27160
27080 LPRINT "- CHANGED BY SOURCE FIELD ";T1;"- ";FLDN$(SFN,T1);
27100 IF FLDTCT(S,N,1) = 1 THEN LPRINT " - ADDED TO "
27120 IF FLDTCT(S,N,1) = 2 THEN LPRINT " - REPLACED BY"
27140 IF FLDTCT(S,N,1) = 3 THEN LPRINT " - SUBTRACT FROM "
27160 NEXT N
27180 IF SUMOPT(S) = 2 GOTO 27420
27200 LPRINT "*******  SUM FIELDS  *******"
27220 LPRINT "NUMBER OF SUMS ";KTSUM(S)
27240 LPRINT "ALL SUMS GO TO THIS FILE ";SUMFN(S);" ";F$(SUMFN(S))
27260 TFN = SUMFN(S)
27280 FOR K = 1 TO KTSUM(S)
27300 LPRINT "******  SUM NUMBER ";K;" *******"
27320 LPRINT " FIELD SUMMED = ";SUMF(S,K);FLDN$(SFN,T1)
27340 LPRINT " RECORD WHERE SUM GOES ";SUMRN(S,K)
27360 T1 = SUMFLDN(S,K)
27380 LPRINT " FIELD WHERE SUM GOES ";SUMFLDN(S,K);" ";FLDN$(TFN,T1)
27400 NEXT K
27420 IF SUMAFOPT(S) = 2 GOTO 27740
27440 LPRINT "*******  SUM FIELDS ACCORDING TO ANOTHER FIELD  *******"
27460 LPRINT "NUMBER OF SUMS BY ANOTHER FIELD  ";KTSUMAF(S)
27480 T1 = SAFFN(S)
27500 LPRINT "ALL SUMS GO TO THIS FILE ";SAFFN(S);F$(T1)
27520 TFN = SAFFN(S)
27540 FOR K = 1 TO KTSUMAF(S)
27560 LPRINT "******  SUMS NUMBER ";K;" *******"
27580 T1 = SAFADD(S,K)
27600 LPRINT "SUM THIS FIELD ";SAFADD(S,K);" ";FLDN$(SFN,T1)
27620 T1 = SAFACCTO(S,K)
27640 LPRINT "BY THIS FIELD  ";SAFACCTO(S,K);" ";FLDN$(SFN,T1)
27660 T1 = SAFFLDN(S,K)
27680 LPRINT "SUM GOES TO THIS FIELD ";SAFFLDN(S,K);" ";FLDN$(TFN,T1)
27720 NEXT K
27740 REM ***
27760 RETURN
50000 REM **********  INTRO
50010 GOSUB 500
50100 PRINT "  T R A N S F E R    D E S C R I P T I O N     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 ""
50920 GOSUB 23780
50950 PRINT "******************  PRESS ANY KEY TO CONTINUE  *******************";
50960 IF INKEY$ = "" GOTO 50960
50970 RETURN
51000 REM ***** EXIT TO SYSTEM
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT "           Put the DATA DISK in the default disk drive  "
52110 PRINT ""
52120 PRINT "          *****  THEN PRESS ANY KEY TO CONTINUE  *****"
52130 PRINT ""
52140 PRINT "      The  CUSTOM  programS only use the PROGRAM DATA DISK"
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
60000 REM *******  INTEGER LESS THEN 100 CHECK  ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM *******  INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM *******  SINGLE PRECISION  *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM *******  DOUBLE PRECISION  *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM **********  RETURN  **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 PRINT ""
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM *******  INPUT NOT ACCEPTABLE  ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# =  -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 S4$ = INKEY$
61920 C2 =  ASC(S4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM **********  ALPHANUMERIC CHECK  **************
62010 MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ********  MAX SET IN PROGRAM  ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4  GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM **********  RETURN  **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT >  KTMAX  GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
 " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 G