1 '                          CROSSTABS
2 '               Written by Tracy L. Gustafson, M.D.
3 '              Round Rock, Texas. Version 3.0, 1984
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1,1),CS(1,1),T(1),N$(1),X(1),X2(1),MD(1),SD(1),NS(3),NN(3),MN(3),MX(3),DR(1),DC(1),DP(1),CX(1)
22 DATA "CROSSTAB REPORTS",28,18
30 GOSUB 4000:AR=CSRLIN
35 LOCATE 24,20:INPUT;"Do you want 1,2 or 3-way CROSSTABS?  ",NB:IF ABS(NB-2)>1 THEN BEEP:GOTO 35
40 LOCATE 24,8:INPUT;"Do you want the report printed on SCREEN or PRINTER? (S or P)  ",A$
45 LOCATE 24,1:PRINT TAB(79):IF A$="s" OR A$="S" THEN PO$="SCRN:":PMAX=80 ELSE IF A$="p" OR A$="P" THEN PO$="LPT1:":PMAX=PRNT-5 ELSE BEEP:GOTO 40
50 LOCATE AR,28:PRINT FILE$;" has";A;"samples.":PRINT:AR=CSRLIN
55 FOR T=1 TO NB:LOCATE AR,22*T-1:PRINT "Sample ";:AC=T*22+6:GOSUB 4200:NS(T)=NS:NEXT
60 PRINT:PRINT "Sample NAME:";:FOR T=1 TO NB:PRINT TAB(22*T);N$(NS(T));:NEXT
65 PRINT:PRINT "MINIMUM value:";:FOR T=1 TO NB:MN(T)=VAL(D(NS(T),CS(NS(T),1))):PRINT TAB(22*T);MN(T);:NEXT
70 PRINT:PRINT "MAXIMUM value:";:FOR T=1 TO NB:NS=NS(T):MX(T)=VAL(D(NS,CS(NS,T(NS)))):PRINT TAB(22*T);MX(T);:NEXT
75 PRINT:PRINT "Interval WIDTH:";:FOR T=1 TO NB:AR=CSRLIN
80 LOCATE AR,T*22:INPUT;"",SW(T):IF SW(T)>0 THEN NEXT ELSE BEEP:LOCATE AR,AC:PRINT "     ":GOTO 80
85 RESTORE 90:AR=CSRLIN+1:LOCATE 24,15:PRINT "Do you want to specify";:FOR T=1 TO NB:READ D1,D2:PRINT D1;D2;:NEXT:INPUT;" headings?  ",A$
90 DATA ""," ROW"," & ","COLUMN"," &"," PAGE"
95 RESTORE 90:T=1:FOR Z=1 TO 3:NN(Z)=1:NZ(Z)=1:NEXT
100 LOCATE 24,12:PRINT TAB(75);:IF A$="y" OR A$="Y" THEN 110 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 85
105 BF=0:FOR T=1 TO NB:GOSUB 115:NEXT:GOTO 185
110 BF=1:READ D1,D2:LOCATE AR,T*22-3:PRINT D2;" HEADINGS":GOSUB 115:GOTO 135
115 CW=0:SW=SW(T)
120 IF SW>=10 THEN SW=SW/10:CW=CW+1:GOTO 120
125 IF SW<1 THEN SW=SW*10:CW=CW-1:GOTO 125
130 MN(T)=INT(MN(T)*10^CW)/10^CW:NN(T)=INT((MX(T)-MN(T))/SW(T))+1:VM=MN(T):RETURN
135 LOCATE ,T*22-7:PRINT MN(T):ON T GOTO 140,145,150
140 ERASE DR:DIM DR(NN(1)):GOTO 155
145 ERASE DC:DIM DC(NN(2)):GOTO 155
150 ERASE DP:DIM DP(NN(3))
155 FOR Z=1 TO NN(T):LOCATE ,T*22-8:VM=VM+SW(T):PRINT "-";VM-10^CW/100;:LOCATE ,T*22+3
160 ON T GOTO 165,170,175
165 INPUT "",DR(Z):GOTO 180
170 INPUT "",DC(Z):GOTO 180
175 INPUT "",DP(Z)
180 NEXT Z:T=T+1:IF T<=NB THEN 110
185 ERASE CX:DIM CX(NN(3),NN(2),NN(1))
190 LOCATE 25,28:COLOR 23:PRINT "CALCULATING CROSSTABS";:COLOR CLR1:MS=0
195 FOR Z=1 TO C:FOR TZ=1 TO NB:NS=NS(TZ):IF D(NS,Z)="" THEN MS=MS+1:GOTO 210 ELSE VX=VAL(D(NS,Z))
200 NZ(TZ)=INT((VX-MN(TZ))/SW(TZ))+1:NEXT TZ
205 CX(NZ(3),NZ(2),NZ(1))=CX(NZ(3),NZ(2),NZ(1))+1
210 NEXT Z
215 LOCATE 25,22:PRINT "Press space bar when ready to print.";
220 A$=INKEY$:IF A$<>CHR$(32) THEN 220
225 BP=0:P$="#####":ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
230 IF PO$="SCRN:" THEN CLS
235 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:BB=3:BP=BP+1
240 PRINT #1,TAB(PMAX/2-4*NB-2);:PRINT #1,N$(NS(1));:FOR ZZ=2 TO NB:PRINT #1," by ";N$(NS(ZZ));:NEXT ZZ
245 IF NB<3 THEN PRINT #1,:PRINT #1,:GOTO 255
250 PRINT #1,TAB(PMAX-25);N$(NS(3));"= ";:IF BF=1 THEN PRINT #1,DP(BP) ELSE T=3:GOSUB 115:PRINT #1,VM+SW(3)*(BP-1);"-";VM+SW(3)*BP-10^CW/100:PRINT #1,
255 BB=2:TB=PMAX/(NN(2)+3):IF TB>18 THEN TB=18
260 IF NB=1 THEN TZ=2:GOTO 280 ELSE PRINT #1,TAB(TB+TB*NN(2)/2);N$(NS(2)):PRINT #1,N$(NS(1));
265 IF BF=1 THEN FOR TZ=1 TO NN(2):PRINT #1,TAB(TB*TZ+5);DC(TZ);:NEXT:GOTO 280
270 T=2:GOSUB 115:FOR TZ=1 TO NN(2):PRINT #1,TAB(TB*TZ+5);VM;"-";:VM=VM+SW(2):NEXT TZ
275 PRINT #1,:VM=MN(2)+SW(2)-10^CW/100:FOR TZ=1 TO NN(2):PRINT #1,TAB(TB*TZ+5);VM;:VM=VM+SW(2):NEXT TZ
280 PRINT #1,TAB(TB*TZ+6);"TOTAL"
285 IF BF=0 THEN T=1:GOSUB 115
290 BB=1:FOR Z=1 TO NN(1):RR=0
295 IF BF=1 THEN PRINT #1,DR(Z); ELSE PRINT #1,VM;"-":PRINT #1,VM+SW(1)-10^CW/100;:VM=VM+SW(1)
300 FOR TZ=1 TO NN(2):TA=CX(BP,TZ,Z):IF TA>0 THEN RR=RR+TA:IF NB>1 THEN PRINT #1,TAB(TB*TZ+7);TA;
305 NEXT TZ
310 PRINT #1,TAB(TB*TZ+7);RR:NEXT Z:RR=0:PRINT #1,:PRINT #1,"TOTAL";
315 FOR TZ=1 TO NN(2):TA=0:FOR Z=1 TO NN(1):TA=TA+CX(BP,TZ,Z):NEXT Z:RR=RR+TA:IF NB>1 THEN PRINT #1,TAB(TB*TZ+7);TA;
320 NEXT TZ:PRINT #1,TAB(TB*TZ+7);RR:PRINT #1,
325 PRINT #1,:PRINT #1,TAB(5);"Missing values: ";MS:IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
330 IF BP=NN(3) THEN 340 ELSE LOCATE 25,22:PRINT "Press space bar to print next page.     ";
335 A$=INKEY$:IF A$<>CHR$(32) THEN 335 ELSE 230
340 CLOSE #1:DQ="Do you want another crosstab report using "
345 LOCATE 25,10:PRINT DQ;:INPUT;"this DATAFILE?  ",A$
350 IF A$="y" OR A$="Y" THEN CLS:PRINT TAB(30);"DATAFILE ";FILE$:AR=CSRLIN:GOTO 35 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 345
355 LOCATE 25,7:PRINT DQ;:INPUT;"a different DATAFILE? ",A$
360 IF A$="y" OR A$="Y" THEN 20 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 355
365 LOCATE 23,1:END
4025 ERASE D,CS,T,N$,X,X2,MD,SD
4030 DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
5000 BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END