5  REM  HP 36807A, 6/74, PART 1 OF 3
10  REM---QUESTIONNAIRE DATA INPUT PROGRAM. BG. 4/73---
20  FILES *,*
30  DIM A$[72],B$[72],C$[72],Z$[72]
40  DIM X$[72]
50  DIM X[200],L[200],Y[50],N[50]
60  RESTORE 9000
70  READ A$,B$,B$,B$
80  ASSIGN A$,1,F9
90  ASSIGN A$,2,Z
100  N1=M1=L1=Y=Y2=0
110  Y1=1
120  IF TYP(0)=1 THEN 290
130  Y3=Y
140  READ A$,B$,C$
150  N1=N1+1
160  Y2=Y2+1
170  L[N1]=L2=LEN(B$)
180  IF B$[L2]=" " THEN 200
190  PRINT "LAST RESPONSE IS NOT A BLANK IN Q#"N1
200  L1=L1+L2
210  M1=M1 MAX L2
220  Y=Y3*L2+L2
230  IF Y<420000. THEN 120
240  N[Y1]=Y2-1
250  Y1=Y1+1
260  Y2=1
270  Y=0
280  GOTO 120
290  MAT Y=ZER[Y1]
300  MAT X=ZER[N1]
310  N[Y1]=Y2
320  REM---get option---
330  PRINT LIN(1)"Option:";
340  ENTER 255,Z,A$
350  PRINT 
360  IF Z<0 THEN 330
370  IF LEN(A$)=0 THEN 2990
380  RESTORE 460
390  I9=0
400  READ B$
410  I9=I9+1
420  IF B$="XXX" THEN 320
430  IF A$=B$[1,3] THEN 450
440  IF A$#B$[4,6] THEN 400
450  GOTO I9 OF 2990,560,620,1880,1420,1570,1820,1880
460  REM---option list---
470  DATA "donDON: exit program (or just use CR)"
480  DATA "optOPT: list options"
490  DATA "addADD: add more data"
500  DATA "fixFIX: change some data"
510  DATA "queQUE: list question data"
520  DATA "recREC: list data records"
530  DATA "sizSIZ: print size data"
540  DATA "delDEL: delete a record"
550  DATA "XXX"
560  REM---opt---
570  RESTORE 460
580  READ B$
590  IF B$="XXX" THEN 320
600  PRINT B$[4]
610  GOTO 580
620  REM---ADD---
630  READ #1,1
640  READ #2,1
650  N=0
660  IF  END #1 THEN 720
670  MAT  READ #1;Y
680  MAT  PRINT #2;Y
690  PRINT #2; END 
700  N=N+1
710  GOTO 670
720  N=N+1
730  PRINT LIN(1)"Record"N
740  N2=N1
750  I=0
760  GOSUB 2570
770  PRINT "Enter from Q$ "A$":";
780  ENTER 255,Z,X$
790  PRINT 
800  IF Z<0 THEN 770
810  IF LEN(X$)>0 THEN 850
820  IF I9=4 THEN 1150
830  GOSUB 2740
840  GOTO 320
850  L=I+LEN(X$)
860  IF L <= N2 THEN 880
870  PRINT L-N2"extra entries deleted."
880  FOR J=1 TO LEN(X$) MIN (N2-I)
890  IF J=1 THEN 920
900  IF X$[J,J]="?" THEN 1000
910  READ A$,B$,C$
920  FOR K=1 TO LEN(B$)
930  IF X$[J,J]=B$[K,K] THEN 1090
940  NEXT K
950  PRINT "Q$ "A$" bad ("X$[J,J]"). Re-enter:";
960  ENTER 255,Z,X$[J,J]
970  PRINT 
980  IF Z<0 THEN 950
990  IF X$[J,J]#"?" THEN 920
1000  GOSUB 2800
1010  PRINT "From ";
1020  GOSUB 2630
1030  IF I8 <= I+1 THEN 1070
1040  GOSUB 2570
1050  PRINT "Q$ cannot be greater than "A$". Try again."
1060  GOTO 1010
1070  I=I8-1
1080  GOTO 770
1090  I=I+1
1100  X[I]=K
1110  NEXT J
1120  IF I >= N2 THEN 1150
1130  READ A$,B$,C$
1140  GOTO 770
1150  PRINT "ok?";
1160  ENTER 255,Z,Z$
1170  PRINT 
1180  IF Z<0 THEN 1150
1190  IF LEN(Z$)=0 THEN 1370
1200  IF Z$#"?" THEN 1230
1210  GOSUB 2800
1220  GOTO 1150
1230  IF Z$[1,1]="Y" THEN 1370
1240  IF Z$[1,1]="y" THEN 1370
1250  PRINT "from ";
1260  GOSUB 2630
1270  I1=I8
1280  PRINT "  to ";
1290  GOSUB 2630
1300  IF I8 >= I1 THEN 1330
1310  PRINT '7'7'7"Bad order. Try again."
1320  GOTO 1250
1330  N2=I8
1340  I=I1-1
1350  GOSUB 2570
1360  GOTO 770
1370  GOSUB 2320
1380  MAT  PRINT #2;Y
1390  IF I9=4 THEN 2200
1400  PRINT #2; END 
1410  GOTO 720
1420  REM---QUE---
1430  RESTORE 9000
1440  READ A$,B$,Z$,C$
1450  PRINT "QUESTIONNAIRE: "C$
1460  PRINT "DATA FILE: "A$
1470  PRINT "DECODED DATA FILE: "B$
1480  PRINT "SUBGROUP FILE: "Z$
1490  PRINT "Q#, responses, and Q name are separated by '//' in list below.)"
1500  PRINT 
1510  FOR I=1 TO N1
1520  READ A$,B$,C$
1530  PRINT  USING "#,3d.xx";I
1540  PRINT A$"//"B$"//"C$
1550  NEXT I
1560  GOTO 320
1570  REM---REC---
1580  I=N1
1590  PRINT "Starting and ending record #s";
1600  N2=N1
1610  INPUT S,E
1620  IF S <= E THEN 1650
1630  PRINT "Bad order. Try again."
1640  GOTO 1590
1650  IF  END #1 THEN 1800
1660  IF S=1 THEN 1730
1670  R=(S-1)*Y1
1680  R1=INT((R+127)/128)
1690  READ #1,R1
1700  FOR K=1 TO R-R1*128+128
1710  READ #1;X
1720  NEXT K
1730  FOR K=S TO E
1740  MAT  READ #1;Y
1750  GOSUB 2420
1760  PRINT LIN(1)"Record"K
1770  GOSUB 2800
1780  NEXT K
1790  GOTO 320
1800  PRINT LIN(1)"There are only"K-1"records in the file."
1810  GOTO 320
1820  REM---SIZ---
1830  PRINT "# of questions:"N1
1840  PRINT "Total # of responses:"L1
1850  PRINT "Max. # of responses for a question:"M1
1860  PRINT "Record size for files (# of numbers):"Y1
1870  GOTO 320
1880  REM---FIX, DEL---
1890  PRINT "Record # (CR if done):";
1900  S=0
1910  ENTER 255,Z,S
1920  PRINT 
1930  IF Z<0 THEN 320
1940  IF  END #1 THEN 2300
1950  IF S>1 THEN 2000
1960  READ #1,1
1970  READ #2,1
1980  R2=128
1990  GOTO 2100
2000  R=(S-1)*Y1
2010  R1=INT((R+127)/128)
2020  READ #1,R1
2030  READ #2,R1
2040  R2=R-R1*128+128
2050  FOR I=1 TO R2
2060  READ #1;X
2070  PRINT #2;X
2080  NEXT I
2090  R2=128-R2
2100  MAT  READ #1;Y
2110  GOSUB 2420
2120  IF I9=4 THEN 1250
2130  GOSUB 2800
2140  PRINT "OK to delete";
2150  INPUT Z$
2160  IF Z$[1,1]="Y" THEN 2180
2170  IF Z$[1,1]#"y" THEN 2190
2180  MAT Y=ZER
2190  MAT  PRINT #2;Y
2200  IF  END #1 THEN 2280
2210  FOR I=1 TO R2-Y1+128*(R2 <= Y1)
2220  READ #1;X
2230  PRINT #2;X
2240  NEXT I
2250  IF TYP(1)#1 THEN 2280
2260  GOSUB 2740
2270  GOTO 1890
2280  PRINT #2; END 
2290  GOTO 2260
2300  PRINT "No such record."
2310  GOTO 2280
2320  REM---Code X into Y---
2330  C1=1
2340  FOR C2=1 TO Y1
2350  Y[C2]=0
2360  FOR C3=1 TO N[C2]
2370  Y[C2]=Y[C2]*L[C1]+X[C1]
2380  C1=C1+1
2390  NEXT C3
2400  NEXT C2
2410  RETURN 
2420  REM---Decode Y into X---
2430  C1=N1
2440  FOR C2=Y1 TO 1 STEP -1
2450  C4=Y[C2]
2460  FOR C3=1 TO N[C2]
2470  C5=INT(C4/L[C1])
2480  X[C1]=C4-C5*L[C1]
2490  IF X[C1]#0 THEN 2520
2500  X[C1]=L[C1]
2510  C5=C5-1
2520  C4=C5
2530  C1=C1-1
2540  NEXT C3
2550  NEXT C2
2560  RETURN 
2570  REM---get (I+1)th Question data---
2580  RESTORE 9020
2590  FOR J=1 TO I+1
2600  READ A$,B$,C$
2610  NEXT J
2620  RETURN 
2630  REM---Get Question Z$ Data---
2640  RESTORE 9020
2650  PRINT "Q$";
2660  INPUT Z$
2670  FOR I8=1 TO N1
2680  READ A$,B$,C$
2690  IF A$=Z$ THEN 2730
2700  NEXT I8
2710  PRINT "No such Q$. Try again."
2720  GOTO 2640
2730  RETURN 
2740  REM---Clear files---
2750  READ #2,2
2760  READ #2,1
2770  READ #1,2
2780  READ #1,1
2790  RETURN 
2800  REM---PRINT CURRENT RECORD---
2810  PRINT  USING 2900;1
2820  RESTORE 9020
2830  FOR J=1 TO (I MIN N1)*(N2=N1)+N1*(N2<N1)
2840  READ A$,B$,C$
2850  PRINT  USING "#,A";B$[X[J],X[J]]
2860  IF J/50#INT(J/50) THEN 2920
2870  PRINT "//"
2880  IF J=N1 THEN 2920
2890  PRINT  USING 2900;J+1
2900  IMAGE#,"#",3d,":"
2910  GOTO 2940
2920  IF J/10#INT(J/10) THEN 2940
2930  PRINT "/";
2940  NEXT J
2950  IF (J-1)/50=INT((J-1)/50) THEN 2970
2960  PRINT "//";
2970  PRINT 
2980  RETURN 
2990  END 
9000  REM -- FRIENDLY FRED'S QUESTION DATA
9005  DATA "FREDCF","FREDDF","FREDSG"
9015  DATA "FRIENDLY FRED'S FRANKFURTERS"
9020  DATA "1(A)","MF","SEX"
9030  DATA "1(B)","ABC","AGE ","AGE GROUP"
9040  DATA "2","RDI","POLITICAL PREFERENCE"
9050  DATA "XXX","YN","EATEN FFF"
9499  DATA 0
9500  REM--SUBGROUPS--
9505  DATA "ALL RESPONDANTS",0
9510  DATA "MALES",1,1,1,1
9520  DATA "INDEPENDENT FEMALES UNDER 20 AND OVER 30",3,1,1,2,2,2,1,3,3,1,3
9530  DATA " MALES OVER 30",2,1,1,1,2,1,3
9999  END 
