PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #88)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “EPISTAT”
EPISTAT has a set of routines for analyzing small data sets, and is for
users well-versed in math and computer operations. The entire package
is fairly complicated and definitely not recommended for the casual
user. However, for anyone with a special interest -- chemistry,
biology, or psychology students who need a number-crunching routine in
their workflow -- it can be a boon.
All of the programs are written in BASIC and the source code is
included.
File Descriptions:
AUTOEXEC BAT Batch file to auto boot program.
ANOVA BAS One and two way analysis of variance.
CORRELAT BAS Calculates Pearson's correlation coefficient.
CHISQR BAS Chi-square test.
BINOMIAL BAS Binomial distribution.
BAYES BAS Bayes theorem to calc rates of false + and - tests. DATA-
ONE BAS Main data entry program.
EPIMRG BAS Used by every EPISTAT program.
EPISETUP BAK Backup for EPISETUP.DAT.
EPISETUP DAT Used by every EPISTAT program.
FILETRAN BAS Transfers data from one data file to another.
EPISTAT BAS Guides user to proper program to use.
FORTRANS BAS Transfers FORTRAN to EPISTAT files.
FISHERS BAS Fisher's test to evaluate 2X2 tables of discrete values.
LNREGRES BAS Two variable linear regression.
HISTOGRM BAS Graphs data sample on CGA screen. NORMAL BAS
Calculates
normal distribution.
MHCHISQR BAS Mantel-Haenszel Chi-square test.
MHCHIMLT BAS Mantel-Haenszel Chi-square test for multiple controls.
MCNEMAR BAS McNemar's test or paired Chi-square test.
SELECT BAS Select subset of a data set.
SCATRGRM BAS Graph scattergrams.
SAMPLSIZ BAS Calculates sample sizes for statistical significance.
RATEADJ BAS Rate adjustment program.
RANKTEST BAS Three tests - signed rank, rank correlation and rank sum.
RANDOMIZ BAS Random sample generator.
PRINTDOC Documentation file (25K).
POISSON BAS Calculates Poisson distribution.
T-TEST BAS T-test compares mean of 2 samples (paired and unpaired).
XTAB BAS Print crosstab reports.
EXAMPLE Sample data set.
ANOVA.BAS
1 ' ANALYSIS OF VARIANCE
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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 "ANALYSIS OF VARIANCE",29,22
30 PRINT:PRINT TAB(14);"1.) 1-WAY ANOVA. For comparing the MEANS of 3 or": PRINT TAB(19);"more independent samples. (unpaired test)":PRINT
35 PRINT TAB(14);"2.) 2-WAY ANOVA. For evaluating the combined effects":PRINT TAB(19);"of 2 variables on a third. (ROW and COLUMN effects)":PRINT
40 PRINT TAB(14);"3.) Evaluate known F value.":PRINT:PRINT
45 LOCATE 15,31:PRINT "Enter choice:":AR=15:AC=45:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 45 ELSE IF ASUB<3 THEN 85
50 CLS:PRINT TAB(27);"F PROBABILITY DISTRIBUTION":PRINT TAB(27);STRING$(26,205)
55 LOCATE 6,29:INPUT "Enter F value: ",F:PRINT
60 PRINT TAB(18);:INPUT "Enter degrees of freedom in NUMERATOR: ",V1:PRINT
65 PRINT TAB(16);:INPUT "Enter degrees of freedom in DENOMINATOR: ",V2
70 PRINT:GOSUB 365
75 COLOR CLR1,CLR2:LOCATE 23,17:INPUT "Do you want to evaluate another F value? ",A$
80 IF A$="y" OR A$="Y" THEN 50 ELSE 360
85 LOCATE 17,1:GOSUB 4000
90 FOR T=1 TO INT((A-1)/7):SCREEN ,,T,0:CLS:NEXT:SCREEN ,,0
95 CLS:ON ASUB GOTO 100,265
100 PRINT TAB(27);"ONE-WAY ";DTTL:PRINT TAB(27);STRING$(28,205):PRINT
105 PRINT TAB(23);FILE$;" has ";A;" samples/variables."
110 PRINT TAB(13);:INPUT "How many variables do you want to include in the ANOVA? ",AMX
115 IF AMX<1 OR AMX>A THEN BEEP:GOTO 110
120 PRINT "Enter these";AMX;"sample numbers:":ERASE NS:DIM NS(AMX):PRINT
125 AR=CSRLIN:FOR AS=1 TO INT((AMX-1)/7):SCREEN ,,AS,0:CLS:NEXT:SCREEN ,,0
130 FOR AS=0 TO INT((AMX-1)/7):A2=AS*7+7:IF A2>AMX THEN A2=AMX
135 A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:PRINT "Sample #:";
140 FOR T=A1 TO A2:AC=(T-A1+1)*10+1
145 GOSUB 4800:NS(T)=VAL(IP$):IF NS(T)<1 OR NS(T)>A THEN BEEP:LOCATE 25,25:PRINT FILE$;" has only";A;"samples.";:LOCATE AR,AC:PRINT " ":GOTO 145
150 NEXT:NEXT AS:PRINT:AR=CSRLIN
155 FOR AS=0 TO INT((AMX-1)/7):A2=AS*7+7:IF A2>AMX THEN A2=AMX
160 A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1
165 PRINT "NAME:";:FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-2);N$(NS(T));:NEXT
170 PRINT:PRINT "MEAN:";:FOR T=A1 TO A2:MN=X(NS(T))/T(NS(T)):MB=ABS(MN):GOSUB 205
175 PRINT TAB((T-A1+1)*10-3);:PRINT USING P$;MN;:NEXT
180 PRINT:PRINT "VAR:";:FOR T=A1 TO A2:MB=SD(NS(T))^2:GOSUB 205
185 PRINT TAB((T-A1+1)*10-3);:PRINT USING P$;MB;:NEXT
190 LOCATE 25,17:IF A2<AMX THEN PRINT "Press P to print next page of variances."; ELSE PRINT " Press C to continue calculations.";
195 A$=INKEY$:IF A$="" THEN 195 ELSE LOCATE 25,15:PRINT TAB(70);:IF A$="P" OR A$="p" THEN NEXT AS ELSE IF A$<>"C" AND A$<>"c" THEN BEEP:GOTO 190
200 SCREEN,,0:LOCATE AR+4,1:ON ASUB GOTO 215,270
205 IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
210 RETURN
215 XM=0:XM2=0:NT=0:ST=0:XT2=0:M1=0:M2=0:MV=0
220 FOR T=1 TO AMX:NS=NS(T):XM=XM+X(NS):XM2=XM2+X2(NS):NT=NT+T(NS):XT2=XT2+X(NS)*X(NS)/T(NS)
225 MV=MV+SD(NS)*SD(NS):M=X(NS)/T(NS):M1=M1+M:M2=M2+M*M:NEXT
230 ST=XT2-XM*XM/NT:SS=XM2-XM*XM/NT:ES=SS-ST:MV=MV/AMX
235 V1=AMX-1:V2=NT-AMX:F=ST/V1*V2/ES:VM=(M2-M1*M1/AMX)/V1
240 PRINT TAB(8);"F";TAB(20);"df N";TAB(30);"df D";TAB(40);"TOTAL SS";TAB(53);"TRTMT SS";TAB(65);"ERROR SS"
245 PRINT TAB(5);F;TAB(20);V1;TAB(30);V2;TAB(39);SS;TAB(52);ST;TAB(64);ES
250 PRINT:PRINT TAB(10);"MEAN VARIANCE";TAB(56);"VARIANCE OF MEANS":PRINT TAB(11);MV;TAB(59);VM:GOSUB 365
255 PRINT TAB(13);"The MEANS of these samples are ";:IF P>0.05 THEN PRINT "NOT ";
260 PRINT "significantly different.";TAB(80):COLOR CLR1,CLR2:GOTO 340
265 PRINT TAB(27);"TWO-WAY ";DTTL:PRINT TAB(27);STRING$(28,205):PRINT:GOTO 105
270 FOR T=2 TO AMX:IF T(NS(T))<>T(NS(1)) THEN PRINT "These samples do not all have the same number of elements---": PRINT TAB(37);"a 2-WAY ANOVA cannot be performed.":GOTO 340 ELSE NEXT
275 XR2=0:XM=0:XM2=0:XC2=0:MV=0:VM2=0:N=T(NS(1)):NT=AMX*N
280 FOR Z=1 TO N:XR=0:FOR T=1 TO AMX:XR=XR+VAL(D(NS(T),Z)):NEXT
285 XR2=XR2+XR*XR/AMX:NEXT
290 FOR T=1 TO AMX:NS=NS(T):XM=XM+X(NS):XM2=XM2+X2(NS):XC2=XC2+X(NS)*X(NS)/N:NEXT
295 SS=XM2-XM*XM/NT:SR=XR2-XM*XM/NT:SC=XC2-XM*XM/NT:RES=SS-SR-SC
300 V1=N-1:V2=(N-1)*(AMX-1):F=SR/V1*V2/RES
305 PRINT TAB(8);"F (ROW)";TAB(23);"df N";TAB(33);"df D";TAB(47);"TOTAL SS";TAB(60);"ROW SS";
310 PRINT TAB(6);F;TAB(23);V1;TAB(33);V2;TAB(46);SS;TAB(58);SR;
315 GOSUB 365:TB=16:DI="ROWS":GOSUB 465
320 V1=AMX-1:F=SC/V1*V2/RES:PRINT:PRINT
325 PRINT TAB(7);"F (COLUMN)";TAB(23);"df N";TAB(33);"df D";TAB(48);"COL SS";TAB(59);"RESIDUAL";
330 PRINT TAB(7);F;TAB(23);V1;TAB(33);V2;TAB(46);SC;TAB(58);RES;
335 GOSUB 365:TB=14:DI="COLUMNS":GOSUB 465
340 LOCATE 24,5:PRINT "Do you want to perform another ANALYSIS OF VARIANCE ";:LOCATE 25,50:INPUT;"using this datafile? ",A$
345 IF A$="y" OR A$="Y" THEN 95 ELSE IF A$="N" OR A$="n" THEN 350 ELSE BEEP:GOTO 340
350 LOCATE 25,47:INPUT;" using a different datafile? ",A$
355 IF A$="y" OR A$="Y" THEN 20
360 GOTO 3000
365 X=1/(V1/V2*F+1):Y=1-X:PF=1:PT=1:VA=V1:VB=V2
370 IF V1 MOD 2<>0 THEN IF V2 MOD 2=0 THEN 390 ELSE 400
375 IF V2 MOD 2=0 THEN IF V2>=V1 THEN 390
380 FOR Z=1 TO (V1/2-1):PF=PF*(0.5/Z*Y*VB):PT=PT+PF:VB=VB+2:NEXT
385 P=X^(V2*0.5)*PT:GOTO 450
390 FOR Z=1 TO (V2/2-1):PF=PF*(0.5/Z*X*VA):PT=PT+PF:VA=VA+2:NEXT
395 P=1-Y^(V1*0.5)*PT:GOTO 450
400 XT=ATN(SQR(F*V1/V2)):X=SIN(XT):Y=COS(XT):PT=Y:PF=Y
405 IF V2=1 THEN 420
410 FOR Z=2 TO (V2-3) STEP 2:PF=PF*Y*Y*Z/(Z+1):PT=PT+PF:NEXT
415 PT=PT*X:XT=XT+PT
420 PT=1:PF=1:IF V1=1 THEN 445
425 FOR Z=2 TO (V2-1) STEP 2:PF=PF*Z/(Z-1):NEXT
430 PF=PF*Y^V2*X:PZ=1:PT=1:VB=V2+1
435 FOR Z=3 TO (V1-2) STEP 2:PZ=PZ*VB*X*X/Z:PT=PT+PZ:VB=VB+2:NEXT
440 XT=XT-PT*PF
445 P=1-XT*2/3.141592653599#
450 PLAY "MS O3 L64 G O2 GE L9 E"
455 PRINT TAB(28);:COLOR CLR2,CLR1:PRINT" p = ";:IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
460 PRINT TAB(53):PRINT:RETURN
465 PRINT TAB(TB);"There is ";:IF P>0.05 THEN PRINT "NOT ";
470 PRINT "a significant difference between ";DI;TAB(80):COLOR CLR1,CLR2:RETURN
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 2,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
BAYES.BAS
1 ' BAYES' THEOREM
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1),PT(1),PD(1)
22 DATA "BAYES' THEOREM",32,16
30 PRINT" This theorem is especially valuable in evaluating the prior probability":PRINT " of disease given a certain symptom, sign or laboratory result."
35 PRINT:PRINT:PRINT "Do you want to evaluate the: ":PRINT
40 PRINT TAB(12);"1.) Probabilities of False Positive and False Negative tests":PRINT
45 PRINT TAB(12);"2.) Probability of Disease given a Positive test"
50 LOCATE 15,25:PRINT "Enter choice:":AR=15:AC=39:GOSUB 4800:ASUB=VAL(IP$):IF ABS(1.5-ASUB)>0.5 THEN BEEP:GOTO 50
55 CLS:ON ASUB GOTO 60,115
60 PRINT TAB(12);"PROBABILITIES OF FALSE POSITIVE AND FALSE NEGATIVE TESTS":PRINT TAB(12);STRING$(56,205):PRINT
65 INPUT " What is the NAME of the disease or condition being tested for? ",D(1)
70 DQ="What is the probability of a POSITIVE test":PRINT TAB(5);DQ:PRINT TAB(37);:PRINT "when a person has ";D(1);:INPUT PT:IF ABS(PT-0.5)>=0.5 THEN GOSUB 215:GOTO 70
75 PRINT TAB(27);"TEST SENSITIVITY = ";PT*100;"%":PRINT
80 PRINT TAB(5);DQ:PRINT TAB(30);:PRINT "when a person does not have ";D(1);:INPUT PF:IF ABS(PF-0.5)>=0.5 THEN GOSUB 215:GOTO 80
85 PRINT TAB(27);"TEST SPECIFICITY = ";(1-PF)*100;"%":PRINT
90 PRINT TAB(8);"Enter estimated incidence of ";D(1):PRINT TAB(10);:INPUT "in the population in which the test is used (PER/10,000) = ",PD:IF PD>10000 THEN BEEP:GOTO 90
95 PD=PD*0.0001:PP=(PF*(1-PD))/(PF+PD*(PT-PF)):PN=((1-PT)*PD)/(1-PF-PD*(PT-PF))
100 GOSUB 210:PRINT:PRINT:COLOR CLR2,CLR1
105 PRINT TAB(10);"The probability of a FALSE POSITIVE result is ";PP;TAB(80):PRINT:PRINT
110 PRINT TAB(10);"The probability of a FALSE NEGATIVE result is ";PN;TAB(80):COLOR CLR1,CLR2:GOTO 195
115 PRINT TAB(19);"PROBABILITIES OF DISEASE GIVEN A POSITIVE TEST":PRINT TAB(19);STRING$(46,205):PRINT
120 PRINT TAB(5); "What is the name of the SYMPTOM COMPLEX, PHYSICAL FINDING,": PRINT TAB(27);:INPUT "or LABORATORY TEST under consideration? ",T$
125 PRINT TAB(5);"In the tested population, HOW MANY DISEASES exist ":PRINT TAB(33);:INPUT "in which this test can be positive? ",N:PRINT
130 ERASE PT,PD,D:DIM PT(N),PD(N),D(N):TF=0
135 PRINT TAB(15);" PERCENT of people PROBABILITY of a "
140 PRINT TAB(15);" in tested population + test in people"
145 PRINT TAB(15);"who have this disease: known to have"
150 PRINT TAB(3);"DISEASE (SUM must = 100%) this disease:": PRINT
155 FOR Z=1 TO N:PRINT Z;:IF TF=1 THEN PRINT D(Z); ELSE INPUT;"",D(Z)
160 PRINT TAB(24);:INPUT;"",P:PD(Z)=P*0.01:PRINT TAB(46);:INPUT "",PT(Z):NEXT Z
165 SP=0:FOR Z=1 TO N:SP=SP+PD(Z)*PT(Z):NEXT
170 LOCATE 9,60:COLOR CLR2,CLR1:PRINT " PROBABILITY of ":LOCATE 10,60:PRINT " this disease in ":LOCATE 11,60:PRINT " a person with a ":LOCATE 12,60:PRINT " positive test: ":GOSUB 210
175 FOR Z=1 TO N:LOCATE 13+Z,66:PRINT USING ".######";PD(Z)*PT(Z)/SP:NEXT
180 COLOR CLR1,CLR2:LOCATE 24,1:PRINT "Would you like to modify these calculations in relation to";
185 LOCATE 25,34:INPUT;"the SAME TEST and the SAME DISEASES? ",A$
190 IF A$="y" OR A$="Y" THEN TF=1:CLS:LOCATE 4,30:PRINT "TEST = ";T$:LOCATE 9,1:GOTO 135
195 LOCATE 24,1:PRINT TAB(80):LOCATE 25,1:PRINT TAB(79):LOCATE 25,12:INPUT;"Do you want another calculation using Bayes' Theorem? ",A$
200 IF A$="Y" OR A$="y" THEN 20
205 GOTO 3000
210 PLAY "MS O3 L64 G O2 GE L9 E":RETURN
215 BEEP:AR=CSRLIN:LOCATE 25,15:PRINT "Probability should be a fraction between 0 and 1.";:LOCATE AR,1:RETURN
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
BINOMIAL.BAS
1 ' BINOMIAL DISTRIBUTION (one-tailed)
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
22 DATA "BINOMIAL PROBABILITY DISTRIBUTION",22,35
30 PRINT TAB(8);"The binomial distribution provides a one-tailed exact test":PRINT "applicable when a dichotomous variable has an equal probability of occurring":PRINT TAB(27);"in each of N trials."
35 LOCATE 9,27:PRINT "Enter the number of trials:"
40 AR=9:AC=56:GOSUB 4800:XN=VAL(IP$):IF INT(XN)=XN THEN NT=XN ELSE GOSUB 165:GOTO 40
45 LOCATE 11,11:PRINT "Enter probability of success on each trial:"
50 AR=11:GOSUB 4800:PS=VAL(IP$):IF ABS(PS-0.5)>0.5 THEN LOCATE 25,18:PRINT "Probability should be fraction between 0 and 1";:GOSUB 170:GOTO 50
55 LOCATE 13,15:PRINT "Enter the number of successes observed:"
60 AR=13:GOSUB 4800:XN=VAL(IP$):IF INT(XN)=XN THEN NO=XN ELSE AR=13:GOSUB 165:GOTO 60
65 COLOR 23:LOCATE 17,29:PRINT "CALCULATING PROBABILITY"
70 IF NO>INT(PS*NT) THEN AF=1:PS=1-PS:CO=NT-NO ELSE AF=0:CO=NO
75 QS=1-PS:F=1:LQ=LOG(QS):LP=LOG(PS):P=EXP(NT*LQ)
80 FOR T=1 TO CO:FZ=NT-T:S=T*LP+FZ*LQ
85 IF F>1.000000e+35 OR S<-80 THEN F=LOG(F):GOTO 95
90 F=F*(FZ+1)/T:P=P+F*EXP(S):NEXT T:GOTO 110
95 FOR Z=T TO CO:FZ=(NT-Z):S=Z*LP+FZ*LQ:F=F+LOG((FZ+1)/Z)
100 IF F+S>-86 THEN P=P+EXP(F+S)
105 NEXT Z
110 PLAY "MS O3 L64 G O2 GE L9 E"
115 LOCATE 17,1:COLOR CLR2,CLR1:PRINT TAB(8);"The probability of observing ";NO;" or ";:IF AF=1 THEN PRINT "more"; ELSE PRINT "fewer";
120 PRINT " cases ";:GOSUB 155:PRINT TAB(80):COLOR CLR1,CLR2
125 IF PS=0.5 THEN P=P*2:PRINT TAB(20);"Two-tailed probability ";:GOSUB 155
130 IF NT*PS<10 OR NT*QS<10 OR P>0.05 THEN 145 ELSE P$=".#####"
135 PRINT:PRINT:PRINT TAB(15);"The observed proportion of successes is ";:PRINT USING P$;NO/NT
140 PRINT TAB(8);"Confidence limits can be calculated as: ";:PRINT USING P$;NO/NT;:PRINT " +/- Z * ";:PRINT USING P$;SQR(PS*QS/NT)
145 LOCATE 25,12:INPUT;"Do you want to perform another binomial calculation? ",A$:IF A$="y" OR A$="Y" THEN 20
150 GOTO 3000
155 IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE IF P>0.95 THEN PRINT "> .95"; ELSE PRINT "= ";P;
160 RETURN
165 LOCATE 25,24:PRINT "Please enter integers only.";
170 BEEP:LOCATE AR,AC:PRINT " ":RETURN
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
CHISQR.BAS
1 ' CHI-SQUARE TEST
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM XC(1,1),SR(1),SC(1):P$="######"
22 DATA "CHI-SQUARE TEST",32,17
30 LOCATE 5,5:PRINT "Do you want to evaluate a:":PRINT
35 PRINT TAB(29);"1.) Table of data.":PRINT
40 PRINT TAB(29);"2.) Known chi-square value.":PRINT
45 PRINT TAB(29);"3.) Chi-square test for trend."
50 LOCATE 15,34:PRINT "Enter choice:":AR=15:AC=48:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 50
55 CLS:ON ASUB GOTO 110,100,60
60 AF=0:PRINT TAB(30);DTTL;" FOR TREND":PRINT TAB(30);STRING$(25,205):N1=0:N2=0:E1=0:E2=0:E3=0
65 LOCATE 6,6:INPUT "Enter NAME of factor you wish to test for dose response: ",DC
70 PRINT TAB(25);"How many levels does ";DC;" have?":AR=7:AC=53+LEN(DC):GOSUB 4800:CL=VAL(IP$):PRINT
75 AR=CSRLIN:LOCATE 25,5:PRINT "Exposure levels should be ranks or midpoints of exposure categories.";:LOCATE AR+1,1
80 PRINT DC;" EXPOSURE LEVEL";TAB(35);"CASES";TAB(50);"CONTROLS":PRINT STRING$(60,196)
85 FOR Z=1 TO CL:AR=CSRLIN:INPUT;" ",XE:AC=36:GOSUB 285:BA=I:AC=53:GOSUB 285:BB=I:PRINT
90 M=BA+BB:N1=N1+BA:N2=N2+BB:E1=E1+BA*XE:E2=E2+M*XE:E3=E3+M*XE*XE:NEXT Z
95 N=N1+N2:X=E1-(N1*E2/N):X=X*X*(N*N*(N-1))/(N1*N2*(N*E3-E2*E2)):V1=1:GOTO 160
100 GOSUB 280:AF=0:LOCATE 6,28:PRINT "Enter chi-square value:":AR=6:AC=53:GOSUB 4800:X=VAL(IP$)
105 LOCATE 8,26:PRINT "Enter degrees of freedom:":AR=8:GOSUB 4800:V1=VAL(IP$):PRINT:GOTO 165
110 GOSUB 280:AF=1:LOCATE 4,10:PRINT "How many ROWS?":AR=4:AC=25:GOSUB 4800:NR=VAL(IP$):PRINT TAB(48);"How many COLUMNS?":AC=66:GOSUB 4800:NC=VAL(IP$)
115 ERASE XC,SR,SC:DIM XC(NR,NC),SR(NR),SC(NC):PRINT:PRINT
120 TB=INT(75/(NC+1))+(NC<5)*20/NC:F=((NR*NC)=4)*(-0.5):V1=(NR-1)*(NC-1)
125 SN=0:CQ=0:X=0:PRINT "Enter your table values:";TAB(TB*(NC+1));"TOTAL":PRINT
130 FOR AX=1 TO NR:AR=CSRLIN:FOR AY=1 TO NC
135 AC=AY*TB:GOSUB 285:XC(AX,AY)=I:SR(AX)=SR(AX)+I:NEXT
140 LOCATE AR,TB*AY-3:PRINT USING P$;SR(AX):SN=SN+SR(AX):PRINT:NEXT
145 PRINT "TOTAL";:AR=CSRLIN:FOR AY=1 TO NC:FOR AX=1 TO NR:SC(AY)=SC(AY)+XC(AX,AY):NEXT:LOCATE AR,TB*AY-4:PRINT USING P$;SC(AY);:NEXT:LOCATE AR,TB*AY-3:PRINT USING P$;SN
150 FOR AX=1 TO NR:FOR AY=1 TO NC:E=SR(AX)*SC(AY)/SN:IF E<5 THEN CQ=1
155 XZ=ABS(XC(AX,AY)-E)-F:XZ=XZ*XZ/E:X=X+XZ:NEXT:NEXT
160 PRINT:PRINT TAB(16);"CHI-SQUARE = ";X;TAB(57);"df =";V1
165 IF X<31 OR V1>2 THEN J=V1/2-1:R=1 ELSE P=0:GOTO 195
170 FOR B=1 TO INT(V1/2-0.5):R=R*J:J=J-1:NEXT
175 IF V1 MOD 2<>0 THEN R=R*1.77245374942627#
180 S=1:I=1:K=((X/2)^(V1/2))*2/(EXP(X/2)*R*V1):VC=V1+2
185 I=I*X/VC:S=S+I:VC=VC+2:IF I>9.999999e-31 THEN 185
190 P=1-K*S
195 PLAY "MS O3 L64 G O2 GE L9 E":PRINT:PRINT TAB(15);
200 COLOR CLR2,CLR1:PRINT TAB(32);"p = ";:IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
205 PRINT TAB(66):COLOR CLR1,CLR2
210 IF AF=0 THEN 235 ELSE IF V1>1 THEN 230 ELSE PRINT:PRINT:PRINT TAB(28);"ODDS RATIO = ";
215 XD=XC(1,2)*XC(2,1):IF XD=0 THEN PRINT "not calculable";:GOTO 230 ELSE XO=XC(1,1)*XC(2,2)/XD:PRINT XO:IF XO=0 THEN 230
220 M1=SR(1):M2=SR(2):N1=SC(1):N2=SC(2):YA=XC(1,1)
225 PRINT TAB(14);"95% Confidence limits: ";:F=-1:GOSUB 245:PRINT " and ";:F=1:GOSUB 245
230 IF CQ=1 THEN PRINT:PRINT:PRINT "The Chi-square test may not be applicable in this case---":PRINT TAB(24);"because the expected count in one or more cells is < 5."
235 LOCATE 25,1:PRINT TAB(79):LOCATE 25,15:INPUT;"Do you want to calculate another Chi-square test? ",A$:IF A$="y" OR A$="Y" THEN 20
240 GOTO 3000
245 N=0:Y1=YA
250 Y=1/Y1+1/(M1-Y1)+1/(N1-Y1)+1/(N2-M1+Y1):IF Y<0 THEN 270
255 Y2=YA+F*0.5+F*1.96*(1/Y1+1/(M1-Y1)+1/(N1-Y1)+1/(N2-M1+Y1))^-0.5:N=N+1
260 IF ABS(Y1-Y2)>0.000009999999 AND N<500 THEN Y1=Y2:GOTO 250
265 IF N<500 THEN PRINT Y2*(N2-M1+Y2)/((M1-Y2)*(N1-Y2));:RETURN
270 XP=1.96/SQR(X):X1=EXP((1-XP)*LOG(XO)):X2=EXP((1+XP)*LOG(XO)):IF F=SGN(X1-X2) THEN PRINT X1; ELSE PRINT X2;
275 RETURN
280 PRINT TAB(34);DTTL:PRINT TAB(34);STRING$(15,205):PRINT:RETURN
285 GOSUB 4800:I=VAL(IP$):IF INT(I)=I THEN RETURN ELSE BEEP:LOCATE 25,20:PRINT "Please enter integers only.";:LOCATE AR,AC:PRINT " ";:GOTO 285
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
CORRELAT.BAS
1 ' CORRELATION COEFFICIENTS
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1,1),CS(1,1),N$(1),X(1),X2(1),T(1),MD(1),SD(1)
22 DATA "CORRELATION COEFFICIENTS",27,26
30 LOCATE 6,22:PRINT "1.) Pearson's correlation coefficient":PRINT
35 PRINT TAB(22);"2.) Spearman's rank correlation"
40 LOCATE 11,27:PRINT "Enter choice:":AR=11:AC=41:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-1.5)>0.5 THEN BEEP:GOTO 40
45 AF=0:CLS:ON ASUB GOTO 50,195
50 PRINT TAB(25);"PEARSON'S CORRELATION COEFFICIENT":PRINT TAB(25);STRING$(33,205):PRINT
55 LOCATE 5,1:IF BF=1 THEN 100 ELSE PRINT " (Enter RETURN if you wish to evaluate significance of a known R value)"
60 LOCATE 4,1:GOSUB 4000:BF=1:GOTO 100
65 AF=1:LOCATE 8,32:PRINT "Enter R value:":AR=8:AC=47:GOSUB 4800:SR=VAL(IP$):SR2=SR*SR
70 IF ABS(SR)>=1 THEN BEEP:LOCATE 25,3:PRINT "Your correlation coefficient should be a decimal fraction between -1 and 1.";:GOTO 65
75 LOCATE 9,25:PRINT "Number of data pairs:":AR=9:AC=47:GOSUB 4800:N=VAL(IP$):PRINT:GOTO 120
80 PRINT:PRINT:PRINT TAB(7);"What are the SAMPLE NUMBERS of the 2 variables you want to correlate?":PRINT:AR=CSRLIN
85 AC=17:GOSUB 4200:NS1=NS:AC=50:GOSUB 4200:NS2=NS
90 IF T(NS1)<>T(NS2) THEN PRINT:PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(32);"a correlation coefficient cannot be calculated.":GOTO 235
95 N=T(NS1):RETURN
100 GOSUB 80:XC=0:FOR Z=1 TO N:XC=XC+VAL(D(NS1,Z))*VAL(D(NS2,Z)):NEXT
105 SC=XC-X(NS1)*X(NS2)/N:SX=X2(NS1)-X(NS1)*X(NS1)/N:
110 SY=X2(NS2)-X(NS2)*X(NS2)/N:SR2=SC*SC/(SX*SY)
115 PRINT:PRINT TAB(20);"Correlation coefficient = ";SC/SQR(SX*SY):PRINT
120 PRINT:V1=N-2:ST=SQR(SR2*V1/(1-SR2))
125 PRINT TAB(7);"Significance of correlation: T = ";ST;SPC(7);"df = ";V1
130 R=ATN(ST/SQR(V1)):RC=COS(R):R2=RC*RC:RS=SIN(R):X=1
135 IF V1 MOD 2=0 THEN 160
140 IF V1=1 THEN Y=R:GOTO 155
145 Y=RC:FOR Z=3 TO (V1-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X*RC:NEXT
150 Y=R+RS*Y
155 P=1-Y*0.636619772365716#:GOTO 170
160 Y=1:FOR Z=2 TO (V1-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X:NEXT
165 P=1-Y*RS
170 PLAY "MS O3 L64 G O2 GE L9 E"
175 PRINT:PRINT TAB(28);"p = ";:IF P<0.000001 THEN PRINT "< 10 (-6)" ELSE PRINT P
180 PRINT:COLOR CLR2,CLR1:PRINT TAB(9);"This correlation coefficient is ";
185 IF P>0.05 THEN PRINT "NOT ";
190 PRINT "significantly different than 0";TAB(80):COLOR CLR1,CLR2:GOTO 235
195 PRINT TAB(27);"SPEARMAN'S RANK CORRELATION":PRINT TAB(27);STRING$(27,205)
200 LOCATE 4,1:IF BF=0 THEN GOSUB 4000:BF=1
205 GOSUB 80:CD=0:S2=0
210 FOR Z=1 TO N:FOR T=1 TO N:IF CS(NS1,Z)=CS(NS2,T) THEN CD=Z-T:S2=S2+CD*CD
215 NEXT:NEXT:SR=1-(6*S2/(N*(N*N-1)))
220 PLAY "MS O3 L64 G O2 GE L9 E":PRINT:PRINT TAB(10);:COLOR CLR2,CLR1
225 PRINT TAB(20); "Correlation coefficient = ";SR;TAB(70):COLOR CLR1,CLR2
230 PRINT:PRINT:PRINT " The probability that a given value of Spearman's correlation coefficient is":PRINT " significantly different than 0 can be evaluated by reference to tables.":PRINT TAB(28);"(See Colton, p. 353)"
235 LOCATE 25,1:PRINT TAB(79):DQ="Would you like to "
240 IF AF=1 THEN LOCATE 25,8:PRINT DQ;:INPUT;"evaluate another correlation coefficient? ",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 65 ELSE 255
245 LOCATE 25,2:PRINT DQ;:INPUT;"calculate another correlation using this DATAFILE? ",A$:IF A$="y" OR A$="Y" THEN 20
250 LOCATE 25,56:INPUT;"a different DATAFILE? ",A$:IF A$="y" OR A$="Y" THEN BF=0:GOTO 20
255 GOTO 3000
4010 IF FILE$="" THEN 65
4025 ERASE D,CS,N$,X,X2,T,MD,SD
4030 DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(A),MD(A),SD(A)
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
DATA-ONE.BAS
1 ' STATISTICAL DATA ENTRY PROGRAM
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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)
22 DATA "STATISTICAL DATA ENTRY PROGRAM",23,32
30 AFI=0:LOCATE 6,27:PRINT "1.) INITIAL DATA ENTRY"
35 PRINT:PRINT TAB(27);"2.) APPEND DATA"
40 PRINT:PRINT TAB(27);"3.) EDIT DATA"
45 PRINT:PRINT TAB(27);"4.) PRINT DATA"
50 PRINT:PRINT TAB(27);"5.) SAVE DATA TO DISK"
55 PRINT:PRINT TAB(27);"6.) LOAD DATA FROM DISK"
60 PRINT:PRINT TAB(27);"7.) EXIT":PRINT
65 LOCATE 21,27:PRINT "Enter choice:";:AR=21:AC=42:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-4)>3 THEN BEEP:GOTO 65
70 ON ASUB GOTO 155,355,375,505,735,750,775
75 COLOR CLR2,CLR1:LOCATE 25,55:PRINT " F10 = STOP ";:COLOR CLR1,CLR2:LOCATE AR,1:RETURN
80 GOSUB 75:TB=1:PRINT "Sample Name = ";:AC=6:T=1:A1=0:IF APND=1 THEN PRINT N$(1) ELSE INPUT "",N$(1)
85 C=C+1
87 AR=8+INT((C-1)/6):IF AR>24 THEN AR=24
88 AC=6+((C-1) MOD 6)*13:LOCATE AR,AC-5:PRINT USING "###:";C;
90 GOSUB 800:DI=IP$:IF DI="" THEN 120
95 VC=VAL(DI):T(1)=T(1)+1:X(1)=X(1)+VC:X2(1)=X2(1)+VC*VC
100 FOR Z=1 TO T(1)-1:VX=VAL(D(1,CS(1,Z))):IF VX<=VC THEN 110
105 FOR TZ=T(1) TO Z+1 STEP -1:CS(1,TZ)=CS(1,TZ-1):NEXT:GOTO 115
110 NEXT Z
115 CS(1,Z)=C
120 D(1,C)=DI:IF NOT JF THEN 130 ELSE IF DI="" THEN C=C-1
125 GOTO 150
130 IF AC>=71 THEN PRINT
135 GOTO 85
140 AR=CSRLIN:LOCATE 25,30:PRINT TAB(79):IF AR>22 THEN PRINT:PRINT:LOCATE 24,1 ELSE LOCATE AR+1,1
145 RETURN
150 GOSUB 140:GOSUB 305:OPEN "SCRN:" FOR OUTPUT AS #1:GOTO 595
155 AFI=-1:LOCATE 23,3:PRINT "How many samples or variables would you like to enter? (1 to 28)";:AR=23:AC=70:GOSUB 4800:A=VAL(IP$):IF A<1 OR A>28 THEN BEEP:GOTO 155
160 GOSUB 350:APND=0:ERASE D,CS,N$,X,X2,T,MD,SD
165 DIM D(A,2000/A),CS(A,2000/A),N$(A),X(A),X2(A),T(A),MD(A),SD(A)
170 C=0:FILE$="":PRINT "First NAME your samples or variables, then ENTER ";
175 PRINT "data:"
180 PRINT TAB(16);"1.) Press `RETURN' key to enter a value."
185 PRINT TAB(16);"3.) Press `TAB' key to back-up";:IF A>1 THEN PRINT " on same row." ELSE PRINT "."
190 PRINT TAB(16);"2.) Press `F10' key after last data entry."
195 PRINT:AR=CSRLIN:IF A=1 THEN 80
200 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
205 A1=AS*7+1:SCREEN ,,AS,0
210 FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);"Sample";T;:NEXT:GOSUB 75:NEXT AS
215 PRINT:AR=CSRLIN
220 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
225 A1=AS*7+1:SCREEN ,,AS,(APND=0)*(-AS):LOCATE AR,1:PRINT "NAME=";
230 FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);:IF APND=1 THEN PRINT N$(T); ELSE INPUT;"",N$(T)
235 NEXT:NEXT AS:PRINT:PRINT
240 AR=CSRLIN:C=C+1
245 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
250 A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:PRINT USING "###:";C;
255 FOR T=A1 TO A2
260 AC=(T-A1+1)*10-3:GOSUB 800:DI=IP$:VC=VAL(DI):IF DI="" THEN 287
265 VC=VAL(DI):T(T)=T(T)+1:X(T)=X(T)+VC:X2(T)=X2(T)+VC*VC
270 FOR Z=1 TO T(T)-1:VX=VAL(D(T,CS(T,Z))):IF VX<=VC THEN 280
275 FOR TZ=T(T) TO Z+1 STEP -1:CS(T,TZ)=CS(T,TZ-1):NEXT:GOTO 285
280 NEXT Z
285 CS(T,Z)=C
287 D(T,C)=DI:IF NOT JF THEN 300 ELSE IF DI="" THEN C=C-1
290 GOTO 320
300 NEXT T:PRINT:NEXT AS:GOTO 240
305 SCREEN ,,0:FOR T=1 TO A:N=T(T):MD(T)=0:VC=0:IF N>1 THEN MN=X(T)/N ELSE MN=X(T):SD(T)=0:GOTO 310
307 FOR ZZ=1 TO N:VC=VC+(VAL(D(T,CS(T,ZZ)))-MN)^2:NEXT ZZ:SD(T)=SQR(VC/(N-1))
310 IF N>0 THEN IF N MOD 2=0 THEN MD(T)=(VAL(D(T,CS(T,N/2)))+VAL(D(T,CS(T,N/2+1))))*0.5 ELSE MD(T)=VAL(D(T,CS(T,N/2+0.5)))
315 NEXT:RETURN
320 GOSUB 305:PO$="SCRN:":OPEN PO$ FOR OUTPUT AS #1
325 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
330 A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:GOSUB 140
335 GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
340 IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
345 RETURN
350 FOR AS=0 TO INT((A-1)/7):SCREEN ,,AS,0:CLS:NEXT:SCREEN ,,0:RETURN
355 GOSUB 350:PRINT TAB(33);"APPEND DATA": PRINT TAB(33);STRING$(11,205):APND=1:AFI=-1
360 IF A<>0 THEN 370
365 BEEP:PRINT " You must enter a datafile from keyboard or disk before using APPEND.":GOTO 765
370 PRINT "APPEND your ";:GOTO 175
375 CLS:PRINT TAB(34);"EDIT DATA":PRINT TAB(34);STRING$(9,205):PRINT
380 PRINT TAB(14);"There are ";A; "sample groups in this datafile.":PRINT
385 PRINT TAB(7);"1.) Enter positive record number to REPLACE a record."
390 PRINT TAB(7);"2.) Enter negative record number to DELETE a record."
395 PRINT TAB(7);"3.) Press F2 to change a sample NAME."
400 PRINT TAB(7);"4.) Press F10 to exit from EDIT session."
405 KEY 2,"98"+CHR$(13):KEY 10,"99"+CHR$(13):AR=CSRLIN:LOCATE 25,32:COLOR CLR2,CLR1:PRINT " F2 = CHANGE NAME ";:LOCATE ,55:PRINT " F10 = EXIT ";:COLOR CLR1,CLR2:LOCATE AR+1,1
410 PRINT "Sample #";TAB(20);"Record #";TAB(40);"Old value";TAB(60);"New value"
415 F=0:AR=CSRLIN:AC=3:GOSUB 4800:B=VAL(IP$):IF B=99 THEN 500 ELSE IF B=98 THEN 490 ELSE IF B<1 OR B>A THEN BEEP:GOTO 415
420 AC=23:GOSUB 4800:BR=VAL(IP$):IF ABS(BR)>C OR BR=0 THEN BEEP:GOTO 420
425 IF BR>0 THEN 430 ELSE F=1:BR=-BR:IF D(B,BR)<>"" THEN 440
427 FOR Z=1 TO T(B):IF CS(B,Z)<>BR THEN NEXT:PRINT:GOTO 415 ELSE 440
430 PRINT TAB(40);D(B,BR);:LOCATE AR,60:INPUT "",DI:VN=VAL(DI)
435 IF D(B,BR)="" THEN T(B)=T(B)+1:GOTO 465
440 VC=VAL(D(B,BR)):X(B)=X(B)-VC:X2(B)=X2(B)-VC*VC
445 FOR Z=1 TO T(B)-1:IF CS(B,Z)<>BR THEN 455
450 FOR TZ=Z TO T(B)-1:CS(B,TZ)=CS(B,TZ+1):NEXT:GOTO 460
455 NEXT Z
460 IF F=1 THEN D(B,BR)="":T(B)=T(B)-1:PRINT:GOTO 415
465 D(B,BR)=DI:X(B)=X(B)+VN:X2(B)=X2(B)+VN*VN
470 FOR Z=1 TO T(B)-1:VX=VAL(D(B,CS(B,Z))):IF VX<=VN THEN 480
475 FOR TZ=T(B) TO Z+1 STEP -1:CS(B,TZ)=CS(B,TZ-1):NEXT:GOTO 485
480 NEXT Z
485 CS(B,Z)=BR:GOTO 415
490 LOCATE AR,1:PRINT "Sample #";TAB(20);"Old name";TAB(40);"New name"
495 LOCATE ,3:INPUT;"",B:IF B>A OR B=0 THEN BEEP:GOTO 495 ELSE PRINT TAB(20);:PRINT N$(B);TAB(40);:INPUT "",N$(B):GOTO 410
500 LOCATE 25,60:PRINT TAB(79);:KEY 10,"":KEY 2,"":GOSUB 305:GOTO 20
505 CLS:PRINT TAB(25);"PRINT DATAFILE ";FILE$:PRINT TAB(25);STRING$(LEN(FILE$)+15,205):PRINT
510 INPUT " Do you want the DATAFILE printed in SORTED or INPUT order? (S or I) ",A$
515 IF A$="i" OR A$="I" THEN BSRT=0:GOTO 525 ELSE IF A$="s" OR A$="S" THEN BSRT=1 ELSE BEEP:GOTO 510
520 IF A>1 THEN PRINT TAB(15);:PRINT "Which sample number do you wish to SORT by?";:AR=CSRLIN:AC=60:GOSUB 4200
525 PRINT:PRINT TAB(8);:INPUT "Do you want to print data on SCREEN or PRINTER? (S or P) ",A$
530 IF A$="P" OR A$="p" THEN PO$="LPT1:":PMAX=PRNT-10 ELSE IF A$="S" OR A$="s" THEN PO$="SCRN:":GOSUB 350:PMAX=70:GOTO 545 ELSE BEEP:GOTO 525
535 PRINT:PRINT TAB(23); "Be sure paper is in printer.":PRINT:PRINT TAB(24);"Press any key when ready:"
540 A$=INKEY$:IF A$="" THEN 540
545 ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
550 IF A>1 THEN 610 ELSE IF A=0 THEN BEEP:PRINT:PRINT TAB(18);"There is no data in this datafile.":CLOSE #1:GOTO 765
555 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
560 PRINT #1,"Sample Name = ";N$(1):PRINT #1,:TB=1:IF BSRT=1 THEN 580
565 FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,": ";D(1,Z);
570 TB=TB+13:IF TB>PMAX THEN TB=1
575 PRINT #1,TAB(TB);:NEXT:GOTO 595
580 FOR Z=1 TO T(1):PRINT #1,USING "###";CS(1,Z);:PRINT #1,": ";D(1,CS(1,Z));
585 TB=TB+13:IF TB>PMAX THEN TB=1
590 PRINT #1,TAB(TB);:NEXT
595 IF T(1)=0 THEN MN=0 ELSE MN=X(1)/T(1)
600 PRINT #1,:PRINT #1,:PRINT #1,TAB(5);"TOTAL =";T(1);TAB(26);"MEAN =";MN;TAB(55);"MEDIAN =";MD(1)
605 PRINT #1,:PRINT #1,TAB(20);"STANDARD DEVIATION =";SD(1):CLOSE #1:GOTO 765
610 AR=CSRLIN:FOR AS=0 TO INT((A-1)*10/PMAX):A2=(AS+1)*PMAX/10:IF A2>A THEN A2=A
615 A1=AS*PMAX/10+1:IF PO$="SCRN:" THEN SCREEN ,,AS,AS:LOCATE AR,1
620 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
625 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);"Sample";T;:NEXT:PRINT #1,
630 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);N$(T);:NEXT:PRINT #1,:PRINT #1,
635 IF BSRT=1 THEN 650
640 FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,":";
645 FOR T=A1 TO A2: PRINT #1,TAB((T-A1+1)*10-3);D(T,Z);:NEXT:PRINT #1,:NEXT:GOTO 660
650 FOR Z=1 TO T(NS):PRINT #1,USING "###";CS(NS,Z);:PRINT #1,":";
655 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,CS(NS,Z));:NEXT:PRINT #1,:NEXT
660 GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
665 PRINT #1,:PRINT #1,"NO.";:P$="#####"
670 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;T(T);:NEXT
675 PRINT #1,:PRINT #1,"MEAN";
680 FOR T=A1 TO A2:IF T(T)>0 THEN MN=X(T)/T(T) ELSE MN=0
685 MB=ABS(MN):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MN;:NEXT
690 PRINT #1,:PRINT #1,"MED";
695 FOR T=A1 TO A2:MB=ABS(MD(T)):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MD(T);:NEXT
700 PRINT #1,:PRINT #1,"SDEV";
705 FOR T=A1 TO A2:MB=SD(T):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;SD(T);:NEXT
710 PRINT #1,:PRINT:IF A2=A THEN 725
715 IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
720 LOCATE 24,28:PRINT "Press `P' to print next page:";
725 LOCATE 25,26:PRINT "Press space bar to return to menu.";
730 A$=INKEY$:IF A$="" THEN 730 ELSE IF A$="p" OR A$="P" THEN LOCATE 24,1:PRINT TAB(80):LOCATE 25,1:PRINT TAB(79):RETURN ELSE IF A$=CHR$(32) THEN CLOSE #1:GOTO 20 ELSE BEEP:GOTO 730
735 CLS:PRINT TAB(28);"SAVING DATA TO DISK":PRINT TAB(28);STRING$(19,205)
740 PRINT:AR=CSRLIN:GOSUB 4100
745 PRINT:PRINT:PRINT TAB(24); "Your data has been saved in: ";FILE$:GOTO 765
750 CLS:PRINT TAB(29);"LOADING DATA FROM DISK":PRINT TAB(29);STRING$(22,205)
755 PRINT:GOSUB 4000
760 PRINT:PRINT:PRINT TAB(24); FILE$;" has been loaded from disk."
765 LOCATE 25,10:PRINT TAB(22);"Press any key to return to main menu:";TAB(75);
770 A$=INKEY$:IF A$="" THEN 770 ELSE SCREEN ,,0:GOTO 20
775 PRINT:PRINT TAB(10);:INPUT "Have you saved your current data to disk? (Y or N) ",A$
780 IF A$<>"y" AND A$<>"Y" THEN 20 ELSE 3000
800 LOCATE AR,AC:PRINT SPACE$(8);:LOCATE AR,AC,1,5,7:CL=0:JF=0
805 I$=INKEY$:IF I$="" THEN 805
810 IF I$>CHR$(31) AND CL<8 THEN CL=CL+1:MID$(IT$,CL,1)=I$:PRINT I$;:GOTO 805
815 IF I$=CHR$(13) THEN IP$=MID$(IT$,1,CL):RETURN
820 IF I$=CHR$(8) THEN IF CL>0 THEN CL=CL-1:PRINT CHR$(29);" ";CHR$(29);:GOTO 805
825 IF I$<>CHR$(9) OR NOT AFI OR T<=A1 THEN 835
826 LOCATE AR,AC:PRINT SPACE$(8);:IF A>1 THEN T=T-1:GOTO 828
827 IF C<=1 THEN BEEP:GOTO 800 ELSE C=C-1
828 IF D(T,C)="" THEN 833
829 VC=VAL(D(T,C)):X(T)=X(T)-VC:X2(T)=X2(T)-VC*VC
830 FOR ZX=1 TO T(T)-1:IF CS(T,ZX)<>C THEN NEXT ZX
831 FOR TZ=ZX TO T(T)-1:CS(T,TZ)=CS(T,TZ+1):NEXT:T(T)=T(T)-1
833 IF A=1 THEN RETURN 87 ELSE RETURN 260
835 IF AFI AND LEN(I$)=2 THEN AI=ASC(MID$(I$,2,1)):IF AI=68 THEN JF=-1:IP$=MID$(IT$,1,CL):RETURN
840 BEEP:GOTO 805
4025 ERASE D,CS,T,N$,X,X2,MD,SD
4030 DIM D(A,2000/A),CS(A,2000/A),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
EPIMRG.BAS
5 DEF SEG=64:A=PEEK(23):IF NOT(A AND 32) THEN POKE 23,(A OR 32)
6 DEF SEG:CLEAR,,1024:OPTION BASE 1:DEFINT A-C,N,T,Z:DEFSTR D
7 OPEN "EPISETUP.DAT" FOR INPUT AS #1
8 INPUT #1,CLR1,CLR2,CLR3,SCRN,PRNT,TYP$,PMAK:CLOSE #1
9 SCREEN 0,SCRN,0:WIDTH 80:COLOR CLR1,CLR2,CLR3:KEY OFF:IT$=SPACE$(30)
10 FOR Z=1 TO 10:KEY Z,"":NEXT:AR=13-SCRN*6:LOCATE ,,1,1,13:LOCATE ,,1,AR,AR
20 CLS:RESTORE 22:READ DTTL,TTB,TTL:PRINT TAB(TTB);"╔";STRING$(TTL,205);"╗":PRINT TAB(TTB);"║ ";DTTL;" ║":PRINT TAB(TTB);"╚";STRING$(TTL,205);"╝":PRINT
3000 CLS:LOCATE 7,1:PRINT "SELECT an EPISTAT program number below:":PRINT
3005 RESTORE 3035:ON ERROR GOTO 5000
3010 FOR Z=1 TO 10:LOCATE Z+10,10:READ D:PRINT Z;D:NEXT
3015 FOR Z=11 TO 20:LOCATE Z,30:READ D:PRINT Z;D:NEXT
3020 FOR Z=21 TO 25:LOCATE Z-10,50:READ D:PRINT Z;D:NEXT
3025 LOCATE 25,16:PRINT "Enter choice (Press RETURN to exit):";:AR=25:AC=54:GOSUB 4800:AD=VAL(IP$)
3030 IF AD>0 AND AD<26 THEN RESTORE 3030:FOR Z=1 TO AD:READ D:NEXT:RUN D
3035 DATA "EPISTAT","DATA-ONE","ANOVA","BAYES","BINOMIAL","CHISQR","CORRELAT","FILETRAN","FISHERS","FORTRANS","HISTOGRM","LNREGRES","MHCHISQR","MHCHIMLT"
3040 DATA "MCNEMAR","NORMAL","POISSON","RANDOMIZ","RANKTEST","RATEADJ","SAMPLSIZ","SCATRGRM","SELECT","T-TEST","XTAB"
3045 LOCATE 23,1:SYSTEM
4000 PRINT TAB(10);:INPUT "Enter the name of the DATAFILE you wish to analyze: ",FILE$
4020 ON ERROR GOTO 5020:OPEN FILE$ FOR INPUT AS #1:INPUT #1,A,C
4040 FOR T=1 TO A:INPUT #1,T(T):NEXT
4050 FOR T=1 TO A:FOR Z=1 TO C:INPUT #1,D(T,Z):NEXT:NEXT
4060 FOR T=1 TO A:FOR Z=1 TO T(T):INPUT #1,CS(T,Z):NEXT:NEXT
4070 FOR T=1 TO A:INPUT #1,N$(T),X(T),X2(T),MD(T),SD(T):NEXT:CLOSE #1:RETURN
4100 LOCATE AR,53:PRINT TAB(63):LOCATE AR,15:INPUT "Enter the name of your new DATAFILE: ",FILE$
4110 ON ERROR GOTO 5040:OPEN FILE$ FOR OUTPUT AS #1
4120 WRITE #1,A,C:FOR T=1 TO A:WRITE #1,T(T):NEXT
4130 FOR T=1 TO A:FOR Z=1 TO C:WRITE #1,D(T,Z):NEXT:NEXT
4140 FOR T=1 TO A:FOR Z=1 TO T(T):WRITE #1,CS(T,Z):NEXT:NEXT
4150 FOR T=1 TO A:WRITE #1,N$(T),X(T),X2(T),MD(T),SD(T):NEXT:CLOSE #1:RETURN
4200 GOSUB 4800:NS=VAL(IP$):IF NS>0 AND NS<=A THEN PRINT " `";N$(NS);"'":RETURN ELSE BEEP:LOCATE 25,22:PRINT FILE$;" has only";A;"samples.";:GOTO 4200
4800 LOCATE AR,AC:PRINT SPACE$(8);:LOCATE AR,AC,1,5,7:CL=0
4805 I$=INKEY$:IF I$="" THEN 4805
4810 IF I$>CHR$(31) AND CL<8 THEN CL=CL+1:MID$(IT$,CL,1)=I$:PRINT I$;:GOTO 4805
4815 IF I$=CHR$(13) THEN IP$=MID$(IT$,1,CL):RETURN
4820 IF I$=CHR$(8) THEN IF CL>0 THEN CL=CL-1:PRINT CHR$(29);" ";CHR$(29);:GOTO 4805
4825 BEEP:GOTO 4805
5020 BEEP:PRINT:DR$="":IF ERR=71 THEN 5035 ELSE IF ERR<>52 AND ERR<>53 THEN 5010 ELSE PRINT TAB(13); "I cannot find a file by that name on ";
5025 IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE PRINT "default ";
5030 PRINT "drive ";DR$:PRINT "Your files are:":FILES DR$+"*.*":RESUME 4000
5035 PRINT TAB(16);"That disk is not ready. Check drive and try again.";:RESUME 4000
5040 BEEP:LOCATE 25,10:IF ERR=61 OR ERR=67 THEN PRINT TAB(17);"That disk is full. Change disks and try again.";:RESUME 4100
5045 IF ERR=64 OR ERR=52 THEN PRINT TAB(16);"That is not a valid FILE NAME. Please change name.";:RESUME 4100
5050 IF ERR=70 THEN PRINT "That disk is write-protected. Put your data on a different disk.";:RESUME 4100
5055 IF ERR=71 THEN PRINT TAB(16);"That disk is not ready. Check drive and try again.";:RESUME 4100 ELSE 5010
5070 BEEP:AR=CSRLIN:IF ERR<>27 AND ERR<>25 THEN 5010 ELSE LOCATE 24,15:PRINT "The printer is not ready. Check before proceeding.";:LOCATE 25,25:PRINT "Press any key to continue:";
5075 A$=INKEY$:IF A$="" THEN 5075 ELSE FOR ZZ=24 TO 25:LOCATE ZZ,10:PRINT TAB(80):NEXT:LOCATE AR,1:RESUME
EPISTAT.BAS
1 ' INTRODUCTION TO EPISTAT
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
5 CLEAR,,1024:OPTION BASE 1:DEFINT A-C,N,T,Z:DEFSTR D
10 DEF SEG=64:A=PEEK(23):IF NOT(A AND 32) THEN POKE 23,(A OR 32)
15 DEF SEG:KEY OFF:WIDTH 80:SCREEN 0,0,0:COLOR 7,0,0:CLS
20 PRINT TAB(14);"═════════════USER-SUPPORTED SOFTWARE═════════════"
25 LOCATE 4,8,1,1,13:PRINT STRING$(61,178)
30 PRINT TAB(8);"▓▓ ▓▓"
35 PRINT TAB(8);"▓▓ EPISTAT is a statistical package designed for ▓▓"
40 PRINT TAB(8);"▓▓ the analysis of small data sets. ▓▓"
45 PRINT TAB(8);"▓▓ If, after using the programs, you find them useful, ▓▓"
50 PRINT TAB(8);"▓▓ your contribution ($25 suggested) will be appreciated. ▓▓"
55 PRINT TAB(8);"▓▓ ▓▓"
60 PRINT TAB(8);"▓▓ Send contributions to: ▓▓"
65 PRINT TAB(8);"▓▓ Tracy L. Gustafson, M.D. ▓▓"
70 PRINT TAB(8);"▓▓ 2011 Cap Rock Circle ▓▓"
75 PRINT TAB(8);"▓▓ Richardson, Texas 75080 ▓▓"
80 PRINT TAB(8);"▓▓ ▓▓"
85 PRINT TAB(8);"▓▓ All users may copy and distribute these programs ▓▓"
90 PRINT TAB(8);"▓▓ provided: ▓▓"
95 PRINT TAB(8);"▓▓ 1.) The programs are not altered in any way. ▓▓"
100 PRINT TAB(8);"▓▓ 2.) No fee is charged for copying or distribution. ▓▓"
105 PRINT TAB(8);"▓▓ ▓▓"
110 PRINT TAB(8);"▓▓ Copyright (c) 1986 Tracy L. Gustafson ▓▓"
115 PRINT TAB(8);STRING$(61,178):PLAY "MS O3 L64 G O2 GE L9 E"
120 FOR Z=1 TO 10000:NEXT:CLR1=7:CLR2=0:CLR3=0:SCRN=0:ON ERROR GOTO 760
125 PRINT:PRINT TAB(10);:INPUT "Do you want to change COLORS or hardware configuration? ",A$:IF A$<>"y" AND A$<>"Y" THEN 265
130 CLS:DEF SEG=0:IF (PEEK(1040) AND 48)<>48 THEN 150
135 DEF SEG=&HB800:POKE 0,0:IF PEEK(0)<>0 THEN 190
140 INPUT "Select COLOR (C) or MONOCHROME (M) adapter: ",A$
145 IF A$="M" OR A$="m" THEN 190 ELSE IF A$<>"C" AND A$<>"c" THEN BEEP:GOTO 140
150 DEF SEG=0:POKE 1040,(PEEK(1040) AND 207) OR 32
155 DEF SEG:SCREEN 0,1,0:LOCATE 5,10:COLOR 0,7:PRINT 0;:COLOR ,0:PRINT TAB(45);:COLOR 8:PRINT 8;STRING$(25,219)
160 FOR Z=1 TO 7:LOCATE 5+Z,10:COLOR Z,0:PRINT Z;STRING$(25,219);:COLOR 7,0:PRINT TAB(45);:COLOR Z+8:PRINT USING "##";Z+8;:PRINT" ";STRING$(25,219):NEXT
165 COLOR 7,0:PRINT:PRINT TAB(15);:INPUT "ENTER your color choices for: FOREGROUND = ",CLR1
170 PRINT TAB(46);:INPUT "BACKGROUND = ",CLR2
175 PRINT TAB(50);:INPUT "BORDER = ",CLR3
180 IF CLR1=7 AND CLR2=0 AND CLR3=0 THEN SCRN=0 ELSE SCRN=1
185 SCREEN 0,SCRN,0:COLOR CLR1,CLR2,CLR3:PRINT
190 DEF SEG:PRINT "1.) Epson";TAB(15);"2.) IBM";TAB(28);"3.) Okidata";TAB(43);"4.) Prowriter";TAB(60);"5.) Other make";TAB(79)
195 PRINT TAB(20);:INPUT "Enter your printer make: ",PMAK:IF ABS(PMAK-3)>2 THEN BEEP:GOTO 195 ELSE PRINT
200 PRINT TAB(15);:INPUT "Is your printer (A) 10, or (B) 15 inches wide? ",A$
205 IF A$="A" THEN PRNT=80 ELSE IF A$="B" THEN PRNT=132 ELSE BEEP:GOTO 200
210 PRINT TAB(6);:INPUT "Do you want (1) pica, (2) elite or (3) compressed type? ",AD:IF ABS(AD-2)>1 THEN BEEP:GOTO 210
215 IF PMAK <5 THEN 235 ELSE PRINT " Enter your printer's BASIC codes for ";:RESTORE 240:FOR Z=1 TO AD:READ D,XF:NEXT:PRINT D;" type:"
220 AR=CSRLIN:PRINT:LOCATE 24,5:PRINT "Enter CHR$()'s by pressing <Alt> and entering NUMBER on numeric keypad.";:LOCATE 25,19:PRINT "Press <Enter> when complete code entered.";
225 LOCATE AR-1,9,1:PRINT " ASCII CODE: ";
230 A$=INKEY$:IF A$="" THEN 230 ELSE IF A$=CHR$(13) THEN TYP$=DT:GOTO 250 ELSE DT=DT+A$:PRINT ASC(A$);:GOTO 230
235 RESTORE 245:FOR Z=1 TO (PMAK-1)*3+AD:READ XF,A1,A2:NEXT
240 DATA "pica",1,"elite",1.2,"compressed",1.7
245 DATA 1,27,64,1.2,27,77,1.7,15,0,1,27,64,1.2,27,77,1.7,15,0,1,24,0,1.2,28,0,1.7,29,0,1,27,78,1.2,27,69,1.7,27,81
250 PRNT=INT(PRNT*XF):TYP$=CHR$(A1)+CHR$(A2)
255 OPEN "EPISETUP.DAT" FOR OUTPUT AS #1
260 WRITE #1,CLR1,CLR2,CLR3,SCRN,PRNT,TYP$,PMAK:CLOSE #1:GOTO 280
265 OPEN "EPISETUP.DAT" FOR INPUT AS #1
270 INPUT #1,CLR1,CLR2,CLR3,SCRN,PRNT,TYP$,PMAK:CLOSE #1
275 SCREEN 0,SCRN,0:COLOR CLR1,CLR2,CLR3
280 CLS:PRINT TAB(25);"╔";STRING$(29,205);"╗":PRINT TAB(25);"║ EPISTAT STATISTICAL PACKAGE ║"
285 PRINT TAB(25);"╚";STRING$(29,205);"╝"
290 LOCATE 6,5:PRINT"Would you like to:":PRINT
295 PRINT TAB(19);"1.) List the tests and functions available.":PRINT
300 PRINT TAB(19);"2.) Determine the best test for your data.":PRINT
305 PRINT TAB(19);"3.) Exit to run a specific test program."
310 LOCATE 15,24:INPUT "Enter choice: ",ASUB:IF ABS(2-ASUB)>1 THEN BEEP:GOTO 310
315 CLS:ON ASUB GOTO 320,420,680
320 PRINT TAB(28);"TESTS AVAILABLE IN EPISTAT":PRINT TAB(28);STRING$(26,205)
325 PRINT:PRINT TAB(29);"PROGRAM";TAB(69);"PROGRAM"
330 PRINT "TEST OR FUNCTION";TAB(30);"NAME";TAB(42);"TEST OR FUNCTION";TAB(70);"NAME"
335 PRINT STRING$(16,196);TAB(29);"────────";TAB(42);STRING$(16,196);TAB(69);"───────"
340 PRINT "Analysis of variance........ANOVA*";TAB(42);"McNemar's test.............MCNEMAR"
345 PRINT "Bayes' theorem..............BAYES";TAB(42);"Mean, Median and S.Dev.....DATA-ONE*"
350 PRINT "Binomial distribution.......BINOMIAL";TAB(42);"Normal distribution........NORMAL*"
355 PRINT "Chi-square test.............CHISQR";TAB(42);"Poisson distribution.......POISSON"
360 PRINT "Correlation coefficients....CORRELAT*";TAB(42);"Random sample generator....RANDOMIZ"
365 PRINT "Crosstab reports............XTAB*";TAB(42);"Rank sum test..............RANKTEST*"
370 PRINT "F Distribution..............ANOVA*";TAB(42);"Rates adjusted.............RATEADJ*"
375 PRINT "Fisher's exact test.........FISHERS";TAB(42);"Sample size determination..SAMPLSIZ"
380 PRINT "Graph histogram.............HISTOGRM*";TAB(42);"Select specific records....SELECT*"
385 PRINT "Graph scattergram...........SCATRGRM*";TAB(42);"Signed rank test...........RANKTEST*"
390 PRINT "Linear regression...........LNREGRES*";TAB(42);"Student's T test...........T-TEST*"
395 PRINT "Mantel-Haenszel Chi-square..MHCHISQR";TAB(42);"Transfer data between"
400 PRINT "Mantel-Haenszel for";TAB(45);"two EPISTAT files.......FILETRAN*"
405 PRINT TAB(3);"multiple controls/case....MHCHIMLT*";TAB(42);"Transfer data from"
410 PRINT TAB(45);"FORTRAN datafiles.......FORTRANS*"
415 LOCATE 24,5:PRINT "*Starred programs can evaluate data entered and saved using DATA-ONE.";:GOTO 740
420 CLS:PRINT TAB(22);"DETERMINING THE BEST STATISTICAL TEST":PRINT TAB(22);STRING$(37,205)
425 LOCATE 5,5:PRINT "Do you want to consider:":PRINT
430 PRINT TAB(24);"1.) Tests for a single sample":PRINT
435 PRINT TAB(24);"2.) Tests for 2 or more samples":PRINT
440 PRINT TAB(24);"3.) Other statistical functions":PRINT
445 PRINT TAB(24);"4.) Data handling utilities":PRINT
450 PRINT TAB(24);"5.) Return to main menu"
455 LOCATE 18,29:INPUT "Enter choice: ",ASUB:IF ABS(ASUB-3)>2 THEN BEEP:GOTO 455
460 CLS:ON ASUB GOTO 465,495,605,635,280
465 PRINT TAB(28);"TESTS FOR A SINGLE SAMPLE":PRINT
470 PRINT "The following tests compare an observed number":PRINT TAB(37);"to the expected (population) rate:":PRINT:PRINT
475 PRINT "[BINOMIAL]: The Binomial distribution applies when a dichotomous variable":PRINT TAB(14);"has an equal probability of occurring on each of N trials.":PRINT
480 PRINT "[NORMAL] : The Normal distribution applies to continuous and dichotomous": PRINT TAB(14);"variables when the sample size is >30 and normally distributed."
485 PRINT TAB(14);"Specifically used when comparing a sample mean with a": PRINT TAB(14);"population mean.":PRINT
490 PRINT "[POISSON] : The Poisson distribution applies when a dichotomous variable":PRINT TAB(14);"has a known probability of occurring on each trial,":PRINT TAB(14);"but the number of trials is not known.":GOTO 750
495 PRINT TAB(27);"TESTS FOR TWO OR MORE SAMPLES":PRINT
500 INPUT "Is the variable under consideration probably normally distributed? (Y or N) ",A$
505 IF A$="Y" OR A$="y" THEN 530 ELSE IF A$="N" OR A$="n" THEN 510 ELSE BEEP:GOTO 500
510 PRINT:PRINT:PRINT "[RANKTEST]: The Signed Rank Test compares the medians of paired samples."
515 PRINT TAB(15);"The Rank Sum Test compares the medians of independent samples.":PRINT
520 PRINT "[CORRELAT]: Includes Spearman's Rank Correlation":PRINT
525 PRINT:PRINT " (NOTE: Both the T-TEST and ANOVA usually can be safely applied to":PRINT TAB(9);"nonparametric data sets that contain more than 30 observations/sample.":GOTO 750
530 PRINT:PRINT TAB(27);"NORMALLY DISTRIBUTED SAMPLES":PRINT
535 PRINT TAB(12);:INPUT"Are these samples paired (P) or independent (I)? ",A$
540 IF A$="P" OR A$="p" THEN 545 ELSE IF A$="i" OR A$="I" THEN 575 ELSE BEEP:GOTO 535
545 PRINT:PRINT "[ANOVA] : TWO-WAY Analysis of Variance evaluates the combined effects":PRINT TAB(14);"of two variables on a third (ROW and COLUMN effects)"
550 PRINT:PRINT "[CORRELAT]: Includes Pearson's correlation coefficient.":PRINT
555 PRINT "[LNREGRES]: Linear Regression analysis evaluates linear association.":PRINT
560 PRINT "[MCNEMAR] : McNemar's test compares paired dichotomous variables.":PRINT
565 PRINT "[MHCHIMLT]: Mantel-Haenszel Chi-square for multiple controls compares":PRINT TAB(14);"dichotomous variables with several controls per case.":PRINT
570 PRINT "[T-TEST] : The paired T-Test compares means of continuous variables.":GOTO 750
575 PRINT:PRINT "[ANOVA] : ONE-WAY Analysis of Variance compares the means of":PRINT TAB(14);"3 or more samples."
580 PRINT TAB(14);"TWO-WAY Analysis of Variance evaluates the combined effects":PRINT TAB(14);"of 2 variables on a third variable.":PRINT
585 PRINT "[CHISQR] : Chi-square Test compares discrete variables when":PRINT TAB(14);"the expected value for each cell is > 5.":PRINT
590 PRINT "[FISHERS] : Fisher's Exact Test compares dichotomous variables.":PRINT
595 PRINT "[MHCHISQR]: Mantel-Haenszel Chi-square Test compares a dichotomous":PRINT TAB(14);"variable while controlling for another factor.":PRINT
600 PRINT "[T-TEST] : The unpaired T-Test compares the means of continuous variables.":GOTO 750
605 PRINT TAB(27);"OTHER STATISTICAL FUNCTIONS":PRINT:PRINT
610 PRINT "[BAYES] : Bayes theorem evaluates the predictive power of a":PRINT TAB(14);"diagnostic test or variable.":PRINT
615 PRINT "[NORMAL] : The Normal distribution calculates the percent of":PRINT TAB(14);"test values expected to fall within a given range.":PRINT
620 PRINT "[RATEADJ] : Direct and indirect rate adjustments are performed to":PRINT TAB(14);"make a sample comparable to a standard.":PRINT
625 PRINT "[RANDOMIZ]: Selects a random sample for survey or study.":PRINT
630 PRINT "[SAMPLSIZ]: Calculates the appropriate sample sizes for surveys,":PRINT TAB(14);"paired and unpaired studies.":GOTO 750
635 PRINT TAB(27);"DATA HANDLING UTILITIES":PRINT:PRINT
640 PRINT "[DATA-ONE]: Input, edit, sort and print data.":PRINT
645 PRINT "[FILETRAN]: Transfer samples between EPISTAT datafiles.":PRINT
650 PRINT "[FORTRANS]: Transfer data from flat card-image FORTRAN files.":PRINT
655 PRINT "[HISTOGRM]: Graph a histogram on screen or printer.":PRINT
660 PRINT "[LNREGRES]: Provides data transformations.":PRINT
665 PRINT "[SCATRGRM]: Graph a scattergram on screen or printer.":PRINT
670 PRINT "[SELECT] : Generates a new datafile containing selected subset":PRINT TAB(15);"of the original records or cases.":PRINT
675 PRINT "[XTAB] : Produces 1, 2 or 3-way crosstab reports.":GOTO 750
680 PRINT TAB(24);"RUNNING EPISTAT STATISTICAL PROGRAMS"
685 PRINT TAB(24);STRING$(36,205):PRINT:PRINT
690 PRINT TAB(3);"Determine the program name (PROGNAME) from Section 1 or 2, then enter: "
695 PRINT:PRINT TAB(30);"RUN ";CHR$(34);"PROGNAME";CHR$(34):PRINT
700 PRINT "Or select the program number below:":PRINT
705 RESTORE 730:FOR Z=1 TO 10:LOCATE Z+10,10:READ D:PRINT Z;D:NEXT
710 FOR Z=11 TO 20:LOCATE Z,30:READ D:PRINT Z;D:NEXT
715 FOR Z=21 TO 25:LOCATE Z-10,50:READ D:PRINT Z;D:NEXT
720 LOCATE 25,16:INPUT;"Enter choice (Press RETURN to exit): ",AD
725 IF AD>0 AND AD<26 THEN RESTORE 730:FOR Z=1 TO AD:READ D:NEXT:RUN D
730 DATA "EPISTAT","DATA-ONE","ANOVA","BAYES","BINOMIAL","CHISQR","CORRELAT","FILETRAN","FISHERS","FORTRANS","HISTOGRM","LNREGRES","MHCHISQR","MHCHIMLT"
735 DATA "MCNEMAR","NORMAL","POISSON","RANDOMIZ","RANKTEST","RATEADJ","SAMPLSIZ","SCATRGRM","SELECT","T-TEST","XTAB"
737 LOCATE 23,1:SYSTEM
740 LOCATE 25,20:PRINT"Press any key to return to main menu:";
745 A$=INKEY$:IF A$="" THEN 745 ELSE 280
750 LOCATE 25,20:PRINT "Press space bar to return to menu:";
755 A$=INKEY$:IF A$=CHR$(32) THEN 420 ELSE 755
760 BEEP:IF ERR<>71 AND ERR<>70 AND ERR<>53 THEN 770 ELSE LOCATE 2,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
765 A$=INKEY$:IF A$="" THEN 765 ELSE RESUME
770 ON ERROR GOTO 0
FILES088.TXT
Disk No 88
Program Title: EPISTAT STATISTICS PACKAGE VERSION 3.3
PC-SIG version 3.3
This package contains a set of routines for use in analysis of small
data sets, and is meant to be used by a person well-versed in math and
computer operations. This is a fairly complex disk and is not recommended
for the casual user. But for those with an interest, it can be of great
help.
Usage: statistical
System Requirements: IBM PC or close compatible, 1 disk drive, Dos 2.0 or
later and a version of BASIC.
Suggested Registration: $15.00
File Descriptions:
ANOVA BAS One and two way analysis of variance
AUTOEXEC BAT Batch file to auto boot program
BAYES BAS Calculates rates of false positive and negative tests
BINOMIAL BAS Binomial distribution
CHISQR BAS Chi-square test
CORRELAT BAS Calculates pearson's correlation coefficient
DATA-ONE BAS Main data entry program
EPIMRG BAS Used by every epistat program
EPISETUP BAK Backup for episetup.dat
EPISETUP DAT Used by every epistat program
EPISTAT BAS Lists available programs and guides user to proper program to use
FILETRAN BAS Transfers data from one data file to another
FISHERS BAS Fisher's exact test to evaluate 2 by 2 tables of discrete values
FORTRANS BAS Transfers fortran to epistat files
HISTOGRM BAS Graphs data sample on high resolution graphics screen
LNREGRES BAS Linear regression
MCNEMAR BAS Mcnemar's test or paired chi-square test
MHCHIMLT BAS Mantel-haenszel chi-square test for multiple controls
MHCHISQR BAS Mantel-haenszel chi-square test
NORMAL BAS Calculates normal distribution
POISSON BAS Calculates poisson distribution
PRINTDOC Documentation file (25k)
RANDOMIZ BAS Random sample generator
RANKTEST BAS Three tests - signed rank, rank correlation and rank sum
RATEADJ BAS Rate adjustment program
SAMPLSIZ BAS Calculates sample sizes for statistical significance
SCATRGRM BAS Graph scatergrams
SELECT BAS Select from other programs
T-TEST BAS T-test compares mean of 2 samples
XTAB BAS Print crosstab reports
EXAMPLE Sample data set
PC-SIG
1030D E Duane Avenue
Sunnyvale Ca. 94086
(408) 730-9291
(c) Copyright 1987 PC-SIG Inc.
FILETRAN.BAS
1 ' FILE TRANSFER PROGRAM
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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),TR(1)
17 D1="What is the name of the DATAFILE you wish to ":D2="Which sample do you want to "
22 DATA "TRANSFERING SAMPLES FROM ONE DATAFILE TO ANOTHER",15,50
30 AF=0:AR=CSRLIN:PRINT TAB(10);D1;"modify?":PRINT TAB(22);"(REPLACE, ADD, or APPEND a sample to) "
35 LOCATE AR,64:INPUT "",FILE1$:EF=1:FILE$=FILE1$
40 ON ERROR GOTO 5020:OPEN FILE1$ FOR INPUT AS #1:INPUT #1,A,C:CC=C
45 PRINT:PRINT " ";D1;:INPUT "retrieve a sample from? ",FILE2$:EF=2:FILE$=FILE2$
50 OPEN FILE2$ FOR INPUT AS #2:INPUT #2,AZ,CZ:PRINT:AR=CSRLIN
55 PRINT TAB(5);"What is the SAMPLE NUMBER in ";FILE2$;" that you want to retrieve?"
60 SWAP A,AZ:AC=72:GOSUB 315:NZ=NS:SWAP A,AZ
65 FILE$=FILE1$:PRINT:IF AF=1 THEN 95 ELSE PRINT
70 PRINT "Do you want to: 1.) REPLACE an existing data sample in ";FILE1$
75 PRINT TAB(18);"2.) ADD this data sample to ";FILE1$;" as sample #";A+1
80 PRINT TAB(18);"3.) APPEND this sample to an existing sample in ";FILE1$
85 PRINT:PRINT TAB(30);"Enter choice:";
90 AR=CSRLIN:AC=45:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 90
95 AR=CSRLIN:AC=61:ON ASUB GOTO 100,105,110
100 AT=A:PRINT TAB(22);D2;"replace?";:AR=17:GOSUB 315:NR=NS:GOTO 115
105 IF A<28 THEN NR=A+1:AT=A+1:GOTO 115 ELSE BEEP:AR=CSRLIN:LOCATE 25,3:PRINT FILE$;" already has the maximum number of samples allowed (28)";:LOCATE AR,1:GOTO 70
110 NR=A+1:AT=A+1:PRINT TAB(20);D2;"append to?";:AR=CSRLIN:GOSUB 315:NA=NS
115 PRINT:PRINT:COLOR 23:PRINT TAB(31);"TRANSFERING SAMPLE":COLOR CLR1
120 IF AF=1 THEN 135 ELSE ERASE D,CS,T,N$,X,X2,MD,SD,TR
125 DIM D(AT,2000/AT),CS(AT,2000/AT),T(AT),N$(AT),X(AT),X2(AT),MD(AT),SD(AT),TR(28)
130 GOSUB 4040
135 FOR T=1 TO NZ-1:INPUT #2,TR(T):NEXT
140 INPUT #2,T(NR):FOR T=NZ+1 TO AZ:INPUT #2,TR(T):NEXT
145 FOR T=1 TO NZ-1:FOR Z=1 TO CZ:INPUT #2,DZ:NEXT:NEXT
150 FOR Z=1 TO CZ:INPUT #2,D(NR,Z):NEXT
155 FOR T=NZ+1 TO AZ:FOR Z=1 TO CZ:INPUT #2,DZ:NEXT:NEXT
160 FOR T=1 TO NZ-1:FOR Z=1 TO TR(T):INPUT #2,CSZ:NEXT:NEXT
165 FOR Z=1 TO T(NR):INPUT #2,CS(NR,Z):NEXT
170 FOR T=NZ+1 TO AZ:FOR Z=1 TO TR(T):INPUT #2,CSZ:NEXT:NEXT
175 FOR T=1 TO NZ-1:INPUT #2,NZ$,XZ,X2Z,MDZ,SDZ:NEXT
180 INPUT #2,N$(NR),X(NR),X2(NR),MD(NR),SD(NR):CLOSE #2
185 IF ASUB<3 THEN 235 ELSE AT=T(NA)+1
190 T(NA)=T(NA)+T(NR):X(NA)=X(NA)+X(NR):X2(NA)=X2(NA)+X2(NR)
195 FOR AZ=1 TO T(NR):CC=CC+1:D(NA,CC)=D(NR,AZ):IF D(NA,CC)="" THEN 220 ELSE VC=VAL(D(NA,CC))
200 FOR Z=1 TO AT-1:VX=VAL(D(NA,CS(NA,Z))):IF VX<=VC THEN 210
205 FOR TZ=AT TO Z+1 STEP -1:CS(NA,TZ)=CS(NA,TZ-1):NEXT:GOTO 215
210 NEXT Z
215 CS(NA,Z)=CC:AT=AT+1
220 NEXT AZ:IF CC>CMAX THEN CMAX=CC
225 N=T(NA):MD(NA)=0:IF N>0 THEN IF N MOD 2=0 THEN MD(NA)=(VAL(D(NA,CS(NA,N/2)))+VAL(D(NA,CS(NA,N/2+1))))*0.5 ELSE MD(NA)=VAL(D(NA,CS(NA,N/2+0.5)))
230 SD(NA)=0:IF N>1 THEN IF X2(NA)>X(NA)*X(NA)/N THEN SD(NA)=SQR((X2(NA)-X(NA)*X(NA)/N)/(N-1))
235 PLAY "MS O3 L64 G O2 GE L9 E"
240 CLS:PRINT:PRINT TAB(5);"A memory file has been constructed that ";:IF ASUB=3 THEN PRINT "APPENDS "; ELSE PRINT "ADDS ";
245 PRINT "sample";NZ;"FROM ";FILE2$;:IF ASUB=3 THEN PRINT TAB(25);"TO sample";NA;"IN "; ELSE PRINT TAB(18);"TO ";
250 PRINT FILE1$;
255 IF ASUB=1 THEN PRINT " (REPLACING sample number";NR;")":GOTO 270 ELSE IF ASUB=2 THEN PRINT " (NEW sample number =";NR;")":GOTO 270
260 PRINT:PRINT:PRINT " Do you want to APPEND data to another sample in datafile ";FILE1$;:INPUT A$
265 IF A$="y" OR A$="Y" THEN CC=C:AF=1:GOTO 45 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 260
270 PRINT:PRINT TAB(10);"How do you want to SAVE this modified datafile to disk:"
275 PRINT:PRINT TAB(25);"1.) Under the filename ";FILE1$;"
280 PRINT TAB(25);"2.) Under a NEW filename."
285 PRINT TAB(25);"3.) CANCEL file modification.":PRINT
290 PRINT TAB(31);"Enter choice:";:AR=CSRLIN:AC=45:GOSUB 4800:BSUB=VAL(IP$):AR=AR+1:IF ABS(BSUB-2)>1 THEN BEEP:GOTO 290 ELSE IF BSUB=3 THEN 305
295 IF ASUB=3 THEN C=CMAX ELSE A=AT:IF T(NR)>C THEN C=T(NR)
300 IF BSUB=2 THEN AR=CSRLIN:GOSUB 4100 ELSE GOSUB 4110
305 LOCATE 25,15:INPUT;"Do you want to perform another FILE TRANSFER? ",A$:IF A$="y" OR A$="Y" THEN 20
310 GOTO 3000
315 GOSUB 4800:NS=VAL(IP$):IF NS>0 AND NS<=A THEN RETURN ELSE BEEP:LOCATE 25,22:PRINT FILE$;" has only";A;"samples.";:GOTO 315
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
5032 IF EF=1 THEN RESUME 30 ELSE IF EF=2 THEN RESUME 45
FISHERS.BAS
1 ' FISHER'S EXACT TEST (one-tailed)
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
22 DATA "FISHER'S EXACT TEST",30,21
30 P=0:PRINT:PRINT " Enter data in 2 by 2 table:"
35 LOCATE 9,25:PRINT "┌───────────────┬───────────────┐"
40 FOR Z=1 TO 3:PRINT TAB(25);"│";TAB(41);"│";TAB(57);"│":NEXT
45 PRINT TAB(25);"├───────────────┼───────────────┤"
50 FOR Z=1 TO 3:PRINT TAB(25);"│";TAB(41);"│";TAB(57);"│":NEXT
55 PRINT TAB(25);"└───────────────┴───────────────┘"
60 LOCATE 11,28:PRINT "A=":AR=11:AC=32:GOSUB 160:BA=I
65 LOCATE 11,45:PRINT "B=":AC=49:GOSUB 160:BB=I:PRINT
70 LOCATE 15,28:PRINT "C=":AR=15:AC=32:GOSUB 160:BC=I
75 LOCATE 15,45:PRINT "D=":AC=49:GOSUB 160:BD=I
80 LOCATE 19,31:COLOR 23:PRINT "CALCULATING PROBABILITY";
85 M=BA:IF BB<M THEN M=BB:SWAP BA,BB:SWAP BC,BD
90 IF BD<M THEN M=BD:SWAP BA,BD:SWAP BB,BC:GOTO 85
95 IF BC<M THEN M=BC:SWAP BA,BC:SWAP BB,BD
100 IF BA/BB>BC/BD THEN IF BC>BB THEN SWAP BA,BB:SWAP BC,BD ELSE SWAP BA,BC:SWAP BB,BD
105 PT=9.999999e-31:N=1
110 FOR Z=(BB+1) TO (BA+BB):PT=PT*Z/N:N=N+1:NEXT:N=BB+BD+1
115 FOR Z=(BC+1) TO (BA+BC):PT=PT*Z/N:N=N+1:NEXT:PT=PT*1.000000e+30
120 FOR Z=(BD+1) TO (BC+BD):PT=PT*Z/N:N=N+1:NEXT:P=P+PT
125 IF BA>0 AND PT>0 THEN BA=BA-1:BB=BB+1:BC=BC+1:BD=BD-1:GOTO 105
130 PLAY "MS O3 L64 G O2 GE L9 E"
135 COLOR CLR2,CLR1:LOCATE 19,15:PRINT TAB(33);"p = ";:IF P<1.000000e-8 THEN PRINT "< 10 (-8)"; ELSE PRINT P;
140 PRINT TAB(66):COLOR CLR1,CLR2:LOCATE 25,10
145 INPUT;"Do you want to perform another Fisher's exact test? (Y or N) ",A$
150 IF A$="y" OR A$="Y" THEN CLS:GOTO 20
155 GOTO 3000
160 GOSUB 4800:I=VAL(IP$):IF INT(I)<>I THEN BEEP:LOCATE 25,25:PRINT "Please enter INTEGERS only.";:GOTO 160
165 RETURN
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
FORTRANS.BAS
1 ' FORTRAN DATA TRANSFER
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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)
22 DATA "FORTRAN DATA TRANSFER",29,23
30 PRINT:PRINT "Do you want to: 1.) Create a new EPISTAT datafile.":PRINT
35 PRINT TAB(20);"2.) Add a sample to an existing EPISTAT datafile."
40 BF=0:LOCATE 11,27:PRINT "Enter choice:":AR=11:AC=41:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-1.5)>0.5 THEN BEEP:GOTO 40
45 CLS:PRINT TAB(29);DTTL:PRINT TAB(29);STRING$(21,205):PRINT
50 IF BF=0 THEN INPUT " Enter the name of the FORTRAN file you want to extract data from: ",FILEF$
55 FILE$=FILEF$:EF=1:ON ERROR GOTO 5020:OPEN FILE$ FOR INPUT AS #2
60 PRINT:AR=CSRLIN:PRINT TAB(10);"Enter the total length of each record or card image:"
65 PRINT TAB(11);"(Do not include the carriage return or line feed.)"
70 AC=64:GOSUB 4800:CJ=VAL(IP$)
75 PRINT:PRINT TAB(10);:INPUT "Enter the name of the variable you want to retrieve: ",DN
80 LOCATE 9,14:PRINT "Enter the column number in which ";DN;" begins:":AR=9:AC=64:GOSUB 4800:C1=VAL(IP$)
85 PRINT TAB(14);"Enter the number of columns (digits) in ";DN;":":AR=10:GOSUB 4800:CW=VAL(IP$)
90 PRINT TAB(14);"Enter the number of (understood) decimal places:":AR=11:GOSUB 4800:CE=VAL(IP$)
95 PRINT TAB(33);:INPUT "Enter the missing value code: ",DM
100 IF ASUB=1 THEN ERASE D,CS:DIM D(1,2000),CS(1,2000):A=1:GOTO 130
105 IF BF=0 THEN PRINT:INPUT " What is the name of the EPISTAT datafile you want to ADD to? ",FILE1$
110 FILE$=FILE1$:EF=2:OPEN FILE$ FOR INPUT AS #1:INPUT #1,A,C
115 ERASE D,CS,T,N$,X,X2,MD,SD:AA=A+1
120 DIM D(AA,C),CS(AA,C),T(AA),N$(AA),X(AA),X2(AA),MD(AA),SD(AA)
125 GOSUB 4040:A=AA
130 PRINT:PRINT:AR=CSRLIN:COLOR 23:PRINT TAB(32);"TRANSFERRING DATA":COLOR CLR1
135 CC=0:T(A)=0:X(A)=0:X2(A)=0:MD(A)=0:SD(A)=0:N$(A)=DN
140 CC=CC+1:LINE INPUT #2,DI:IF LEN(DI)<>CJ THEN CC=CC-1:GOTO 175 ELSE DJ=MID$(DI,C1,CW):IF DJ=DM THEN D(A,CC)="":GOTO 175
145 DK=MID$(DJ,1,CW-CE):IF CE>0 THEN DK=DK+"."+MID$(DJ,CW-CE+1,CE)
150 D(A,CC)=DK:VC=VAL(DK):T(A)=T(A)+1:X(A)=X(A)+VC:X2(A)=X2(A)+VC*VC
155 FOR Z=1 TO T(A)-1:VX=VAL(D(A,CS(A,Z))):IF VX<=VC THEN 165
160 FOR TZ=T(A) TO Z+1 STEP -1:CS(A,TZ)=CS(A,TZ-1):NEXT:GOTO 170
165 NEXT Z
170 CS(A,Z)=CC
175 IF NOT EOF(2) THEN 140 ELSE CLOSE #2
180 N=T(A):IF N>1 THEN IF X2(A)>X(A)*X(A)/N THEN SD(A)=SQR((X2(A)-X(A)*X(A)/N)/(N-1))
185 IF N>0 THEN IF N MOD 2=0 THEN MD(A)=(VAL(D(A,CS(A,N/2)))+VAL(D(A,CS(A,N/2+1))))*0.5 ELSE MD(A)=VAL(D(A,CS(A,N/2+0.5)))
190 IF CC>C THEN C=CC
195 IF ASUB=2 THEN LOCATE AR,32:PRINT TAB(55):FILE$=FILE1$:GOSUB 4110:GOTO 205
200 PRINT TAB(7);"(If you choose ";FILEF$;" you will write over your FORTRAN file.)":GOSUB 4100
205 FILE1$=FILE$:LOCATE 25,5:PRINT "Do you want to transfer another sample from ";FILEF$;" to ";FILE1$;:INPUT;A$
210 IF A$="y" OR A$="Y" THEN ASUB=2:BF=1:FILE$=FILEF$:GOTO 45 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 205
215 GOTO 3000
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 2,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
5032 IF EF=1 THEN RESUME 50 ELSE IF EF=2 THEN RESUME 105 ELSE 5010
GO.TXT
╔═════════════════════════════════════════════════════════════════════════╗
║ <<<< Disk #88 EPISTAT >>>> ║
╠═════════════════════════════════════════════════════════════════════════╣
║ To copy the documentation to your printer type: ║
║ COPY PRINTDOC PRN (press enter) ║
╚═════════════════════════════════════════════════════════════════════════╝
HISTOGRM.BAS
1 ' HISTOGRAM GRAPHING PROGRAM
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1,1),CS(1,1),N$(1),X(1),X2(1),T(1),MD(1),SD(1),CT(1),EX(1),BP(201)
22 DATA "HISTOGRAM GRAPHING PROGRAM",26,28
30 GOSUB 4000
35 PRINT:AR=CSRLIN:PRINT TAB(9);"What is the SAMPLE NUMBER of the variable you want to graph?";:AC=71:GOSUB 4200
40 CLS:PRINT TAB(29);DTTL;:PRINT TAB(29);STRING$(26,205):AR=CSRLIN+1
45 LOCATE 25,35:COLOR CLR2,CLR1:PRINT " F1 = PRINT COPY ";:LOCATE 25,55:PRINT " F10 = RETURN ";:COLOR CLR1,CLR2:LOCATE AR,1
50 N=T(NS):D1=D(NS,CS(NS,1)):D2=D(NS,CS(NS,N)):FD=VAL(D2)-VAL(D1)
55 PRINT TAB(8);"The";N;"VALUES in ";N$(NS);" range from ";D1;" to ";D2;":"
60 PRINT TAB(27);"The difference between these values is";FD;"."
65 PRINT:PRINT TAB(8);:INPUT "Enter the full name of the variable to be graphed: ",DV
70 PRINT TAB(23);"What are the units of ";DV;"?";TAB(65);:INPUT "",DU
75 PRINT:AR=CSRLIN:LOCATE 24,12:PRINT "The maximum number of intervals I can graph is 60.";
80 LOCATE AR,23:PRINT "Enter WIDTH of each cell (in ";DU;")";:AC=65:GOSUB 4800:FU=VAL(IP$)
85 IF FD/FU>65 THEN BEEP:GOTO 75
90 LOCATE 22,35:COLOR 23:PRINT "CALCULATING";:COLOR CLR1
95 EZ=VAL(D1)-3*FU:HD=1:IF VAL(D1)>=0 AND EZ<=0 THEN EZ=0:SN=FU ELSE SN=EZ
100 EN=VAL(D2)
105 IF EN>99 THEN HD=HD*10:SN=SN/10:EN=EN/10:GOTO 105
110 IF ABS(SN)<0.1 THEN HD=HD/10:SN=SN*10:GOTO 110
115 IF SN<-99 THEN HD=HD*10:SN=SN/10:GOTO 115
120 IF EZ<>0 THEN EZ=INT(SN*10)*(HD/10)
125 FD=VAL(D2)-EZ:BT=INT(FD/FU)+4:CC=1:ERASE CT,EX:DIM CT(BT),EX(BT)
130 EX(1)=EZ:FOR T=1 TO N:VX=VAL(D(NS,CS(NS,T)))
135 IF VX<EX(CC) THEN CT(CC)=CT(CC)+1:NEXT:GOTO 145
140 CC=CC+1:EX(CC)=EX(CC-1)+FU:GOTO 135
145 FOR Z=CC TO BT:EX(Z)=EX(Z-1)+FU:NEXT
150 CMX=1:FOR Z=1 TO BT:IF CT(Z)>CMX THEN CMX=CT(Z)
155 NEXT
160 SCREEN 2,1:OUT 985,(CLR1-(CLR1=0)):CLS:PRINT TAB(35);FILE$
165 XI=20/CMX:CIX=1:CI=INT(XI):IF XI>5 THEN CI=5 ELSE IF XI<1 THEN CIX=INT(1/XI+1):CI=1
170 LV=(CMX+1)*CI/CIX:LINE(34,171)-(34,171-LV*8)
175 FOR Z=1 TO CMX/CIX:HL=171-Z*8*CI:LINE (30,HL)-(34,HL):NEXT:NH=0
180 FOR Z=1 TO CMX/CIX:HL=22-Z*CI:NH=NH+CIX:IF CI=1 THEN IF Z MOD 2=0 THEN 190
185 LOCATE HL,1:PRINT USING "###";NH
190 NEXT
195 CH=INT(70/BT):IF CH>5 THEN CH=5 ELSE IF CH<1 THEN CH=1
200 LH=(BT+1)*CH:LINE (34,171)-(LH*8+34,171):ZH=5/CH:IF CH=4 THEN ZH=2
205 FOR Z=1 TO BT:HL=34+8*CH*Z:IF Z MOD ZH=1 THEN LINE (HL,171)-(HL,175) ELSE LINE (HL,171)-(HL,173)
210 NEXT
215 EXH=EX(BT)/HD:IF ABS(EXH)<10 THEN P$="###.##" ELSE P$="###.#"
220 FOR Z=1 TO BT:IF (Z-1) MOD ZH<>0 THEN 230
225 HL=2+CH*Z:LOCATE 23,HL:PRINT USING P$;EX(Z)/HD;
230 NEXT
235 TB=LEN(DV)+LEN(DU)-8*(HD<>1):LOCATE 25,HL/2-TB/2+3:PRINT DV;" (";DU;:IF HD<>1 THEN PRINT " x";:PRINT USING "##^^^^";HD;
240 PRINT ")";:CHP=CH*8
245 FOR Z=1 TO BT:LLC=34+CHP*(Z-1):RLC=LLC+CHP:UC=171-INT(CT(Z)*CI*8/CIX):LINE (LLC,171)-(RLC,UC),,BF:NEXT
250 A$=INKEY$:IF A$="" THEN 250 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN 370 ELSE IF AI=59 THEN 260
255 BEEP:GOTO 250
260 ON ERROR GOTO 5070:OPEN "LPT1:" AS #1:WIDTH #1,255:DEF SEG=&HB800
265 ON PMAK GOTO 270,270,310,340
270 PRINT #1,CHR$(27)+"@";CHR$(13);CHR$(27)+"3"+CHR$(23);CHR$(27)+"U"+CHR$(1);
275 FOR Z=0 TO 79:PRINT #1,CHR$(27)+"L"+CHR$(32)+CHR$(3);
280 FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
285 FOR AY=100 TO 1 STEP -1:BQ=BP(AY+100):BR=BP(AY):IF BQ=13 THEN BQ=9
286 IF BR=13 THEN BR=9
287 PRINT #1,STRING$(4,BQ);STRING$(4,BR);:NEXT
290 PRINT #1,CHR$(13);CHR$(10);:NEXT
295 PRINT #1,CHR$(27)+"3"+CHR$(36);CHR$(13);CHR$(12);
300 PRINT #1,CHR$(27)+"U"+CHR$(0);TYP$;
305 PLAY "MS O3 L64 G O2 GE L9 E":CLOSE #1:DEF SEG:GOTO 250
310 PRINT #1,CHR$(27)+"0";CHR$(30);CHR$(3);
315 FOR Z=79 TO 0 STEP -1
320 FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
325 FOR AY=1 TO 100:BQ=BP(AY):BR=BP(AY+100):NQ=2:NR=2:IF BQ=3 THEN NQ=4
326 IF BR=3 THEN NR=4
327 PRINT #1,STRING$(NQ,BQ);STRING$(NR,BR);:NEXT
330 PRINT #1,CHR$(3);CHR$(14);:NEXT
335 PRINT #1,CHR$(3);CHR$(2);CHR$(27)+"6";TYP$;:GOTO 305
340 PRINT #1,CHR$(27)+"N";CHR$(27)+"T16";CHR$(27)+"L005";CHR$(27)+">";
345 FOR Z=79 TO 0 STEP -1:PRINT #1,CHR$(27)+"S0600";
350 FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
355 FOR AY=1 TO 100:PRINT #1,STRING$(3,BP(AY));STRING$(3,BP(AY+100));:NEXT
360 PRINT #1,CHR$(13);CHR$(10);:NEXT
365 PRINT #1,CHR$(27)+"<";CHR$(27)+"L000";CHR$(27)+"A";TYP$;:GOTO 305
370 SCREEN 0,SCRN:COLOR CLR1,CLR2,CLR3:CLS
375 DQ="Would you like another HISTOGRAM using ":LOCATE 25,8:PRINT DQ;:INPUT "the SAME sample? ",A$
380 IF A$="y" OR A$="Y" THEN 40 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 370
385 LOCATE 25,47:INPUT "a DIFFERENT sample? ",A$
390 IF A$="N" OR A$="n" THEN 405 ELSE IF A$<>"y" AND A$<>"Y" THEN BEEP:GOTO 385
395 LOCATE 25,5:PRINT TAB(75):LOCATE 25,20:PRINT "Is the sample you want in ";FILE$;:INPUT;A$
400 IF A$="Y" OR A$="y" THEN LOCATE 2,1:GOTO 35 ELSE IF A$="n" OR A$="N" THEN 20 ELSE BEEP:GOTO 395
405 GOTO 3000
4025 ERASE D,CS,N$,X,X2,T,MD,SD
4030 DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(A),MD(A),SD(A)
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
5072 A$=INKEY$:IF A$="" THEN 5072 ELSE CLOSE #1:RESUME 160
LNREGRES.BAS
1 ' LINEAR REGRESSION
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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),ST(1)
22 DATA "LINEAR REGRESSION",32,19
30 LOCATE 7,28:PRINT "1.) Linear regression":PRINT
35 PRINT TAB(28);"2.) Data transformations":PRINT
40 PRINT TAB(28);"3.) Exit"
45 LOCATE 14,32:PRINT "Enter choice:":AR=14:AC=46:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 45
50 ON ASUB GOTO 55,195,385
55 CLS:PRINT TAB(32);DTTL:PRINT TAB(32);STRING$(17,205):PRINT:GOSUB 4000
60 PRINT:PRINT " What are the SAMPLE NUMBERS of the 2 variables you want to compare?":PRINT TAB(10);"Predictor variable (X)";TAB(45);"Dependent variable (Y)"
65 AR=CSRLIN:AC=13:GOSUB 4200:NS1=NS:AC=48:GOSUB 4200:NS2=NS:PRINT
70 IF T(NS1)<>T(NS2) THEN BEEP:PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(37);"a regression analysis cannot be performed.":FOR Z=1 TO 5000:NEXT:GOTO 20
75 XC=0:N=T(NS1):FOR Z=1 TO N:XC=XC+VAL(D(NS1,Z))*VAL(D(NS2,Z)):NEXT
80 SC=XC-X(NS1)*X(NS2)/N:SX=X2(NS1)-X(NS1)*X(NS1)/N
85 SY=X2(NS2)-X(NS2)*X(NS2)/N:SB=SC/SX:IA=(X(NS2)-SB*X(NS1))/N
90 COLOR CLR2,CLR1:PRINT TAB(13);"Regression equation: Y =";IA;:IF SB>0 THEN PRINT "+"; ELSE PRINT "-";
95 PRINT ABS(SB);"* X";TAB(79):COLOR CLR1,CLR2:PRINT:PRINT
100 V1=N-2:S2=(SY-SC*SC/SX)/V1:SEB=SQR(S2/SX):ST=ABS(SB)/SEB
105 PRINT " Significance of slope: T =";ST;TAB(45);"df =";V1;
110 R=ATN(ST/SQR(V1)):RC=COS(R):R2=RC*RC:RS=SIN(R):X=1
115 IF V1 MOD 2=0 THEN 140
120 IF V1=1 THEN Y=R:GOTO 135
125 Y=RC:FOR Z=3 TO (V1-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X*RC:NEXT
130 Y=R+RS*Y
135 P=1-Y*0.636619772365716#:GOTO 150
140 Y=1:FOR Z=2 TO (V1-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X:NEXT
145 P=1-Y*RS
150 PLAY "MS O3 L64 G O2 GE L9 E"
155 PRINT TAB(60);"p = ";: IF P<0.000001 THEN PRINT "< 10 (-6)" ELSE PRINT P
160 PRINT:COLOR CLR2,CLR1:PRINT TAB(10);"The slope of this line is ";
165 IF P>0.05 THEN PRINT "NOT ";
170 PRINT "significantly different than 0";TAB(79):COLOR CLR1,CLR2:PRINT
175 PRINT:PRINT " Confidence limits on the slope can be calculated as:":PRINT
180 DF=STR$(V1):DF=RIGHT$(DF,LEN(DF)-1):PRINT TAB(25);SB;"+/- T(";DF;") *";SEB
185 LOCATE 24,8:INPUT;"Do you want another regression calculation with this DATAFILE? ",A$
190 IF A$="y" OR A$="Y" THEN CLS:GOTO 60 ELSE 375
195 CLS:PRINT TAB(32);"DATA TRANSFORMATIONS":PRINT TAB(32);STRING$(20,205):PRINT:LOCATE 4,1:GOSUB 4000
200 PRINT:PRINT TAB(29);"1.) X' = Ax + B":PRINT TAB(29);"2.) X' = Ax² + B"
205 PRINT TAB(29);"3.) X' = A*√x + B":PRINT TAB(29);"4.) X' = A/x + B"
210 PRINT TAB(29);"5.) X' = x - mean":PRINT TAB(29);"6.) X' = A*ln(x) + B"
215 PRINT TAB(29);"7.) X' = ln(x/100-x)":PRINT TAB(29);"8.) X' = Sample A + Sample B"
220 PRINT TAB(29);"9.) X' = Sample A * Sample B":PRINT
225 LOCATE 16,29:PRINT "Choose transformation:":AR=16:AC=52:GOSUB 4800:TN=VAL(IP$):IF ABS(TN-5)>4 THEN BEEP:GOTO 225
230 IF TN>7 THEN 240 ELSE PRINT " Enter the SAMPLE NUMBER of the variable you want transformed:";:AR=17:AC=68:GOSUB 4200:N=T(NS)
235 IF TN=5 OR TN=7 THEN 245 ELSE PRINT TAB(27);"A =";:AR=CSRLIN:AC=31:GOSUB 4800:KA=VAL(IP$):PRINT TAB(49);"B =";:AC=53:GOSUB 4800:KB=VAL(IP$):GOTO 245
240 PRINT TAB(15);"Sample A =";:AR=CSRLIN:AC=26:GOSUB 4200:KA=NS:LOCATE AR,45:PRINT "Sample B =";:AC=56:GOSUB 4200:KB=NS:IF T(KB)>T(KA) THEN N=T(KB) ELSE N=T(KA)
245 A=AN:X(A)=0:X2(A)=0:PRINT:AR=CSRLIN:COLOR 23:LOCATE AR,29:PRINT "PERFORMING TRANSFORMATION";:COLOR CLR1,CLR2
250 ON TN GOTO 255,260,265,270,275,280,285,290,295
255 FOR Z=1 TO N:ST(Z)=KA*VAL(D(NS,Z))+KB:NEXT:GOTO 300
260 FOR Z=1 TO N:L=VAL(D(NS,Z)):ST(Z)=KA*L*L+KB:NEXT:GOTO 300
265 FOR Z=1 TO N:ST(Z)=KA*SQR(VAL(D(NS,Z)))+KB:NEXT:GOTO 300
270 FOR Z=1 TO N:ST(Z)=KA/VAL(D(NS,Z))+KB:NEXT:GOTO 300
275 LM=X(NS)/T(NS):FOR Z=1 TO N:ST(Z)=VAL(D(NS,Z))-LM:NEXT:GOTO 300
280 FOR Z=1 TO N:ST(Z)=KA*LOG(VAL(D(NS,Z)))+KB:NEXT:GOTO 300
285 FOR Z=1 TO N:L=VAL(D(NS,Z)):ST(Z)=LOG(L/(100-L)):NEXT:GOTO 300
290 FOR Z=1 TO N:ST(Z)=VAL(D(KA,Z))+VAL(D(KB,Z)):GOSUB 350:NEXT Z:GOTO 305
295 FOR Z=1 TO N:ST(Z)=VAL(D(KA,Z))*VAL(D(KB,Z)):GOSUB 350:NEXT Z:GOTO 305
300 FOR Z=1 TO N:XX=ST(Z):X(A)=X(A)+XX:X2(A)=X2(A)+XX*XX:NEXT
305 FOR Z=1 TO N:SP=INT(ST(Z)*1.000000e+7)*1.000000e-7:DS=STR$(SP)
310 IF SP>0 THEN D(A,Z)=RIGHT$(DS,LEN(DS)-1) ELSE D(A,Z)=DS
315 NEXT:IF TN=4 THEN 325 ELSE IF TN>7 THEN 330
320 FOR Z=1 TO N:CS(A,Z)=CS(NS,Z):NEXT:GOTO 330
325 FOR Z=1 TO N:CS(A,Z)=CS(NS,(N-Z+1)):NEXT
330 T(A)=N:VC=0:MN=X(T)/N:FOR ZZ=1 TO N:VC=VC+(ST(ZZ)-MN)^2:NEXT ZZ:SD(A)=SQR(VC/(N-1))
335 IF N>0 THEN IF N MOD 2=0 THEN MD(A)=(VAL(D(A,CS(A,N/2)))+VAL(D(A,CS(A,N/2+1))))*0.5 ELSE MD(A)=VAL(D(A,CS(A,N/2+0.5)))
340 LOCATE AR,5:PRINT "The transformed variable has been added to ";FILE$;" as sample #";A
345 PRINT:PRINT TAB(7);"Enter name for the TRANSFORMED `";N$(NS);:INPUT "' data sample: ",N$(A):AR=CSRLIN:GOSUB 4100:GOTO 20
350 X(A)=X(A)+ST(Z):X2(A)=X2(A)+ST(Z)*ST(Z)
355 FOR ZZ=1 TO (Z-1):VX=ST(CS(A,ZZ)):IF VX<=ST(Z) THEN 365
360 FOR TZ=Z TO (ZZ+1) STEP -1:CS(A,TZ)=CS(A,TZ-1):NEXT:GOTO 370
365 NEXT ZZ
370 CS(A,ZZ)=Z:RETURN
375 LOCATE 25,25:PRINT "Press any key to return to menu.";
380 A$=INKEY$:IF A$="" THEN 380 ELSE 20
385 GOTO 3000
4025 IF ASUB=1 THEN AN=A ELSE AN=A+1
4027 ERASE D,CS,T,N$,X,X2,SD,MD,ST
4030 DIM D(AN,C),CS(AN,C),T(AN),N$(AN),X(AN),X2(AN),MD(AN),SD(AN),ST(C)
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
MCNEMAR.BAS
1 ' MCNEMAR'S TEST
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
22 DATA "MCNEMAR'S TEST (paired chi-square)",21,36
30 PRINT TAB(12);:INPUT "What is the name of the FACTOR to be tested? ",F$
35 PRINT:PRINT " ENTER the number of PAIRS in each category:"
40 PRINT:PRINT TAB(36);"CONTROLS"
45 PRINT TAB(28);"+ ";F$;TAB(42);"- ";F$
50 PRINT TAB(24);"┌──────────────┬──────────────┐"
55 PRINT TAB(11);"+ ";F$;TAB(24);"│";TAB(39);"│";TAB(54);"│"
60 PRINT " CASES";TAB(24);"├──────────────┼──────────────┤"
65 PRINT TAB(11);"- ";F$;TAB(24);"│";TAB(39);"│";TAB(54);"│"
70 PRINT TAB(24);"└──────────────┴──────────────┘"
75 AR=12:AC=30:GOSUB 170:BA=I:AC=46:GOSUB 170:BB=I
80 AR=14:AC=30:GOSUB 170:BC=I:AC=46:GOSUB 170:BD=I
85 X=ABS(BB-BC)-1:N=BB+BC:X=X*X/N:PRINT:PRINT
90 PRINT TAB(20);"CHI-SQUARE = ";X;TAB(53);"df = 1":PRINT
95 IF X>31 THEN P=0:GOTO 115
100 R=1.77245374942627#:S=1:I=1:K=SQR(X/2)*2/(EXP(X/2)*R):VC=3
105 I=I*X/VC:S=S+I:VC=VC+2:IF I>9.999999e-31 THEN 105
110 P=1-K*S
115 PLAY "MS O3 L64 G O2 GE L9 E":PRINT TAB(19);
120 COLOR CLR2,CLR1:PRINT TAB(33);"p = ";:IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
125 PRINT TAB(61):COLOR CLR1,CLR2:PRINT:PRINT
130 PRINT TAB(28);"ODDS RATIO = ";:IF BC=0 THEN PRINT "not calculable" ELSE PRINT BB/BC
135 XA=N*(N+3.842):XB=N*(2*BB+5.842):XD=N*(2*BB+1.842)
140 PRINT TAB(15);"95% Confidence limits: ";
145 IF BB=0 THEN PRINT "not calculable"; ELSE PL=(XD-SQR(XD*XD-4*XA*(BB-1)*(BB-1)))/(2*XA):PRINT PL/(1-PL);
150 PRINT " and ";:IF BC=0 THEN PRINT "not calculable"; ELSE PU=(XB+SQR(XB*XB-4*XA*(BB+1)*(BB+1)))/(2*XA):PRINT PU/(1-PU)
155 LOCATE 25,15:INPUT;"Do you want to calculate another McNemar's test? ",A$
160 IF A$="y" OR A$="Y" THEN 20
165 GOTO 3000
170 GOSUB 4800:I=VAL(IP$):IF INT(I)=I THEN RETURN ELSE BEEP:LOCATE 25,15:PRINT "Please enter integers only";:GOTO 170
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
MHCHIMLT.BAS
1 ' MANTEL-HAENSZEL MATCHED CHI-SQUARE FOR MULTIPLE CONTROLS
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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",12,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(15);"How many controls are matched with each case?";:AR=CSRLIN:AC=62:GOSUB 4800:AM=VAL(IP$):RETURN
45 PRINT:PRINT TAB(21);"How many matched groups will you enter?";:AR=CSRLIN:AC=62:GOSUB 4800:NM=VAL(IP$)
50 GOSUB 40:PRINT: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:PRINT:AR=CSRLIN:PRINT TAB(8);Z;
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
80 AC=56:GOSUB 4800:BX=VAL(IP$):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 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
100 PRINT TAB(12);"What are the";AM;"SAMPLE NUMBERS of the CONTROL groups?"
105 FOR Z=2 TO AM+1:AR=CSRLIN:AC=62: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-0.5)>0.51 THEN 205
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
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(15);"CHI-SQUARE = ";X;TAB(59);"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 "MS O3 L64 G O2 GE L9 E":PRINT TAB(15);
175 COLOR CLR2,CLR1:PRINT TAB(34);"p = ";:IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
180 PRINT TAB(66):COLOR CLR1,CLR2:PRINT:PRINT:PRINT TAB(33);"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(16);"95% Confidence limits: ";EXP((1-XP)*LOG(XO));" and ";EXP((1+XP)*LOG(XO))
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
200 GOTO 3000
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
210 BEEP:LOCATE 25,8:PRINT "The number of positive ";D1;" per group should be";AA;"or ";D2;TAB(79):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 2,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
MHCHISQR.BAS
1 ' MANTEL-HAENSZEL CHI-SQUARE TEST
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
22 DATA "MANTEL-HAENSZEL CHI-SQUARE TEST",24,33
30 PRINT TAB(20);: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 TAB(5);DT;" must be a dichotomous variable,":PRINT TAB(35);"but ";DC;" may have > 2 categories."
45 LOCATE 10,20:PRINT "How many categories does ";DC;" have?";:AR=10:AC=52+LEN(DC):GOSUB 4800:CJ=VAL(IP$):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 CJ: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)-0.5:X=X*X/SN:V1=1
100 COLOR CLR2,CLR1:PRINT TAB(10);"CHI-SQUARE = ";X;TAB(42);"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-0.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 "MS O3 L64 G O2 GE L9 E"
140 PRINT TAB(57);"p = ";:IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
145 PRINT TAB(80):COLOR CLR1,CLR2
150 PRINT:PRINT:PRINT TAB(29);"ODDS RATIO = ";:IF SB=0 THEN PRINT "not calculable":GOTO 160
155 XO=SA/SB:XP=1.96/SQR(X):PRINT XO;TAB(14);"95% Confidence limits: ";EXP((1-XP)*LOG(XO));" and ";EXP((1+XP)*LOG(XO))
160 LOCATE 25,8:INPUT;"Do you want to calculate another Mantel-Haenszel Chi-square? ",A$:IF A$="y" OR A$="Y" THEN 20
165 GOTO 3000
170 GOSUB 4800:I=VAL(IP$):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 2,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
NORMAL.BAS
1 ' NORMAL DISTRIBUTION
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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)
22 DATA "NORMAL DISTRIBUTION",30,21
30 DQ="Do you want to evaluate another ":PRINT:PRINT LEFT$(DQ,14);":":PRINT
35 PRINT TAB(13);"1.) Determine if the mean of your sample is significantly":PRINT TAB(19);"different from the population mean.":PRINT
40 PRINT TAB(13);"2.) Determine what percent of test values lie within":PRINT TAB(19);"a given range.":PRINT
45 PRINT TAB(13);"3.) Evaluate a known Z value."
50 LOCATE 16,30:PRINT "Enter choice:":AR=16:AC=44:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 50
55 ON ASUB GOTO 60,130,195
60 CLS:PRINT TAB(11);"COMPARING SAMPLE MEAN TO POPULATION MEAN (two-tailed Z test)":PRINT TAB(11);STRING$(60,205)
65 LOCATE 5,8:PRINT "(Enter RETURN if you want to enter known MEAN and STD. DEV.)"
70 LOCATE 4,1:GOSUB 4000
75 LOCATE 7,15:PRINT "What is the SAMPLE NUMBER you wish to analyze?";:AR=7:AC=63:GOSUB 4200
80 LOCATE 9,20:PRINT "This sample has a MEAN of";X(NS)/T(NS)
85 LOCATE 11,15:PRINT "What is the POPULATION MEAN for this variable?":AR=11:GOSUB 4800:M=VAL(IP$)
90 XZ=(X(NS)/T(NS)-M)*SQR(T(NS))/SD(NS):GOSUB 220
95 LOCATE 25,10:PRINT DQ;"MEAN using this DATAFILE? ";:INPUT;"",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 75 ELSE 210
100 PRINT:PRINT:PRINT TAB(25);
105 INPUT "What is the SAMPLE MEAN? ",SM:PRINT:PRINT TAB(21);
110 INPUT "What is the POPULATION MEAN? ",M:PRINT:PRINT TAB(11);
115 INPUT "What is the SAMPLE STANDARD DEVIATION? ",SV:PRINT:PRINT TAB(7);
117 INPUT "How many observations were in this SAMPLE? ",N
120 XZ=(SM-M)*SQR(N)/SV:GOSUB 220
125 LOCATE 25,12:PRINT DQ;:INPUT;"known SAMPLE MEAN? ",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 100 ELSE 210
130 CLS:PRINT TAB(21);"PERCENT OF TEST VALUES IN A GIVEN RANGE":PRINT TAB(21);STRING$(39,205)
135 LOCATE 5,23:INPUT "What is the MEAN of this test? ",SM
140 LOCATE 7,15:INPUT "What is the STANDARD DEVIATION of this test? ",SV
145 LOCATE 9,23:PRINT "Enter limits of RANGE in question:":PRINT TAB(23);"LOWER LIMIT";TAB(45);"UPPER LIMIT"
150 AR=CSRLIN:AC=27:GOSUB 4800:LL=VAL(IP$):AC=49:GOSUB 4800:UL=VAL(IP$)
155 XZ=(LL-SM)/SV:GOSUB 180:PC=P
160 XZ=(UL-SM)/SV:GOSUB 180:PC=(PC-P)*100
165 COLOR CLR2,CLR1:GOSUB 250
170 PRINT TAB(13);"The PERCENT of test values in this range = ";:IF PC<100 THEN PRINT PC; ELSE PRINT "> 99.99999";
175 PRINT TAB(80):COLOR CLR1,CLR2:LOCATE 25,18:PRINT DQ;:INPUT;"TEST RANGE? ",A$:IF A$="y" OR A$="Y" THEN 130 ELSE 210
180 IF ABS(XZ)>6 THEN P=0 ELSE GOSUB 240:P=PT*R
185 IF XZ<0 THEN P=1-P
190 RETURN
195 CLS:PRINT TAB(15);"EVALUATING Z VALUE - NORMAL DISTRIBUTION (two-tailed)":PRINT TAB(15);STRING$(53,205)
200 LOCATE 5,30:INPUT "Enter Z value: ",XZ:GOSUB 220
205 LOCATE 25,20:PRINT DQ;:INPUT;"Z value? ",A$:IF A$="y" OR A$="Y" THEN 195
210 LOCATE 25,4:INPUT;"Do you want to perform another analysis using the NORMAL DISTRIBUTION? ",A$:IF A$="y" OR A$="Y" THEN 20
215 GOTO 3000
220 IF ABS(XZ)>6 THEN P=0:GOTO 225 ELSE GOSUB 240:P=2*PT*R
225 GOSUB 250:COLOR CLR2,CLR1:PRINT TAB(28);"Two-tailed p = ";
230 IF P<0.000001# THEN PRINT "< 10 (-6)";TAB(71) ELSE PRINT P;TAB(71)
235 COLOR CLR1,CLR2:RETURN
240 R=1/SQR(EXP(XZ*XZ)*6.283185307#):W=1/((ABS(XZ)*0.2316419)+1)
245 W2=W*W:PT=(W*0.31938153#)-(W2*0.356563782#)+(W*W2*1.781477937#)-(W2*W2*1.821255978#)+(W2*W2*W*1.330274429#):RETURN
250 PLAY "MS O3 L64 G O2 GE L9 E"
255 PRINT:PRINT:PRINT TAB(10);:RETURN
4010 IF FILE$="" THEN 100
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 2,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
POISSON.BAS
1 ' POISSON DISTRIBUTION (one-tailed)
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
22 DATA "POISSON PROBABILITY DISTRIBUTION",22,34
30 PRINT " The Poisson distribution is a one-tailed exact test that applies specifically ":PRINT " when the number of SUCCESSES can be counted but the number of FAILURES cannot."
35 PRINT TAB(8);"It can also be used to approximate the binomial distribution":PRINT TAB(4);"when the number of trials is > 100 and the the population rate is < 5% ."
40 LOCATE 11,22:PRINT "Enter the number of cases OBSERVED:"
45 AR=11:AC=60:GOSUB 4800:I=VAL(IP$):IF INT(I)=I THEN XO=I ELSE BEEP:LOCATE 25,21:PRINT "Observed number must be an integer.";:GOTO 45
50 LOCATE 13,22:PRINT "Enter the number of cases EXPECTED:"
55 PRINT TAB(29);"(may be a fraction)":PRINT TAB(20);"(e.g. population rate * time interval)":AR=13:AC=60:GOSUB 4800:E=VAL(IP$)
60 COLOR 23:LOCATE 17,28:PRINT "CALCULATING PROBABILITY"
65 AF=0:YO=XO:CE=0:IF E<YO THEN YO=YO-1:AF=1
70 IF YO=0 THEN SF=1 ELSE SF=E+1
75 F=E:FOR Z=2 TO YO:F=F*E/Z:IF F>1.000000e+22 THEN F=F*1.92875216527315e-22#:SF=SF* 1.92875216527315e-22#:CE=CE+1
80 IF F>=1.000000e-31 THEN SF=SF+F:NEXT Z
85 SL=LOG(SF)-E+CE*50:IF SL>80 THEN P=0 ELSE P=EXP(SL)
90 IF AF=1 THEN P=1-P
95 PLAY "MS O3 L64 G O2 GE L9 E"
100 COLOR CLR2,CLR1:LOCATE 17,1:PRINT TAB(8);"The probability of observing ";XO;" or ";
105 IF AF=1 THEN PRINT "more cases "; ELSE PRINT "fewer cases ";
110 IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE IF P>0.95 THEN PRINT "> .95"; ELSE PRINT "= ";P;
115 PRINT TAB(80):COLOR CLR1,CLR2:LOCATE 25,6:INPUT;"Do you want to perform another Poisson distribution calculation? ",A$:IF A$="y" OR A$="Y" THEN 20
120 GOTO 3000
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
RANDOMIZ.BAS
1 ' SELECTING A RANDOM SAMPLE
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM CX(10),CC(10),EX(10)
22 DATA "SELECTING A RANDOM SAMPLE",26,27
30 LOCATE 7,5:PRINT "Do you want to:":PRINT
35 PRINT TAB(14);"1.) Select a SURVEY SAMPLE from a population.":PRINT
40 PRINT TAB(14);"2.) Assign UNPAIRED subjects to 2 groups prospectively."
45 PRINT:PRINT TAB(14);"3.) Assign PAIRED subjects to 2 groups prospectively."
50 LOCATE 16,30:PRINT "Enter choice:":AR=16:AC=44:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 50
55 LOCATE 20,10:INPUT "Do you want numbers printed on screen or printer? (S or P) ",A$
60 IF A$="p" OR A$="P" THEN PO$="LPT1:":PMAX=PRNT-10 ELSE IF A$="S" OR A$="s" THEN PO$="SCRN:":PMAX=70 ELSE BEEP:GOTO 55
65 ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
70 CLS:ON ASUB GOTO 75,135,220
75 PRINT TAB(30);"SELECT A SURVEY SAMPLE":PRINT TAB(30);STRING$(22,205)
80 LOCATE 4,20:PRINT "What is the smallest number you want?":AR=4:AC=60:GOSUB 4800:E1=VAL(IP$)
85 PRINT TAB(21);"What is the largest number you want?":AR=5:GOSUB 4800:E2=VAL(IP$)
90 LOCATE 7,10:PRINT "How many random numbers between";E1;"and";E2;"do you want?":AR=7:AC=68:GOSUB 4800:NM=VAL(IP$)
95 ERASE EX:DIM EX(NM+1)
100 PRINT:PRINT:PRINT #1,TAB(PMAX/2-14);NM;"RANDOM NUMBERS BETWEEN";E1;"AND";E2
105 PRINT #1,:GOSUB 210:NT=0:EZ=E1-1
110 IF (E2-EZ)*RND<NM-NT THEN NT=NT+1:EZ=EZ+1:EX(NT)=EZ:IF NT<NM THEN 110 ELSE 120
115 EZ=EZ+1:GOTO 110
120 TB=6:IF E2>10000 THEN TB=10
125 GOSUB 215:T=1:FOR Z=1 TO NM:PRINT #1,TAB(T);EX(Z);:T=T+TB:IF T>PMAX THEN T=1
130 NEXT:PRINT #1,:GOTO 265
135 PRINT TAB(26);"ASSIGN SUBJECTS TO TWO GROUPS":PRINT TAB(26);STRING$(29,205)
140 LOCATE 4,2:INPUT "Will subjects enter the study over a period of time longer than 1 month? ",A$:PRINT:AF=0
145 IF A$="y" OR A$="Y" THEN AF=1:PRINT "Then it is preferable to randomize SUBSETS independently to avoid seasonal bias":PRINT TAB(15);"and to asssure equal numbers of cases and controls":PRINT TAB(23);"should the study terminate early.":PRINT
150 D1="How many subjects ":IF AF=1 THEN PRINT TAB(8);D1;"are expected to enter the study each month?":AR=10:AC=70:GOSUB 4800:NN=VAL(IP$) ELSE PRINT TAB(13);D1;"(total) will be in the study?":AR=6:AC=62:GOSUB 4800:NN=VAL(IP$)
155 NM=NN/2:ERASE CX,CC:DIM CX(NM+1),CC(NM+1):PRINT:PRINT
160 PRINT #1,TAB(PMAX/2-13);"RANDOM ASSIGNMENT OF";NN;"SUBJECTS":PRINT #1,
165 GOSUB 210:NT=0:NC=0:EZ=0
170 EZ=EZ+1:IF (NN-EZ)*RND<NM-NT THEN NT=NT+1:CX(NT)=EZ ELSE NC=NC+1:CC(NC)=EZ
175 IF NT+NC<NN THEN 170
180 GOSUB 215:PRINT #1,"CASES = ";:T=11
185 FOR Z=1 TO NT:PRINT #1,TAB(T);CX(Z);:T=T+7:IF T>PMAX THEN T=11
190 NEXT
195 PRINT #1,:PRINT #1,:PRINT #1,"CONTROLS =";:T=11
200 FOR Z=1 TO NC:PRINT #1,TAB(T);CC(Z);:T=T+7:IF T>PMAX THEN T=11
205 NEXT:PRINT #1,:GOTO 265
210 RANDOMIZE (VAL(RIGHT$(TIME$,2))):COLOR 23:AR=CSRLIN:PRINT TAB(35);"RANDOMIZING";:COLOR CLR1:RETURN
215 LOCATE AR,1:PRINT TAB(79):LOCATE AR,1:PLAY "MS O3 L64 G O2 GE L9 E":RETURN
220 PRINT TAB(23);"ASSIGN PAIRED SUBJECTS TO TWO GROUPS":PRINT TAB(23);STRING$(36,205)
225 LOCATE 4,17:PRINT "How many PAIRS of subjects are in the study?":AR=4:AC=62:GOSUB 4800:NM=VAL(IP$)
230 PRINT TAB(12);"Each member of a pair is assigned #1 or #2 on the basis of"
235 PRINT TAB(14);"alphabetical order or some other objective criterion."
240 PRINT #1,:PRINT #1,TAB(PMAX/2-17);"RANDOM ASSIGNMENT OF";NM;"PAIRS TO TWO GROUPS":PRINT #1,
245 PRINT #1,TAB(PMAX/3);"#1 IN PAIR";TAB(PMAX*2/3);"#2 IN PAIR"
250 RANDOMIZE VAL(RIGHT$(TIME$,2)):PRINT #1,:D1="CASE":D2="CONTROL"
255 FOR Z=1 TO NM:PRINT #1,TAB(15);Z;:RN=RND:PRINT #1,TAB(PMAX/3+2);:IF RN<0.5 THEN PRINT #1,D1;TAB(PMAX*2/3+2);D2 ELSE PRINT #1,D2;TAB(PMAX*2/3+2);D1
260 NEXT
265 CLOSE #1:LOCATE 25,16:INPUT;"Do you want to perform another randomization? ",A$:IF A$="y" OR A$="Y" THEN 20
270 GOTO 3000
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
RANKTEST.BAS
1 ' RANK SUM AND SIGNED RANK TESTS
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1),CS(1),T(1),N$(1),X(1),X2(1),MD(1),SD(1),SR(1),C(1),CF(1)
22 DATA "RANK TESTS (Non-parametric tests)",22,35
30 LOCATE 7,5:PRINT "(If you know rank sums, press ENTER to skip directly to RANK TESTS.)"
35 LOCATE 6,1:GOSUB 4000
40 LOCATE 9,20:PRINT "1.) WILCOXON RANK SUM TEST (independent samples)":PRINT
45 PRINT TAB(20);"2.) SIGNED RANK TEST (paired samples)":PRINT
50 PRINT TAB(30);"Enter choice:":AR=13:AC=44:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-1.5)>0.5 THEN BEEP:GOTO 50
55 CLS:ON ASUB GOTO 95,330
60 PRINT TAB(5);"What are the SAMPLE NUMBERS of the 2 variables you want to compare?":PRINT:AR=CSRLIN
65 AC=17:GOSUB 4200:NS1=NS:AC=50:GOSUB 4200:NS2=NS
70 PRINT "Medians = ";TAB(17);MD(NS1);TAB(50);MD(NS2)
75 IF ASUB=2 AND T(NS1)<>T(NS2) THEN PRINT:PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(35);"a signed rank test cannot be performed.":GOTO 580
90 RETURN
95 PRINT TAB(23);"WILCOXON RANK SUM TEST (two-tailed)":PRINT TAB(23);STRING$(35,205):PRINT
100 IF FILE$="" THEN PRINT ELSE GOSUB 60:N=T(NS1)+T(NS2):GOTO 130
105 DQ="Enter the NUMBER of observations in Sample ":PRINT TAB(16);DQ;"#1:":AR=5:AC=64:GOSUB 4800:N1=VAL(IP$)
110 PRINT TAB(16);DQ;"#2:":AR=6:GOSUB 4800:N2=VAL(IP$)
115 N=N1+N2:NMN=1:IF N1>N2 THEN NMN=2:SWAP N1,N2
120 LOCATE 8,18:PRINT "Enter the SUM of the ranks for Sample #";NMN;":":AR=8:GOSUB 4800:T=VAL(IP$)
125 ERASE C,CF:DIM C(N1),CF(N1):GOTO 205
130 ERASE SR:DIM SR(3,C*2+1):GOSUB 375:T1=1:T2=1
135 FOR Z=1 TO N
140 IF T1>T(NS1) THEN SR(1,Z)=VAL(D(NS2,CS(NS2,T2))):SR(2,Z)=0:T2=T2+1:GOTO 160
145 IF T2>T(NS2) THEN SR(1,Z)=VAL(D(NS1,CS(NS1,T1))):SR(2,Z)=1:T1=T1+1:GOTO 160
150 VC=VAL(D(NS1,CS(NS1,T1))):VX=VAL(D(NS2,CS(NS2,T2)))
155 IF VC<VX THEN SR(1,Z)=VC:SR(2,Z)=1:T1=T1+1:GOTO 160 ELSE SR(1,Z)=VX:SR(2,Z)=0:T2=T2+1
160 NEXT Z:AD=1:SZ=1
165 FOR Z=1 TO N:IF SR(1,Z)=SR(1,Z+1) THEN AD=AD+1:SZ=SZ+Z+1:GOTO 175
170 FOR T=Z TO (Z+1-AD) STEP -1:SR(3,T)=SZ/AD:NEXT T:SZ=Z+1:AD=1
175 NEXT Z:SR1=0:SR2=0
180 FOR Z=1 TO N:IF SR(2,Z)=1 THEN SR1=SR1+SR(3,Z) ELSE SR2=SR2+SR(3,Z)
185 NEXT
190 DQ="Sum of ranks for ":LOCATE AR,24:PRINT DQ;N$(NS1);" = ";SR1:PRINT
195 PRINT TAB(24);DQ;N$(NS2);" = ";SR2:PRINT
200 T=SR1:N1=T(NS1):N2=T(NS2):IF N1>N2 THEN SWAP N1,N2:T=SR2
205 XN=N1*(N+1):IF XN-T<T THEN T=XN-T
210 AK=0:IF N<25 THEN 215
212 U1=N1*N2+N1*(N1+1)/2-T:SD1=N1*N2*(N+1)/12:XZ=(U1-N1*N2/2)/SQR(SD1):GOSUB 2000:AR=15:GOTO 565
215 T=T-N1*(N1+1)*0.5:GOSUB 220:GOTO 225
220 AR=15:COLOR 23:LOCATE 15,28:PRINT "CALCULATING PROBABILITY":RETURN
225 BF=4:WT=0:FT=0:CB=0:CF=0:FOR Z=1 TO N1:C(Z)=0:CF(Z)=0:NEXT
230 IF N1<4 THEN 290
235 IF T-CF<=N2-CB THEN CT=T-CF+1:CK=0:GOTO 275
240 CX=N2-CB+1:CD=T-CF-CX+1:CE=CX-CD:CK=INT(CD*0.5+0.5):IF CD<=CX THEN 265
245 CE=0:CJ=CD:CD=CX:IF CK>CX THEN CK=CX
250 FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25)
255 CX=CX-1:CJ=CJ-2:IF CJ>=CX THEN CD=CX ELSE CD=CJ
260 CE=CX-CD:NEXT Z:GOTO 270
265 FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25):CX=CX-1:CD=CD-2:CE=CE+1:NEXT Z
270 CT=T+1-CF-3*CK
275 FOR Z=1 TO INT(CT/3+0.7):WT=WT+INT((CT*(CT+2)+1)*0.25):CT=CT-3:NEXT Z:CF=CF+4
280 IF CF>T THEN BF=BF+1:IF BF>N1 THEN 310 ELSE CF(BF)=CF(BF)+BF:CF=CF(BF):GOTO 280
285 C(BF)=C(BF)+1:FOR Z=2 TO BF:C(Z)=C(BF):CF(Z)=CF:NEXT Z:BF=4:CB=C(4):CF=CF(4):GOTO 235
290 BF=N1-1:CT=T-CF(BF)+1:CX=N2-C(BF)+1:IF CT<=CX THEN WT=WT+CT ELSE WT=WT+CX
295 CF(BF)=CF(BF)+N1+1-BF
300 IF CF(BF)>T OR C(BF)>=N2 THEN BF=BF-1:IF BF<1 THEN 310 ELSE CF(BF)=CF(BF)+N1+1-BF:GOTO 300
305 C(BF)=C(BF)+1:FOR Z=BF+1 TO 2:C(Z)=C(BF):CF(Z)=CF(BF):NEXT Z:GOTO 290
310 FT=N:FOR Z=N1 TO 2 STEP -1:N=N-1:FT=FT*N/Z:IF FT>1.000000e+35 THEN 320
315 NEXT Z:P=WT*2/FT:GOTO 565
320 FT=LOG(FT):FOR Z=Z-1 TO 2 STEP -1:N=N-1:FT=FT+LOG(N/Z):NEXT Z
325 P=EXP(LOG(2*WT)-FT):GOTO 565
330 PRINT TAB(26);"SIGNED RANK TEST (two-tailed)":PRINT TAB(26);STRING$(29,205):PRINT
335 IF FILE$="" THEN PRINT ELSE GOSUB 60:GOSUB 375:GOTO 380
340 LOCATE 5,12:PRINT "Enter the NUMBER of non-zero differences ranked:":AR=5:AC=62:GOSUB 4800:N=VAL(IP$)
345 ERASE C,CF:DIM C(N),CF(N):DQ="Enter the SUM of "
350 LOCATE 7,21:PRINT DQ;"negative signed ranks:":AR=7:GOSUB 4800:NN=VAL(IP$)
355 PRINT TAB(21);DQ;"positive signed ranks:":AR=8:GOSUB 4800:NP=VAL(IP$)
360 IF ABS(NN)<=NP THEN T=ABS(NN) ELSE T=NP
365 IF ABS(NN)+NP=N*(N+1)*0.5 THEN 455 ELSE BEEP:LOCATE 25,1:PRINT "The SUM of the absolute values of positive and negative ranks should = ";N*(N+1)*0.5;:GOTO 350
375 AR=10:COLOR 23:LOCATE 10,32:PRINT "RANKING SAMPLES":COLOR CLR1:RETURN
380 ERASE SR:DIM SR(3,C*2+1):N=T(NS1):NZ=N:CR=0
385 FOR Z=1 TO N:VC=VAL(D(NS1,Z)):VX=VAL(D(NS2,Z)):VD=VC-VX
390 IF ABS(VD)<1.000000e-10 THEN NZ=NZ-1:GOTO 405 ELSE CR=CR+1:AY=CR
395 FOR TZ=1 TO CR-1:IF ABS(VD)<ABS(SR(1,TZ)) THEN SR(1,AY)=SR(1,AY-1):AY=AY-1
400 NEXT TZ:SR(1,AY)=VD
405 NEXT Z:AD=1:SZ=1
410 FOR Z=1 TO CR:IF ABS(SR(1,Z))=ABS(SR(1,Z+1)) THEN AD=AD+1:SZ=SZ+Z+1:GOTO 425
415 FOR T=(Z+1-AD) TO Z:SR(2,T)=SZ/AD:IF SR(1,T)>0 THEN SR(3,T)=1 ELSE SR(3,T)=0
420 NEXT T:SZ=Z+1:AD=1
425 NEXT Z:SNP=0:SNN=0
430 FOR Z=1 TO CR:IF SR(3,Z)=1 THEN SNP=SNP+SR(2,Z) ELSE SNN=SNN+SR(2,Z)
435 NEXT Z
440 LOCATE AR,20:PRINT "The sum of positive signed RANKS is ";SNP:PRINT
445 PRINT TAB(20);"The sum of negative signed RANKS is -";SNN:PRINT
450 SWAP N,NZ:T=SNN:IF SNN>SNP THEN T=SNP
455 GOSUB 220:IF N<21 THEN 460
457 SD1=N*(N+1)*(2*N+1)/24:XZ=(T-N*(N+1)/4)/SQR(SD1):GOSUB 2000:GOTO 565
460 IF N<5 THEN P=1:GOTO 565 ELSE WT=N+1:IF WT>T+1 THEN WT=T+1
465 IF T<=N THEN CT=T-2:GOTO 495
470 CX=N-1:CD=T-CX-2:CE=CX-CD:CK=INT(CD*0.5+0.5):CJ=CD
475 IF CD>CX THEN CE=0:CD=CX:IF CK>CX THEN CK=CX
480 FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25)
485 CX=CX-1:CJ=CJ-2:IF CJ<CX THEN CD=CJ ELSE CD=CX
490 CE=CX-CD:NEXT Z:CT=T-3*CK-2
495 FOR Z=1 TO INT(CT/3+0.7):WT=WT+INT((CT*(CT+2)+1)*0.25):CT=CT-3:NEXT Z
500 AS=0:FOR Z=1 TO N:C(Z)=Z-1:CF(Z)=AS:AS=AS+Z:NEXT Z
505 C(4)=4:CB=4:CF=10:BF=4
510 IF T-CF<=N-CB THEN CT=T-CF+1:GOTO 545 ELSE CX=N-CB+1:CD=T-CF-CX+1:CE=CX-CD:CK=INT(CD*0.5+0.5)
515 IF CD<=CX THEN 535 ELSE CE=0:CJ=CD:CD=CX:IF CK>CX THEN CK=CX
520 FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25)
525 CX=CX-1:CJ=CJ-2:IF CJ<CX THEN CD=CJ ELSE CD=CX
530 CE=CX-CD:NEXT Z:GOTO 540
535 FOR Z=1 TO CK:WT=WT+CD*0.5*(CX+CE+1)+INT((CE*(CE+2)+1)*0.25):CX=CX-1:CD=CD-2:CE=CE+1:NEXT Z
540 CT=T+1-CF-3*CK
545 FOR Z=1 TO INT(CT/3+0.7):WT=WT+INT((CT*(CT+2)+1)*0.25):CT=CT-3:NEXT Z:CF=CF+4
550 IF CF>T THEN BF=BF+1:IF BF>N THEN 560 ELSE CF(BF)=CF(BF)+BF:CF=CF(BF):FOR Z=4 TO BF-1:C(Z)=C(BF)+1:CF(Z)=CF:NEXT Z:GOTO 550
555 C(BF)=C(BF)+1:CB=C(BF):BF=4:GOTO 510
560 IF N<100 THEN P=WT/2^(N-1) ELSE P=EXP(LOG(WT)-(N-1)*LOG(2#))
565 PLAY "MS O3 L64 G O2 GE L9 E"
570 LOCATE AR,20:COLOR CLR2,CLR1:PRINT TAB(33);"p = ";:IF AK=1 THEN PRINT ">.05"; ELSE IF P>0.5 THEN PRINT "> .5"; ELSE IF P<0.000001 THEN PRINT "< 10 (-6)"; ELSE PRINT P;
575 PRINT TAB(61);:COLOR CLR1,CLR2:LOCATE 25,1:PRINT TAB(79)
580 DQ="Do you want to perform another rank test ":LOCATE 25,9:PRINT DQ;
585 IF FILE$="" THEN PRINT "? (Y or N) ";ELSE PRINT "using this datafile? ";
590 INPUT;"",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 40
595 IF FILE$<>"" THEN LOCATE 25,7:PRINT DQ;:INPUT "using a different datafile? ",A$:IF A$="y" OR A$="Y" THEN 20
605 GOTO 3000
2000 IF ABS(XZ)>6 THEN P=0:RETURN ELSE GOSUB 2020:P=2*PT*R:RETURN
2020 R=1/SQR(EXP(XZ*XZ)*6.283185307#):W=1/((ABS(XZ)*0.2316419)+1)
2025 W2=W*W:PT=(W*0.31938153#)-(W2*0.356563782#)+(W*W2*1.781477937#)-(W2*W2*1.821255978#)+(W2*W2*W*1.330274429#):RETURN
4010 IF FILE$="" THEN 40
4025 ERASE D,CS,T,N$,X,X2,MD,SD,SR,C,CF
4030 DIM D(A,C),CS(A,C+5),SR(3,C*2+1),N$(A),X(A),X2(A),T(A),SD(A),MD(A),C(C),CF(C)
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
RATEADJ.BAS
1 ' DIRECT AND INDIRECT RATE ADJUSTMENT
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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)
22 DATA "RATE ADJUSTMENTS",31,18
30 LOCATE 5,1:GOSUB 4000
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 "
40 PRINT:IF A$="I" OR A$="i" THEN 85 ELSE IF A$<>"D" AND A$<>"d" THEN BEEP:GOTO 35
45 AR=CSRLIN:PRINT " ";DQ;"study rates to be adjusted:":AC=63:GOSUB 4200:NS1=NS
50 AR=CSRLIN:PRINT " ";DQ;"standard population figures:":GOSUB 4200:NS2=NS:GOSUB 235
55 AR=CSRLIN:PRINT TAB(18);"Rates in ";N$(NS1);" are given per what number?":GOSUB 4800:RD=VAL(IP$)
60 SR=0:FOR Z=1 TO N:SR=SR+VAL(D(NS1,Z))*VAL(D(NS2,Z)):NEXT
65 SAR=SR/X(NS2):GOSUB 230
70 PRINT TAB(15);"Direct-adjusted rate = ";SAR;"per";RD;TAB(80):COLOR CLR1,CLR2:PRINT
75 PRINT:PRINT " Remember, if the number of cases in any cell is < 5, then";
80 PRINT TAB(30);"indirect rate adjustment may be more appropriate.":GOTO 215
85 DQ="Enter the SAMPLE NUMBER of the ":AR=CSRLIN
90 PRINT TAB(6);DQ;"study population figures:";:AC=63:GOSUB 4200:NS1=NS
95 AR=CSRLIN:PRINT TAB(4);DQ;"standard population rates:";:GOSUB 4200:NS2=NS:GOSUB 235
100 AR=CSRLIN:PRINT TAB(18);"Rates in ";N$(NS2);" are given per what number?":GOSUB 4800:RD=VAL(IP$)
105 E=0:FOR Z=1 TO N:E=E+VAL(D(NS1,Z))*VAL(D(NS2,Z)):NEXT:E=E/RD:PRINT
110 AR=CSRLIN:PRINT TAB(20);"How many cases were observed in ";N$(NS1);"?"::GOSUB 4800:XO=VAL(IP$)
115 PRINT TAB(17);"Expected number of cases in the study group =";INT(E)
120 PRINT:COLOR CLR2,CLR1:PRINT TAB(14);"Adjusted rate = ";XO/E;"* STANDARD POPULATION RATE";TAB(80);:COLOR CLR1,CLR2
125 COLOR 23:PRINT:PRINT:AR=CSRLIN:PRINT TAB(28);"CALCULATING PROBABILITY";
130 AF=0:YO=XO:CE=0:IF E<YO THEN YO=YO-1:AF=1
135 IF XO>1000 THEN 170
140 IF YO=0 THEN SF=1 ELSE SF=E+1
145 F=E:FOR Z=2 TO YO:F=F*E/Z:IF F>1.000000e+22 THEN F=F*1.92875216527315e-22#:SF=SF*1.92875216527315e-22#:CE=CE+1
150 IF F>=1.000000e-31 THEN SF=SF+F:NEXT Z
155 SL=LOG(SF)-E-CE*50:IF SL>80 THEN P=0 ELSE P=EXP(SL)
160 IF AF=1 THEN P=1-P
165 GOTO 190
170 X=(XO-E)*(XO-E)/E:IF X>31 THEN P=0:GOTO 190
175 R=1.77245374942627#:S=1:I=1:K=((X/2)^(0.5)*2)/(EXP(X/2)*R):VC=3
180 I=I*X/VC:S=S+I:VC=VC+2:IF I>9.999999e-31 THEN 180
185 P=1-K*S
190 GOSUB 230:LOCATE AR,1:PRINT TAB(10);"The probability of observing ";XO;" or ";
195 IF AF=1 THEN PRINT "more cases ="; ELSE PRINT "fewer cases =";
200 IF P<=0.000001 THEN PRINT " < 10 (-6)"; ELSE IF P>0.95 THEN PRINT " > .95"; ELSE PRINT P;
205 PRINT TAB(80):COLOR CLR1,CLR2:PRINT
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% ."
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
220 LOCATE 25,47:INPUT;"a different DATAFILE? ",A$:IF A$="y" OR A$="Y" THEN 20
225 GOTO 3000
230 PRINT:PRINT:COLOR CLR2,CLR1:PLAY "MS O3 L64 G O2 GE L9 E":RETURN
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
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 2,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
SAMPLSIZ.BAS
1 ' CALCULATING SAMPLE SIZES
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
22 DATA "CALCULATING SAMPLE SIZES",26,26
30 AF=0:PRINT:PRINT TAB(22);"1.) For a population survey":PRINT
35 PRINT TAB(22);"2.) For a paired case-control study":PRINT
40 PRINT TAB(22);"3.) For an unpaired case-control study":PRINT:PRINT
45 LOCATE 12,28:PRINT "Enter choice:":AR=12:AC=42:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 45
50 D1="the true population rate ":D2="and your sample rate ":D3=" How certain must you be ":D4="POPULATION"
55 CLS:ON ASUB GOTO 65,110,115
60 PRINT "Enter your best estimate of the ";D4;" RATE of the study characteristic:":PRINT TAB(27);"(err towards 50%)";TAB(54);"Percent = ";:AR=CSRLIN:AC=65:GOSUB 4800:P=VAL(IP$):RETURN
65 PRINT TAB(24);"SAMPLE SIZE FOR ";D4;" SURVEY":PRINT TAB(24);STRING$(33,205):PRINT
70 LOCATE 4,5:PRINT "How LARGE is the population from which you want to select your sample?":PRINT TAB(26);"(you may approximate)":AR=5:AC=63:GOSUB 4800:PS=VAL(IP$):LOCATE 7,1:GOSUB 60
75 LOCATE 10,7:PRINT "What is the MAXIMUM difference between ";D1:PRINT TAB(7);D2;"that you can tolerate?";TAB(54);"Percent =":AR=11:GOSUB 4800:XD=VAL(IP$)
80 LOCATE 13,1:PRINT D3;"that the difference between ";D1:PRINT TAB(25);D2;"is <";XD;"% ?"
85 PRINT TAB(22);"1) 90% 2) 95% 3) 99% 4) 99.9%":AR=15:GOSUB 4800:C=VAL(IP$)
90 IF C=1 THEN XZA=1.645 ELSE IF C=2 THEN XZA=1.96 ELSE IF C=3 THEN XZA=2.575 ELSE IF C=4 THEN XZA=3.29 ELSE BEEP:GOTO 80
95 P=P/100:XD=XD/100:SN=XZA*XZA*P*(1-P)/(XD*XD):SN=SN/(1+SN/PS)
100 GOSUB 220:PRINT:PRINT:COLOR CLR2,CLR1:PRINT TAB(23);
105 PRINT "The SAMPLE SIZE required is ";INT(SN+0.5);:GOTO 205
110 AF=0:PRINT TAB(20);"SAMPLE SIZE FOR PAIRED CASE-CONTROL STUDY":PRINT TAB(20);STRING$(41,205):GOSUB 60:GOTO 120
115 AF=1:PRINT TAB(19);"SAMPLE SIZE FOR UNPAIRED CASE-CONTROL STUDY":PRINT TAB(19);STRING$(43,205):D4="CONTROL GROUP":GOSUB 60
120 LOCATE 6,10:PRINT "Do you expect the TEST GROUP rate to be HIGHER or LOWER":PRINT TAB(20);:INPUT "than the control group rate? (H or L) ",A$
125 IF A$<>"h" AND A$<>"H" AND A$<>"l" AND A$<>"L" THEN BEEP:GOTO 120
130 LOCATE 9,4:PRINT "What is the SMALLEST DIFFERENCE between the test group and controls":PRINT TAB(12);"that you want to be able to detect?";TAB(54);"Percent =":AR=10:AC=65:GOSUB 4800:XD=VAL(IP$)
135 IF A$="h" OR A$="H" THEN PT=P+XD ELSE PT=P-XD
140 LOCATE 12,1:PRINT D3;"that you detect a difference as small as";XD;"% ?":PRINT TAB(30);"(if it exists) ?":PRINT TAB(17);
145 PRINT "1) 70% 2) 80% 3) 90% 4) 95% 5) 99%":AR=14:GOSUB 4800:C=VAL(IP$)
150 IF C=1 THEN XZB=0.525 ELSE IF C=2 THEN XZB=0.842 ELSE IF C=3 THEN XZB=1.282 ELSE IF C=4 THEN XZB=1.645 ELSE IF C=5 THEN XZB=2.327 ELSE BEEP:GOTO 140
155 LOCATE 16,3:PRINT D3;"that any difference between your samples":PRINT TAB(14);
160 PRINT "that you may detect is not simply due to chance?":PRINT TAB(20);
165 PRINT "1) 90% 2) 95% 3) 99% 4) 99.9%":AR=18:GOSUB 4800:C=VAL(IP$)
170 IF C=1 THEN XZA=1.645 ELSE IF C=2 THEN XZA=1.96 ELSE IF C=3 THEN XZA=2.575 ELSE IF C=4 THEN XZA=3.29 ELSE BEEP:GOTO 155
175 LOCATE 20,14:PRINT "Enter the number of CONTROLS per CASE desired:":AR=20:GOSUB 4800:CC=VAL(IP$):P=P/100:XD=XD/100:PT=PT/100
180 IF AF=0 THEN SN=(XZA*SQR(P*(1-P))+XZB*SQR(PT*(1-PT)))/XD:GOTO 190
185 PC=P:P=(P+PT)/2:SN=(XZA*SQR(2*P*(1-P))+XZB*SQR(PT*(1-PT)+PC*(1-PC)))/XD
190 SN=SN*SN*(CC+1)/(2*CC):PRINT
195 GOSUB 220:COLOR CLR2,CLR1:DQ="The number of ":LOCATE 22,1:PRINT TAB(19);:IF AF=0 AND CC=1 THEN PRINT DQ;"PAIRS required is: ";INT(SN+0.5);:GOTO 205
200 PRINT DQ;"CASES required is: ";INT(SN+0.5);TAB(80):PRINT TAB(18);DQ;"CONTROLS required is: ";INT(SN+0.5)*CC;
205 PRINT TAB(80):COLOR CLR1,CLR2:LOCATE 25,17
210 INPUT;"Do you want to calculate another SAMPLE SIZE? ",A$:IF A$="y" OR A$="Y" THEN 20
215 GOTO 3000
220 PLAY "MS O3 L64 G O2 GE L9 E":RETURN
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
SCATRGRM.BAS
1 ' SCATTERGRAM GRAPHING PROGRAM
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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(2),MN(2),MX(2),BT(2),SW(2),FD(2),HD(2),XR(2),XC(2),BP(201)
22 DATA "SCATTERGRAM GRAPHING PROGRAM",26,30
30 LOCATE 6,1:GOSUB 4000
35 DQ="What is the SAMPLE NUMBER of the variable you want on the "
40 PRINT:AR=CSRLIN:PRINT DQ;"X-axis?":AC=68:GOSUB 4200:NS(1)=NS
45 PRINT:AR=CSRLIN:PRINT DQ;"Y-axis?":GOSUB 4200:NS(2)=NS
50 N=T(NS(1)):IF N<>T(NS(2)) THEN BEEP:PRINT:PRINT "These 2 samples do not have the same number of elements------":PRINT TAB(47);"a scattergram cannot be drawn.":GOTO 465
55 CLS:PRINT TAB(25);DTTL:PRINT TAB(25);STRING$(28,205):AR=CSRLIN+1
60 LOCATE 25,5:COLOR CLR2,CLR1:PRINT " F1 = PRINT COPY ";:LOCATE ,30:PRINT " F5 = LINEAR REGRESSION ";:LOCATE ,62:PRINT " F10 = RETURN ";
65 COLOR CLR1,CLR2:LOCATE AR,25:PRINT "X-AXIS";TAB(50);"Y-AXIS"
70 PRINT "Sample NAME:";TAB(25);N$(NS(1));TAB(50);N$(NS(2))
75 PRINT "MINIMUM value:";:FOR T=1 TO 2:MN(T)=VAL(D(NS(T),CS(NS(T),1))):PRINT TAB(25*T);MN(T);:NEXT:PRINT
80 PRINT "MAXIMUM value:";:FOR T=1 TO 2:MX(T)=VAL(D(NS(T),CS(NS(T),N))):PRINT TAB(25*T);MX(T);:NEXT:PRINT
85 PRINT " Axis LABELS:";TAB(24);:INPUT;"",DV1:PRINT TAB(49);:INPUT "",DV2
90 PRINT "Measurement UNITS:";TAB(24);:INPUT;"",DU1:PRINT TAB(49);:INPUT "",DU2
95 AR=CSRLIN:LOCATE 23,5:PRINT "The maximum number of intervals I can graph is":PRINT TAB(37);"60 on the X-axis and 20 on the Y-axis.";
100 LOCATE AR,1:PRINT "Labeling interval:";
105 T=1:HD(1)=1:AC=26:GOSUB 4800:SW(1)=VAL(IP$):GOSUB 120:IF BT(1)>60 THEN BEEP:GOTO 105 ELSE EX=EE
110 T=2:HD(2)=1:AC=51:GOSUB 4800:SW(2)=VAL(IP$):GOSUB 120:IF BT(2)>20 THEN BEEP:GOTO 110 ELSE EY=EE
115 GOTO 160
120 EE=MN(T)-3*SW(T):EN=MX(T)+SW(T):IF MN(T)>=0 AND EE<=0 THEN EE=0:SN=SW(T) ELSE SN=EE
125 IF EN>99 THEN HD(T)=HD(T)*10:SN=SN/10:EN=EN/10:GOTO 125
130 IF ABS(SN)<0.1 THEN HD(T)=HD(T)/10:SN=SN*10:GOTO 130
135 IF SN<-99 THEN HD(T)=HD(T)*10:SN=SN/10:GOTO 135
140 IF EE<>0 THEN EE=INT(SN*10)*(HD(T)/10)
145 BT(T)=(MX(T)-EE)/SW(T)+1:RETURN
150 IF ABS(EE)<10 THEN P$="###.##" ELSE P$="###.#"
155 RETURN
160 SCREEN 2,1:OUT 985,(CLR1-(CLR1=0)):CLS:PRINT TAB(35);FILE$
165 CH=INT(60/BT(1)):IF CH>5 THEN CH=5
170 LH=BT(1)*CH*8+114:LINE (110,171)-(LH,171):ZH=5/CH:IF CH=4 THEN ZH=2
175 FOR Z=1 TO BT(1):HL=114+8*CH*Z:IF Z MOD ZH=0 THEN LINE (HL,171)-(HL,175) ELSE LINE (HL,171)-(HL,173)
180 NEXT Z
185 EMX=EX+BT(1)*SW(1):EE=EMX/HD(1):GOSUB 150
190 FOR Z=0 TO BT(1):IF Z MOD ZH=0 THEN HL=12+CH*Z:LOCATE 23,HL:PRINT USING P$;(EX+Z*SW(1))/HD(1);
195 NEXT Z
200 TB=LEN(DV1)+LEN(DU1)-8*(HD(1)<>1):LOCATE 25,BT(1)*CH/2+12-TB/2:PRINT DV1;" (";DU1;:IF HD(1)<>1 THEN PRINT " x";:PRINT USING"##^^^^";HD(1);
205 PRINT ")";
210 CI=INT(20/BT(2)):IF CI>5 THEN CI=5
215 LV=171-BT(2)*CI*8:LINE (114,175)-(114,LV)
220 FOR Z=1 TO BT(2):HL=171-Z*CI*8:IF CI=1 THEN IF Z MOD 2<>0 THEN LINE(112,HL)-(114,HL):GOTO 230
225 LINE (110,HL)-(114,HL)
230 NEXT Z
235 EMY=(EY+SW(2)*BT(2)):EE=EMY/HD(2):GOSUB 150
240 FOR Z=0 TO BT(2):HL=22-Z*CI:IF CI=1 THEN IF Z MOD 2<>0 THEN 250
245 LOCATE HL,9:PRINT USING P$;(EY+Z*SW(2))/HD(2);
250 NEXT Z
255 TB=LEN(DV2)+2-2*(HD(2)<>1):AR=22-BT(2)*CI/2-TB/2
260 FOR Z=1 TO LEN(DV2):LOCATE AR,4:PRINT MID$(DV2,Z,1):AR=AR+1:NEXT
265 LOCATE AR+1,1:PRINT MID$(DU2,1,8):IF LEN(DU2)>8 THEN PRINT " ";MID$(DU2,9,6)
270 IF HD(2)<>1 THEN PRINT " x":PRINT USING "##^^^^";HD(2)
275 FOR Z=1 TO N:XC=VAL(D(NS(1),Z))-EX:XC=114+XC*CH*8/SW(1)
280 XR=VAL(D(NS(2),Z))-EY:XR=171-XR*CI*8/SW(2):CIRCLE (XC,XR),2:NEXT
285 A$=INKEY$:IF A$="" THEN 285 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN 460 ELSE IF AI=63 THEN 295 ELSE IF AI=59 THEN 350
290 BEEP:GOTO 285
295 XC=0:FOR Z=1 TO N:XC=XC+VAL(D(NS(1),Z))*VAL(D(NS(2),Z)):NEXT
300 SC=XC-X(NS(1))*X(NS(2))/N:SX=X2(NS(1))-X(NS(1))*X(NS(1))/N
305 SY=X2(NS(2))-X(NS(2))*X(NS(2))/N:SB=SC/SX:IA=(X(NS(2))-SB*X(NS(1)))/N
310 CC=1:YT=IA+SB*EX:IF YT<EY OR YT>EMY THEN 320
315 XC(1)=114:XR(1)=171-(YT-EY)/SW(2)*CI*8:CC=2
320 XT=(EY-IA)/SB:IF XT<=EX OR XT>=EMX THEN 330
325 XC(CC)=114+CH*8*(XT-EX)/SW(1):XR(CC)=171:IF CC=2 THEN 345 ELSE CC=CC+1
330 YT=IA+SB*EMX:IF YT<EY OR YT>EMY THEN 340
335 XC(CC)=114+CH*8*(EMX-EX)/SW(1):XR(CC)=171-CI*8*(YT-EY)/SW(2):IF CC=2 THEN 345
340 XT=(EMY-IA)/SB:XR(2)=171-CI*8*(EMY-EY)/SW(2):XC(2)=114+CH*8*(XT-EX)/SW(1)
345 LINE (XC(1),XR(1))-(XC(2),XR(2)):GOTO 285
350 ON ERROR GOTO 5070:OPEN "LPT1:" AS #1:WIDTH #1,255:DEF SEG=&HB800
355 ON PMAK GOTO 360,360,400,430
360 PRINT #1,CHR$(27)+"@";CHR$(13);CHR$(27)+"3"+CHR$(23);CHR$(27)+"U"+CHR$(1);
365 FOR Z=0 TO 79:PRINT #1,CHR$(27)+"L"+CHR$(32)+CHR$(3);
370 FOR AY=0 TO 99:AX=AY*80+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(AX+8192):NEXT
375 FOR AY=100 TO 1 STEP -1:BQ=BP(AY+100):BR=BP(AY):IF BQ=13 THEN BQ=9
376 IF BR=13 THEN BR=9
377 PRINT #1,STRING$(4,BQ);STRING$(4,BR);:NEXT
380 PRINT #1,CHR$(13);CHR$(10);:NEXT
385 PRINT #1,CHR$(27)+"3"+CHR$(36);CHR$(13);CHR$(12)
390 PRINT #1,CHR$(27)+"U"+CHR$(0);TYP$;
395 PLAY "MS O3 L64 G O2 GE L9 E":CLOSE #1:DEF SEG:GOTO 285
400 PRINT #1,CHR$(27)+"0";CHR$(30);CHR$(3);
405 FOR Z=79 TO 0 STEP -1
410 FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
415 FOR AY=1 TO 100:BQ=BP(AY):BR=BP(AY+100):NQ=2:NR=2:IF BQ=3 THEN NQ=4
416 IF BR=3 THEN NR=4
417 PRINT #1,STRING$(NQ,BQ);STRING$(NR,BR);:NEXT
420 PRINT #1,CHR$(3);CHR$(14);:NEXT
425 PRINT #1,CHR$(3);CHR$(2);CHR$(27)+"6";TYP$;:GOTO 395
430 PRINT #1,CHR$(27)+"N";CHR$(27)+"T16";CHR$(27)+"L005";CHR$(27)+">";
435 FOR Z=79 TO 0 STEP -1:PRINT #1,CHR$(27)+"S0600";
440 FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
445 FOR AY=1 TO 100:PRINT #1,STRING$(3,BP(AY));STRING$(3,BP(AY+100));:NEXT
450 PRINT #1,CHR$(13);CHR$(10);:NEXT
455 PRINT #1,CHR$(27)+"<";CHR$(27)+"L000";CHR$(27)+"A";TYP$;:GOTO 395
460 SCREEN 0,1:COLOR CLR1,CLR2,CLR3:CLS
465 LOCATE 25,9:DQ="Do you want another SCATTERGRAM using ":PRINT DQ;:INPUT;"the SAME two samples? ",A$
470 IF A$="y" OR A$="Y" THEN 55 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 465
475 LOCATE 25,7:PRINT " ";DQ;:INPUT;"DIFFERENT samples? ",A$
480 IF A$="N" OR A$="n" THEN 495 ELSE IF A$<>"Y" AND A$<>"y" THEN BEEP:GOTO 475
485 LOCATE 25,3:PRINT TAB(75):LOCATE 25,20:PRINT "Are the samples you want in ";FILE$;:INPUT;A$
490 IF A$="y" OR A$="Y" THEN CLS:LOCATE 2,1:GOTO 35 ELSE IF A$="n" OR A$="N" THEN 20 ELSE BEEP:GOTO 485
495 GOTO 3000
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 2,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
5072 A$=INKEY$:IF A$="" THEN 5072 ELSE CLOSE #1:RESUME 160
SELECT.BAS
1 ' SELECT SPECIFIC RECORDS
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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),CZ(1),NN(10),NA(10),NB(10),SA(10)
22 DATA "SELECT SPECIFIC RECORDS",27,25
30 LOCATE 5,1:GOSUB 4000
35 AR=CSRLIN:LOCATE 25,1:PRINT "1";:FOR Z=2 TO 10:PRINT TAB(Z*7-1);Z;:NEXT
40 RESTORE 45:COLOR CLR2,CLR1:FOR Z=1 TO 10:READ AC,DC:LOCATE 25,AC:PRINT DC;:NN(Z)=1:NEXT:COLOR CLR1,CLR2
45 DATA 2," Sample # ",15," = ",22," > ",29," >= ",36," < ",43," <= ",50," <> ",57," AND ",64," OR ",72," DONE "
50 LOCATE AR,1:PRINT:PRINT TAB(14);"1.) Use FORMAT (A) SELECT IF: Sample #1 >= NUMBER"
55 PRINT TAB(26);"or (B) SELECT IF: Sample #1 >= Sample #2"
60 PRINT TAB(14);"2.) Press RETURN after entering a NUMBER."
65 PRINT TAB(14);"3.) Press Key F10 when selection criteria are complete."
70 PRINT:PRINT "SELECT IF: ";:ZS=0:DS="SELECTED ON: "
75 GOSUB 145:IF AI=59 THEN ZS=ZS+1:PRINT "Sample #";:AR=CSRLIN:AC=POS(0):GOSUB 180:NA(ZS)=VAL(DZ):DS=DS+N$(VAL(DZ)) ELSE IF AI=68 AND ZS=0 THEN DS="":CC=C:FOR Z=1 TO C:CZ(Z)=Z:NEXT:GOTO 190 ELSE BEEP:GOTO 75
80 GOSUB 145:IF AI<60 OR AI>65 THEN BEEP:GOTO 80 ELSE AO=AI-59:NB(ZS)=AO
85 IF AO=1 THEN DZ="=" ELSE IF AO=2 THEN DZ=">" ELSE IF AO=3 THEN DZ=">=" ELSE IF AO=4 THEN DZ="<" ELSE IF AO=5 THEN DZ="<=" ELSE IF AO=6 THEN DZ="<>"
90 PRINT DZ;" ";:DS=DS+" "+DZ+" "
95 GOSUB 145:IF AI=59 THEN NB(ZS)=NB(ZS)+6:PRINT "Sample #";:AR=CSRLIN:AC=POS(0):GOSUB 180:SA(ZS)=VAL(DZ):DS=DS+N$(VAL(DZ)):GOTO 135 ELSE IF AI<>0 THEN BEEP:GOTO 95
100 PRINT A$;:DZ=A$:L=1:GOSUB 160:SA(ZS)=VAL(DZ):N=NA(ZS)
105 ON AO GOTO 110,115,115,120,120,130
110 IF SA(ZS)<VAL(D(N,CS(N,1))) OR SA(ZS)>VAL(D(N,CS(N,T(N)))) THEN 125 ELSE 130
115 IF SA(ZS)>VAL(D(N,CS(N,T(N)))) THEN 125 ELSE 130
120 IF SA(ZS)<VAL(D(N,CS(N,1))) THEN 125 ELSE 130
125 LOCATE 24,15:PRINT "There are no records satisfying this criterion.";:BEEP:FOR Z=1 TO 5000:NEXT:LOCATE ,15:PRINT TAB(70):LOCATE AR,AC:PRINT " ":LOCATE AR,AC:GOTO 95
130 DS=DS+DZ:PRINT " ";
135 GOSUB 145:IF ZS=10 THEN 190 ELSE IF AI=66 THEN NN(ZS)=2:DZ="AND " ELSE IF AI=67 THEN NN(ZS)=3:DZ="OR " ELSE IF AI=68 THEN 190 ELSE BEEP:GOTO 135
140 PRINT DZ;:DS=DS+" "+DZ:GOTO 75
145 AR=CSRLIN:AC=POS(0):L=0:LOCATE ,,1
150 A$=INKEY$:IF A$="" THEN 150 ELSE AI=0:IF A$=CHR$(13) THEN BEEP:GOTO 150 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1))
155 RETURN
160 LOCATE ,,1:A$=INKEY$:IF A$="" THEN 160 ELSE IF A$=CHR$(13) THEN RETURN
165 IF A$=CHR$(8) THEN IF L>0 THEN L=L-1:PRINT CHR$(29);" ";CHR$(29);:DZ=LEFT$(DZ,L):GOTO 160 ELSE BEEP:GOTO 160
170 IF A$>="-" AND A$<":" THEN PRINT A$;:DZ=DZ+A$:L=L+1 ELSE BEEP
175 GOTO 160
180 DZ="":GOSUB 160:IF VAL(DZ)>0 AND VAL(DZ)<=A THEN PRINT " ";:RETURN
185 LOCATE 24,25:PRINT FILE$;" has only";A;"samples.";:BEEP:LOCATE 24,20:LOCATE AR,AC:PRINT " ":LOCATE AR,AC:GOTO 180
190 PRINT:PRINT:INPUT "Do you want Selected Records written to SCREEN (S),PRINTER (P), or DISK (D)? ",A$
195 PO$="":IF A$="D" OR A$="d" THEN 215 ELSE IF A$="s" OR A$="S" THEN PO$="SCRN:" ELSE IF A$="p" OR A$="P" THEN PO$="LPT1:" ELSE BEEP:GOTO 190
200 INPUT " Do you want the records printed in SORTED or in INPUT order? (S or I) ",A$
205 IF A$="i" OR A$="I" THEN BSRT=0:GOTO 215 ELSE IF A$="s" OR A$="S" THEN BSRT=1 ELSE BEEP:GOTO 200
210 IF A>1 THEN PRINT TAB(19);"Which sample number do you wish to SORT by?";:AR=CSRLIN:AC=65:GOSUB 4800:NS=VAL(IP$):IF NS<1 OR NS>A THEN BEEP:GOTO 210
215 PRINT:PRINT:AR=CSRLIN:IF DS="" THEN 350 ELSE COLOR 23:LOCATE AR,32:PRINT "SELECTING RECORDS";:COLOR CLR1
220 CC=0:FOR Z=1 TO C:FOR TZ=1 TO ZS:VX=VAL(D(NA(TZ),Z)):VY=SA(TZ)
225 ON NB(TZ) GOTO 235,240,245,250,255,260,230,230,230,230,230,230
230 VY=VAL(D(SA(TZ),Z)):ON NB(TZ) GOTO 1,1,1,1,1,1,235,240,245,250,255,260
235 IF VX=VY THEN 275 ELSE 265
240 IF VX>VY THEN 275 ELSE 265
245 IF VX>=VY THEN 275 ELSE 265
250 IF VX<VY THEN 275 ELSE 265
255 IF VX<=VY THEN 275 ELSE 265
260 IF VX<>VY THEN 275 ELSE 265
265 ON NN(TZ) GOTO 290,270,280
270 TZ=TZ+1:GOTO 265
275 IF NN(TZ)<>2 THEN 285
280 NEXT TZ
285 CC=CC+1:CZ(CC)=Z
290 NEXT Z
295 IF CC=0 THEN BEEP:LOCATE AR,19:PRINT "There are no records meeting these selection criteria.":GOTO 545
300 FOR T=1 TO A:T(T)=0:X(T)=0:X2(T)=0:MD(T)=0:SD(T)=0:NEXT
305 FOR TT=1 TO CC:FOR T=1 TO A:DT=D(T,CZ(TT)):D(T,TT)=DT:IF DT="" THEN 330 ELSE VC=VAL(DT)
310 FOR Z=1 TO T(T):VX=VAL(D(T,CS(T,Z))):IF VX<=VC THEN 320
315 FOR TZ=T(T)+1 TO Z+1 STEP -1:CS(T,TZ)=CS(T,TZ-1):NEXT:GOTO 325
320 NEXT Z
325 CS(T,Z)=TT:T(T)=T(T)+1:X(T)=X(T)+VC:X2(T)=X2(T)+VC*VC
330 NEXT T:NEXT TT
335 FOR T=1 TO A:N=T(T):IF N>1 THEN IF X2(T)>X(T)*X(T)/N THEN SD(T)=SQR((X2(T)-X(T)*X(T)/N)/(N-1))
340 IF N>0 THEN IF N MOD 2=0 THEN MD(T)=(VAL(D(T,CS(T,N/2)))+VAL(D(T,CS(T,N/2+1))))*0.5 ELSE MD(T)=VAL(D(T,CS(T,N/2+0.5)))
345 NEXT
350 IF PO$="LPT1:" THEN PMAX=PRNT-10 ELSE IF PO$="SCRN:" THEN PMAX=70:FOR T=0 TO INT((A-1)/7):SCREEN ,,T,0:CLS:NEXT:SCREEN ,,0:GOTO 365 ELSE 560
355 LOCATE AR,23:PRINT "Be sure paper is in printer.":PRINT TAB(24);"Press space bar when ready:":ON ERROR GOTO 5070
360 A$=INKEY$:IF A$="" THEN 360 ELSE IF A$<>CHR$(32) THEN BEEP:GOTO 360
365 OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
370 IF A>1 THEN 425
375 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,:PRINT #1,DS
380 PRINT #1,:PRINT #1,"Sample Name = ";N$(1):PRINT #1,:TB=1:IF BSRT=1 THEN 400
385 FOR Z=1 TO CC:PRINT #1,USING "###";Z;PRINT #1,":";D(1,Z);
390 TB=TB+13:IF TB>PMAX THEN TB=1
395 PRINT #1,TAB(TB);:NEXT:GOTO 415
400 FOR Z=1 TO CC:PRINT #1,USING "###";CS(1,Z);:PRINT #1,":";D(1,CS(1,Z));
405 TB=TB+13:IF TB>PMAX THEN TB=1
410 PRINT #1,TAB(TB);:NEXT
415 PRINT #1,:PRINT #1,TAB(5);"TOTAL =";T(1);TAB(26);"MEAN =";X(1)/T(1);TAB(55);"MEDIAN =";MD(1)
420 PRINT #1,:PRINT #1,TAB(20);"STANDARD DEVIATION =";SD(1):PRINT:PRINT:GOTO 545
425 AR=CSRLIN:FOR AS=0 TO INT((A-1)*10/PMAX):A2=(AS+1)*PMAX/10:IF A2>A THEN A2=A
430 A1=AS*PMAX/10+1:IF PO$="SCRN:" THEN SCREEN,,AS,AS:LOCATE AR,1
435 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,:PRINT #1,DS:PRINT #1,
440 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);"Sample";T;:NEXT:PRINT #1,
445 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);N$(T);:NEXT:PRINT #1,:PRINT #1,
450 IF BSRT=1 THEN 465
455 FOR Z=1 TO CC:PRINT #1,USING "###";Z;:PRINT #1,":";
460 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,Z);:NEXT:PRINT #1,:NEXT:GOTO 475
465 FOR Z=1 TO CC:PRINT #1,USING "###";CS(NS,Z);:PRINT #1,":";
470 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,CS(NS,Z));:NEXT:PRINT #1,:NEXT
475 PRINT #1,:PRINT #1,"NO.";:P$="#####"
480 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;T(T);:NEXT
485 PRINT #1,:PRINT #1,"MEAN";
490 FOR T=A1 TO A2:IF T(T)>0 THEN MN=X(T)/T(T) ELSE MN=0
495 MB=ABS(MN):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MN;:NEXT
500 PRINT #1,:PRINT #1,"MED";
505 FOR T=A1 TO A2:MB=ABS(MD(T)):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MD(T);:NEXT
510 PRINT #1,:PRINT #1,"SDEV";
515 FOR T=A1 TO A2:MB=SD(T):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;SD(T);:NEXT
520 PRINT #1,:PRINT:IF A2=A THEN 540
525 IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
530 LOCATE 25,12:PRINT TAB(75):LOCATE 25,12:PRINT "Press `P' to print next page, space bar to quit:";
535 A$=INKEY$:IF A$="" THEN 535 ELSE IF A$="p" OR A$="P" THEN NEXT AS ELSE IF A$<>CHR$(32) THEN BEEP:GOTO 530
540 CLOSE #1:IF PO$="SCRN:" THEN AR=CSRLIN:LOCATE 25,16:INPUT;"Do you want a hard copy of selected records? ",A$:IF A$="y" OR A$="Y" THEN PO$="LPT1:":GOTO 355
545 LOCATE 25,1:PRINT TAB(79):LOCATE 25,16:INPUT;"Do you want to perform another record selection? ",A$
550 IF A$="y" OR A$="Y" THEN SCREEN ,,0:GOTO 20
555 GOTO 3000
560 C=CC:GOSUB 4100
565 LOCATE 24,17:PRINT "Selected data has been saved in ";FILE$;:GOTO 545
570 IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
575 RETURN
4025 ERASE D,CS,T,N$,X,X2,MD,SD,NN,CZ
4030 DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A),CZ(C)
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:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END
T-TEST.BAS
1 ' STUDENT'S T-TEST (two-tailed)
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1),CS(1),T(1),N$(1),X(1),X2(1),MD(1),SD(1)
22 DATA "STUDENT'S T-TEST (two-tailed)",24,31
30 LOCATE 6,7:PRINT "(Press RETURN if you wish to skip directly to T evaluation)"
35 LOCATE 5,1:GOSUB 4000
40 PRINT:PRINT:PRINT TAB(4);"What are the SAMPLE NUMBERS of the 2 variables you want to compare?":PRINT TAB(10);:AR=CSRLIN
45 AC=17:GOSUB 4200:NS1=NS:AC=47:GOSUB 4200:NS2=NS
50 PRINT TAB(5);"Means =";TAB(19);X(NS1)/T(NS1);TAB(49);X(NS2)/T(NS2)
55 PRINT "Variances =";TAB(19);SD(NS1)^2;TAB(49);SD(NS2)^2:PRINT
60 PRINT TAB(12);"Are these INDEPENDENT or PAIRED samples? (I or P) ";
65 INPUT"", A$:IF A$="I" OR A$="i" THEN 90 ELSE IF A$<>"P" AND A$<>"p" THEN BEEP:GOTO 60
70 IF T(NS1)<>T(NS2) THEN BEEP:PRINT:PRINT " These 2 samples do not have the same number of elements---":PRINT TAB(37);"a paired T-TEST cannot be performed.":GOTO 220
75 XD=0:XD2=0:N=T(NS1):V=N-1
80 FOR Z=1 TO N:ED=VAL(D(NS1,Z))-VAL(D(NS2,Z)):XD=XD+ED:XD2=XD2+ED*ED:NEXT
85 VD=(XD2-XD*XD/N)/V:ST=ABS(XD/N)*SQR(N)/SQR(VD):GOTO 115
90 N1=T(NS1):N2=T(NS2):V=N1+N2-2:V1=N1-1:V2=N2-1
95 VR=((X2(NS1)-X(NS1)*X(NS1)/N1)+(X2(NS2)-X(NS2)*X(NS2)/N2))/V
100 VR=VR*(1/N1+1/N2):ST=ABS(X(NS1)/N1-X(NS2)/N2)/SQR(VR)
105 F=SD(NS1)^2/SD(NS2)^2:IF F<1 THEN F=1/F:SWAP V1,V2
110 GOSUB 240:IF P<0.05 THEN PRINT:PRINT " The T-TEST may not be appropriate because these variances are so different.":PRINT TAB(22);"( F =";F;", p ";:IF P<0.000001 THEN PRINT "< 10 (-6) )." ELSE PRINT "=";P;")."
115 PRINT:PRINT TAB(12);"T = ";ST;TAB(57);"df =";V:GOTO 135
120 CLS:PRINT TAB(19);"EVALUATING THE T DISTRIBUTION (two-tailed)":PRINT TAB(19);STRING$(43,205)
125 LOCATE 5,30:PRINT "Enter T value: ":AR=5:AC=46:GOSUB 4800:ST=ABS(VAL(IP$))
130 LOCATE 7,25:PRINT "degrees of freedom:":AR=7:GOSUB 4800:V=VAL(IP$):PRINT:PRINT
135 R=ATN(ST/SQR(V)):RC=COS(R):R2=RC*RC:RS=SIN(R):X=1
140 IF V MOD 2=0 THEN 165
145 IF V=1 THEN Y=R:GOTO 160
150 Y=RC:FOR Z=3 TO (V-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X*RC:NEXT
155 Y=R+RS*Y
160 P=1-Y*0.636619772365716#:GOTO 175
165 Y=1:FOR Z=2 TO (V-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X:NEXT
170 P=1-Y*RS
175 PLAY "MS O3 L64 G O2 GE L9 E"
180 PRINT TAB(25);:COLOR CLR2,CLR1:PRINT " p = ";:IF P<0.000001 THEN PRINT"< 10 (-6)"; ELSE PRINT P;
185 PRINT TAB(56):IF AF=1 THEN COLOR CLR1,CLR2:GOTO 230
190 PRINT TAB(11);"The MEANS of these 2 samples are ";:IF P>0.05 THEN PRINT "NOT ";
195 PRINT "significantly different.";TAB(80):COLOR CLR1,CLR2
200 PRINT:PRINT:PRINT " The confidence limits on the DIFFERENCE between the means of these samples":PRINT " can be calculated as: ":PRINT TAB(25);
205 DF=STR$(V):DF=RIGHT$(DF,LEN(DF)-1):IF A$="i" OR A$="I" THEN 215
210 YD=ABS(XD/N):PRINT YD; "+/- T(";DF;") * ";SQR(VD/N):GOTO 220
215 YD=ABS(X(NS1)/N1-X(NS2)/N2):PRINT YD;"+/- T(";DF;") * ";SQR(VR)
220 DQ="Do you want another T-TEST using ":LOCATE 25,15:PRINT DQ;:INPUT;"this datafile? ",A$:IF A$="y" OR A$="Y" THEN CLS:GOTO 40
225 LOCATE 25,12:PRINT DQ;:INPUT;"a DIFFERENT datafile? ",A$:IF A$="y" OR A$="Y" THEN 20 ELSE 235
230 LOCATE 25,20:INPUT;"Do you want to evaluate another T value? ",A$:IF A$="y" OR A$="Y" THEN 120
235 GOTO 3000
240 X=1/(V1/V2*F+1):Y=1-X:PF=1:PT=1:VA=V1:VB=V2
245 IF V1 MOD 2<>0 THEN IF V2 MOD 2=0 THEN 265 ELSE 275
250 IF V2 MOD 2=0 THEN IF V2>=V1 THEN 265
255 FOR Z=1 TO (V1/2-1):PF=PF*(0.5/Z*Y*VB):PT=PT+PF:VB=VB+2:NEXT
260 P=X^(V2*0.5)*PT:GOTO 325
265 FOR Z=1 TO (V2/2-1):PF=PF*(0.5/Z*X*VA):PT=PT+PF:VA=VA+2:NEXT
270 P=1-Y^(V1*0.5)*PT:GOTO 325
275 XT=ATN(SQR(F*V1/V2)):X=SIN(XT):Y=COS(XT):PT=Y:PF=Y
280 IF V2=1 THEN 295
285 FOR Z=2 TO (V2-3) STEP 2:PF=PF*Y*Y*Z/(Z+1):PT=PT+PF:NEXT
290 PT=PT*X:XT=XT+PT
295 PT=1:PF=1:IF V1=1 THEN 320
300 FOR Z=2 TO (V2-1) STEP 2:PF=PF*Z/(Z-1):NEXT
305 PF=PF*Y^V2*X:PZ=1:PT=1:VB=V2+1
310 FOR Z=3 TO (V1-2) STEP 2:PZ=PZ*VB*X*X/Z:PT=PT+PZ:VB=VB+2:NEXT
315 XT=XT-PT*PF
320 P=1-XT*2/3.141592653599#
325 RETURN
4010 AF=0:IF FILE$="" THEN AF=1:GOTO 120
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 2,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
XTAB.BAS
1 ' CROSSTABS
2 ' Copyright Tracy L. Gustafson, M.D.
3 ' Round Rock, Texas. Version 3.3, 1986
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",30,18
30 GOSUB 4000:AR=CSRLIN
35 LOCATE 24,20:PRINT "Do you want 1,2 or 3-way CROSSTABS?";:AR=24:AC=58:GOSUB 4800:NB=VAL(IP$):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 6,28:PRINT FILE$;" has";A;"samples.":PRINT:AR=7
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 AC=T*22:GOSUB 4800:SW(T)=VAL(IP$):IF SW(T)>0 THEN NEXT ELSE BEEP: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 ABS(SW)>=10 THEN SW=SW/10:CW=CW+1:GOTO 120
125 IF ABS(SW)<1 THEN SW=SW*10:CW=CW-1:GOTO 125
130 IF MN(T)>0 THEN MN(T)=FIX(MN(T)*10^CW)/10^CW
132 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,23: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);: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 GOTO 3000
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 2,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
Directory of PC-SIG Library Disk #0088
Volume in drive A has no label
Directory of A:\
AUTOEXEC BAT 21 7-07-86 12:00p
EPISETUP DAT 128 7-07-86 12:00p
EPIMRG BAS 3690 7-07-86 12:00p
EPISTAT BAS 11140 7-07-86 12:00p
DATA-ONE BAS 8659 7-07-86 12:00p
ANOVA BAS 5298 7-07-86 12:00p
BAYES BAS 3193 7-07-86 12:00p
BINOMIAL BAS 2114 7-07-86 12:00p
CHISQR BAS 3591 7-07-86 12:00p
CORRELAT BAS 3221 7-07-86 12:00p
FILETRAN BAS 3892 7-07-86 12:00p
FISHERS BAS 1647 7-07-86 12:00p
FORTRANS BAS 2890 7-07-86 12:00p
HISTOGRM BAS 4421 7-07-86 12:00p
LNREGRES BAS 4678 7-07-86 12:00p
MHCHISQR BAS 1961 7-07-86 12:00p
MHCHIMLT BAS 2973 7-07-86 12:00p
MCNEMAR BAS 1821 7-07-86 12:00p
NORMAL BAS 3222 7-07-86 12:00p
POISSON BAS 1728 7-07-86 12:00p
RANDOMIZ BAS 3480 7-07-86 12:00p
RANKTEST BAS 6898 7-07-86 12:00p
RATEADJ BAS 3034 7-07-86 12:00p
SAMPLSIZ BAS 3534 7-07-86 12:00p
SCATRGRM BAS 5604 7-07-86 12:00p
SELECT BAS 6652 7-07-86 12:00p
T-TEST BAS 3737 7-07-86 12:00p
XTAB BAS 4183 7-07-86 12:00p
EPISETUP BAK 128 7-07-86 12:00p
PRINTDOC 50051 5-04-87 12:00p
EXAMPLE 591 7-07-86 12:00p
FILES088 TXT 2268 7-08-87 2:45p
GO BAT 38 7-08-87 2:45p
GO TXT 463 7-08-87 2:46p
34 file(s) 160949 bytes
143360 bytes free