1 '                 MANTEL-HAENSZEL CHI-SQUARE TEST
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
22 DATA "MANTEL-HAENSZEL CHI-SQUARE TEST",20,33
30 PRINT TAB(13);:INPUT "Enter NAME of the factor you wish to TEST:   ",DT
35 PRINT TAB(5);:INPUT "Enter NAME of the related factor you wish to CONTROL FOR:   ",DC
40 PRINT:PRINT DT;" must be a dichotomous variable, but ";DC;" may have > 2 categories."
45 PRINT TAB(12);"How many categories does ";DC;:INPUT " have?   ",CL:PRINT
50 PRINT:PRINT TAB(32);"CASES";TAB(55);"CONTROLS": PRINT" ";DC;" CATEGORY";
55 PRINT TAB(25);"+";DT;TAB(36);"-";DT;TAB(50);"+";DT;TAB(61);"-";DT
60 PRINT STRING$(17,196);TAB(23);STRING$(48,196)
65 N=0:SA=0:SB=0:SN=0
70 FOR Z=1 TO CL:AR=CSRLIN:LOCATE AR,5:INPUT;"",A$
75 AC=27:GOSUB 170:BA=I:AC=38:GOSUB 170:BB=I:AC=52:GOSUB 170:BC=I:AC=63:GOSUB 170:BD=I:PRINT
80 N=BA+BB+BC+BD:SA=SA+BA*BD/N:SB=SB+BB*BC/N
85 SN=SN+(BA+BB)*(BA+BC)*(BC+BD)*(BB+BD)/(N*N*(N-1))
90 NEXT Z:PRINT
95 X=ABS(SA-SB)-.5:X=X*X/SN:V1=CL-1
100 COLOR CLR2,CLR1:PRINT TAB(10);"CHI-SQUARE = ";X;TAB(40);"df =";V1;
105 IF X<31 OR V1>2 THEN J=V1/2-1:R=1 ELSE P=0:GOTO 135
110 FOR B=1 TO INT(V1/2-.5):R=R*J:J=J-1:NEXT
115 IF V1 MOD 2<>0 THEN R=R*1.77245374942627#
120 S=1:I=1:VC=V1+2:K=((X/2)^(V1/2))*2/(EXP(X/2)*R*V1)
125 I=I*X/VC:S=S+I:VC=VC+2:IF I>9.999999E-31 THEN 125
130 P=1-K*S
135 PLAY "O2 MB MS T120 L16 D-P8A-P8 L3 D-"
140 PRINT TAB(55);"p = ";:IF P<.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
145 PRINT TAB(73):COLOR CLR1,CLR2
150 PRINT:PRINT:PRINT TAB(25);"ODDS RATIO = ";:IF SB=0 THEN PRINT "not calculable":GOTO 160
155 XO=SA/SB:XP=1.96/SQR(X):PRINT XO;TAB(10);"95% Confidence limits:  ";EXP((1-XP)*LOG(XO));"  and  ";EXP((1+XP)*LOG(XO))
160 LOCATE 25,5:INPUT;"Do you want to calculate another Mantel-Haenszel Chi-square?  ",A$:IF A$="y" OR A$="Y" THEN 20
165 LOCATE 23,1:END
170 LOCATE AR,AC:INPUT;"",I:IF INT(I)=I THEN RETURN ELSE BEEP:LOCATE 25,15:PRINT "Please enter integers only.";:LOCATE AR,AC:PRINT "    ":GOTO 170
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