home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / RATEADJ.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  3.0 KB  |  54 lines
  1. 1  '               DIRECT AND INDIRECT RATE ADJUSTMENT
  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)
  6. 22  DATA "RATE ADJUSTMENTS",31,18
  7. 30  LOCATE 5,1:GOSUB 4000
  8. 35  PRINT:PRINT TAB(7);:INPUT "Do you want the DIRECT or INDIRECT adjustment method? (D or I)  ",A$:DQ="Enter the SAMPLE NUMBER of the "
  9. 40  PRINT:IF A$="I" OR A$="i" THEN 85 ELSE IF A$<>"D" AND A$<>"d" THEN BEEP:GOTO 35
  10. 45  AR=CSRLIN:PRINT "   ";DQ;"study rates to be adjusted:":AC=63:GOSUB 4200:NS1=NS
  11. 50  AR=CSRLIN:PRINT "  ";DQ;"standard population figures:":GOSUB 4200:NS2=NS:GOSUB 235
  12. 55  AR=CSRLIN:PRINT TAB(18);"Rates in ";N$(NS1);" are given per what number?":GOSUB 4800:RD=VAL(IP$)
  13. 60  SR=0:FOR Z=1 TO N:SR=SR+VAL(D(NS1,Z))*VAL(D(NS2,Z)):NEXT
  14. 65  SAR=SR/X(NS2):GOSUB 230
  15. 70  PRINT TAB(15);"Direct-adjusted rate = ";SAR;"per";RD;TAB(80):COLOR CLR1,CLR2:PRINT
  16. 75  PRINT:PRINT " Remember, if the number of cases in any cell is < 5, then";
  17. 80  PRINT TAB(30);"indirect rate adjustment may be more appropriate.":GOTO 215
  18. 85  DQ="Enter the SAMPLE NUMBER of the ":AR=CSRLIN
  19. 90  PRINT TAB(6);DQ;"study population figures:";:AC=63:GOSUB 4200:NS1=NS
  20. 95  AR=CSRLIN:PRINT TAB(4);DQ;"standard population rates:";:GOSUB 4200:NS2=NS:GOSUB 235
  21. 100  AR=CSRLIN:PRINT TAB(18);"Rates in ";N$(NS2);" are given per what number?":GOSUB 4800:RD=VAL(IP$)
  22. 105  E=0:FOR Z=1 TO N:E=E+VAL(D(NS1,Z))*VAL(D(NS2,Z)):NEXT:E=E/RD:PRINT
  23. 110  AR=CSRLIN:PRINT TAB(20);"How many cases were observed in ";N$(NS1);"?"::GOSUB 4800:XO=VAL(IP$)
  24. 115  PRINT TAB(17);"Expected number of cases in the study group =";INT(E)
  25. 120  PRINT:COLOR CLR2,CLR1:PRINT TAB(14);"Adjusted rate = ";XO/E;"* STANDARD POPULATION RATE";TAB(80);:COLOR CLR1,CLR2
  26. 125  COLOR 23:PRINT:PRINT:AR=CSRLIN:PRINT TAB(28);"CALCULATING PROBABILITY";
  27. 130  AF=0:YO=XO:CE=0:IF E<YO THEN YO=YO-1:AF=1
  28. 135  IF XO>1000 THEN 170
  29. 140  IF YO=0 THEN SF=1 ELSE SF=E+1
  30. 145  F=E:FOR Z=2 TO YO:F=F*E/Z:IF F>1E+22 THEN F=F*0:SF=SF*0:CE=CE+1
  31. 150  IF F>=0 THEN SF=SF+F:NEXT Z
  32. 155  SL=LOG(SF)-E-CE*50:IF SL>80 THEN P=0 ELSE P=EXP(SL)
  33. 160  IF AF=1 THEN P=1-P
  34. 165  GOTO 190
  35. 170  X=(XO-E)*(XO-E)/E:IF X>31 THEN P=0:GOTO 190
  36. 175  R=1.77245:S=1:I=1:K=((X/2)^(0.5)*2)/(EXP(X/2)*R):VC=3
  37. 180  I=I*X/VC:S=S+I:VC=VC+2:IF I>0 THEN 180
  38. 185  P=1-K*S
  39. 190  GOSUB 230:LOCATE AR,1:PRINT TAB(10);"The probability of observing ";XO;" or ";
  40. 195  IF AF=1 THEN PRINT "more cases ="; ELSE PRINT "fewer cases =";
  41. 200  IF P<=9.99E-07 THEN PRINT " < 10 (-6)"; ELSE IF P>0.95 THEN PRINT " > .95"; ELSE PRINT P;
  42. 205  PRINT TAB(80):COLOR CLR1,CLR2:PRINT
  43. 210  IF NO>100 THEN PRINT:PRINT TAB(5);"Remember, the Poisson calculation of probability":PRINT TAB(20);"may not be applicable when the observed rate is > 5% ."
  44. 215  LOCATE 25,5:INPUT;"Do you want another rate adjustment using this DATAFILE?  ",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 35
  45. 220  LOCATE 25,47:INPUT;"a different DATAFILE?  ",A$:IF A$="y" OR A$="Y" THEN 20
  46. 225  GOTO 3000
  47. 230  PRINT:PRINT:COLOR CLR2,CLR1:PLAY "MS O3 L64 G O2 GE L9 E":RETURN
  48. 235  IF T(NS1)=T(NS2) THEN N=T(NS1):RETURN ELSE BEEP:PRINT:PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(40);"rate adjustment cannot be performed.":GOTO 215
  49. 4025  ERASE D,CS,T,N$,X,X2,MD,SD
  50. 4030  DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
  51. 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:"
  52. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  53. 5010  ON ERROR GOTO 0:END
  54.