1	! FIELD -- FIELD TRANSFER PROGRAM
	! FILES MUST MATCH
80 PRINT"FIELD TRANSFER PROGRAM" : PRINT
90 INPUT"INSTRUCTIONS (Y/N)";Y$ : IF ASCII(Y$)<>89% THEN 140
100 PRINT"THIS PROGRAM WILL EXTRACT A SPECIFIED FIELD FROM THE"
105 PRINT"TRANSFER FILE, PLACE IT IN A GIVEN POSITION WITHIN THE"
110 PRINT"INPUT FILE, AND COPY THE RESULT TO THE OUTPUT FILE." : PRINT
112 PRINT"YOU MUST SPECIFY THE NAMES OF THE INPUT, OUTPUT, AND"
115 PRINT"TRANSFER FILES.  NEXT, YOU SHOULD"
120 PRINT"SPECIFY THE FIELD LENGTH (SAME FOR BOTH FILES) AND"
125 PRINT"(A) THE STARTING COL OF THE FIELD IN THE INPUT FILE"
130 PRINT"(B) THE COL WHERE THE FIELD IS TO BE PLACED IN THE";
	" OUTPUT FILE."
132 PRINT : PRINT"THE FILES M U S T MATCH!"
135 PRINT : PRINT
140 N5%=1% : GOSUB 4000
180 ON ERROR GO TO 300
200 INPUT"INPUT FILE (DEV:FILE)";F1$
210 INPUT"TRANSFER FILE (DEV:FILE)";F3$
220 INPUT"OUTPUT FILE (DEV:FILE)";F2$
240 OPEN F1$ FOR INPUT AS FILE 1%
250 FIELD #1%,N1%*R% AS Z$,N1% AS A$(R%) FOR R%=0% TO N6%
255 OPEN F3$ FOR INPUT AS FILE 3%
257 FIELD #3%,N1%*C% AS Z$,N1% AS C$(C%) FOR C%=0% TO N6%
260 OPEN F2$ FOR OUTPUT AS FILE 2%
270 FIELD #2%,N1%*S% AS Z$,N1% AS B$(S%) FOR S%=0% TO N6%
275 S%=0%
280 INPUT" FIELD LENGTH";L%
281 IF L%<1% THEN PRINT"** RETYPE **" : GO TO 280
282 IF L%>N1%-2% THEN PRINT"** FIELD TOO LONG **" : GO TO 280
285 INPUT" STARTING COL IN INPUT FILE";S1%
286 IF S1%<1% OR S1%>N1%-2% THEN PRINT"** THAT DOESN'T MAKE SENSE";
	" **" : GO TO 285
290 INPUT" STARTING COL IN OUTPUT FILE";S2%
291 IF S2%<1% OR S2%>N1%-2% THEN PRINT"** THAT DOESN'T MAKE SENSE";
	" **" : GO TO 290
295 GO TO 390
300 IF ERR<>5% THEN ON ERROR GO TO 0
340 PRINT CHR$(7%)+"** CAN'T FIND "+F1$+" **" : RESUME 360
360 INPUT"INPUT FILE (DEV:FILE)";F1$
	! TRY FOR INPUT FILE AGAIN
380 GO TO 240
390 ON ERROR GO TO 900
400 IF R%<N6% THEN R%=R%+1% ELSE R%=0% : GET #1%
420 IF LEFT(A$(R%),1%)="\" THEN 1000	! END-OF-FILE?
430 IF C%<N6% THEN C%=C%+1% ELSE C%=0% : GET #3%
440 IF LEFT(C$(C%),1%)="\" THEN 1000
450 IF LEFT(C$(C%),6%)<>LEFT(A$(R%),6%) THEN
	PRINT"** SORRY, FILES DO NOT MATCH - TRANSFER HALTED **" :
	CLOSE 1%,2%,3% : KILL F2$ : GO TO 9999
480	! - - - - - - - - - - - - -
490 LSET B$(S%)=LEFT(A$(R%),S2%-1%)+MID(C$(C%),S1%,L%)+
	RIGHT(A$(R%),S2%+L%)
500 IF S%<N6% THEN S%=S%+1% ELSE S%=0% : PUT #2%,COUNT N3%
520 GO TO 400
900 IF ERR<>11% THEN ON ERROR GO TO 0
1000 FOR H%=S% TO N6%
1100 LSET B$(H%)="\\\\\\"+SPACE$(N2%)+CHR$(13%)+CHR$(10%)
1200 NEXT H%
1250 PUT #2%, COUNT N3%
1300 CLOSE 1%,2%,3%
1400 GO TO 9999
4000 DIM V2$(50),V2%(2,50)
4020 ON ERROR GO TO 4320
4030 INPUT"FILE TYPE";F$ : 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% : R%=R%+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 READ V1$ : GO TO 4040
4360 DATA DK2:,DK1:,DK0:,DK3:
4380 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" :
	PRINT"IT MUST BE REPLACED TO PROCEED."
9999 END