100 ! LABELA -- LABELS FOR ADMISSIONS FILE ! NAME, ADDRESS, CITY, STATE, ZIP 120 ! EITHER A STANDARD OR A CUSTOM SELECTION MAY BE USED 140 ! 13-DEC-73 J. WARDEN WABASH COLLEGE 160 DEF FNF$(U1%)=MID(NUM$(U1%),2%,LEN(NUM$(U1%))-2%) 180 DIM B$(50),P$(63) 190 N0$="MC DE MAC VAN " 200 PRINT CHR$(29%)+CHR$(31%)+CHR$(140%) 220 PRINT"ADDRESS LABELS FROM ADMISSIONS FILE" 240 N5%=1% : GOSUB 2020 260 GOSUB 1520 280 READ M$(I%) FOR I%=1% TO 4% 300 DATA " JR"," III"," II"," IV" 320 INPUT"OUTPUT TO";F2$ : IF F2$="" THEN F2$="KB:" 340 OPEN F2$ FOR OUTPUT AS FILE 2 360 ON ERROR GO TO 400 380 GO TO 440 400 IF ERR<>5% THEN ON ERROR GO TO 0 420 IF ERL=480% THEN PRINT "** CAN'T FIND ";F$;" **" : RESUME 440 430 IF ERL=1840% THEN PRINT "** CAN'T FIND SORT INDEX FILE **" : CLOSE 1%,2% : GO TO 9999 440 INPUT"INPUT FILE (DEV:FILE)";F$ 480 OPEN F$ FOR INPUT AS FILE 1 500 INPUT"ALPHA ORDER (Y/N)";P$ : IF ASCII(P$)<>89% THEN GOSUB 1840 520 FIELD #1%,N1%*A% AS Z$, N1% AS A$(A%) FOR A%=0% TO N6% 530 IF P0% THEN 660 540 PRINT" SKIP PAST ID ([R] FOR NOSKIP)";:INPUT LINE I5$ 580 I5$=LEFT(I5$,6%) : IF LEN(I5$)<>6% THEN 660 600 IF A% I5$ THEN 680 ELSE 600 640 IF P0% THEN GOSUB 1900 : GO TO 680 660 IF A%" " THEN 640 ELSE 880 ! DEP WHO HAVE NOT CANC 740 ! -- DATE SELECTION -- 760 ! DATE SELECTION 780 IF MID(A$(A%),189%,1%)<>" " THEN 660 800 D1$=MID(A$(A%),109%,6%) : D1$=RIGHT(D1$,5%)+LEFT(D1$,4%) ! D2: YR,MO,DAY 820 IF D1$=SPACE$(6%) THEN 660 840 IF D1$>D2$ THEN 660 ! IF D2 LATER THEN DATE GIVEN REJECT 860 ! - - - - -- - - - - - - - ! CUSTOM SELECT LINE: ! IF MID(A$(A%),X,Y) [NOT WANTED] THEN 640 ! - - - - - - - - - - - - - 880 FOR U%=1% TO 4% 900 B$(U%)=MID(A$(A%),V2%(1%,U%),V2%(2%,U%)) 920 NEXT U% 940 B$(4)=LEFT(B$(4),2%)+" "+RIGHT(B$(4),3%) 960 GOSUB 1200 980 PRINT #2,N$ 1000 PRINT #2,B$(2%) 1020 PRINT #2,B$(3)+" "+B$(4) 1040 PRINT #2,CHR$(10)+CHR$(10) 1060 K%=K%+1% ! COUNT LABEL 1080 GO TO 640 1100 ! --- THAT'S ALL --- 1120 PRINT #2% : PRINT #2%,K%;"LABELS PRINTED" 1140 PRINT K%;"LABELS PRINTED" 1160 PRINT #2%,CHR$(10%)+CHR$(10%)+CHR$(10%) 1180 PRINT #2%, CHR$(26%); : CLOSE 1%,2%,4% : GO TO 2440 1200 ! === NAME COMPOSITION SUBROUTINE === 1220 N1$="" 1240 M1%=INSTR(1%,B$(1%)," ") 1250 IF M1%<5% THEN IF INSTR(1%,N0$,LEFT(B$(1%),3%)) THEN M1%=INSTR(5%,B$(1%)," ") 1260 M2%=INSTR(1%,B$(1%)," ") 1280 IF M2%=0% THEN M2%=29% 1300 FOR M%=1% TO 4% 1320 IF INSTR(1%,B$(1%),M$(M%)) THEN 1380 1340 NEXT M% 1360 GO TO 1460 1380 M3%=INSTR(1%,B$(1%),M$(M%)) 1400 M2%=M3% 1420 N1$=M$(M%) 1440 B$(1)=LEFT(B$(1),M3%) 1460 N$=MID(B$(1),M1%+1%,M2%-M1%)+LEFT(B$(1),M1%) 1480 N$=N$+N1$ 1500 RETURN 1520 ! SETUP SUBROUTINE 1540 PRINT"SELECTION:" : INPUT"DEP (NC), STD DATE (D1,D2), OR CUSTOM [D,S, OR C]";X$ : X%=ASCII(X$) 1560 IF X%=68% OR X%=67% THEN RETURN ELSE IF X%<>83% THEN 1540 1580 PRINT"PRINT ITEMS WITH D2 EARLIER THAN OR SAME AS THE FOLLOWING DATE:" 1600 INPUT"YEAR";D1% : IF D1%<72% OR D1%>75% THEN 1600 1620 INPUT"MONTH";D2% : IF D2%<1% OR D2%>12% THEN 1620 1640 INPUT"DAY";D3% : IF D3%<1% OR D3%>31% THEN 1640 1660 IF D3%=31% THEN IF D2%=2% OR D2%=4% OR D2%=6% OR D2%=9% OR D2%=11% THEN 1720 1680 IF D3%=30% AND D2%=2% THEN 1720 1700 GO TO 1740 1720 PRINT"** BETTER LOOK AT A CALENDAR!! **" : GO TO 1600 1740 D2$=FNF$(D1%) 1760 IF D2%<10% THEN D2$=D2$+"0"+FNF$(D2%) ELSE D2$=D2$+FNF$(D2%) 1780 IF D3%<10% THEN D2$=D2$+"0"+FNF$(D3%) ELSE D2$=D2$+FNF$(D3%) 1800 PRINT"SELECTION DATE IS ";D2$; : INPUT" (Y/N)";Y$ : IF ASCII(Y$)=89% THEN RETURN ELSE GO TO 1600 1820 ! === KEY ACCESS SUBROUTINE === 1840 OPEN F$+".KEY" FOR INPUT AS FILE 4% 1860 FIELD #4%,8%*P% AS Z$, 8% AS P$(P%) FOR P%=0% TO 62% 1880 P0%=1% : RETURN 1900 IF P%<62% THEN P%=P%+1% ELSE P%=0% : GET #4% 1920 IF ASCII(P$(P%))=92% THEN 1120 1940 P1%=CVT$%(RIGHT(P$(P%),6%)) 1960 A1%=(P1%+N6%)/N% : A%=P1%-1%-(A1%-1%)*N% 1980 GET #1%, RECORD A1% 2000 RETURN 2020 DIM V2$(50),V2%(2,50) 2040 ON ERROR GO TO 2360 2060 F$="ADM" 2080 OPEN V1$+"$ATRIB" FOR INPUT AS FILE 1% 2100 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1% 2120 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% 2140 IF LEFT(A$(A%),3%)="\\\" THEN PRINT"NO SUCH FILE TYPE" : GO TO 2440 2160 IF LEFT(A$(A%),3%)<>F$ THEN 2120 2180 V2%(2%,0%),N%=VAL(MID(A$(A%),4%,2%)) : N9%=VAL(MID(A$(A%),6%,1%))*2% 2200 N1%=510%/N% : N2%=N1%-8% : N3%=N%*N1% : N6%=N%-1% 2220 FOR V%=1% TO 50% 2240 V2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF V2$(V%)=" " THEN 2320 2260 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%)) 2280 V2%(1%,V%)=ASCII(CHR$(V5%)) : V2%(2%,V%)=ASCII(CHR$(SWAP%(V5%))) 2300 NEXT V% 2320 V2%(1%,0%)=V%-1% : IF N5% THEN 2340 ELSE PRINT"CODES: "; : PRINT V2$(I%)+" "; FOR I%=1% TO V%-1% : PRINT 2340 CLOSE 1% : ON ERROR GO TO 0 : RETURN 2360 IF ERR<>5% AND ERR<>21% THEN 2420 ELSE RESUME 2380 2380 IF V1$="" THEN V1$="DK1:" : GO TO 2080 2420 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" : PRINT"IT MUST BE REPLACED TO PROCEED." 2440 END