100	! EDITUP -- A RANDOM-ACCESS EDIT PROGRAM FOR
	! STUDENT CLASS SCHEDULES ALLOWING MULTIPLE ENTRY.
105	! COURSES MAY BE ADDED, DELETED, OR CHANGED.
	! C/NC, SC'S, AND GRADES MAY BE CHANGED.
110	! THIS PROGRAM REQUIRES UPDATE!!!
120	! 24-AUG-73	J. WARDEN	WABASH COLLEGE
130 ON ERROR GO TO 790
140 OPEN "KB:" AS FILE 4%
160 G2$="A+A A-B+B B-C+C C-D+D D-F  CR NC IN CO"
180 C8$=CHR$(29%)+CHR$(31%)+CHR$(140%)+CHR$(10%)
200 PRINT C8$;"MULTI-STATION CLI EDIT  V03A"
220 F9$=" \    \  ##.#   \\   \\"
240 B%=0% : S9%=1%
260 N%=4% : N1%=510%/N% : N2%=N1%-8% : N3%=N1%*N% : N6%=N%-1%
280 INPUT"CLASS LIST FILE";F$ :
	OPEN F$ AS FILE 1%, MODE 1%
300 FIELD #1%, N1%*R% AS Z$, N1% AS A$(R%) FOR R%=0% TO N6%
320 CHANGE SYS(CHR$(6%)+CHR$(-8%)+CHR$(1%)) TO S% :
	C0%=(S%(7%)+SWAP%(S%(8%)))*N% :
	S%(I%)=0% FOR I%=0% TO 30%
340 INPUT"OUTPUT LISTINGS TO";O$ :
	IF O$="" OR O$="KB:" THEN O%=0% ELSE
	OPEN O$ FOR OUTPUT AS FILE 3% : O%=3%
360 S7$="DK0:SUBF74"
380 PRINT"USE SUBJECT FILE '"+S7$+"' (Y/N)"; : INPUT N1$ :
	IF ASCII(N1$)=89% THEN 420
400 INPUT"SUBJECT FILE (DEV:FILE)";S7$
420 OPEN S7$ FOR INPUT AS FILE 5%
440 FIELD #5%,127%*X% AS Z$,127% AS S2$(X%) FOR X%=0% TO 3%
460 DIM S$(300)=8%,S%(300)
480 PRINT"* WAIT A MOMENT PLEASE *"
500 IF X%<3% THEN X%=X%+1% ELSE X%=0% : GET #5%
520 IF LEFT(S2$(X%),1%)="\" THEN 600
540 S$(S9%)=LEFT(S2$(X%),6%)+MID(S2$(X%),19%,1%)
560	S%(VAL(MID(S2$(X%),8%,3%)))=S9%
580 S9%=S9%+1% : GO TO 500
600 S9%=S9%-1% : S%(0%)=S9% : CLOSE 5%
620 PRINT S9%;"SUBJECTS ON FILE" : PRINT : SLEEP(2%)
640 PRINT C8$ : PRINT"ID: "; : INPUT LINE #4%,N1$ :
	IF ASCII(N1$)=10% OR ASCII(N1$)=13% THEN 640
660 W3%=0% : Z%=0%
680 Z1%=ASCII(RIGHT(N1$,LEN(N1$))) :
	IF Z1%=0% OR Z1%=10% OR Z1%=13% THEN
	N1$=LEFT(N1$,LEN(N1$)-1%) : GO TO 680
700 IF N1$="S" THEN 1580
720 IF LEN(N1$)=6% THEN 740 ELSE
	PRINT"ID MUST BE 6 CHAR - RETYPE!" : GO TO 640
740 GOSUB 1400 : IF R9%<=0% THEN 640
760 W$=A$(R%) : GOSUB 820
780 GOSUB 1120 : GO TO 640
790 IF ERR<>19% THEN ON ERROR GO TO 0
795 PRINT"* WAIT PLEASE *" : SLEEP 5% : RESUME
800	! 'LOOK' ROUTINE
820 D%=4% : PRINT C8$
840 PRINT #D%,MID(W$,7%,2%)+"  "+MID(W$,13%,28%)
860 IF ASCII(RIGHT(W$,11%))=83% THEN
	PRINT #D%,"    SPECIAL STUDENT"
