1 '        MANTEL-HAENSZEL MATCHED CHI-SQUARE FOR MULTIPLE CONTROLS
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(1)
22 DATA "MANTEL-HAENSZEL MATCHED CHI-SQUARE FOR MULTIPLE CONTROLS",8,58
30 AR=CSRLIN:LOCATE AR+1,11:PRINT "(Press RETURN if you want to enter summary data.)"
35 LOCATE AR,1:GOSUB 4000:GOTO 95
40 PRINT TAB(10);:INPUT "How many controls are matched with each case?   ",AM:RETURN
45 PRINT:PRINT TAB(14);:INPUT "How many matched groups will you enter?   ",NM
50 GOSUB 40:INPUT "   Enter the NAME of the characteristic or factor under study:  ",DT
55 HX=0:HX2=0:XBT=0:XBC=0
60 PRINT:PRINT TAB(25);"No. of CASES";TAB(50);"No. of CONTROLS"
65 PRINT TAB(5);"Group #";TAB(26);"+ ";DT;TAB(53);"+ ";DT:PRINT STRING$(66,196)
70 FOR Z=1 TO NM:AR=CSRLIN:PRINT TAB(8);Z;
75 LOCATE AR,29:INPUT;"",AX:IF AX<>0 AND AX<>1 THEN AC=29:D1="cases":AA=0:D2="1":GOSUB 210:GOTO 75
80 LOCATE AR,56:INPUT "",BX:IF BX>AM THEN AC=56:D1="controls":AA=AM:D2="less":GOSUB 210:GOTO 80
85 CX=AX+BX:HX=HX+CX:HX2=HX2+CX*CX:XBT=XBT+BX:IF AX=1 THEN XBC=XBC+BX
90 NEXT Z:PRINT STRING$(66,196):GOTO 145
95 PRINT:PRINT:GOSUB 40:AR=CSRLIN:PRINT TAB(10);"What is the SAMPLE NUMBER of the CASE group?":AC=56:GOSUB 4200:NS(1)=NS
100 PRINT TAB(9);"What are the";AM;"SAMPLE NUMBERS of the CONTROL groups?"
105 FOR Z=2 TO AM+1:AR=CSRLIN:AC=60:GOSUB 4200:NS(Z)=NS:NEXT Z
110 FOR Z=2 TO AM+1:IF T(NS(1))<>T(NS(Z)) THEN BEEP:PRINT "These samples do not all have the same number of elements----": PRINT TAB(25);"a paired Mantel-Haenszel test cannot be performed.":GOTO 195
115 NEXT:XBT=0:XBC=0:HX=0:HX2=0
120 FOR Z=1 TO T(NS(1)):XA=VAL(D(NS(1),Z)):XB=0:IF ABS(XA-.5)>.51 THEN 205
125 FOR T=2 TO AM+1:QX=VAL(D(NS(T),Z)):XB=XB+QX:IF ABS(QX-.5)>.51 THEN 205
130 NEXT
135 XC=XA+XB:HX=HX+XC:HX2=HX2+XC*XC:XBT=XBT+XB:IF XA=1 THEN XBC=XBC+1
140 NEXT
145 X=AM*HX-(AM+1)*XBT:X=X*X/((AM+1)*HX-HX2)
150 PRINT:PRINT TAB(11);"CHI-SQUARE = ";X;TAB(53);"df = 1":IF X>31 THEN P=0:GOTO 170
155 R=1.77245374942627#:S=1:I=1:K=SQR(X/2)*2/(EXP(X/2)*R):VC=3
160 I=I*X/VC:S=S+I:VC=VC+2:IF I>9.999999E-31 THEN 160
165 P=1-K*S
170 PLAY "O3 MB MS T120 L16 D-FA- O4 L8 D- P8 O3 L3 D-":PRINT TAB(10);
175 COLOR CLR2,CLR1:PRINT TAB(30);"p = ";:IF P<.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
180 PRINT TAB(60):COLOR CLR1,CLR2:PRINT:PRINT:PRINT TAB(25);"ODDS RATIO = ";
185 IF XBT=XBC THEN PRINT "not calculable.":GOTO 195 ELSE XO=(AM*(HX-XBT)-XBC)/(XBT-XBC):PRINT XO
190 XP=1.96/SQR(X):PRINT TAB(10);"95% Confidence limits:  ";EXP((1-XP)*LOG(XO));"  and  ";EXP((1+XP)*LOG(XO))
195 LOCATE 25,8:PRINT TAB(79):LOCATE 25,8:INPUT;" Do you want to calculate another Mantel-Haenszel test?  ",A$:IF A$="y" OR A$="Y" THEN 20
200 LOCATE 23,1:END
205 BEEP:PRINT:PRINT:PRINT "An error in data entry was detected:":PRINT "All records should contain a "1" if factor is present, a "0" if it is absent.":PRINT:GOTO 195
210 BEEP:LOCATE 25,8:PRINT "The number of positive ";D1;" per group should be";AA;"or ";D2;TAB(79):LOCATE AR,AC:PRINT "     ":RETURN
4010 IF FILE$="" THEN 45
4025 ERASE D,CS,N$,X,X2,T,SD,MD,NS
4030 DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(A),SD(A),MD(A),NS(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