1 '                     FILE TRANSFER PROGRAM
2 '               Written by Tracy L. Gustafson, M.D.
3 '              Round Rock, Texas. Version 3.0, 1984
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1,1),CS(1,1),T(1),N$(1),X(1),X2(1),MD(1),SD(1),TR(1)
17 D1="What is the name of the DATAFILE you wish to ":D2="Which sample do you want to "
22 DATA "TRANSFERING SAMPLES FROM ONE DATAFILE TO ANOTHER",12,50
30 AF=0:AR=CSRLIN:PRINT TAB(10);D1;"modify?":PRINT TAB(17);"(REPLACE, ADD, or APPEND a sample to) "
35 LOCATE AR,64:INPUT "",FILE1$:EF=1:FILE$=FILE1$
40 ON ERROR GOTO 5020:OPEN FILE1$ FOR INPUT AS #1:INPUT #1,A,C:CC=C
45 PRINT:PRINT D1;:INPUT "retrieve a sample from?  ",FILE2$:EF=2:FILE$=FILE2$
50 OPEN FILE2$ FOR INPUT AS #2:INPUT #2,AZ,CZ:PRINT:AR=CSRLIN
55 PRINT TAB(5);"What is the SAMPLE NUMBER in ";FILE2$;" that you want to retrieve?"
60 SWAP A,AZ:AC=72:GOSUB 315:NZ=NS:SWAP A,AZ
65 FILE$=FILE1$:PRINT:IF AF=1 THEN 95 ELSE PRINT
70 PRINT "Do you want to:  1.)  REPLACE an existing data sample in ";FILE1$
75 PRINT TAB(18);"2.)  ADD this data sample to ";FILE1$;" as sample #";A+1
80 PRINT TAB(18);"3.)  APPEND this sample to an existing sample in ";FILE1$
85 PRINT:PRINT TAB(25);"Enter choice:   ";
90 INPUT "",ASUB:IF ABS(ASUB-2)>1 THEN BEEP:GOTO 90
95 AR=CSRLIN:AC=56:ON ASUB GOTO 100,105,110
100 AT=A:PRINT TAB(17);D2;"replace?";:GOSUB 315:NR=NS:GOTO 115
105 IF A<28 THEN NR=A+1:AT=A+1:GOTO 115 ELSE BEEP:AR=CSRLIN:LOCATE 25,3:PRINT FILE$;" already has the maximum number of samples allowed (28)";:LOCATE AR,1:GOTO 70
110 NR=A+1:AT=A+1:PRINT TAB(15);D2;"append to?";:GOSUB 315:NA=NS
115 PRINT:PRINT:COLOR 23:PRINT TAB(27);"TRANSFERING SAMPLE":COLOR CLR1
120 IF AF=1 THEN 135 ELSE ERASE D,CS,T,N$,X,X2,MD,SD,TR
125 DIM D(AT,2000/AT),CS(AT,2000/AT),T(AT),N$(AT),X(AT),X2(AT),MD(AT),SD(AT),TR(28)
130 GOSUB 4040
135 FOR T=1 TO NZ-1:INPUT #2,TR(T):NEXT
140 INPUT #2,T(NR):FOR T=NZ+1 TO AZ:INPUT #2,TR(T):NEXT
145 FOR T=1 TO NZ-1:FOR Z=1 TO CZ:INPUT #2,DZ:NEXT:NEXT
150 FOR Z=1 TO CZ:INPUT #2,D(NR,Z):NEXT
155 FOR T=NZ+1 TO AZ:FOR Z=1 TO CZ:INPUT #2,DZ:NEXT:NEXT
160 FOR T=1 TO NZ-1:FOR Z=1 TO TR(T):INPUT #2,CSZ:NEXT:NEXT
165 FOR Z=1 TO T(NR):INPUT #2,CS(NR,Z):NEXT
170 FOR T=NZ+1 TO AZ:FOR Z=1 TO TR(T):INPUT #2,CSZ:NEXT:NEXT
175 FOR T=1 TO NZ-1:INPUT #2,NZ$,XZ,X2Z,MDZ,SDZ:NEXT
180 INPUT #2,N$(NR),X(NR),X2(NR),MD(NR),SD(NR):CLOSE #2
185 IF ASUB<3 THEN 235 ELSE AT=T(NA)+1
190 T(NA)=T(NA)+T(NR):X(NA)=X(NA)+X(NR):X2(NA)=X2(NA)+X2(NR)
195 FOR AZ=1 TO T(NR):CC=CC+1:D(NA,CC)=D(NR,AZ):IF D(NA,CC)="" THEN 220 ELSE VC=VAL(D(NA,CC))
200 FOR Z=1 TO AT-1:VX=VAL(D(NA,CS(NA,Z))):IF VX<=VC THEN 210
205 FOR TZ=AT TO Z+1 STEP -1:CS(NA,TZ)=CS(NA,TZ-1):NEXT:GOTO 215
210 NEXT Z
215 CS(NA,Z)=CC:AT=AT+1
220 NEXT AZ:IF CC>CMAX THEN CMAX=CC
225 N=T(NA):MD(NA)=0:IF N>0 THEN IF N MOD 2=0 THEN MD(NA)=(VAL(D(NA,CS(NA,N/2)))+VAL(D(NA,CS(NA,N/2+1))))*.5 ELSE MD(NA)=VAL(D(NA,CS(NA,N/2+.5)))
230 SD(NA)=0:IF N>1 THEN IF X2(NA)>X(NA)*X(NA)/N THEN SD(NA)=SQR((X2(NA)-X(NA)*X(NA)/N)/(N-1))
235 PLAY "MB O3 T200 L16 GF#GF#GF#GF#GF#GF# L10 G.D O2 L7 BGD O1 L6 B L3 G"
240 CLS:PRINT:PRINT TAB(5);"A memory file has been constructed that ";:IF ASUB=3 THEN PRINT "APPENDS "; ELSE PRINT "ADDS ";
245 PRINT "sample";NZ;"FROM ";FILE2$;:IF ASUB=3 THEN PRINT TAB(25);"TO sample";NA;"IN "; ELSE PRINT TAB(18);"TO ";
250 PRINT FILE1$;
255 IF ASUB=1 THEN PRINT "   (REPLACING sample number";NR;")":GOTO 270 ELSE IF ASUB=2 THEN PRINT "   (NEW sample number =";NR;")":GOTO 270
260 PRINT:PRINT:PRINT "   Do you want to APPEND data to another sample in datafile ";FILE1$;:INPUT A$
265 IF A$="y" OR A$="Y" THEN CC=C:AF=1:GOTO 45 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 260
270 PRINT:PRINT TAB(10);"How do you want to SAVE this modified datafile to disk:"
275 PRINT:PRINT TAB(20);"1.)  Under the filename ";FILE1$;"
280 PRINT TAB(20);"2.)  Under a NEW filename."
285 PRINT TAB(20);"3.)  CANCEL file modification.":PRINT
290 PRINT TAB(26);:INPUT "Enter choice:  ",BSUB:AR=CSRLIN:IF ABS(BSUB-2)>1 THEN BEEP:GOTO 290 ELSE IF BSUB=3 THEN 305
295 IF ASUB=3 THEN C=CMAX ELSE A=AT:IF T(NR)>C THEN C=T(NR)
300 IF BSUB=2 THEN AR=CSRLIN:GOSUB 4100 ELSE GOSUB 4110
305 LOCATE 25,15:INPUT;"Do you want to perform another FILE TRANSFER?  ",A$:IF A$="y" OR A$="Y" THEN 20
310 LOCATE 23,1:END
315 LOCATE AR,AC:INPUT;"",NS:IF NS>0 AND NS<=A THEN RETURN ELSE BEEP:LOCATE 25,22:PRINT FILE$;" has only";A;"samples.";:LOCATE AR,AC:PRINT "     ":GOTO 315
5000 BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
5032 IF EF=1 THEN RESUME 30 ELSE IF EF=2 THEN RESUME 45