5  REM  HP 36807A, 6/74, ?PRINT, PART 2 OF 3
10  REM---QUESTIONNAIRE PRINT PROGRAM. BG. 4/73---
20  FILES *,*,*
30  DIM A$[72],B$[72],C$[72],D$[72],V$[72],Z$[72]
40  DIM X$[72],R[10],S[10],T[10]
50  DIM X[100],M[100],L[100],Y[50],N[50],A[500]
60  RESTORE 9000
70  READ A$,B$,C$,V$
80  ASSIGN A$,1,Z
90  ASSIGN B$,2,F9
100  ASSIGN C$,3,F7
110  N1=M1=L1=Y=Y2=0
120  Y1=1
130  IF TYP(0)=1 THEN 290
140  Y3=Y
150  READ A$,B$,C$
160  N1=N1+1
170  M[N1]=L1
180  Y2=Y2+1
190  L[N1]=L2=LEN(B$)
200  L1=L1+L2
210  M1=M1 MAX L2
220  Y=Y3*L2+L2
230  IF Y<420000. THEN 130
240  N[Y1]=Y2-1
250  Y1=Y1+1
260  Y2=1
270  Y=0
280  GOTO 130
290  MAT Y=ZER[Y1]
300  MAT X=ZER[N1]
310  N[Y1]=Y2
320  IF L1 <= 1000 THEN 350
330  PRINT "Array A too small; must be"L1"Change DIM and above statement."
340  STOP 
350  REM---get option---
360  PRINT LIN(1)"Option:";
370  ENTER 255,Z,A$
380  PRINT 
390  IF Z<0 THEN 360
400  IF LEN(A$)=0 THEN 2970
410  RESTORE 490
420  I9=0
430  READ B$
440  I9=I9+1
450  IF B$="XXX" THEN 350
460  IF A$=B$[1,3] THEN 480
470  IF A$#B$[4,6] THEN 430
480  GOTO I9 OF 2970,580,640,900,2170,2470,2270
490  REM---option list---
500  DATA "donDON: exit program (or just use CR)"
510  DATA "optOPT: list options"
520  DATA "decDEC: decode data, put into file 2"
530  DATA "subSUB: print subgroup analysis"
540  DATA "psgPSG: print subgroup tabulations on file 3"
550  DATA "fsgFSG: get subgroup data from file 3 and print"
560  DATA "lsgLSG: list subgroup descriptions"
570  DATA "XXX"
580  REM---opt---
590  RESTORE 490
600  READ B$
610  IF B$="XXX" THEN 350
620  PRINT B$[4]
630  GOTO 600
640  REM---DEC---
650  IF F9 <= 0 THEN 680
660  PRINT "FILE 2 IS EITHER NOT OPENED OR NOT AVAILABLE FOR WRITING."
670  GOTO 350
680  READ #1,1
690  READ #2,1
700  N=0
710  IF  END #1 THEN 850
720  IF  END #2 THEN 780
730  MAT  READ #1;Y
740  GOSUB 2520
750  MAT  PRINT #2;X
760  N=N+1
770  GOTO 730
780  PRINT "FILE 2 IS TOO SHORT. IT HOLDS ONLY"N"RECORDS."
790  IF  END #1 THEN 830
800  MAT  READ #1;Y
810  N=N+1
820  GOTO 800
830  PRINT "ROOM FOR"N"RECORDS IS NEEDED."
840  GOTO 350
850  PRINT "ALL DONE."N"RECORDS WERE DECODED."
860  PRINT #2; END 
870  READ #2,2
880  READ #2,1
890  GOTO 350
900  REM---SUB---
910  IF F9<3 THEN 990
920  F8=2
930  PRINT "DATA HAS NOT BEEN DECODED. GO AHEAD ANYWAY";
940  INPUT X$
950  IF X$[1,1]="y" THEN 970
960  IF X$[1,1]#"Y" THEN 350
970  READ #1,1
980  GOTO 1560
990  IF TYP(2)>1 THEN 920
1000  F8=1
1010  READ #2,1
1020  GOTO 980
1030  PRINT "SET AT 1ST LINE OF PAGE & CR";
1040  ENTER 255,Z,Z$
1050  IF Z<0 THEN 1030
1060  PRINT LIN(-5);
1070  RESTORE 9000
1080  READ A$,A$,A$,B$
1090  PRINT B$": "X$
1100  FOR I=1 TO LEN(B$)+LEN(X$)+2
1110  PRINT "-";
1120  NEXT I
1130  GOSUB 2840
1140  PRINT 
1150  PRINT  USING 1160;D$,N
1160  IMAGE 4x,13a,";",7d," records."//
1170  RESTORE 9020
1180  P1=11
1190  IF N=0 THEN 1540
1200  FOR I=1 TO N1
1210  READ A$,B$,C$
1220  PRINT A$;TAB(7);C$":"
1230  PRINT LIN(-1);
1240  P1=P1+2
1250  B=LEN(B$)
1260  K1=0
1270  K=13 MIN B
1280  IF K<1 THEN 1530
1290  PRINT "   ans: ";
1300  FOR J=1 TO K
1310  PRINT  USING "#,xxxax";B$[K1+J,K1+J]
1320  NEXT J
1330  PRINT LIN(1)"        ";
1340  FOR J=1 TO K
1350  PRINT " ----";
1360  NEXT J
1370  PRINT LIN(1)"     #: ";
1380  FOR J=1 TO K
1390  PRINT  USING "#,5d";A[M[I]+K1+J]
1400  NEXT J
1410  PRINT LIN(1)"     %: ";
1420  FOR J=1 TO K
1430  PRINT  USING 1440;A[M[I]+K1+J]/N*100
1440  IMAGE#,4d,"%"
1450  NEXT J
1460  PRINT LIN(-2)
1470  P1=P1+6
1480  IF P1 <= 54 THEN 1500
1490  GOSUB 2670
1500  K1=K1+13
1510  B=B-13
1520  GOTO 1270
1530  NEXT I
1540  GOSUB 2670
1550  GOTO I9-3 OF 2100,350,2140
1560  REM---SUB---
1570  PRINT "Starting & ending subgroups";
1580  INPUT F1,F2
1590  FOR F3=F1 TO F2
1600  IF I9#6 THEN 1660
1610  READ #3,1
1620  IF  END #3 THEN 2500
1630  READ #3;F4,N
1640  MAT  READ #3;A
1650  IF F3#F4 THEN 1630
1660  RESTORE 9500
1670  FOR F4=1 TO F3
1680  IF TYP(0)=3 THEN 350
1690  READ X$,S
1700  X=0
1710  FOR I=1 TO S
1720  READ S[I],T[I]
1730  FOR J=1 TO T[I]
1740  READ R[X+J]
1750  NEXT J
1760  X=X+T[I]
1770  NEXT I
1780  NEXT F4
1790  IF I9=6 THEN 2070
1800  MAT A=ZER[L1]
1810  P=P1=N=P3=0
1820  IF  END #1 THEN 2820
1830  IF F8=2 THEN 1850
1840  IF  END #2 THEN 2820
1850  GOSUB 2750
1860  IF P3=1 THEN 2010
1870  IF X[1]=0 THEN 1850
1880  X=0
1890  FOR I=1 TO S
1900  FOR J=1 TO T[I]
1910  IF X[S[I]]=R[X+J] THEN 1940
1920  NEXT J
1930  GOTO 1850
1940  X=X+T[I]
1950  NEXT I
1960  N=N+1
1970  FOR I=1 TO N1
1980  A[M[I]+X[I]]=A[M[I]+X[I]]+1
1990  NEXT I
2000  GOTO 1850
2010  IF I9#5 THEN 2070
2020  PRINT #3;F3,N
2030  MAT  PRINT #3;A
2040  PRINT #3; END 
2050  PRINT "SUBGROUP"F3"DONE.  # OF RECORDS ="N
2060  GOTO 2100
2070  IF F3=F1 THEN 1030
2080  P1=6
2090  GOTO 1070
2100  IF F8=1 THEN 2130
2110  READ #1,1
2120  GOTO 2140
2130  READ #2,1
2140  NEXT F3
2150  IF I9=5 THEN 2250
2160  GOTO 350
2170  REM---PSG---
2180  IF F7#0 THEN 2220
2190  IF  END #3 THEN 2240
2200  READ #3,1
2210  GOTO 900
2220  PRINT "Subgroup file not available."
2230  GOTO 350
2240  PRINT "Subgroup file too short."F3-F1"subgroups were printed on file."
2250  READ #3,1
2260  GOTO 350
2270  REM---LSG---
2280  RESTORE 9500
2290  I=0
2300  PRINT LIN(1)"Subgroups:"
2310  IF TYP(0)=3 THEN 350
2320  READ X$,S
2330  I=I+1
2340  PRINT I;X$
2350  FOR J=1 TO S
2360  READ Q,R
2370  PRINT  USING 2380;Q
2380  IMAGE#,9d,": "
2390  FOR K=1 TO R
2400  READ R1
2410  PRINT  USING 2420;R1
2420  IMAGE#,3d,","
2430  NEXT K
2440  PRINT 
2450  NEXT J
2460  GOTO 2310
2470  REM---RSG---
2480  IF F7>2 THEN 2220
2490  GOTO 1560
2500  PRINT "Subgroup"F3"is not on the subgroup file."
2510  GOTO 350
2520  REM---Decode Y into X---
2530  C1=N1
2540  FOR C2=Y1 TO 1 STEP -1
2550  C4=Y[C2]
2560  FOR C3=1 TO N[C2]
2570  C5=INT(C4/L[C1])
2580  X[C1]=C4-C5*L[C1]
2590  IF X[C1]#0 THEN 2620
2600  X[C1]=L[C1]
2610  C5=C5-1
2620  C4=C5
2630  C1=C1-1
2640  NEXT C3
2650  NEXT C2
2660  RETURN 
2670  REM---page---
2680  PRINT LIN(P1-63);
2690  P=P+1
2700  PRINT  USING 2710;P
2710  IMAGE 32x,"- p.",3d," -"
2720  PRINT LIN(-8);
2730  P1=6
2740  RETURN 
2750  REM---READ NEXT RECORD---
2760  IF F8=1 THEN 2800
2770  MAT  READ #1;Y
2780  GOSUB 2520
2790  RETURN 
2800  MAT  READ #2;X
2810  RETURN 
2820  P3=1
2830  RETURN 
2840  REM---Returns date in D$ (13 chars.). DIM D$(72) in main program---
2850  D1=(INT(TIM(3)/4)=TIM(3)/4)
2860  D2=TIM(2)+(TIM(2)>(59+D1))*(2-D1)
2870  D1=INT((D2+91)/30.55)-2
2880  D2=D2+91-INT((D1+2)*30.55)
2890  D$="       , 19  Jan.Feb.Mar.Apr.May JuneJulyAug.Sep.Oct.Nov.Dec.0123456789"
2900  D$[1,4]=D$[4*D1+10]
2910  D$[6,6]=D$[6+(56+INT(D2/10))*(D2>9)]
2920  D$[7,7]=D$[62+D2-INT(D2/10)*10]
2930  D$[12,12]=D$[62+INT(TIM(3)/10)]
2940  D$[13,13]=D$[62+TIM(3)-INT(TIM(3)/10)*10]
2950  D$=D$[1,13]
2960  RETURN 
2970  END 