880 PRINT #D%
900 U%=(INSTR(40%,W$,"     ")-35%)/7% : H,H2=0.
920	FOR I%=1% TO U%
940	C1$=MID(W$,41%+(I%-1%)*7%,7%) : C%=VAL(LEFT(C1$,3%))
960	H%=ASCII(RIGHT(C1$,4%))-48% : IF H%<1% OR H%>3%
	THEN H1=0. ELSE H1=H%
980	H1=H1*0.5 : H=H+H1 : C1%=ASCII(RIGHT(C1$,5%)) :
	IF C1%<>67% THEN H2=H2+H1
1000	PRINT #D%,USING F9$,S$(S%(C%)),H1,CHR$(C1%),
	RIGHT(C1$,6%)
1020	NEXT I% : PRINT #D%
1040	PRINT #D%,"TWD GRAD:";H2;"   TOTAL:";H
1060 PRINT #D%,CHR$(10%)+CHR$(10%)
1070 IF D%=3% THEN D1%=D1%+1% :
	IF D1%>3% THEN D1%=0% : PRINT #D%,CHR$(12%);
1080 D%=4% : RETURN
1100	! INSERT ENTRIES
1120 PRINT">";
1140 INPUT LINE #4%,A1$ : A1%=ASCII(A1$)-10% :
	IF A1%*(A1%-3%)=0% THEN 1120
1160 A1%=ASCII(RIGHT(A1$,LEN(A1$))) :
	IF A1%=0% OR A1%=10% OR A1%=13% THEN
	A1$=LEFT(A1$,LEN(A1$)-1%) :
	GO TO 1160
1180 IF A1$="OK" THEN 1340	! WE'RE DONE
1200 IF A1$="OOPS" OR A1$="EX" THEN
	UNLOCK #1% : GO TO 1380
1220 IF A1$="L:" THEN IF O%=0% THEN A1$="L"
	ELSE D%=3% : GOSUB 840 : GO TO 1120
1240 IF A1$="L" THEN GOSUB 820 : GO TO 1120
1260 A2%=INSTR(5%,A1$,"/D") : IF A2%=0% THEN A2%=43%
	ELSE A1$=LEFT(A1$,A2%-1%)+RIGHT(A1$,A2%+2%) :
	A2%=45%
1280 GOSUB 1640
1300 IF Q1%>0% THEN 1120
1320 Z%=Z%+1% : H$(Z%)=C2$ : L$(Z%)=T$ : GO TO 1120
1340	! WRITEOUT ROUTINE
1360 LSET A$(R%)=W$ : PUT #1%, RECORD R1%
1380 RETURN
1400	! SEARCH FOR ID
1420 M%=C0%+1% : B%=1%
1440	FOR I3%=1% TO 10%
1460	R9%=(M%+B%)/2% : R1%=(R9%+N6%)/N% :
	R%=R9%-1%-(R1%-1%)*N% :
	GET #1%, RECORD R1%
1480	T1$=LEFT(A$(R%),6%)
1500	IF T1$=N1$ THEN 1560 ELSE IF T1$<N1$ THEN B%=R9%
	ELSE M%=R9%
1520 NEXT I3%
1540 PRINT N1$;" NOT FOUND" : SLEEP(2%) : R9%=0% : RETURN
1560 RETURN
1580 CLOSE 1%,2%,3%,4%
1600 PRINT"FILE ";F$;" CLOSED"
1620 GO TO 2720
1640	! DECODING OF SUBJ/CR/SC//GR STRING...
1660 C1$=A1$
1680 P4%=INSTR(5%,C1$,"//") : IF P4%=0% THEN 1780
1700 G$=MID(C1$,P4%+2%,2%) : G%=ASCII(G$)
1720 IF INSTR(1%,G2$,G$)=0% OR G%=43% OR G%=45% THEN 1880
1740 IF G%=32% THEN G$="  "
1760 C1$=LEFT(C1$,P4%-1%)+RIGHT(C1$,P4%+4%)
1780 P1%=INSTR(5%,C1$,"/C") : IF P1% THEN P$="C" :
	C1$=LEFT(C1$,P1%-1%)+RIGHT(C1$,P1%+2%)
