100	! SELEX -- GENERAL-PURPOSE RECORD SELECTION ROUTINE
	! FOR USE WITH WCIS FILES.
120	! 29-NOV-73	J. WARDEN	WABASH COLLEGE
140 K$(1)="<" : K$(2)="=" : K$(3)=">"
160 OPEN "KB:" AS FILE 9%
180 PRINT"SELEX  V01A"
200 PRINT "#"; : INPUT LINE #9%,C$ : C%=ASCII(C$)-10% :
	IF C%*(C%-3%)*(C%-17%)=0% THEN CLOSE 1%,2%,9% : GO TO 2300
220 IF LEFT(C$,3%)="/HE" THEN GOSUB 1560 : GO TO 200
240	C%=ASCII(RIGHT(C$,LEN(C$)))-10% :
	IF C%*(C%-3%)*(C%-17%)=0% THEN C$=LEFT(C$,LEN(C$)-1%) :
	GO TO 240
260 IF LEFT(C$,4%)="/CH:" THEN ON ERROR GO TO 460 :
	CHAIN RIGHT(C$,5%)
280 O%=INSTR(1%,C$,"<") : IF O%=0% THEN 480
300	O$=LEFT(C$,O%-1%) : C$=RIGHT(C$,O%+1%) :
	O%=INSTR(1%,C$,"/") : IF O%=0% THEN 480
320 F$=RIGHT(C$,O%+1%) : I$=LEFT(C$,O%-1%)
340 O%=INSTR(1%,F$,"/M") : IF O%=0% THEN N5%=1%
	ELSE N5%=0% : F$=LEFT(F$,O%-1%)
360 GOSUB 1900
380	IF N5%=9% THEN CLOSE 1% : GO TO 200
400 IF I$=O$ THEN PRINT"** PLEASE USE UNIQUE OUTPUT FILE **" :
	GO TO 200
420 GOSUB 1100
440 GO TO 500
460 RESUME 480
480 PRINT"** COMMAND ERROR **" : GO TO 200
500 ON ERROR GO TO 640
520 OPEN I$ FOR INPUT AS FILE 1%
540 FIELD #1%,N1%*A% AS Z$,N1% AS A$(A%) FOR A%=0% TO N6%
560 OPEN O$ FOR OUTPUT AS FILE 2%
580 FIELD #2%,N1%*B% AS Z$,N1% AS B$(B%) FOR B%=0% TO N6%
600	B%=0%	!!!
620 GO TO 700
640 IF ERR<>5% THEN 680
660 IF ERL=520% THEN PRINT
	"** CAN'T FIND FILE: ";I$;" **" :
	RESUME 200
680 PRINT"** I/O ERROR **" : RESUME 200
700 ON ERROR GO TO 980
720 IF A%<N6% THEN A%=A%+1% ELSE A%=0% : GET #1%
740	IF ASCII(A$(A%))=92% THEN 1000
760	FOR K%=1% TO S%
780 IF S%(K%,1%)=1% THEN 840 ELSE IF S%(K%,1%)=2% THEN 820
800	IF MID(A$(A%),S%(K%,2%),S%(K%,3%))>S$(K%) THEN 880 ELSE 860
820	IF MID(A$(A%),S%(K%,2%),S%(K%,3%))=S$(K%) THEN 880 ELSE 860
840	IF MID(A$(A%),S%(K%,2%),S%(K%,3%))<S$(K%) THEN 880 ELSE 860
860 IF S%(K%,0%)=1% THEN 720 ELSE 900
880 IF S%(K%,0%)=2% THEN 720
900	NEXT K%
920 LSET B$(B%)=A$(A%)
940 IF B%<N6% THEN B%=B%+1% ELSE B%=0% : PUT #2%
960 GO TO 720
980 IF ERR<>11% THEN PRINT "** ";
	SYS(CHR$(6%)+CHR$(9%)+CHR$(ERR));" **" : CLOSE 1% :
	RESUME 200%
1000 FOR H%=B% TO N6%
1020 LSET B$(H%)="\\\\\\"+SPACE$(N2%)+CHR$(13%)+CHR$(10%)
1040 NEXT H%
1060 PUT #2%, COUNT N3%
1080 CLOSE 1%,2% : PRINT : GO TO 200
1100	! === SET UP SELECTION ===
1120 DIM S%(5%,3%),S$(5%)
1140 S%=0%
1160 PRINT "*"; : INPUT LINE #9%,C$
1180	C%=ASCII(RIGHT(C$,LEN(C$)))-10% :
	IF C%*(C%-3%)*(C%-27%)=0% THEN C$=LEFT(C$,LEN(C$)-1%) :
	GO TO 1180
1200 IF LEFT(C$,2%)="OK" THEN RETURN ELSE
	IF LEFT(C$,2%)="EX" THEN PRINT">> STARTING OVER <<" :
	GO TO 1140
1220 S%=S%+1% : IF S%>5% THEN PRINT
	">> MAXIMUM 5 SELECTION CRITERIA <<" :
	& ">> TYPE 'EX' TO START OVER, 'OK' TO BEGIN TRANSFER <<" :
	GO TO 1160
1240 IF LEFT(C$,5%)="KEEP:" THEN C$=RIGHT(C$,6%) :
	S%(S%,0%)=1% : GO TO 1300
1260 IF LEFT(C$,4%)="REJ:" THEN C$=RIGHT(C$,5%) :
	S%(S%,0%)=2% : GO TO 1300
