1 ! LISTA -- LISTING OF ADMISSIONS FILE ! EITHER A STANDARD OR A CUSTOM SELECTION ! OF RECORDS MAY BE USED 2 ! REVISED 11-JAN-73 J. WARDEN 100 DEF FNF$(U1%)=MID(NUM$(U1%),2%,LEN(NUM$(U1%))-2%) 140 DIM B$(50) 150 PRINT CHR$(29%)+CHR$(31%)+CHR$(140%) 160 PRINT"LISTING: ADMISSIONS FILE" 200 N5%=1% : GOSUB 4000 220 M1%=V2%(1%,0%) : M2%=M1%/2% 240 S$=" \"+SPACE$(38%)+"\\"+SPACE$(20%)+"\" 260 T$=" \\ \ \ \\ \ \ \\ \ \" 270 GOSUB 2000 280 PRINT"HEADER LINE";:INPUT LINE H$ 300 H$=LEFT(H$,LEN(H$)-2%) 320 PRINT H$ : INPUT"CORRECT (Y/N)";Y$ : IF ASCII(Y$)<>89% THEN 280 340 INPUT"OUTPUT TO (DEV:FILE)";F2$ 360 OPEN F2$ FOR OUTPUT AS FILE 2 380 GOSUB 1100 400 ON ERROR GO TO 440 420 GO TO 480 440 IF ERR<>5% THEN ON ERROR GO TO 0 460 PRINT"** CAN'T FIND FILE **" : RESUME 480 480 INPUT"INPUT FILE (DEV:FILE)";F$ 500 IF LEN(F$)<=2% THEN 960 520 OPEN F$ FOR INPUT AS FILE 1 540 FIELD #1,N1%*R% AS Z$, N1% AS A$(R%) FOR R%=0% TO N6% 560 IF R%" " THEN 560 ELSE 660 600 ! -- DATE SELECTION -- 604 IF MID(A$(R%),109%,6%)<>SPACE$(6%) THEN 560 ! IF D2 PRESENT REJECT 606 D1$=MID(A$(R%),84%,6%) : D1$=RIGHT(D1$,5%)+LEFT(D1$,4%) ! D1 -- YR,MO,DAY 608 IF D1$=SPACE$(6%) THEN 560 610 IF D1$>=D2$ THEN 560 ! IF D1 ON OR AFTER DATE GIVEN REJECT 640 ! - - - - - - - - - - ! CUSTOM SELECT HERE: ! IF MID(A$(R%),A,B) [NOT WANTED] THEN 560 ! - - - - - - - - - 660 FOR U%=1% TO 4% 680 B$(U%)=MID(A$(R%),V2%(1%,U%),V2%(2%,U%)) 700 NEXT U% 720 B$(4)=LEFT(B$(4),2%)+" "+RIGHT(B$(4),3%) 740 D$="" 760 PRINT#2,USING S$,B$(1),LEFT(A$(R%),6%) 780 PRINT #2,USING S$,B$(2%) 800 PRINT #2,USING S$,B$(3)+" "+B$(4),D$ 820 PRINT #2,CHR$(10)+CHR$(10) 840 K%=K%+1% 860 L%=L%+1% : IF L%>=9% THEN GOSUB 1040 880 GO TO 560 900 CLOSE 1% 960 IF F2$<>"LP:" THEN PRINT #2%,CHR$(12%) 980 PRINT #2%,CHR$(26%) : CLOSE 2% 1000 PRINT K%;" ENTRIES PRINTED" 1020 GO TO 9999 1040 ! HEADER SUBROUTINE 1060 L%=0% ! RESET 1080 PRINT #2,CHR$(12%) 1100 PRINT #2," "+H$ 1120 PRINT #2," "+DATE$(0) 1140 PRINT #2,CHR$(10)+CHR$(10) 1160 RETURN 2000 ! SETUP SUBROUTINE 2040 INPUT"SELECTION: DEP (NC), STD DATE (D1,D2), OR CUSTOM";X$ 2060 IF X$="D" OR X$="C" THEN RETURN 2200 PRINT"PRINT ITEMS WITH D1 EARLIER THAN THE FOLLOWING DATE:" 2220 INPUT"YEAR";D1% : IF D1%<72% OR D1%>75% THEN 2220 2240 INPUT"MONTH";D2% : IF D2%<1% OR D2%>12% THEN 2240 2260 INPUT"DAY";D3% : IF D3%<1% OR D3%>31% THEN 2260 2280 IF D3%=31% THEN IF D2%=2% OR D2%=4% OR D2%=6% OR D2%=9% OR D2%=11% THEN 2300 2290 IF D3%=30% AND D2%=2% THEN 2300 2295 GO TO 2400 2300 PRINT"** BETTER LOOK AT A CALENDAR!! **" : GO TO 2220 2400 D2$=FNF$(D1%) 2420 IF D2%<10% THEN D2$=D2$+"0"+FNF$(D2%) ELSE D2$=D2$+FNF$(D2%) 2440 IF D3%<10% THEN D2$=D2$+"0"+FNF$(D3%) ELSE D2$=D2$+FNF$(D3%) 2460 PRINT"SELECTION DATE IS ";D2$; : INPUT" (Y/N)";Y$ : IF ASCII(Y$)=89% THEN RETURN ELSE GO TO 2220 4000 DIM V2$(50),V2%(2,50) 4020 ON ERROR GO TO 4320 4030 F$="ADM" 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