C PROGRAM SURVEY C C DESCRIPTION C THIS PROGRAM READS CODED RESPONSES TO A QUESTIONNAIRE AND WRITES C THEM INTO AN ASCII DATA FILE. C C SOURCE C NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE, C NORTON, MASS. C C INSTRUCTIONS C THERE SHOULD BE NO MORE THAN 128 QUESTIONS. RESPONSES MAY BE C CODED BY ANY DIGIT FROM 0 TO 9. ADDITIONAL SYMBOLS THAT MAY BE C USED ARE THE MINUS SIGN (-), THE AMPERSAND (&), AND THE BLANK, C INTERPRETED RESPECTIVELY AS THE NUMBERS 11, 12, AND 13. THESE C SHOULD BE RESERVED FOR SUCH CATEGORIES AS "NOT APPLICABLE", C "DON'T KNOW", AND "NO RESPONSE". C C THE FIRST 5 COLUMNS OF EACH DATA CARD ARE FOR IDENTIFICATION, C WITH THE FIRST 4 COLUMNS BEING UNIQUE TO THE RESPONDENT. THE C NEXT 67 COLUMNS OF THE CARD ARE FOR THE CODED RESPONSES, ONE C COLUMN PER QUESTION. THE LAST 8 COLUMNS ARE NOT USED. IF THERE C ARE MORE THAN 67 QUESTIONS, A SECOND CARD FOR EACH RESPONDENT C MAY BE PREPARED IN THE SAME MANNER. C C THE SET OF DATA CARDS MUST BE PRECEDED BY FIVE OR SEVEN PROGRAM C CARDS. THE FIRST OF THESE HAS PUNCHED IN ITS FIRST 5 COLUMNS C THE NAME THAT THE DATA FILE IS TO HAVE. THE SECOND MAY BE USED C FOR A DESCRIPTION OF THE SURVEY (NOT MORE THAN 48 CHARACTERS). C THE THIRD CARD SPECIFIES THE NUMBER OF QUESTIONS (ANY FORMAT C IS ACCEPTABLE). THE LAST TWO CARDS OR PAIRS OF CARDS, PUNCHED C IN THE SAME FORMAT AS THE DATA CARDS, INDICATE RESPECTIVELY THE C LOWEST NUMBER AND THE HIGHEST NUMBER TO BE COUNTED AS A RESPONSE C TO EACH QUESTION. NUMBERS OUTSIDE THIS RANGE ARE TREATED AS "NO C RESPONSE" AND EXCLUDED FROM THE TOTAL. ON THESE CARDS BLANKS C AND MINUS SIGNS ARE EQUIVALENT TO ZEROS, AND AMPERSANDS MAY NOT C BE USED. C C THE LAST DATA CARD MUST BE FOLLOWED BY A SINGLE BLANK CARD OR A C PAIR OF BLANK CARDS, ACCORDING AS ONE OR TWO CARDS ARE USED FOR C EACH RESPONDENT. C C THIS PROGRAM ASSUMES THAT INPUT IS FROM THE USER TERMINAL AND C OUTPUT IS TO THE DISK. IF A DIFFERENT INPUT DEVICE, SUCH AS THE C SYSTEM CARD READER, IS TO BE USED, IT SHOULD BE ASSIGNED LOGICAL C UNIT 5 PRIOR TO RUNTIME. ALSO, FOR INPUT FROM THE CARD READER, C THE USER SHOULD RESPOND TO THE PROGRAM'S REQUEST FOR DATA BY C TYPING "@CDR:". FOR INPUT FROM A FILE ON THE DISK, THE USER C SHOULD TYPE "@DSK:FILNAM.EXT", WHERE 'FILNAM.EXT' IS THE NAME C OF A CARD-IMAGE SOURCE FILE. C C SPECIAL INSTRUCTIONS FOR NONSTANDARD SOURCE DECKS C DATA CARDS DO NOT NEED TO BE PREPARED IN EXACT ACCORDANCE WITH C THE ABOVE INSTRUCTIONS TO BE ACCEPTABLE, PROVIDED THAT (1) THERE C ARE NO MORE THAN TWO CARDS PER RESPONDENT, (2) EACH CARD CON- C TAINS AN IDENTIFICATION LABEL, AND (3) THE ONLY RESPONSE CODES C USED ARE DIGITS, MINUS SIGNS, AMPERSANDS, AND BLANKS. WHEN A C NONSTANDARD SOURCE DECK IS INPUT, THE PROGRAM CARD SPECIFYING C THE NUMBER OF QUESTIONS MUST BE REPLACED BY A FORMAT CARD GIVING C THE BLOCKS OF COLUMNS IN WHICH IDENTIFICATION AND RESPONSES ARE C PUNCHED ON EACH DATA CARD. C C FOR EXAMPLE, IF THE SOURCE DECK CONTAINS ONE CARD PER RESPONDENT C WITH RESPONSES PUNCHED IN COLUMNS 1 THROUGH 72 AND IDENTIFICA- C TION IN COLUMNS 74 THROUGH 80, THE FORMAT CARD SHOULD READ: C 74-80,1-72 C FOR A SOURCE DECK CONTAINING TWO CARDS PER RESPONDENT, HAVING C IDENTIFICATION IN THE FIRST 4 COLUMNS OF EACH CARD AND RESPONSES C IN COLUMNS 5 THROUGH 80 OF THE FIRST CARD AND 5 THROUGH 64 OF C THE SECOND CARD, BUT WITH THE LAST 8 RESPONSES TO BE IGNORED, C THE FORMAT CARD SHOULD READ: C 1-4,5-80/1-4,5-56 C C RELATED PROGRAMS C THE PROGRAM SORTER TABULATES THE RESPONSES TO EACH QUESTION OF C THE QUESTIONNAIRE BY FREQUENCIES AND PERCENTAGES. THE PROGRAM C CROSS CORRELATES RESPONSES TO SELECTED QUESTIONS TO GIVE MAR- C GINAL FREQUENCIES, CROSS-TABULATIONS, AND OTHER STATISTICS AND C PERMITS THE COLLAPSING OF TABLES AND THE COMBINING OF VARIABLES. C THE PROGRAM MERGE COMBINES UP TO 64 FILES OF RESPONSES TO THE C SAME SET OF QUESTIONS. THE PROGRAM UNITE COMBINES TWO FILES OF C RESPONSES TO DIFFERENT QUESTIONS BY THE SAME RESPONDENTS. C C .................................................................. C INTEGER A(48),TODAY(2),IFMT(13),AFMT(13),NEW(7),END(4) INTEGER XOFF,BLANK,TWELVE,ELEVEN,ZERO,NINE INTEGER R(128),IR(2) LOGICAL SKIP COMMON IFMT,AFMT,NEW,END DATA IFMT /' ( A 4 , 1 X, ', 1 ' 67 I1 / 5 X, 61 I1 ) '/ DATA AFMT /' ( A 4 , 1 X, ', 1 ' 67 A1 / 5 X, 61 A1 ) '/ IR(1) = 'LOW' IR(2) = 'HIGH' XOFF = 17260188454 BLANK = 17315143744 TWELVE = 20536369216 ELEVEN = 24294465600 ZERO = 25905078336 NINE = 30736916544 CALL TIME(NOW) CALL DATE(TODAY) TYPE 1, NOW,TODAY 1 FORMAT (' SURVEY',8X,A5,9X,2A5//) 20 TYPE 2 2 FORMAT (/' ENTER DATA.'//) C ENTER FILE NAME. 30 ACCEPT 3, DATA,FILNAM,EXT 3 FORMAT (3A5) IF (DATA.EQ.' ') GO TO 20 SKIP = DATA.LT.'A' IF (DATA.EQ.'@DSK:') CALL IFIL(5,FILNAM,EXT) IF (SKIP) READ (5,3) DATA FILE = RENAME(DATA,'.TMP',DATA,'.BAK') CALL OFIL(1,DATA,'.TMP') WRITE (1,17) C ENTER DESCRIPTION OF SURVEY. 50 READ (5,5) (A(I),I=1,48) 5 FORMAT (48A1) DO 60 I=48,1,-1 IF (A(I).NE.BLANK) GO TO 70 60 A(I) = 0 70 WRITE (1,5) (A(I),I=1,48) C ENTER NUMBER OF QUESTIONS OR FORMAT INFORMATION. 100 READ (5,10) (NEW(2*I-1),END(I),I=1,4) 10 FORMAT (8I) M = NEW(1) IF (END(1).NE.0) CALL FORMAT(M) IF (M.GE.2 .AND. M.LE.128) GO TO 110 IF (SKIP) STOP 100 TYPE 3, XOFF PAUSE 'MISSING OR IMPROPER SPECIFICATION' GO TO 100 110 WRITE (1,11) M 11 FORMAT (2X,I3,' VARIABLES') IF (END(1).EQ.0 .AND. M.GT.67) GO TO 120 IF (END(1).NE.0 .AND. NEW(5).NE.0) GO TO 120 DO 115 I=9,12 IFMT(I) = BLANK 115 AFMT(I) = BLANK 120 DO 140 K=1,2 GO TO 130 125 TYPE 3, XOFF,ID IERR = IERR+1 IF (SKIP) GO TO 140 PAUSE 'ILLEGAL CHARACTER IN INPUT STRING' C ENTER LOWEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION. C ENTER HIGHEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION. 130 READ (5,IFMT,ERR=125) ID,(R(I),I=1,M) 140 WRITE (1,14) IR(K),(R(I),I=1,M) 14 FORMAT (A4,1X,128I1) WRITE (1,17) LAST = 0 C ENTER RESPONSES TO QUESTIONS BY EACH RESPONDENT. 150 READ (5,AFMT,END=170) ID,(R(I),I=1,M) IF (ID.EQ.BLANK) GO TO 170 DO 155 I=1,M IF (R(I).GE.ZERO .AND. R(I).LE.NINE) GO TO 155 IF (R(I).EQ.BLANK) GO TO 155 IF (R(I).EQ.TWELVE) GO TO 155 IF (R(I).EQ.ELEVEN) GO TO 155 TYPE 3, XOFF,ID,R(I) IERR = IERR+1 IF (SKIP) GO TO 155 PAUSE 'ILLEGAL CHARACTER IN INPUT STRING' GO TO 150 155 CONTINUE 160 WRITE (1,16) ID,(R(I),I=1,M) 16 FORMAT (A4,1X,128A1) LAST = LAST+1 GO TO 150 170 WRITE (1,17) 17 FORMAT () 180 WRITE (1,18) LAST 18 FORMAT (1X,I4,' RESPONDENTS') END FILE 1 FILE = RENAME(DATA,'.BAK',DATA,'.DAT') FILE = RENAME(DATA,'.DAT',DATA,'.TMP') IF (IERR.NE.0 .AND. SKIP) TYPE 19 19 FORMAT (/' ILLEGAL CHARACTERS IN ABOVE LINES'/) TYPE 18, LAST STOP END C SUBROUTINE FORMAT(M) INTEGER IFMT(13),AFMT(13),NEW(7),END(4),NEWFMT(7) COMMON IFMT,AFMT,NEW,END M = 0 NEW(5) = NEW(7) IF (NEW(1).LT.1 .OR. -END(1).GT.80 .OR. NEW(1).GT.-END(1)) RETURN IF (NEW(3).LT.1 .OR. -END(2).GT.80 .OR. NEW(3).GT.-END(2)) RETURN IF (NEW(5).LT.0 .OR. -END(4).GT.80 .OR. NEW(5).GT.-END(4)) RETURN M = 2-END(2)-NEW(3)-END(4)-NEW(5)+(NEW(5).EQ.0) IF (M.LT.2 .OR. M.GT.128) RETURN NEW(2) = MIN0(1-END(1)-NEW(1),4) NEW(4) = 1-END(2)-NEW(3) NEW(6) = 1-END(4)-NEW(5) ENCODE (35,103,NEWFMT) NEW 103 FORMAT (3(' T',I2,',',I3,2X),I5) IF (NEW(1).EQ.1) NEWFMT(1) = ' ' IF (NEW(3).EQ.NEW(1)+NEW(2)) NEWFMT(3) = ' ' IF (NEW(5).EQ.1) NEWFMT(5) = ' ' DO 105 I=1,6 IFMT(2*I) = NEWFMT(I) 105 AFMT(2*I) = NEWFMT(I) RETURN END C C LOGICAL FUNCTION RENAME(NEWNAM,NEWEXT,OLDNAM,OLDEXT) C RETURNS VALUE .FALSE. IF FILE OLDNAM.EXT DOES NOT EXIST. C OTHERWISE, RENAME IS .TRUE. AND FILE IS RENAMED NEWNAM.EXT C WITH PROTECTION <155>. THIS SUBPROGRAM IS WRITTEN IN THE C MACRO-10 ASSEMBLER LANGUAGE.