home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / MHCHIMLT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  2.9 KB  |  50 lines
  1. 1  '        MANTEL-HAENSZEL MATCHED CHI-SQUARE FOR MULTIPLE CONTROLS
  2. 2  '                Copyright Tracy L. Gustafson, M.D.
  3. 3  '               Round Rock, Texas. Version 3.2, 1985
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  5. 15  DIM D(1,1),CS(1,1),T(1),N$(1),X(1),X2(1),MD(1),SD(1),NS(1)
  6. 22  DATA "MANTEL-HAENSZEL MATCHED CHI-SQUARE FOR MULTIPLE CONTROLS",12,58
  7. 30  AR=CSRLIN:LOCATE AR+1,11:PRINT "(Press RETURN if you want to enter summary data.)"
  8. 35  LOCATE AR,1:GOSUB 4000:GOTO 95
  9. 40  PRINT TAB(15);"How many controls are matched with each case?";:AR=CSRLIN:AC=62:GOSUB 4800:AM=VAL(IP$):RETURN
  10. 45  PRINT:PRINT TAB(21);"How many matched groups will you enter?";:AR=CSRLIN:AC=62:GOSUB 4800:NM=VAL(IP$)
  11. 50  GOSUB 40:PRINT:INPUT "   Enter the NAME of the characteristic or factor under study:  ",DT
  12. 55  HX=0:HX2=0:XBT=0:XBC=0
  13. 60  PRINT:PRINT TAB(25);"No. of CASES";TAB(50);"No. of CONTROLS"
  14. 65  PRINT TAB(5);"Group #";TAB(26);"+ ";DT;TAB(53);"+ ";DT:PRINT STRING$(66,196)
  15. 70  FOR Z=1 TO NM:PRINT:AR=CSRLIN:PRINT TAB(8);Z;
  16. 75  AC=29:GOSUB 4800:AX=VAL(IP$):IF AX<>0 AND AX<>1 THEN AC=29:D1="cases":AA=0:D2="1":GOSUB 210:GOTO 75
  17. 80  AC=56:GOSUB 4800:BX=VAL(IP$):IF BX>AM THEN AC=56:D1="controls":AA=AM:D2="less":GOSUB 210:GOTO 80
  18. 85  CX=AX+BX:HX=HX+CX:HX2=HX2+CX*CX:XBT=XBT+BX:IF AX=1 THEN XBC=XBC+BX
  19. 90  NEXT Z:PRINT STRING$(66,196):GOTO 145
  20. 95  LOCATE 8,1:GOSUB 40:PRINT TAB(15);"What is the SAMPLE NUMBER of the CASE group?";:AR=9:AC=62:GOSUB 4200:NS(1)=NS
  21. 100  PRINT TAB(12);"What are the";AM;"SAMPLE NUMBERS of the CONTROL groups?"
  22. 105  FOR Z=2 TO AM+1:AR=CSRLIN:AC=62:GOSUB 4200:NS(Z)=NS:NEXT Z
  23. 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
  24. 115  NEXT:XBT=0:XBC=0:HX=0:HX2=0
  25. 120  FOR Z=1 TO T(NS(1)):XA=VAL(D(NS(1),Z)):XB=0:IF ABS(XA-0.5)>0.51 THEN 205
  26. 125  FOR T=2 TO AM+1:QX=VAL(D(NS(T),Z)):XB=XB+QX:IF ABS(QX-0.5)>0.51 THEN 205
  27. 130  NEXT
  28. 135  XC=XA+XB:HX=HX+XC:HX2=HX2+XC*XC:XBT=XBT+XB:IF XA=1 THEN XBC=XBC+1
  29. 140  NEXT
  30. 145  X=AM*HX-(AM+1)*XBT:X=X*X/((AM+1)*HX-HX2)
  31. 150  PRINT:PRINT TAB(15);"CHI-SQUARE = ";X;TAB(59);"df = 1":IF X>31 THEN P=0:GOTO 170
  32. 155  R=1.77245:S=1:I=1:K=SQR(X/2)*2/(EXP(X/2)*R):VC=3
  33. 160  I=I*X/VC:S=S+I:VC=VC+2:IF I>0 THEN 160
  34. 165  P=1-K*S
  35. 170  PLAY "MS O3 L64 G O2 GE L9 E":PRINT TAB(15);
  36. 175  COLOR CLR2,CLR1:PRINT TAB(34);"p = ";:IF P<9.99E-07 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
  37. 180  PRINT TAB(66):COLOR CLR1,CLR2:PRINT:PRINT:PRINT TAB(33);"ODDS RATIO = ";
  38. 185  IF XBT=XBC THEN PRINT "not calculable.":GOTO 195 ELSE XO=(AM*(HX-XBT)-XBC)/(XBT-XBC):PRINT XO
  39. 190  XP=1.96/SQR(X):PRINT TAB(16);"95% Confidence limits:  ";EXP((1-XP)*LOG(XO));"  and  ";EXP((1+XP)*LOG(XO))
  40. 195  LOCATE 25,8:PRINT TAB(79):LOCATE 25,12:INPUT;" Do you want to calculate another Mantel-Haenszel test?  ",A$:IF A$="y" OR A$="Y" THEN 20
  41. 200  GOTO 3000
  42. 205  BEEP:PRINT:PRINT:PRINT TAB(25);"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
  43. 210  BEEP:LOCATE 25,8:PRINT "The number of positive ";D1;" per group should be";AA;"or ";D2;TAB(79):RETURN
  44. 4010  IF FILE$="" THEN 45
  45. 4025  ERASE D,CS,N$,X,X2,T,SD,MD,NS
  46. 4030  DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(A),SD(A),MD(A),NS(A)
  47. 5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 2,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
  48. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  49. 5010  ON ERROR GOTO 0:END
  50.