1800 P2%=INSTR(5%,C1$,"/G") : IF P2% THEN IF P1%
	THEN 1880 ELSE P$=" " :
	C1$=LEFT(C1$,P2%-1%)+RIGHT(C1$,P2%+2%)
1820 P3%=INSTR(5%,C1$,"/") : IF P3%=0% THEN 1900
1840 H1%=ASCII(RIGHT(C1$,P3%+1%)) : IF H1%<49% OR H1%>51%
	THEN 1880 ELSE H$=CHR$(H1%) :
	C1$=LEFT(C1$,P3%-1%)+RIGHT(C1$,P3%+2%)
1860 GO TO 1900
1880 PRINT"* RETYPE *" : Q1%=2% : RETURN
1900	! SUBJECT SEARCH
1920 C1$=LEFT(C1$+SPACE$(6%),6%)
1940  M%=S9%+1% : B1%=1%
1960 FOR I3%=1% TO 10%
1980   J%=(M%+B1%)/2%
2000   T$=LEFT(S$(J%),6%)
2020	IF T$=C1$ THEN 2080 ELSE
	IF T$<C1$ THEN B1%=J% ELSE M%=J%
2040 NEXT I3%
2060 PRINT"NO SUCH COURSE" : Q1%=2% : RETURN
2080	FOR I%=1% TO 280%	! MUST BE > LGST CODE ##
2100	IF S%(I%)=J% THEN 2140
2120	NEXT I% : GO TO 2060
2140 N$=NUM$(I%) : N$="000"+MID(N$,2%,LEN(N$)-2%)
2160 N$=RIGHT(N$,LEN(N$)-2%)
2180 U2%=0% : H1$=MID(S$(J%),7%,1%)
2200	U%=(INSTR(40%,W$,"     ")-35%)/7% 
2220	IF U%=0% AND A2%=45% THEN PRINT"NO COURSES" :
	RETURN
2240	FOR I%=1% TO U%
2260	J%=41%+(I%-1%)*7%
2280	C1$=MID(W$,J%,3%) : IF C1$=N$ THEN 2360
2300	NEXT I%
2320 IF A2%=45% THEN PRINT"NOT ENROLLED FOR THIS COURSE" :
	RETURN
2340 GO TO 2640
2360 IF A2%=45% THEN 2560
2380	IF P1%+P2%=0% THEN P$=MID(W$,J%+4%,1%)
2400	IF P4%=0% THEN G$=MID(W$,J%+5%,2%)
2420	IF P3%=0% THEN H$=MID(W$,J%+3%,1%)
2440	IF H$=" " THEN H$=H1$
2460 U2%=1%
2480 C1$=C1$+H$+P$+LEFT(G$+"  ",2%)
2500 IF INSTR(1%,C1$,CHR$(10%)) OR INSTR(1%,C1$,CHR$(13%))
	THEN PRINT"** RETYPE **" : RETURN
2520 IF U2% THEN U1%=J% ELSE U1%=41%+(U%-1%)*7%
2540 W$=LEFT(W$,U1%-1%)+C1$+RIGHT(W$,U1%+7%) : RETURN
2560 W$=LEFT(W$,J%-1%)+RIGHT(W$,J%+7%)
2580 U1%=41%+(U%-1%)*7%
2600 W$=LEFT(W$,U1%-1%)+SPACE$(7%)+RIGHT(W$,U1%)
2620 U%=U%-1% : RETURN
2640 C1$=N$ : IF P3%=0% THEN H$=H1$
2660 IF P1%+P2%=0% THEN P$=" "
2680 IF P4%=0% THEN G$="  "
2700 U%=U%+1% : GO TO 2480
2720 END