1! FRQOUT - OUTPUT AN ASCII FILE 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" 10 EXTEND 20 P$="OUTPUT" \ F%=12% ! FILE CHANNEL NUMBER 30 ON ERROR GOTO 9000 \ GOSUB 10000 ! ERROR TRAPPING ENABLED. 40! DEFINE STRING CONSTANTS& FF$=CHR$(12%) ! FORM FEED& \ CR$=CHR$(13%) ! CARRIAGE RETURN& \ LDN$="CSU:" ! LOGICAL DEVICE NAME FOR PRIVATE DISK& \ FIL$=".FIL" \ EXT$=".DAT" \ LST$=".LST" \ LIB$="LIB:" ! LIBRARY ACCOUNT& \ 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 DEF FNMOD%(NUMB%,MOD%)=NUMB%-NUMB%/MOD%*MOD% ! MOD FUNCTION 70 INPUT "DO YOU WANT INSTRUCTIONS";A$ \ ON FNA%(A$) GOTO 70,80,100 80 PRINT LF$;"OUTPUT ALLOWS YOU TO OUTPUT THE RAW DATA INTO AN"; " ASCII FILE." 100! DATA AND FILE INITIALIZATION 110 REJ% = 255% ! VALUE OF REJECTED RESPONSE 120 INFIL$ = SYS(CHR$(7%)) ! GET INPUT FILE FROM CORE COMMON& \ OPEN INFIL$ FOR INPUT AS FILE 1% 130 GET #1% \ FIELD #1%, 3% AS X$, 1% AS IDLEN$, 1% AS NITEM$, 2% AS N$, 1% AS LRECL$ \ NITEM% = ASCII(NITEM$) \ IDLEN% = ASCII(IDLEN$) \ N% = CVT$%(N$) \ LRECL% = ASCII(LRECL$) \ NREC% = 512%/LRECL% ! GET CONTROL INFO FROM FIRST BLOCK. 140 PRINT LF$;"PLEASE ENTER A 1 TO 6 CHARACTER NAME FOR THE NEW FILE" \ INPUT "TO BE CREATED";OUTFIL$ \ D% = INSTR(1%,OUTFIL$,".") ! NAME OF OUTPUT FILE TO BE CREATED, DEFAULT TO EXTENTION OF ".DAT." 150 OUTFIL$ = OUTFIL$ + EXT$ IF D%=0% \ IF INFIL$<>OUTFIL$ THEN OPEN OUTFIL$ FOR INPUT AS FILE F% ELSE PRINT "YOU HAVE SPECIFIED THE SAME FILE FOR OUTPUT AS"; "YOU ARE USING FOR INPUT" \ GOTO 140 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,140 170 CLOSE F% \ OPEN OUTFIL$ FOR OUTPUT AS FILE F% 180 PRINT \ T% = 0% 190 DIM L%(5%) 200! BUILD NEW OUTPUT FILE 210 FOR I% = 1% TO N% STEP NREC% \ GET #1% 220 FOR K% = 1% TO NREC% \ GOTO 300 IF I%+K% > N%+1% 230 NOUT% = NOUT% + 1% \ FIELD #1%,(K%-1%)*LRECL% AS DUM$, IDLEN% AS ID$ \ J% = 0% \ FULL% = 0% \ CODE%=NITEM%*3%/(79%-IDLEN%) \ CODE%=CODE%+1% IF FNMOD%(NITEM%*3%,79%-IDLEN%) ! FIND OUT HOW LONG THE RECORD IS. 240 FOR M% = 1% TO CODE% \ PRINT #F%, ID$; \ IF CODE% > 1% THEN PRINT #F%, NUM1$(M%); \ CC% = 1% ! PRINT ID NUMBER AND CARD CODE IF ANY. 250 IF CODE% = M% THEN FULL% = NITEM% ELSE FULL% = FULL% + ((80% - (IDLEN%+1%))/3%) ! CHECK FOR LAST CARD TO BE PRINTED ! IN THE SAME ID NUMBER SERIES. 260 WHILE J% < FULL% \ FIELD #1%, (K%-1%)*LRECL% AS DUM$, IDLEN% AS ID$, J% AS OFFSET$, 1% AS X$ \ X% = ASCII(X$) \ X% = -1% IF X% = REJ% \ PRINT #F%, USING "###",X%; \ J% = J% + 1% \ T% = T% + 1% \ NEXT ! FIELD THRU ALL THE RESPONSES. 265 L%(M%) = T% \ T%=0% ! PUT NUMBER OF RESPONSES IN ARRAY. 270 PRINT #F% \ NEXT M% 280 NEXT K% \ NEXT I% 300! PRINT STATS 310 PRINT "ID LENGTH IS";IDLEN%;", WITH";NITEM%;"RESPONSES" \ PRINT 320 PRINT "CARD";I%;"HAS";L%(I%);"RESPONSES" FOR I%=1% TO CODE% \ PRINT 350 PRINT "NUMBER OF RESPONDENTS ARE";NOUT%;"," \ PRINT "AND THE OUTPUT FILE IS ";OUTFIL$ 600! RETURN TO 'FREQ' CONTROL PROGRAM 610 CLOSE 1%,F% \ X$ = SYS(CHR$(8%)+INFIL$) \ IF INFIL$ = "" THEN FRQRET% = 30% ELSE FRQRET% = 250% 620 CHAIN LIB$+"FREQ" FRQRET% 9000! ERROR ROUTINE 9010 IF ERR = 28% THEN GOSUB 10000 \ RESUME 9990 9990 CLOSE 2% \ KILL OUTFIL$ \ RESUME 600 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 140 ! IF OUTFIL$ ALREADY EXISTS. 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 10000! CTRL/C TRAP 10010 V$=SYS(CHR$(6%)+CHR$(-7%)) \ V$="" \ RETURN 32750 PRINT "*** ";P$;" END ";TIME$(0%) \ NO EXTEND 32767 END