100	! COMPAC -- SUBJECT CODE COMPACTING ROUTINE
	! FOR USE WITH CLI FILES.  AFTER USE SUBJECT FILE
	! MUST BE RECODED USING 'CODER'.
120	! 04-DEC-73	J. WARDEN	WABASH COLLEGE
140 PRINT"SUBJECT CODE COMPACTING ROUTINE  V01A"
160	DEF FNF$(X%)
180	X$=MID(NUM$(X%),2%,LEN(NUM$(X%))-2%)
200	FNF$=LEFT("000",3%-LEN(X$))+X$
220	IF M9% THEN M8%=9% ELSE M8%=15%
240	FNEND
280 ON ERROR GO TO 920
320 DIM S%(600%)
340 INPUT"SUBJECT FILE";F5$
360 OPEN F5$ FOR INPUT AS FILE 1% :
	FIELD #1%,127%*V% AS Z$, 127% AS V$(V%) FOR V%=0% TO 3%
380 I%=1%
400 IF V%<3% THEN V%=V%+1% ELSE V%=0% : GET #1%
420	IF LEFT(V$(V%),1%)="\" THEN 460
440	S%(VAL(MID(V$(V%),8%,3%)))=I% : I%=I%+1% :
	GO TO 400
460 S%(0%)=I%-1%
480 INPUT"CLASS LIST FILE";F$
500 OPEN F$ FOR INPUT AS FILE 3%
520 FIELD #3%,127%*A% AS Z$,127% AS A$(A%) FOR A%=0% TO 3%
540 INPUT"OUTPUT TO (DEV:FILE)";O$ :
	IF O$="" THEN O$="KB:"
560 OPEN O$ FOR OUTPUT AS FILE 4%
580 FIELD #4%,127%*B% AS Z$, 127% AS B$(B%) FOR B%=0% TO 3%
600	B%=0%	!!!
620	! MAIN LOOP
640 IF A%<3% THEN A%=A%+1% ELSE A%=0% : GET #3%
660 IF LEFT(A$(A%),1%)="\" THEN 1040
680	R%=R%+1%
690	I%=0%
700 T0$=A$(A%)
720 U%=(INSTR(40%,A$(A%),"     ")-35%)/7%	! NO. COURSES
740 FOR I%=1% TO U%
760 T0%=41%+(I%-1%)*7%
780 C1$=MID(A$(A%),41%+(I%-1%)*7%,7%)
800 C%=VAL(LEFT(C1$,3))
820 T0$=LEFT(T0$,T0%-1%)+FNF$(S%(C%))+RIGHT(T0$,T0%+3%)
840 NEXT I%
860 LSET B$(B%)=T0$
880 IF B%<3% THEN B%=B%+1% ELSE B%=0% : PUT #4%
900 GO TO 620
920 IF ERR=11% THEN 1040 ELSE IF ERR=5% THEN 960
940 IF ERR<>52% OR I%<>0% THEN ON ERROR GO TO 0
	ELSE PRINT"BAD RECORD: ";LEFT(A$(A%),40%) :
	P1$="  " : RESUME 700
980	IF ERL=360% THEN
	PRINT"** CAN'T FIND ";F5$;" **" : RESUME 340
1000	IF ERL=500% THEN
	PRINT"** CAN'T FIND ";F$;" **" : RESUME 480
1020 ON ERROR GO TO 0
1040 LSET B$(B%)="\\\\\\"+SPACE$(119%)+CHR$(13%)+CHR$(10%)
	FOR B%=B% TO 3%
1060 PUT #4% : CLOSE 1%,2%,3%,4%
1070 PRINT R%;"ENTRIES RECODED":
	&"DON'T FORGET TO RECODE SUBJECT FILE!"
1080 END