1280 GO TO 1460
1300 FOR K%=1% TO 3%
1320 O%=INSTR(1%,C$,K$(K%)) : IF O% THEN
	F1$=LEFT(C$,O%-1%) : C$=RIGHT(C$,O%+1%) :
	S%(S%,1%)=K% : GO TO 1360
1340 NEXT K% : GO TO 1460
1360 IF LEN(F1$)<>2% THEN 1440
1380	FOR J%=1% TO V2%(1%,0%)
1400	IF V2$(J%)=F1$ THEN S%(S%,2%)=V2%(1%,J%) :
	S%(S%,3%)=V2%(2%,J%) : GO TO 1540
1420	NEXT J% : GO TO 1460
1440 IF LEFT(F1$,1%)="(" THEN IF RIGHT(F1$,LEN(F1$))=")"
	THEN F1$=MID(F1$,2%,LEN(F1$)-2%) : GO TO 1480
1460 PRINT">> RETYPE <<" : S%=S%-1% : GO TO 1160
1480 O%=INSTR(1%,F1$,",") : IF O%=0% THEN 1460
1500 S%(S%,2%)=VAL(LEFT(F1$,O%-1%)) :
	S%(S%,3%)=VAL(RIGHT(F1$,O%+1%))
1520	IF S%(S%,2%)<1% OR S%(S%,2%)>N1% OR S%(S%,3%)>N1%
	THEN 1460
1540 IF LEN(C$)<>S%(S%,3%) THEN 1460 ELSE
	S$(S%)=C$ : GO TO 1160
1560	! === 'HELP' SUBROUTINE ===
1580 PRINT : PRINT"'SELEX' USES THE COMMAND LINE FORMAT:" : &
1600 PRINT"# DEV:OUTPUT < DEV:INPUT /TYP /M" :&
1620 PRINT"	THE CORRECT FILE TYPE MUST BE GIVEN IN THE":
	PRINT"	/TYP SWITCH.  /M PROVIDES AN OPTIONAL LISTING":
	PRINT"	OF THE FILE MNEMONICS." :&
1640 PRINT"IF THE I/O FILE SPECIFICATION IS CORRECT, AN ASTERISK":
	&"IS PRINTED TO SIGNIFY SELECT MODE. ";
	"FOUR COMMANDS ARE AVAILABLE:"
1660 &"	(1) OK		BEGINS TRANSFER" :
	&"	(2) EX		ALLOWS YOU TO START OVER"
1680 &"	(3) KEEP: [FIELD] (OPERATOR) [STRING]" :
	&"	(4) REJ: [FIELD] (OPERATOR) [STRING]"
1700 &"  IN COMMANDS (3) AND (4)," :
	&"	[FIELD] CAN DESCRIBE AN ACTUAL FIELD (7,2)" :
	&"	OR IT CAN BE THE NAME OF A FIELD: NM,CY,ETC."
1720 &"	(OPERATOR) CAN BE:  < , = , OR > ."
1740 &"	[STRING] IS ANY STRING TO BE USED AS A SELECTION" :
	&"	CRITERION.  FOR EXAMPLE:"
1760 &
1780 &"	*KEEP:CY>77" : &"	*KEEP:(6,3)=123" :
     &"	*REJ:SS=S"   : &"	*OK" : &
1800 &"	INTERPRETS AS: SELECT RECORDS WITH '78' OR GREATER IN" :
     &"	THE 'CY' FIELD, SELECT (ALSO) RECORDS WITH '123' IN"
1820 &"	COLUMNS 6-7-8, AND REJECT RECORDS WITH AN 'S' IN THE":
     &"	'SS' FIELD.":&:&
1840 &"ADDITIONAL COMMANDS:" : &"	/HELP  FOR HELP MESSAGE"
1860 &"	/CH:PROG    CHAINS TO 'PROG'." : & : RETURN
1880	! === FILE ATTRIBUTES SUBROUTINE ===
1900 DIM V2$(50),V2%(2,50)
1920 ON ERROR GO TO 2220
1940 OPEN V1$+"$ATRIB" FOR INPUT AS FILE 1%
1960 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1%
1980 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% : R%=R%+1%
2000 IF ASCII(A$(A%))=92% THEN
	PRINT"** INVALID FILE TYPE **" : N5%=9% : RETURN
2020 IF LEFT(A$(A%),3%)<>F$ THEN 1980
2040 V2%(2%,0%),N%=VAL(MID(A$(A%),4%,2%)) :
	N9%=VAL(MID(A$(A%),6%,1%))*2%
2060 N1%=510%/N% : N2%=N1%-8% : N3%=N%*N1% : N6%=N%-1%
2080 FOR V%=1% TO 50%
2100 V2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF V2$(V%)="  " THEN 2180
2120 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%))
2140	V2%(1%,V%)=ASCII(CHR$(V5%)) :
	V2%(2%,V%)=ASCII(CHR$(SWAP%(V5%)))
2160 NEXT V%
2180 V2%(1%,0%)=V%-1% : IF N5% THEN 2200 ELSE
	PRINT"CODES: "; :
	PRINT V2$(I%)+" "; FOR I%=1% TO V%-1% : PRINT
2200 CLOSE 1% : ON ERROR GO TO 0 : RETURN
2220 IF ERR<>5% AND ERR<>21% THEN 2280 ELSE RESUME 2240
2240 READ V1$ : GO TO 1940
2260 DATA DK2:,DK1:,DK0:,DK3:
2280 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" :
	PRINT"IT MUST BE REPLACED TO PROCEED."
2300 END