1 ! TRANSF -- WILL SELECTIVELY TRANSFER ANY NUMBER ! OF FIELDS FROM ANY WCIS FILE TO ANOTHER, RECORD ! BY RECORD. 2 ! AFTER FILES ARE SET UP, A RECORD IS TAKEN FROM THE ! 'XMIT' FILE AND ITS DISPLAY FIELD IS PRINTED; IF THE ! ID CODE OF THE CORRESPONDING RECORD IN THE 'RCV' FILE 3 ! IS ENTERED CORRECTLY, THE PRESELECTED FIELDS ARE ! TRANSFERRED FROM 'XMIT' TO 'RCV'. PROGRAM MAY START ! SEARCH ANYWHERE IN THE XMIT FILE AND MAY BE STOPPED ! AT ANY TIME. 5 ! 02-NOV-74 J. WARDEN WABASH COLLEGE 8 DIM M%(30%) 10 OPEN "KB:" AS FILE 9% 12 PRINT"FIELD TRANSFER PROGRAM" 15 PRINT"FILES (DEV:FILE/TYPE):" 20 Z0$=CHR$(140%)+CHR$(29%)+CHR$(31%) 50 DEF FNA$(X%)=MID(A$(A%),V2%(1%,X%),V2%(2%,X%)) 100 PRINT"XMIT FILE"; : INPUT LINE T$ : T$=LEFT(T$,LEN(T$)-2%) 102 T%=INSTR(1%,T$,"/") : IF T%=0% THEN 110 104 I$=LEFT(T$,T%-1%) : F$=RIGHT(T$,T%+1%) 106 GOSUB 4000 : PRINT : GO TO 120 110 PRINT"** RETYPE PLEASE **" : GO TO 100 120 PRINT"RCV FILE"; : INPUT LINE T$ : T$=LEFT(T$,LEN(T$)-2%) 122 T%=INSTR(1%,T$,"/") : IF T%=0% THEN 130 124 O$=LEFT(T$,T%-1%) : F$=RIGHT(T$,T%+1%) 125 O1$=F$ 126 GOSUB 5000 : GO TO 140 130 PRINT"** RETYPE PLEASE **" : GO TO 120 140 PRINT"FIELDS TO XFER (END WITH 'STOP'):" 150 FOR I%=1% TO 9% 160 PRINT I%;TAB(5%);"FROM>"; : INPUT #9%,F$ : IF F$="STOP" THEN 300 162 PRINT TAB(5%); 165 PRINT"TO >"; : INPUT #9%,T$ : IF T$="STOP" THEN 300 170 FOR J%=1% TO V2%(1%,0%) : IF F$=V2$(J%) THEN 180 172 NEXT J% : PRINT"CODE ";F$;" NOT FOUND" : GO TO 160 180 FOR K%=1% TO W2%(1%,0%) : IF T$=W2$(K%) THEN 190 182 NEXT K% : PRINT"CODE ";T$;" NOT FOUND" : GO TO 160 190 IF V2%(2%,J%)>W2%(2%,K%) THEN 250 200 V2$=RIGHT(V2$(J%),2%) : W2$=RIGHT(W2$(K%),2%) 205 IF (V2$="#" OR V2$="%" OR W2$="#" OR W2$="%") AND V2$<>W2$ THEN 250 220 F%(I%)=J% : T%(I%)=K% : GO TO 280 250 PRINT"** CAN'T DO IT! **" : GO TO 160 280 NEXT I% 300 I%=I%-1% : PRINT : PRINT"TRANSFER SCHEME:" 320 FOR J%=1% TO I% 340 PRINT USING "## \\ -> \\",J%,V2$(F%(J%)),W2$(T%(J%)) 350 NEXT J% 360 INPUT"CORRECT (Y/N)";Y$ : IF ASCII(Y$)<>89% THEN 140 370 PRINT : INPUT"DISPLAY FIELD";D$ : IF LEN(D$)<>2% THEN 370 372 FOR J%=1% TO V2%(1%,0%) : IF V2$(J%)=D$ THEN 380 374 NEXT J% : GO TO 370 380 J2%=J% ! DISPLAY FIELD # 400 ON ERROR GO TO 3000 420 OPEN I$ FOR INPUT AS FILE 1% 430 OPEN O$ FOR INPUT AS FILE 2% : GOSUB 2000 : CLOSE 2% 440 OPEN O$ AS FILE 2% 450 FIELD #1%,N1%*A% AS Z$, N1% AS A$(A%) FOR A%=0% TO N6% 460 FIELD #2%,M1%*B% AS Z$, M1% AS B$(B%) FOR B%=0% TO M6% 480 INPUT"SKIP TO ID (=NO SKIP)";I0$ : IF I0$="" OR LEN(I0$)<>6% THEN 500 485 IF A%6% THEN PRINT : PRINT"** ID MUST BE 6 CHARACTERS - RETYPE **" : SLEEP 2% : GO TO 520 550 ! SCAN FOR ID 555 T%=L0%+1% : C%=1% : L1%=LOG(T%)/LOG(2)+4% 560 FOR I3%=1% TO L1% 565 R%=(T%+C%)/2% 570 R1%=(R%+N6%)/N% : B%=R%-1%-(R1%-1%)*N% : GET #2%, RECORD R1% 575 I2$=LEFT(B$(B%),6%) : IF I2$<>" " THEN 585 580 R%=R%+(-1%)^I3% : IF R%T% OR R%<=0% THEN 600 ELSE 570 585 IF I2$=T$ THEN 700 ELSE IF I2$>T$ THEN 595 590 C%=R% : GO TO 600 595 T%=R% 600 NEXT I3% 605 ON ERROR GO TO 3000 610 R1%=(L0%+N6%)/N% : B%=L0%-1%-(R1%-1%)*N% : IF R1%<1% THEN R1%=1% : B%=0% 615 GET #2%, RECORD R1% : GO TO 625 620 IF B%=0% THEN 2050 2070 T%=T%-1% : IF T%>0% THEN 2030 2080 IF T1%=0% THEN &LOG(0%) ELSE 2120 2090 IF T2%=0% THEN 2060 2100 IF ASCII(RIGHT(B$(B%),M1%-1%))=65% THEN T1%=T1%+1% : GO TO 2060 2110 L0%=(T%-1%)*M%+B%+1% 2120 PRINT Z0$ : PRINT"FILE ";O$;" CONTAINS";L0%;"RECORDS"; : IF T1%=1% THEN &" PLUS 1 CORRECTION" ELSE IF T1% THEN &" PLUS";T1%;"CORRECTIONS" ELSE PRINT 2130 SLEEP 3% 2140 RETURN 3000 IF ERL=2020% OR ERL=2080% THEN PRINT"FILE ";O$;" IS EMPTY" : GO TO 9999 3005 GO TO 9999 3010 IF ERR<>5% THEN 3100 3100 IF ERR<>11% THEN ON ERROR GO TO 0 3110 IF ERL=500% OR ERL=485% THEN RESUME 1100 3999 STOP 4000 DIM V2$(50),V2%(2,50) 4020 ON ERROR GO TO 4320 4030 F$=LEFT(F$,3%) 4040 OPEN V1$+"$ATRIB" FOR INPUT AS FILE 1% 4060 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1% 4080 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% 4100 IF LEFT(A$(A%),3%)="\\\" THEN PRINT"NO SUCH FILE TYPE" : GO TO 9999 4120 IF LEFT(A$(A%),3%)<>F$ THEN 4080 4140 V2%(2%,0%),N%=VAL(MID(A$(A%),4%,2%)) : N9%=VAL(MID(A$(A%),6%,1%))*2% 4160 N1%=510%/N% : N2%=N1%-8% : N3%=N%*N1% : N6%=N%-1% 4180 FOR V%=1% TO 50% 4200 V2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF V2$(V%)=" " THEN 4280 4220 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%)) 4240 V2%(1%,V%)=ASCII(CHR$(V5%)) : V2%(2%,V%)=ASCII(CHR$(SWAP%(V5%))) 4260 NEXT V% 4280 V2%(1%,0%)=V%-1% : IF N5% THEN 4300 ELSE PRINT"CODES: "; : PRINT V2$(I%)+" "; FOR I%=1% TO V%-1% : PRINT 4300 CLOSE 1% : ON ERROR GO TO 0 : RETURN 4320 IF ERR<>5% AND ERR<>21% THEN 4380 ELSE RESUME 4340 4340 IF V1$="" THEN V1$="DK1:" : GO TO 4040 4380 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" : PRINT"IT MUST BE REPLACED TO PROCEED." 4400 GO TO 9999 5000 DIM W2$(50),W2%(2,50) 5020 ON ERROR GO TO 5340 5040 F$=LEFT(F$,3%) 5060 OPEN V1$+"$ATRIB" FOR INPUT AS FILE 1% 5080 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1% 5100 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% 5120 IF LEFT(A$(A%),3%)="\\\" THEN PRINT"NO SUCH FILE TYPE" : GO TO 9999 5140 IF LEFT(A$(A%),3%)<>F$ THEN 5100 5160 W2%(2%,0%),M%=VAL(MID(A$(A%),4%,2%)) : M9%=VAL(MID(A$(A%),6%,1%))*2% 5180 M1%=510%/M% : M2%=M1%-8% : M3%=M%*M1% : M6%=M%-1% 5200 FOR V%=1% TO 50% 5220 W2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF W2$(V%)=" " THEN 5300 5240 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%)) 5260 W2%(1%,V%)=ASCII(CHR$(V5%)) : W2%(2%,V%)=ASCII(CHR$(SWAP%(V5%))) 5280 NEXT V% 5300 W2%(1%,0%)=V%-1% : IF N5% THEN 5320 ELSE PRINT"CODES: "; : PRINT W2$(I%)+" "; FOR I%=1% TO V%-1% : PRINT 5320 CLOSE 1% : ON ERROR GO TO 0 : RETURN 5340 IF ERR<>5% AND ERR<>21% THEN 5380 ELSE RESUME 5360 5360 IF V1$="" THEN V1$="DK1:" : GO TO 5060 5380 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" : PRINT"IT MUST BE REPLACED TO PROCEED." 9999 END