Program written, modified, or edited at StatSoft, Inc.}

randomaccess;
NoDataFileVariableNames;
	dim work1(4);
	dim row(2);
	dim col(2);

	iret:=DisplayMessageBox (MB_YESNOCANCEL,
        'Mantel-Haenszel Statistic for 2x2xk Tables',
        'This program will compute the Mantel-Haenszel statistic for 2x2xk frequency
tables.  Do you want to apply a continuity correction to the test?');
	if iret=IDCANCEL then stop;
	if iret=IDYES then icont:=1;
	if iret=IDNO  then icont:=0;

	ntables:=2;
	if (DisplayNumericInputBox ('Enter number of tables (k)',
	 'No. of tables k', ntables)=0) then stop;
	if ntables<>trunc(ntables) then begin
	   DisplayMessageBox (MB_ICONSTOP,
	   'Invalid Number of Tables (k)',
	   'The number of 2x2 tables k must be an integer value.');
	   stop;
	end;

{allocate memory}
	redim tables(4,ntables);
	redim scr(ntables*2,2);

	for itable:=1 to ntables do begin
	 line01$:='Frequencies for table '+Str (itable, 2, 0);
	 if (DisplayNumericInputBox (line01$,
	  'Frequency (1,1)|Frequency (1,2)|Frequency (2,1)|Frequency (2,2)',
          work1)=0) then stop;
	  MatrixCopy (work1, 1, 1, 4, 1, tables, 1, itable);
	  ni:=0;
	  for i:=1 to 4 do ni:=ni+work1(i);
	  if ni<1 then begin
	   DisplayMessageBox (MB_ICONSTOP,
	   'Zero Cell Frequency',
	   'The last table has no entries; all cells are zero; program cannot continue.');
	   stop;
	  end;
	  rmh1:=rmh1+work1(1)*work1(4)/ni;
	  rmh2:=rmh2+work1(2)*work1(3)/ni;
	  chis1:=chis1+(work1(1)*work1(4)-work1(2)*work1(3))/ni-.5*icont;
	  row(1):=work1(1)+work1(2);
	  row(2):=work1(3)+work1(4);
	  col(1):=work1(1)+work1(3);
	  col(2):=work1(2)+work1(4);
	  chis2:=chis2+(row(1)*row(2)*col(1)*col(2)/(ni*ni*(ni-1)));
	  MatrixSetToZero (work1);
	end;
	rmh:=rmh1/rmh2;
	x:=chis1*chis1/chis2;
	p:=1-IChi2 (x, 1);
{final results}
	line01$:='Mantel-Haenszel Test for 2x2xk Tables';
	line01$:=line01$+'|RMH='+Str (rmh, 6, 2);
	line01$:=line01$+'|Chi-square(1)='+Str (x, 8, 3)+'  p='+str(p,7,5);
	kname1$:='Column 1|Column 2';
	kname2$:='';
	i:=1;
	for itable:=1 to ntables do begin
	 kname2$:=kname2$+'Table '+Str (itable, 2, 0)+'Row 1';
	 scr(i,1):=tables(1,itable);
	 scr(i,2):=tables(2,itable);
	 i:=i+1;
	 kname2$:=kname2$+'|        '+'Row 2|';
	 scr(i,1):=tables(3,itable);
	 scr(i,2):=tables(4,itable);
	 i:=i+1;
	end;
	NewScrollsheet (ntables*2, 2, scr, line01$, kname2$, kname1$);

2300 East 14th Street, Tulsa, OK 74104
Phone: (918) 749-1119; Fax: (918) 749-2217
e-mail: info@statsoft.com

©Copyright StatSoft, Inc., 1984-2004.
StatSoft, StatSoft logo, STATISTICA, SEWSS, SEDAS, Data Miner, SEPATH and GTrees are trademarks of StatSoft, Inc.