1! FRQSEL - SELECT A SUBSET FROM A '.FRQ' FILE 2! FREQUENCY ANALYSIS PACKAGE DEVELOPED AT: CENTRAL STATE UNIVERSITY COMPUTER CENTER EDMOND, OKLAHOMA 73034 BY: ARDOTH A. HASSLER DATE: AUGUST, 1979 5 CHAIN "LIB:FREQ" ! ENTRY POINT IS PROGRAM 'FREQ' 10 EXTEND \ ON ERROR GOTO 9000 \ GOSUB 10000 40! DEFINE STRING CONSTANTS& FF$=CHR$(12%) ! FORM FEED& \ CR$=CHR$(13%) ! CARRIAGE RETURN& \ LIB$="LIB:" ! PROGRAM LIBRARY ACCOUNT& \ FIL$=".FIL" \ LST$=".LST" \ EXT$=".FRQ" ! FREQUENCY FILE EXTENSION& \ LF$=CHR$(10%) ! LINE FEED& \ E$="INVALID - RE-ENTER" 50! CHECK RESPONSE (INVALID/YES/NO)& DEF FNA%(A$) \ A%=INSTR(1%," YN",LEFT(A$,1%)) \ A%=1% IF A%=0% \ PRINT "PLEASE ANSWER YES OR NO" IF A%=1% \ FNA%=A% \ FNEND ! CALLING ARGUMENT - A$ - STRING TO CHECK RETURNED ARGUMENT - FNA% 1 - INVALID 2 - YES 3 - NO USAGE - ON FNA%(A$) GOTO ERROR,YES,NO WHERE ERROR,YES AND NO REPRESENT STATEMENT NUMBERS 60 INPUT "DO YOU WANT INSTRUCTIONS";A$ \ ON FNA%(A$) GOTO 60,70,100 70 PRINT LF$;"SELECT ALLOWS YOU TO CREATE A FILE CONTAINING A SUBSET"; " OF DATA." \ PRINT "A SUBSET MAY BE SELECTED BY USING EITHER ID NUMBERS"; " OR A RESPONSE" \ PRINT "TO (A) SPECIFIC ITEM(S). IF THE LATTER OPTION IS "; "CHOSEN," \ PRINT "THE PURPOSE IS TO ALLOW FREQUENCIES TO BE OBTAINED"; " BEYOND A 2-WAY." 80 PRINT LF$;"YOU WILL BE ASKED TO ENTER AN OUTPUT FILE NAME, " \ PRINT "AND WHETHER YOU WANT TO SELECT BY ID NUMBERS OR BY "; "VARIABLE." \ PRINT "YOU WILL THEN ENTER THE DESIRED ID NUMBERS OR "; "THE VARIABLE(S)" \ PRINT "TO SELECT ON, AND THE ITEM TO BE RETAINED FOR EACH "; "VARIABLE." 90 PRINT LF$;"FOR FURTHER INSTRUCTION, SEE THE 'FREQUENCY "; "PACKAGE" \ PRINT "USER'S GUIDE' OR THE ACADEMIC COORDINATOR." 100! DATA AND FILE INITIALIZATION 110 DIM VAR%(10%),RESP%(10%),ID(100%) \ MAXID%=100% \ MAXSEL%=10% ! VAR% - VARIABLES TO SELECT RESP% - DESIRED RESPONSE ID - DESIRED ID NUMBERS 120 REJ%=255% ! VALUE TO REJECT AS BLANK 130 INFIL$=SYS(CHR$(7%)) ! GET INPUT FILE FROM CORE COMMON& \ OPEN INFIL$ FOR INPUT AS FILE 1% 140 GET #1% \ FIELD #1%, 3% AS X$, 1% AS IDLEN$, 1% AS NITEM$, 2% AS N$, 1% AS LRECL$ \ IDLEN%=ASCII(IDLEN$) \ NITEM%=ASCII(NITEM$) \ N%=CVT$%(N$) \ LRECL%=ASCII(LRECL$) \ NREC%=512%/LRECL% 150 PRINT LF$;"PLEASE ENTER A 1 TO 6 CHARACTER NAME FOR THE NEW FILE" \ INPUT "TO BE CREATED";OUTFIL$ \ F%=INSTR(1%,OUTFIL$,".") \ IF F% THEN IF RIGHT(OUTFIL$,F%)<>EXT$ THEN PRINT "EXTENSION MUST BE ";EXT$ \ GOTO 150 155 OUTFIL$=OUTFIL$+EXT$ IF F%=0% \ IF INFIL$<>OUTFIL$ THEN OPEN OUTFIL$ FOR INPUT AS FILE 2% ELSE PRINT "YOU HAVE SPECIFIED THE SAME FILE FOR OUTPUT AS"; " YOU ARE USING FOR INPUT" \ GOTO 150 160 PRINT "YOU HAVE SPECIFIED AN ALREADY EXISTING FILE." \ INPUT "DO YOU REALLY WANT TO DESTROY THIS FILE";A$ \ ON FNA%(A$) GOTO 160,170,150 170 CLOSE 2% \ OPEN OUTFIL$ FOR OUTPUT AS FILE 2% 200! GET SELECTION CRITERIA 210 PRINT "DO YOU WANT TO SELECT ON ID NUMBER OR BY VARIABLE"; \ INPUT " (I,V)";A$ \ A$=LEFT(A$,1%) \ IF A$="V" THEN GOSUB 2000 ELSE IF A$="I" THEN GOSUB 3000 ELSE PRINT E$ \ GOTO 210 300! BUILD NEW FILE OF SELECTED RECORDS 310 PUT #SWAP%(1%)+2% ! COPY PARAMETERS TO NEW FILE& \ R%=0% ! OUTPUT RECORD COUNTER& \ NOUT%=0% ! NUMBER OF NEW OUTPUT RECORDS 320 FOR K%=1% TO N% STEP NREC% \ GET #1% 330 FOR I%=1% TO NREC% \ GOTO 400 IF K%+I%>N%+1% \ OFFSET%=(I%-1%)*LRECL% 340 PASS%=0% \ IF NID% THEN GOSUB 3100 ELSE GOSUB 2100 350 GOTO 390 IF PASS% ! RECORD IS ONE TO BYPASS 370 NOUT%=NOUT%+1% \ R%=R%+1% \ IF R%>NREC% THEN PUT #2% \ R%=1% 380 FIELD #1%, OFFSET% AS X$, LRECL% AS INREC$ \ FIELD #2%, (R%-1%)*LRECL% AS X$, LRECL% AS OUTREC$ \ LSET OUTREC$=INREC$ 390 NEXT I% \ NEXT K% 400! WRITE LAST BLOCK AND SET PARAMETERS IN FIRST RECORD 410 IF NOUT%<=0% THEN PRINT "NO RECORDS WERE SELECTED" \ GOTO 500 420 FIELD #2%, R%*LRECL% AS X$, (NREC%-R%)*LRECL% AS X$ \ LSET X$="" \ PUT #2% 430 GET #2%, RECORD 1% \ FIELD #2%, 5% AS X$, 2% AS N$ \ LSET N$=CVT%$(NOUT%) \ PUT #2%, RECORD 1% 440 PRINT "FILE ";OUTFIL$;" HAS BEEN CREATED WITH";NOUT%;"RECORDS" 450 GOTO 500 IF NVAR% \ PRINT "ID";ID(I%);"WAS NOT FOUND ON THE FILE" IF ID(I%)<>-1. FOR I%=1% TO NID% 500! CLOSE FILES, CHECK FILE TO RETURN 510 CLOSE 2% 520 INPUT "DO YOU WANT TO SELECT ANOTHER SUBSET";A$ \ ON FNA%(A$) GOTO 520,530,600 530 GET #1%, RECORD 1% \ I%=0% \ NVAR%=0% \ NID%=0% \ GOTO 150 600! RETURN TO 'FREQ' CONTROL PROGRAM 610 CLOSE 1% \ X$=SYS(CHR$(8%)+INFIL$) \ IF INFIL$="" THEN FRQRET%=30% ELSE FRQRET%=250% 620 CHAIN LIB$+"FREQ" FRQRET% 2000! GET VARIABLE SELECTION CRITERIA 2010 PRINT LF$; \ INPUT "VARIABLE TO SELECT (0 TO END)";VAR% \ GOTO 2030 IF VAR%>0% \ IF I%=0% THEN PRINT "YOU HAVE NOT SELECTED ANY VARIABLES" \ GOTO 2010 2020 NVAR%=I% \ GOTO 2090 2030 IF VAR%>NITEM% THEN PRINT E$ \ GOTO 2010 2040 FIELD #1%, 12% AS X$, (VAR%-1%)*4% AS X$, 1% AS QMAX$, 1% AS QMIN$ 2050 INPUT "RESPONSE TO SELECT";RESP% \ IF RESP%ASCII(QMAX$) THEN PRINT E$ \ GOTO 2050 2060 I%=I%+1% \ VAR%(I%)=VAR% \ RESP%(I%)=RESP% 2070 IF I%=MAXSEL% THEN PRINT "YOU HAVE SELECTED";MAXSEL%;"VARIABLES." \ PRINT "THIS IS THE MAXIMUM THAT MAY BE SELECTED." \ NVAR%=I% \ GOTO 2090 2080 GOTO 2010 2090 RETURN 2100! FIND VARIABLES TO SELECT 2110 FOR J%=1% TO NVAR% \ FIELD #1%, OFFSET% AS X$, VAR%(J%)+IDLEN%-1% AS X$, 1% AS RESP$ \ RESP%=ASCII(RESP$) \ IF RESP%=REJ% OR RESP%<>RESP%(J%) THEN PASS%=-1% \ GOTO 2190 2120 NEXT J% 2190 RETURN 3000! GET ID NUMBER TO SELECT 3010 PRINT "ID TO SELECT ( TO END)"; \ INPUT LINE A$ \ A$=CVT$$(A$,4%) \ A%=LEN(A$) \ ID=VAL(A$) \ GOTO 3030 IF A% \ IF I%=0% THEN PRINT "YOU HAVE NOT SELECTED ANY ID NUMBERS" \ GOTO 3010 3020 NID%=I% \ GOTO 3090 3030 IF A%>IDLEN% THEN PRINT E$ \ GOTO 3010 3040 I%=I%+1% \ ID(I%)=ID \ IF I%=MAXID% THEN PRINT "ONLY";MAXID%;"ID NUMBERS MAY BE SELECTED" \ NID%=I% \ GOTO 3090 3050 GOTO 3010 3090 START%=1% \ RETURN 3100! FIND ID RECORDS TO KEEP 3110 FIELD #1%, OFFSET% AS X$, IDLEN% AS ID$ \ ID=VAL(ID$) 3120 FOR J%=START% TO NID% \ GOTO 3150 IF ID<>ID(J%) \ ID(J%)=-1. ! CHANGE STARTING LOCATION (DONT LOOK FOR ALREADY FOUND IDS)& \ IF J%=START% THEN START%=START%+1% \ GOTO 3190 3130 FOR J0%=START% TO J% \ IF ID(J%)<>-1. THEN START%=J0% \ GOTO 3190 3140 NEXT J0% \ GOTO 3190 3150 NEXT J% \ PASS%=-1% 3190 RETURN 9000! ERROR ROUTINE 9010 IF ERR=28% THEN GOSUB 10000 \ RESUME 9990 9020 GOTO 9050 IF ERR<>2% AND ERR<>5% AND ERR<>10% \ IF ERL=130 THEN PRINT "CORRUPT INPUT FILE NAME" \ INFIL$="" \ RESUME 600 9030 IF ERL=9990 THEN RESUME 600 ELSE IF (ERR=2 OR ERR=10) AND ERL=155 THEN PRINT E$ \ RESUME 150 9040 RESUME 170 9050 IF ERR>49% OR ERR<53% THEN PRINT E$ \ RESUME 9900 PRINT "UNEXPECTED ERROR";ERR;"ENCOUNTERED IN PROGRAM ";P$;" AT LINE"; ERL \ PRINT "PLEASE RETAIN THIS OUTPUT AND NOTIFY COMPUTER CENTER "; "PERSONNEL" \ INFIL$="" \ RESUME 600 9950 ON ERROR GOTO 0 9990 CLOSE 2% \ KILL OUTFIL$ \ GOTO 600 10000! CTRL/C TRAP 10010 V$=SYS(CHR$(6%)+CHR$(-7%)) \ V$="" \ RETURN 32767 END