#!/usr/bin/perl
#
# $Id: IntegroTS.pl,v 1.5 2006/04/12 19:18:47 ddoughty Exp $
#
# Source File: teststats.pl

# Get config
# use strict;
use FileHandle;
use Time::Local;
use Data::Dumper;
use URI::Escape;
require 'sitecfg.pl';
require 'testlib.pl';
require 'tstatlib.pl';
require 'ui.pl';

#use strict;
use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS);
use vars qw($testcomplete $cgiroot $pathsep $dataroot );

&app_initialize;

warn "INFO: " . __FILE__ . " running.\n" ;

$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI

my $HBI_Debug_IntegroTS = 0 ;

&LanguageSupportInit();
&get_session($FORM{'tid'});
&get_client_profile($SESSION{'clid'});
my @sortbys = qw(Name LoginID Date);
my ($bExport,$idlist);
#print STDERR Dumper(\%FORM,\%CLIENT,\%SESSION);
if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
}

# Get the time stamp style
my $timestamp;
if ($FORM{'timestamp'} eq 'currenttime') {
    $timestamp = scalar(localtime(time));
} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
    $timestamp = $FORM{'customtime'};
} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
    my $fh = new FileHandle;
    if ($fh->open($file)) {
	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
	#print "<pre>".Dumper(\@history)."</pre>";
	if (defined $idlist) {
	    foreach (reverse @history) {
		if (exists $idlist->{$_->[2]}) {
		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
		    last;
		}
	    }
	} else {
	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
	}
    } else {
	print STDERR "Could not open $file in Integro.pl\n";
    }
}
if (defined $timestamp) {
    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
} else {
    $timestamp = "<br>\n";
}

if ($FORM{'export'}) {
    print "Content-Type: application/doc\n\n";
    $bExport=1;
} elsif ($FORM{'csv'}) {
    print "Content-Type: text/x-csv\n\n";
} else {
    print "Content-Type: text/html\n\n";
    $bExport=0;
}
#print STDERR Dumper(\%FORM,$idlist);
if (&get_session($FORM{'tid'})) {
    if ($FORM{'testsummary'} eq 'composite') {
			&show_test_composite($idlist);
    } elsif ($FORM{'testsummary'} eq 'bycnd') {
			&show_test_resultsbycnd($idlist);
    } else {
			&extract_test_data();
    }
}
if ($bExport) {
    exit(0);
}

sub extract_test_data() {
    &LanguageSupportInit();
    &get_client_profile($SESSION{'clid'});
    &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
    my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
    my @colhdrs=();
    push @colhdrs,"";
    if ($FORM{'cndnme'}) {
	push @colhdrs,"left:Last Name";
	push @colhdrs,"left:First Name";
	push @colhdrs,"left:MI";
    }
    push @colhdrs,"left:User ID";
    if ($FORM{'cndeml'}) {
	push @colhdrs,"left:Email Address";
    }
    if ($FORM{'cnd1'}) {
	push @colhdrs,"left:$CLIENT{'clcnd1'}";
    }
    if ($FORM{'cnd2'}) {
	push @colhdrs,"left:$CLIENT{'clcnd2'}";
    }
    if ($FORM{'cnd3'}) {
	push @colhdrs,"left:$CLIENT{'clcnd3'}";
    }
    if ($FORM{'cnd4'}) {
	push @colhdrs,"left:$CLIENT{'clcnd4'}";
    }
    if ($FORM{'cndscr'}) {
	push @colhdrs,"center:Correct";
	push @colhdrs,"center:Incorrect";
	push @colhdrs,"right:Score";
    }
    my @dataflds=();
    my @unsorted=();
    my $row="";
    my @qsumry=();
    my $user="";
    my $joint="\&";
    my $colhdr;
    my $colalgn;
    my $fidx;
    for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
	$user = $filelist[$fidx];
	$user =~ s/.$TEST{'id'}$//;
	$user =~ s/^$CLIENT{'clid'}.//;
	my $excuser="inc$user";
	if ($FORM{$excuser}) {
	    next;
	}
	&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
	@qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
	&get_candidate_profile($CLIENT{'clid'},$user);
	if ($FORM{'cndnme'}) {
	    $row=join($joint,$row,"$CANDIDATE{'nml'}");
	    $row=join($joint,$row,"$CANDIDATE{'nmf'}");
	    $row=join($joint,$row,"$CANDIDATE{'nmm'}");
	}
	$row=join($joint,$row,"$user");
	if ($FORM{'cndeml'}) {
	    $row=join($joint,$row,"$CANDIDATE{'eml'}");
	}
	if ($FORM{'cnd1'}) {
	    $row=join($joint,$row,"$CANDIDATE{'cnd1'}");
	}
	if ($FORM{'cnd2'}) {
	    $row=join($joint,$row,"$CANDIDATE{'cnd2'}");
	}
	if ($FORM{'cnd3'}) {
	    $row=join($joint,$row,"$CANDIDATE{'cnd3'}");
	}
	if ($FORM{'cnd4'}) {
	    $row=join($joint,$row,"$CANDIDATE{'cnd4'}");
	}
	if ($FORM{'cndscr'}) {
	    $row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]);
	}
	push @unsorted, $row;
	$row="";
    }
    my @sorted=sort @unsorted;
    @unsorted=();
    my $rowcount=$#filelist+1;
    &print_report_dataextract_header($rowcount,@colhdrs,@colalign);
    my ($i);
    for $i (0 .. $#sorted) {
	@dataflds=split($joint, $sorted[$i]);
	if ($bExport) {
	    for $i (1 .. $#dataflds) {
		print "$dataflds[$i]";
		if ($i == $#dataflds) {
		    print "\n";
		} else {
		    print "\t";
		}
	    }
	} else {
	    print "<TR>\n";
	    for $i (1 .. $#dataflds) {
		($colalgn,$colhdr) = split(/:/,$colhdrs[$i]);
		print "\t\t<td align=$colalgn valign=top>$dataflds[$i]</td>\n";
	    }
	    print "<TR>\n";
	}
    }
    &print_report_bycnd_footer();
    @sorted=();
}

sub print_report_dataextract_header {
    my ($ncount,@cols)= @_;
    my $colhdr;
    my $colalgn;
    my $i;
    if ($bExport) {
	print "$TEST{'desc'}\n";
	print "Raw Data Extraction\n";
	print "$ncount Completed Responses\n";
	for $i (1 .. $#cols) {
	    ($colalgn,$colhdr) = split(/:/,$cols[$i]);
	    print "$colhdr";
	    if ($i == $#cols) {
		print "\n";
	    } else {
		print "\t";
	    }
	}
    } else {
	print "<HTML>\n";
	print "<HEAD>\n";
	print "\t<TITLE>Test Data Extraction</TITLE>\n";
	print "\t<SCRIPT language=\"JavaScript\">\n";
	print "\t<\!--\n";
	print "\t	function wdwOnLoad() {\n";
	print "\t		window.focus();\n";
	print "\t	}\n";
	print "\t	window.onload=wdwOnLoad;\n";
	print "\t//-->\n";
	print "\t</SCRIPT>\n";
	print "</HEAD>\n";
	print "<BODY>\n";
	print "<CENTER>\n";
	print "<B>$TEST{'desc'}</B><BR>\n";
	print "<B>Raw Data Extraction</B><BR>\n";
	print "<font size=2><I>$ncount Completed Responses</I></font>\n";
	#print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n";
	print "<TABLE cellpadding=2 cellspacing=2 border=0 width=100%>\n";
	print "\t<TR>\n";
	for $i (1 .. $#cols) {
	    ($colalgn,$colhdr) = split(/:/,$cols[$i]);
	    print "\t\t<td align=$colalgn valign=top><b>$colhdr</b></td>\n";
	}
	print "\t<\TR>\n";
    }
}

sub date_out_of_range {
    my ($completedat,$datefm,$dateto) = @_;
    my @unsorted=();
    push @unsorted, $completedat;
    push @unsorted, $datefm;
    push @unsorted, $dateto;
    my @sorted = sort @unsorted;
    my $bretyes = ($sorted[1] eq $unsorted[0]) ? 0 : 1;
    @unsorted=();
    @sorted=();
    return $bretyes;
}

$^W=1;
sub sort_test_results {
    my ($sortby,@rows) = @_;
    if ($sortby eq 'Name') {
	#print STDERR "by Name\n";
	return sort {$a->{'columns'}->[0] cmp $b->{'columns'}->[0];} @rows;
    } elsif ($sortby eq 'LoginID') {
	#print STDERR "by LoginID\n";
	return sort {$a->{'columns'}->[1] cmp $b->{'columns'}->[1];} @rows;
    } elsif ($sortby eq 'Date') {
	#print STDERR "by Date\n";
	return sort {$a->{'end'} <=> $b->{'end'};} @rows;
    } else {
	#print STDERR "by Nothing\n";
	return @rows;
    }
}

sub show_test_resultsbycnd {
    &LanguageSupportInit();
    &get_client_profile($SESSION{'clid'});
    &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
    my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
    my ($url) = ("$cgiroot/teststats.pl?");
    if (not $FORM{'sortby'}) {$FORM{'sortby'}=$sortbys[0];}
    if (not $FORM{'reverse'}) {$FORM{'reverse'}=0;}
    foreach (keys %FORM) {
	if (($_ ne 'sortby') and ($_ ne 'reverse') and ($FORM{$_} !~ /\s+/)) {
	    #print STDERR "$_=$FORM{$_}\n";
	    $url .= "&$_=$FORM{$_}";
	} else {
	    #print STDERR "NOT $_=$FORM{$_}\n";
	}
    }
    my $csvurl = $url."&csv=1&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1);
    my $reverseurl = $url."&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1);
    my %sorturls;
    foreach my $sorter (@sortbys) {
	$sorturls{$sorter} = $url."&sortby=$sorter";
    }
    my @sorted=();
    my @unsorted=();
    my $user;
    my $test;
    my $qidx;
    my $trash;
    my $subjskl;
    my $subj;
    my $sklvl;
    my $subjlist=",";
    my @qids=();
    my @qsumry=();
    my @corincs=();
    my $bysubjflag = ($FORM{'statsbysubj'} ne '') ? 1 : 0;
    my @subjects=();
    my @subjcnts=();
    my @subjtot=();
    my @subjmean=();
    my @subjmedian=();
    my @meanscore=split('\,',"0,0,0,0,100,0,0");
    my @medianscore=();
    my $i=0;
    my $j=0;
    my $fidx;
    my @rows=();
    my $row={};
    my @answ=();
    my $qid;
    my $usrnm;
    my $nresultcount=$#filelist+1;
    my $mtime;
    my $completedat;
    my $displaydate;
    if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";}
    if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";}
    if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";}
    if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";}
    my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}";
    my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}";
    for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
	$user = $filelist[$fidx];
	$user =~ s/.$TEST{'id'}$//;
	$user =~ s/^$CLIENT{'clid'}.//;
	my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'});
	if (not defined $history) {
	    #print STDERR "$user from history.\n";
	    $history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'});
	} else {
	    #print STDERR "$user from log.\n";
	}
	if (not defined $history) {
	    # no log file entry for this test
	    #print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n";
	    my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9];
	    $history->{'end'} = $mtime;
	    $history->{'start'} = $history->{'end'};
	    #print STDERR Dumper($history);
	}
	#$trash=join($pathsep,$testcomplete,$filelist[$fidx]);
	#open (TMPFILE, "<$trash");
	#$mtime = (stat(TMPFILE))[9];
	#close TMPFILE;
	$completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'});
	$displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'});
	#print STDERR "$completedat $displaydate $datefm $dateto\n";
	if (&date_out_of_range($completedat,$datefm,$dateto)) {
	    $nresultcount--;
	    next;
	}
	my $excuser="inc$user";
	if ($FORM{$excuser}) {
	    $nresultcount--;
	    next;
	}
	&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
	@qids = split(/\&/, $SUBTEST_QUESTIONS{2});
	@answ=split(/\&/,$SUBTEST_ANSWERS{2});
	@qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
	@corincs = split(/\//, $qsumry[$#qsumry]);
	for $i (0 .. $#subjects) {
	    $subjcnts[$i][0]=0;
	    $subjcnts[$i][1]=0;
	    $subjcnts[$i][2]=0;
	    $subjcnts[$i][3]=0;
	}
	&get_candidate_profile($CLIENT{'clid'},$user);
	$usrnm="$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}";
	$row={'columns' => [$usrnm,$user,$displaydate]};
	$row->{'start'} = $history->{'start'};
	$row->{'end'} = $history->{'end'};
	#print STDERR "Survey = $TEST_SESSION{'srvy'}\n";
	if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') {
	    for $qid (1 .. $#qids) {
		($test,$qidx) = split(/\./, $qids[$qid]);
		($trash,$subjskl) = split(/::/, $answ[$qid]);
		($subj,$sklvl,$trash)=split(/\.|\:/,$subjskl);
		unless ($subjlist =~ /\,$subj\,/i) {
		    $subjlist = join('',$subjlist,"$subj\,");
		    push @subjects,"$subj";
		    $i=$#subjects;
		    $subjcnts[$i][0]=0;	# questions in subject area
		    $subjcnts[$i][1]=0;	# correct answers
		    $subjcnts[$i][2]=0;	# incorrect answers
		    $subjcnts[$i][3]=0;	# pct correct
		    $subjtot[$i][0]=0;
		    $subjtot[$i][1]=0;
		    $subjtot[$i][2]=0;
		    $subjtot[$i][3]=0;
		    $subjmean[$i][0]=0;	# population count
		    $subjmean[$i][1]=0;	# population value summation
		    $subjmean[$i][2]=0;	# population mean
		    $subjmean[$i][3]=0;	# population standard deviation
		    $subjmean[$i][4]=100;	# population range-low
		    $subjmean[$i][5]=0;	# population range-high
		}
		for $i (0 .. $#subjects) {
		    if ($subj eq $subjects[$i]) {
			$subjcnts[$i][0]++;
			$subjtot[$i][0]++;
			if (substr($corincs[$qid],0,1) eq '1') {
			    $subjcnts[$i][1]++;
			    $subjtot[$i][1]++;
			} else {
			    $subjcnts[$i][2]++;
			    $subjtot[$i][2]++;
			}
			$subjcnts[$i][3]=int((($subjcnts[$i][1]/$subjcnts[$i][0])*100));
			$subjtot[$i][3]=int((($subjtot[$i][1]/$subjtot[$i][0])*100));
			last;
		    }
		}
	    }
	    if ($bysubjflag) {
		for $i (0 .. $#subjects) {
		    push @{$row->{'columns'}},$subjcnts[$i][0],$subjcnts[$i][1],$subjcnts[$i][2],$subjcnts[$i][3];
		    $subjmean[$i][0]++;
		    $subjmean[$i][1]+=$subjcnts[$i][3];
		    $subjmean[$i][2]=int(($subjmean[$i][1]/$subjmean[$i][0]));
		    #$subjmean[$i][4]=(($subjcnts[$i][3] < $subjmean[$i][4]) || ($subjmean[$i][4] == 0)) ? $subjcnts[$i][3] : $subjmean[$i][4];
		    $subjmean[$i][4]=($subjcnts[$i][3] < $subjmean[$i][4]) ? $subjcnts[$i][3] : $subjmean[$i][4];
		    $subjmean[$i][5]=($subjcnts[$i][3] > $subjmean[$i][5]) ? $subjcnts[$i][3] : $subjmean[$i][5];
		    $subjmedian[$i][$fidx]=$subjcnts[$i][3];
		    $subjcnts[$i][0]=0;
		    $subjcnts[$i][1]=0;
		    $subjcnts[$i][2]=0;
		    $subjcnts[$i][3]=0;
		}
	    }
	    $meanscore[0]++;	# data count
	    $meanscore[1]+=$qsumry[2];								# sum of values
	    $meanscore[2]=int(($meanscore[1]/$meanscore[0]));	# unbiased population mean
	    $meanscore[4]=($qsumry[2] < $meanscore[4]) ? $qsumry[2] : $meanscore[4];
	    $meanscore[5]=($qsumry[2] > $meanscore[5]) ? $qsumry[2] : $meanscore[5];
	    $medianscore[$fidx]=$qsumry[2];
	}
	push @{$row->{'columns'}},$qsumry[0],$qsumry[1],$qsumry[2];
	push @rows, $row;
    }
    @sorted=sort {$a <=> $b} @medianscore;
    $j=$#sorted/2;
    $i=$sorted[$j];
    if (($#sorted % 2) == 0) {
	@medianscore=();
	$medianscore[0]=$i;
    } else {
	$j++;
	$i+=$sorted[$j];
	@medianscore=();
	$medianscore[0]=int(($i/2));
    }
    my @scores=();
    for $i (0 .. $#subjects) {
	for $j (0 .. $#filelist) {
	    $scores[$j]=$subjmedian[$i][$j];
	}
	@sorted=sort {$a <=> $b} @scores;
	@scores=();
	$j=$#sorted/2;
	$qid=$sorted[$j];
	if (($#sorted % 2) == 0) {
	    $subjmedian[$i][0]=$qid;
	} else {
	    $j++;
	    $qid+=$sorted[$j];
	    $subjmedian[$i][0]=int(($qid/2));
	}
    }
    # The sorting block
    if ($FORM{'reverse'}) {
	@sorted = reverse &sort_test_results($FORM{'sortby'},@rows);
    } else {
	@sorted = &sort_test_results($FORM{'sortby'},@rows);
    }
    # end of the sorting block
    @rows=();
    if ($FORM{'csv'}) {
	&print_report_bycnd_csv(@sorted);
	return;
    }
    my $colspan=&print_report_bycnd_header($nresultcount,$bysubjflag,\%sorturls,$FORM{'sortby'},
					   $csvurl,$reverseurl,@subjects);
    @unsorted=();
    @subjcnts=();
    my $symbol="";
    my @cols=();
    my @rowhdrs=('Questions','Correct','Incorrect','Pct Correct');
    my $rowspan=($bysubjflag) ? ($#rowhdrs+1) : 1;
    foreach my $row (@sorted) {
	@cols=@{$row->{'columns'}};
	my ($start,$end,$duration,$datestamp,$total);
	if ($bExport) {
	    print "$cols[0]\t$cols[1]\t$cols[2]\t";
	    if ($bysubjflag) { print "\n";}
	} else {
	    #($start,$end,$duration) = get_teststartend($CLIENT{'clid'},$cols[1],$FORM{'tstid'});
	    $start = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'start'}))[0..2]));
	    $end = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'end'}))[0..2]));
	    $duration = &fmtDuration($row->{'end'} - $row->{'start'});
	    if ($end == "Unknown" ) {
		$datestamp = "";
	    } else {
		my $gmend = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'end'}))[0..2]));
		$datestamp = "$cols[2] $gmend GMT";
	    	$datestamp =~ s/ /_/g;
	    }
	    $total = $cols[-3] + $cols[-2];
	    
	    my $params = "tid=$SESSION{'tid'}&clid=$CLIENT{'clid'}&cndid=".
		uri_escape($cols[1]).
		"&tstid=$FORM{'tstid'}&correct=$cols[-3]&incorrect=$cols[-2]&total=$total&percent=$cols[-1]";
	    print "\t<TR>\n";
	    print "\t\t<TD rowspan=$rowspan valign=top><a href=\"$cgiroot/testreport.pl?$params\" TARGET=\"testreport\">$cols[0]</a></TD>\n";
	    print "\t\t<TD rowspan=$rowspan valign=top>$cols[1]</TD>\n";
	    print "\t\t<TD rowspan=$rowspan valign=top>$cols[2]</TD>\n";
	}
	if ($bysubjflag) {
	    for $j (0 .. $#rowhdrs) {
		$symbol=($j==3) ? "\%" : "";
		if ($j > 0) {
		    if ($bExport == 0) {
			print "\t<TR>\n";
		    }
		}
		if ($bExport) {
		    print "\t\t$rowhdrs[$j]\t";
		} else {
		    print "\t\t<TD align=right valign=top><font size=2><i>$rowhdrs[$j]</i></font></TD>\n";
		}
		for $fidx (0 .. $#subjects) {
		    $qid=($fidx*4)+$j+3;
		    if ($bExport) {
			print "$cols[$qid]\t";
		    } else {
			print "\t\t<TD align=center valign=top>$cols[$qid]$symbol</TD>\n";
		    }
		    if ($j==3) {
			$subjmean[$fidx][3]+=(($subjmean[$fidx][2]-$cols[$qid])*($subjmean[$fidx][2]-$cols[$qid]));
		    }
		}
		if ($j == 0) {
		    $fidx=$#cols-2;
		    if ($bExport) {
			print "$cols[$fidx++]\t";
			print "$cols[$fidx++]\t";
			print "$cols[$fidx]\t";
		    } else {
			print "\t\t<TD rowspan=$rowspan align=center valign=bottom>$cols[$fidx++]</TD>\n";
			print "\t\t<TD rowspan=$rowspan align=center valign=bottom>$cols[$fidx++]</TD>\n";
			print "\t\t<TD rowspan=$rowspan align=center valign=bottom>$cols[$fidx]\%</TD>\n";
		    }
		}
		if ($bExport) {
		    print "\n";
		} else {
		    print "\t</TR>\n";
		}
	    }
	} else {
	    $j=$#cols-2;
	    if ($bExport) {
		print "$cols[$j++]\t";
		print "$cols[$j++]\t";
		print "$cols[$j]\n";
	    } else {
		print "\t\t<TD rowspan=$rowspan align=left valign=top>$start</TD>\n";
		print "\t\t<TD rowspan=$rowspan align=left valign=top>$end</TD>\n";
		print "\t\t<TD rowspan=$rowspan align=left valign=top>$duration</TD>\n";
		if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') {
		    print "\t\t<TD rowspan=$rowspan align=center valign=top>$cols[$j++]</TD>\n";
		    print "\t\t<TD rowspan=$rowspan align=center valign=top>$cols[$j++]</TD>\n";
		    print "\t\t<TD rowspan=$rowspan align=center valign=top>$cols[$j]\%</TD>\n";
		} else {
		    print "\t\t<TD rowspan=$rowspan align=center valign=top colspan=3>Not Scored by Definition</TD>\n";
		}
		print "\t</TR>\n";
	    }
	}
	if ($bysubjflag) {
	    if ($bExport==0) {
		print "\t<TR>\n";
		print "\t\t<TD colspan=$colspan valign=cemter><HR width=100\%></TD>\n";
		print "\t</TR>\n";
	    }
	}
	$meanscore[3]+=(($meanscore[2]-$cols[$#cols])*($meanscore[2]-$cols[$#cols]));
	@cols=();
    }
    $meanscore[3]=int((sqrt($meanscore[3]/($#sorted+1))));
    if ($bysubjflag) {
	@rowhdrs=('Questions','Correct','Incorrect','Pct Correct','Unbiased Mean','Std. Dev.','Range-Low','Range-High','Median');
	$rowspan=$#rowhdrs+1;
	for $j (0 .. $#rowhdrs) {
	    if ($bExport == 0) {
		print "\t<TR>\n";
	    }
	    if ($j == 0) {
		if ($bExport) {
		    print "\n\tComposite\t";
		} else {
		    print "\t\t<TD rowspan=$rowspan colspan=3 align=right valign=top><font size=2><b><i>Composite</i></b></font></TD>\n";
		}
	    } else {
		if ($bExport) {
		    print "\t\t";
		}
	    }
	    if ($bExport) {
		print "$rowhdrs[$j]\t";
	    } else {
		print "\t\t<TD align=right valign=top><font size=2><i>$rowhdrs[$j]</i></font></TD>\n";
	    }
	    if ($j < 4) {
		$symbol=($j==3) ? "\%" : "";
		for $fidx (0 .. $#subjects) {
		    if ($bExport) {
			print "$subjtot[$fidx][$j]\t";
		    } else {
			print "\t\t<TD align=center valign=top><b>$subjtot[$fidx][$j]</b>$symbol</TD>\n";
		    }
		}
		if ($j == 0) {
		    if ($bExport) {
			print "\t\t";
		    } else {
			print "\t\t<TD rowspan=3 colspan=3 align=center valign=top>\&nbsp\;<br></TD>\n";
		    }
		} elsif ($j == 3) {
		    if ($bExport) {
			print "\tOverall\t";
		    } else {
			print "\t\t<TD colspan=3 align=center valign=top><b><i>Overall</i><b></TD>\n";
		    }
		}
	    } else {
		$symbol="\%";
		$i=$j-2;
		for $fidx (0 .. $#subjects) {
		    if ($i == 6) {
			if ($bExport) {
			    print "$subjmedian[$fidx][0]\t";
			} else {
			    print "\t\t<TD align=center valign=top><b>$subjmedian[$fidx][0]</b>$symbol</TD>\n";
			}
		    } else {
			if ($i==3) {
			    $subjmean[$fidx][3]=int((sqrt(($subjmean[$fidx][3]/$subjmean[$fidx][0]))));
			    if ($bExport) {
				print "$subjmean[$fidx][$i]\t";
			    } else {
				print "\t\t<TD align=center valign=top>\&\#177<b>$subjmean[$fidx][$i]</b>$symbol</TD>\n";
			    }
			} else {
			    if ($bExport) {
				print "$subjmean[$fidx][$i]\t";
			    } else {
				print "\t\t<TD align=center valign=top><b>$subjmean[$fidx][$i]</b>$symbol</TD>\n";
			    }
			}
		    }
		}
		$i=$j-2;
		if ($i==3) {
		    if ($bExport) {
			print "\t$meanscore[$i]\t";
		    } else {
			print "\t\t<TD colspan=3 align=center valign=top>\&\#177<b>$meanscore[$i]</b>$symbol</TD>\n";
		    }
		} elsif ($i==6) {
		    if ($bExport) {
			print "\t$medianscore[0]\t";
		    } else {
			print "\t\t<TD colspan=3 align=center valign=top><b>$medianscore[0]</b>$symbol</TD>\n";
		    }
		} else {
		    if ($bExport) {
			print "\t$meanscore[$i]\t";
		    } else {
			print "\t\t<TD colspan=3 align=center valign=top><b>$meanscore[$i]</b>$symbol</TD>\n";
		    }
		}
	    }
	    if ($bExport) {
		print "\n";
	    } else {
		print "\t</TR>\n";
	    }
	}
	if ($bExport == 0) {
	    print "\t<TR>\n";
	    print "\t\t<TD colspan=$colspan valign=cemter><HR width=100\%></TD>\n";
	    print "\t</TR>\n";
	}
    } elsif ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') {
	@rowhdrs=('Unbiased Mean','Std. Dev.','Range-Low','Range-High','Median');
	$rowspan=$#rowhdrs+1;
	$symbol="\%";
	#print STDERR Dumper(\@meanscore);
	for $j (0 .. $#rowhdrs) {
	    $i=$j+2;
	    if ($bExport == 0) {
		print "\t<TR>\n";
	    }
	    if ($j==0) {
		if ($bExport) {
		    print "\tComposite\n";
		} else {
		    print "\t\t<TD rowspan=$rowspan colspan=6 align=right valign=top><font size=2><b><i>Composite</i></b></font></TD>\n";
		}
	    }
	    if ($bExport) {
		print "\t$rowhdrs[$j]\t";
	    } else {
		print "\t\t<TD align=right colspan=2 valign=top><font size=2><i>$rowhdrs[$j]</i></font></TD>\n";
	    }
	    if ($j==1) {
		if ($bExport) {
		    print "\t\t$meanscore[$i]";
		} else {
		    print "\t\t<TD align=center valign=top>\&\#177<b>$meanscore[$i]</b>$symbol</TD>\n";
		}
	    } elsif ($j==4) {
		if ($bExport) {
		    print "\t\t$medianscore[0]";
		} else {
		    print "\t\t<TD align=center valign=top><b>$medianscore[0]</b>$symbol</TD>\n";
		}
	    } else {
		if ($bExport) {
		    print "\t\t$meanscore[$i]";
		} else {
		    print "\t\t<TD align=center valign=top><b>$meanscore[$i]</b>$symbol</TD>\n";
		}
	    }
	    if ($bExport) {
		print "\n";
	    } else {
		print "\t</TR>\n";
	    }
	}
	if ($bExport == 0) {
	    print "\t<TR>\n";
	    print "\t\t<TD colspan=9 valign=cemter><HR width=100\%></TD>\n";
	    print "\t</TR>\n";
	}
    } else {
	if ($bExport == 0) {
	    print "\t<TR>\n";
	    print "\t\t<TD colspan=9 valign=cemter><HR width=100\%></TD>\n";
	    print "\t</TR>\n";
	}
    }
    &print_report_bycnd_footer();
    @subjtot=();
    @subjects=();
    @sorted=();
}
$^W=0;

sub print_report_bycnd_header {
    my ($ncount,$bysubj,$sorturls,$sortby,$csvurl,$reverseurl,@subjects) = @_;
    my $i;
    my $titlesfx="";
    my $nsubjects = $#subjects;
    my $colspan=$nsubjects+2;
    my $colspan2=$nsubjects+2;
    if ($bysubj) {
	$colspan2+=6;
	$titlesfx=" (Subject Area)";
    } else {
	$colspan2=9;
    }
    my $sortspan = int($colspan2/8);  # wac changed 4 to 8 to make columns closer
    if ($bExport) {
	print "$TEST{'desc'}\n";
	print "Question$titlesfx Response Statistics\n";
	print "$ncount Completed Responses\n";
	print "Candidate\tDate\t";
	if ($bysubj) {
	    print "BD\t";
	    for $i (0 .. $nsubjects) {
		print "$subjects[$i]\t";
	    }
	};
	print "TC\tTI\tTS\n";
    } else {
	print "<HTML>\n";
	print "<HEAD>\n";
	print "\t<TITLE>Question Response Statistics</TITLE>\n";
	print "\t<SCRIPT language=\"JavaScript\">\n";
	print "\t<\!--\n";
	print "\t	function wdwOnLoad() {\n";
	print "\t		window.focus();\n";
	print "\t	}\n";
	print "\t	window.onload=wdwOnLoad;\n";
	print "\t//-->\n";
	print "\t</SCRIPT>\n";
	print "</HEAD>\n";
	print "<BODY>\n";
	print "<CENTER>\n";
	print "<B>$TEST{'desc'}</B><BR>\n";
	print "<B>Question$titlesfx Response Statistics</B><BR>\n";
	print "<font size=2><I>$ncount Completed Responses</I></font>\n";
	#print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n";
	print "<TABLE cellpadding=2 cellspacing=2 border=0 width=100%>\n";

	print "\t<TR>\n";
	print "\t\t<TD colspan=$sortspan valign=center>\n";
	foreach (@sortbys) {
	    if ($_ ne $sortby) {
		print "\t\t\t<a href=\"$sorturls->{$_}\">Sort by $_</a><br>\n";
	    } else {
		print "\t\t\tSorted by $_<br>\n";
	    }
	}
	print "\t\t\t</td><TD colspan=".($colspan2-$sortspan)." valign=center>";
	print "<a href=\"$csvurl\">CSV Report</a>\n\t\t\t<br>&nbsp;<br>";
	print "<A href=\"$reverseurl\">Change to ".($FORM{'reverse'}?'ascending':'descending')."</a>\n\t\t</TD>\n";
	print "\t</TR>\n";
	print "\t<TR><TD colspan=$colspan2><HR WIDTH=\"100\%\"></TD></TR>\n";
	print "\t<TR>\n";
	print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Candidate</B></font></TD>\n";
	print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>LoginID</B></TD>\n";
	print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Date</B></font></TD>\n";
	if ($bysubj) {
	    print "\t\t<TD colspan=$colspan align=center valign=top><font size=2><B>Subject Areas</B></font></TD>\n";
	} else {
	    print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Start</B></TD>\n";
	    print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>End</B></font></TD>\n";
	    print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Duration</B></font></TD>\n";
	}	    
	print "\t\t<TD colspan=3 align=center valign=bottom><font size=2><B>Overall</B></font></TD>\n";
	print "\t</TR>\n";
	print "\t<TR>\n";
	if ($bysubj) {
	    print "\t\t<TD align=center valign=top><font size=2><B>\&nbsp\;</B></font></TD>\n";
	    for $i (0 .. $nsubjects) {
		print "\t\t<TD align=center valign=top><font size=2><B>$subjects[$i]</B></font></TD>\n";
	    }
	};
	print "\t\t<TD align=center valign=top><font size=2><B>Correct</B></font></TD>\n";
	print "\t\t<TD align=center valign=top><font size=2><B>Incorrect</B></font></TD>\n";
	print "\t\t<TD align=center valign=top><font size=2><B>Score</B></font></TD>\n";
	print "\t</TR>\n";
	print "\t<TR><TD colspan=$colspan2><HR WIDTH=\"100\%\"></TD></TR>\n";
    }
    return $colspan2;
}

sub print_report_bycnd_footer {
    if ($bExport) { return;}
    print "</TABLE>\n";
    print "</BODY>\n";
    print "</HTML>\n";
}

sub print_report_bycnd_csv {
    print "userid,testname,date,score\n";
    my %testlookup;
    my $lookupfile = join($pathsep,$dataroot,"namelookup.$CLIENT{'clid'}");
    #print STDERR "Opening $lookupfile\n";
    if (-e $lookupfile) {
	my $fh = new FileHandle;
	if ($fh->open($lookupfile)) {
	    while ($_ = <$fh>) {
		chomp;
		my @line = split(/\s+/,$_,2);
		$testlookup{$line[0]} = $line[1];
	    }
	}
    }
    foreach (@_) {
	my @row = @{$_->{'columns'}};
	my ($userid,$testid,$date,$score) = ($row[1],$TEST{'id'},$row[2],$row[$#row]);
	if ($testlookup{$testid}) {$testid = $testlookup{$testid};}
	print join(',',$userid,$testid,$date,$score)."\n";
    }
}

sub show_test_composite {
    my ($idlist) = @_;
    &LanguageSupportInit();
    $mymsg = "";
    my $nresponses=0;
    &get_client_profile($SESSION{'clid'});
    &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
    @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
    @questions = &get_question_list($TEST{'id'},$CLIENT{'clid'});
    $qhdr = shift @questions;
    @sorted = sort @questions;
    @questions = @sorted;
    unshift @questions, $qhdr;
    @sorted = ();
  # Initialize an array to hold collected answers for each question.
    for (1 .. $#questions) {
	($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$_]);
	if ( $qtp eq 'nrt' ) {
	    $qca = 'N/A';
	}
	$qtx =~ s/\;/<BR>/g;
	($test,$qid) = split(/\./, $id);
	$qstatsid[$qid] = $id;
	$qstatsqc[$qid] = 0;	# occurrences of question
	$qstatsqp[$qid] = 0;	# percent occurrences of question
	$qstatsqt[$qid] = $qtx;	# question text
	if ($qil eq 'Y') {
	    $qstatsqf[$qid] = "obs";	# question type
	} else {
	    $qstatsqf[$qid] = $qtp;	# question type
	    $qallans = "";
	    if ($qtp eq 'tf') {
		$qallans = "$qca\;$qia\;$xlatphrase[670]"; #670=No Response
	    } elsif ($qtp eq 'mcs' || $qtp eq 'mca' || $qtp eq 'lik') {
		if ($qca eq '') {
		    $qallans = "$qia\;$xlatphrase[670]";
		} else {
		    $qallans = "$qca\;$qia\;$xlatphrase[670]";
		}
	    } elsif ($qtp eq 'mtx' || $qtp eq 'mtr') {
		# DED When qca is saved correctly in tdef,
		# put this back and delte rest:
		# $qallans = "$qca";
		### DED 2/25/05 Assumes RC labels, not lblall
		($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
		@qiar = split("\;", $qiar);
		@qiac = split("\;", $qiac);
		$qallans = "";
		foreach $qiarow (@qiar)
		{
		    foreach $qiacol (@qiac)
		    {
			$qallans .= "xxx\;";
		    }
		}
	    } elsif ($qtp eq 'mcm') {
		if ($qca eq '') {
		    $qallans = "$qia";
		} else {
		    $qallans = "$qca\;$qia";
		}
	    } elsif ($qtp eq 'esa') {
		if ($qca eq '') {
		    $qallans = "";
		} else {
		    $qallans = "$qca";
		}
	    } elsif ($qtp eq 'nrt') {
		if ($qca eq 'N/A') {
		    $qallans = "Other\;$xlatphrase[670]\;"; 
		} else {
		    $qallans = "$qca\;Other\;$xlatphrase[670]\;"; 
		}
	    } elsif ($qtp eq 'mch') {
		@qcans = split(/\;/, $qca);
		@qians =  split(/\;/, $qia);
		for (my $i = 0; $i <= $#qcans; $i++ ) {
		    $qallans = join('', $qallans, "$qcans[$i]===$qians[$i]<BR>");
		}
	    } elsif ($qtp eq 'ord') {
		$qallans = "$qca";
	    }
	    $qallans =~ s/\;\;/\;/g;
	    $qstatsqr[$qid] = $qallans;	# response options
	    $fqstatsqr[$qid] = $qallans;	### DED for FBQ
	    $qstatsqw[$qid] = ();
	    if (($qtp eq 'mch') || ($qtp eq 'ord')) {
		if ($qtp eq 'mch') {
		    @qstato = split(/<BR>/, $qallans);
		} else {
		    @qstato = split(/\;/, $qallans);
		}
		$ncount = $#qstato + 1;
		$ncount = int(($ncount * ($ncount + 1)) + 3);
		for (my $i = 0; $i <= $ncount; $i++ ) {
		    $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;");	# response option count
		    $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;");	# response option percentage
		}
	    } elsif ($qtp eq 'mcm' || $qtp eq 'esa' || $qtp eq 'mtx' || $qtp eq 'mtr') {
		### ASSUMES rank=1..10 - need to allow for other ranks
		@qstato = split(/\;/, $qallans);
		if ($qtp eq 'mtr') 
		{
		    # Have to allow for [1..10] in 
		    # each answer, so make it big!
		    $ncount = (($#qstato + 1) * 10) + 3;
		}
		else
		{
		    $ncount = $#qstato + 3;
		}
		for (my $i = 0; $i <= $ncount; $i++ ) {
		    $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;");	# response option count
		    $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;");	# response option percentage
		}
	    } else {
		@qstato = split(/\;/, $qallans);
		foreach $qstat (@qstato) {
		    $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;");	# response option count
		    $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;");	# response option percentage
		}
	    }
	}
	@qstato = ();
    }
    # Collect the answers from each test.
    $ncount = $#filelist + 1;
    @qucmts=();
    $nresponses=$#filelist+1;
    for (my $fidx = 0; $fidx <= $#filelist; $fidx++ ) {
	$user = $filelist[$fidx];
	$user =~ s/.$TEST{'id'}$//;
	$user =~ s/^$CLIENT{'clid'}.//;
	if (defined $idlist and not $idlist->{$user}) {
	    $nresponses--;
	    next;
	}
	my $excuser="inc$user";
	if ($FORM{$excuser}) {
	    $nresponses--;
	    next;
	}
	&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
	@qids = split(/\&/, $SUBTEST_QUESTIONS{2});
	@qrsp = split(/\&/, $SUBTEST_RESPONSES{2});
	@qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
	@corincs = split(/\//, $qsumry[5]);
	@qsumry = ();
	@qsumry = split(/\&/, $SUBTEST_ANSWERS{2});
	@qansseq = ();
	$fqid="";
	$fqididx="";
	for (1 .. $#qids) {
	    ($test,$qidx) = split(/\./, $qids[$_]);
	    ($qansord,$trash) = split(/::/, $qsumry[$_]);
	    $qansord =~ s/\=([0-1])//g;
	    $qansseq[$_] = $qansord;

	    ($qresp,$qucmt) = split(/::/, $qrsp[$_]);
	    $qresp=~ tr/+/ /;
	    $qresp=~ tr/'//d;
	    $qrsp[$_]=$qresp;
         
   	    ##### v ADT - 7/03/2002 ###################################
   	    #  Added code to print NRT answers in the form of the comments
            #push @qresponses, "$qidx\&$user\&$qresp";
        
	    if ($qucmt ne '') {
		$qucmt =~ tr/+/ /;
		$qucmt =~ tr/'//d;
		push @qucmts, "$qidx\&$user\&$qucmt";
	    }
	    ### DED 10/28/2002 Support for filter-by-question (FBQ)
	    if ($FORM{'question'} eq $qids[$_]) {
	        $fqididx=$_;
	        ($trash,$fqid)=split(/\./,$qids[$_]);
	    }
        }
    ### DED 10/28/2002 Support for filter-by-question (fbq)
    #print "<p>FormQues= $FORM{'question'} Ans= $FORM{'answer'} Qansseq= $qansseq[$fqididx]<p>\n";
    if ($fqid ne "" && $FORM{'answer'} ne "") {
	$fmatch=0;
	if ($qstatsqf[$fqid] eq 'mcs' || $qstatsqf[$fqid] eq 'mca' || $qstatsqf[$fqid] eq 'lik') {
	    @fqansseq=split(/\?/,$qansseq[$fqididx]);
	    shift @fqansseq;
	    @fans=split(/\&/,$FORM{'answer'});
	    shift @fans;
	    foreach $fans (@fans) {
		@ffresp=();
		$fresp="";
		for (0 .. $#fqansseq) {
		    $fqseqans[$fqansseq[$_]]=$_;
		    $ffresp[$_]="xxx";
		}
		if ($fans ne "No+Response") {
		    $ffresp[$fqseqans[$fans]]=$fqseqans[$fans];
		}
		if ($ffresp[0] eq "") {
		    $fresp="";
		} else {
		    foreach (@ffresp) {
			$fresp=join('?',$fresp,$_);
		    }
		}
		if ($qrsp[$fqididx] eq $fresp && $fresp ne "") {
		    $fmatch=1;
		}
		@ffresp=();
		if ($fmatch == 1)  { break; }
	    }
	    @fqansseq=();
	    @fans=();
	} elsif ($qstatsqf[$fqid] eq 'mcm') {
	    @fqansseq=split(/\?/,$qansseq[$fqididx]);
	    shift @fqansseq;
	    @fans=split(/\&/,$FORM{'answer'});
	    shift @fans;
	    @ffresp=();
	    $fresp="";
	    for (0 .. $#fqansseq) {
		$fqseqans[$fqansseq[$_]]=$_;
		$ffresp[$_]="xxx";
	    }
	    if ($fans[0] ne "No+Response") {
		foreach (@fans) {
		    $ffresp[$fqseqans[$_]]=$fqseqans[$_];
		}
	    }
	    if ($ffresp[0] eq "") {
		$fresp="";
	    } else {
		foreach (@ffresp) {
		    $fresp=join('?',$fresp,$_);
		}
	    }
	    if ($qrsp[$fqididx] eq $fresp && $fresp ne "") {
		$fmatch=1;
	    }
	    @fqansseq=();
	    @fans=();
	    @ffresp=();
	} elsif ($qstatsqf[$fqid] eq 'tf') {
	    if ($FORM{'answer'} eq "\&0" ) {
		$fresp=$qansseq[$fqididx];
	    } elsif ($FORM{'answer'} eq "\&1" ) {
	      SWITCH: for ($qansseq[$fqididx]) {
		  $fresp	=  /TRUE/	&& "FALSE"
		      || /FALSE/	&& "TRUE"
			  || /YES/	&& "NO"
			      || /NO/		&& "YES"
				  ||		   "bad";
	      }
	    } elsif ($FORM{'answer'} eq "\&No+Response") {
		$fresp="";
	    } else {
		$fresp="bad";
	    } 
	    if ($qrsp[$fqididx] eq $fresp && $fresp ne "bad") {
		$fmatch=1;
	    }
	} elsif ($qstatsqf[$fqid] eq 'esa') {
	    ($fqstatsqr,$trash)=split(/;Other/,$fqstatsqr[$fqid]);
	    @fqr=split(/\;/,$fqstatsqr);
	    @fans=split(/\&/,$FORM{'answer'});
	    shift @fans;
	    if ($fans[0] eq "No+Response") {
		$fqr="";
		if ($fqr eq $qrsp[$fqididx]) {
		    $fmatch=1;
		}
	    } else {
		foreach (@fans) {
		    $fqr=lc($fqr[$_]);
		    $fqrsp=lc($qrsp[$fqididx]);
		    if ($fqr eq $fqrsp && $fqr ne "") {
			$fmatch=1;
			last;
		    }
		}
	    }
	    @fqr=();
	    @fans=();
	}
	#print "<p>FQid= $fqid Qtp= $qstatsqf[$fqid] Qstatsid= $qstatsid[$fqid] Fresp= $fresp Qrsp=$qrsp[$fqididx]<p>\n";
	if ($fmatch == 0) {
	    ### Don't count this one
	    #print "...Skipping...";
	    $nresponses--;
	    @fqucmts = @qucmts;
	    @qucmts = ();
	    foreach (@fqucmts) {
		if (!($_ =~ /\&$user\&/)) {
	    		push @qucmts, "$_";
	        }
	    }
	    next;
	}
	$fresp="";
    }
    ### DED	End fbq support
    @qsumry=();
    for (1 .. $#qids) {
	($test,$qidx) = split(/\./, $qids[$_]);
	if ($qstatsqf[$qidx] ne 'obs') {
	    $qstatsqc[$qidx]++;
	    $qstatsqp[$qidx] = format_percent(($qstatsqc[$qidx] / $ncount),
					      { fmt => "%.0f" } );
	    @qstatc = split(/\;/, $qstatsqrc[$qidx]);
	    @qstatp = split(/\;/, $qstatsqrp[$qidx]);
	    if ($qstatsqf[$qidx] eq 'tf') {
		@qstato = split(/\;/, $qstatsqr[$qidx]);
		if ($qrsp[$_] eq $qstato[0]) {
		    $qstatc[0]++;
		} elsif ($qrsp[$_] eq $qstato[1]) {
		    $qstatc[1]++;
		} else {
		    $qstatc[2]++;
		}
	    }elsif ($qstatsqf[$qidx] eq 'esa'){
		$ncountidx = $#qstatc - 2;
		$qresp = $qrsp[$_];
		$qresp =~ s/\+/ /g;
		if ($qresp ne '') {
		    # 
		    # if answered, Determine from the score summary
		    # if answered correctly
		    #
		    $corinc = substr($corincs[$_], 0, 1);
		    if ($corinc == 0) {
			$ncountidx++;
		    }
		    $qstatc[$ncountidx]++;

		    if ($corinc == 1) {
			@qansord = split(/\;/, $qansseq[$_]);
			for $q (0 .. $#qansord) {
			    if ($qansord[$q] eq $qresp) {
				$qstatc[$q]++;
				last;
			    }
			}
		    } else {	# incorrect
			$found=0;
			@qstatw=split(/\;/,$qstatsqw[$qidx]);
			shift(@qstatw);
			for $q (0 .. $#qstatw) {
			    if ($qstatw[$q] eq $qresp) {
				$qstatsqwc[$q]++;
				$found=1;
				last;
			    }
			}
			if ($found != 1) {
			    $qstatsqwc[$#qstatw+1]=1;
			    $qstatsqw[$qidx]=join(';',$qstatsqw[$qidx],$qresp);
			}
			@qstatq=();
		    }
		} else {
		    $qstatc[$#qstatc]++;
		}
		@qansord = ();
	    } elsif ($qstatsqf[$qidx] eq 'nrt'){
		# HBI This is the code to put the narrative answers in the report.
		if ($qrsp[$_] ne '') {
		    $qstatc[1]++;
		    $qrsp[$_] =~ s/\;/\:/g;
		    $qrsp[$_] =~ s/\r//g;
		    $qrsp[$_] =~ s/\n/\\n/g;
		    
		    $qstatsqr[$qidx] = join('<br><br>',$qstatsqr[$qidx],$qrsp[$_]);
		} else {
		    $qstatc[2]++;
		}
	    } elsif ($qstatsqf[$qidx] eq 'mcs' || $qstatsqf[$qidx] eq 'mca' || $qstatsqf[$qidx] eq 'lik') {
		### DED Filter out "?" and "xxx" in qrsp so will match
		$qrsp[$_] =~ s/\?//g;
		$qrsp[$_] =~ s/xxx//g;
		@qansord = split(/\?/, $qansseq[$_]);
		shift @qansord;
		$found = 0;
		### DED 10/09/02 Changed to allow for 
		### randomized answers
		#for (my $i = 0; $i <= $#qansord; $i++ ) {
		#if (("$qansord[$i]" eq "$qrsp[$_]") && ($qrsp[$_] ne '')) {
		if ($qrsp[$_] ne '') {
		    $qstatc[$qansord[$qrsp[$_]]]++;
		    $found = 1;
		}
		#}
		unless ($found) { 
		    # increment "No Response"
		    $qstatc[$#qstatc]++;
		}
		@qansord = ();
	    } elsif ($qstatsqf[$qidx] eq 'mtx') {
		$ncountidx = $#qstatc - 2;
		$qresp = $qrsp[$_];
		$qresp =~ s/xxx//g;
		$qresp =~ s/\?//g;
		if ($qresp ne '') {
		    # 
		    # if answered, Determine from the score summary
		    # if answered correctly
		    #
		    $corinc = substr($corincs[$_], 0, 1);
		    if ($corinc == 0) {
			$ncountidx++;
		    }
		    $qstatc[$ncountidx]++;

		    if ($corinc == 0) {
			($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
			($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
			@qiar = split("\;", $qiar);
			@qiac = split("\;", $qiac);

			# skipping answer sequence part (no rand answ)
			$holding3 = $_;
			@qresps = split(/\?/, $qrsp[$_]);
			shift @qresps;
			$i=0;
			foreach $qiarow (@qiar)
			{
			    foreach $qiacol (@qiac)
			    {
				if ($qresps[$i] ne "xxx") {
				    $qstatc[$i]++;
				}
				$i++;
			    }
			}
		    }
		} else {
		    # increment No Response counter
		    $qstatc[$#qstatc]++;
		}
		@qansord = ();
		$_ = $holding3;
	    } elsif ($qstatsqf[$qidx] eq 'mtr') {
		$ncountidx = $#qstatc - 2;
		$qresp = $qrsp[$_];
		$qresp =~ s/xxx//g;
		$qresp =~ s/\?//g;
		if ($qresp ne '') {
		    # 
		    # if answered, Determine from the score summary
		    # if answered correctly
		    #
		    $corinc = substr($corincs[$_], 0, 1);
		    if ($corinc == 0) {
			$ncountidx++;
		    }
		    $qstatc[$ncountidx]++;

		    if ($corinc == 0) {
			($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
			($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
			@qiar = split("\;", $qiar);
			@qiac = split("\;", $qiac);

			# skipping answer sequence part (no rand answ)
			$holding3 = $_;
			@qresps = split(/\?/, $qrsp[$_]);
			shift @qresps;
			$iqresps=0;
			$iqstatc=0;
			foreach $qiarow (@qiar)
			{
			    foreach $qiacol (@qiac)
			    {
				if ($qresps[$iqresps] ne "xxx") 
				{
				    # $qresps[$iqresps] will be [1..10], so adjust index accordingly
				    $irank = $iqstatc + $qresps[$iqresps] - 1;
				    $qstatc[$irank]++;
				}
				$iqresps++;
				$iqstatc += 10;
			    }
			}
		    }
		} else {
		    # increment No Response counter
		    $qstatc[$#qstatc]++;
		}
		@qansord = ();
		$_ = $holding3;
	    } elsif ($qstatsqf[$qidx] eq 'mcm') {
		$ncountidx = $#qstatc - 2;
		$qresp = $qrsp[$_];
		$qresp =~ s/xxx//g;
		$qresp =~ s/\?//g;
		if ($qresp ne '') {
		    # 
		    # if answered, Determine from the score summary
		    # if answered correctly
		    #
		    $corinc = substr($corincs[$_], 0, 1);
		    if ($corinc == 0) {
			$ncountidx++;
		    }
		    $qstatc[$ncountidx]++;

		    if ($corinc == 0) {
			@qansord = split(/\?/, $qansseq[$_]);
			shift @qansord;
			$holding3 = $_;
			#$found = 0;
			### DED 10/18/02 Changed to allow for 
			### randomized answers & new format
			@qresps = split(/\?/, $qrsp[$_]);
			shift @qresps;
			foreach $qresp (@qresps) {
			    if ($qresp ne "xxx") {
				$qstatc[$qansord[$qresp]]++;
			    }
			}
		    }
		} else {
		    $qstatc[$#qstatc]++;
		}
		@qansord = ();
		$_ = $holding3;
	    } elsif ($qstatsqf[$qidx] eq 'mch') {
		$ncountidx = $#qstatc - 2;
		$qresp = $qrsp[$_];
		$qresp =~ s/xxx//g;
		$qresp =~ s/\?//g;
		if ($qresp ne '') {
		    # 
		    # if answered, Determine from the score summary
		    # if answered correctly
		    #
		    $corinc = substr($corincs[$_], 0, 1);
		    if ($corinc == 0) {
			$ncountidx++;
		    }
		    $qstatc[$ncountidx]++;
		    ### DED 10/18/02 Changed for 
		    ###	 random answers and new format
		    
		    #
		    # Count occurrence of each match

		    # $qansseq[$qidx] [Wrong! DED]
		    # $qansseq[$_] 
		    # &a.3.2.0.6.5.8.4.7.1::MATCH.0:1:1:0						
		    # $qrsp[$_]
		    # &dgihbfcea	[Old format]
		    # &?d?g?i?h?b?f?c?e?a [New]
		    
		    #$qansseq[$qidx] =~ s/\&//g;
		    $qansseq[$_] =~ s/\&//g;
		    $qrsp[$_] =~ s/\&//g;
		    $qrsp[$_] =~ s/ //g;
		    #@corord = split(/\./, $qansseq[$qidx]);
		    @corord = split(/\./, $qansseq[$_]);
		    #@selord = split(//,$qrsp[$_]);
		    @selord = split(/\?/,$qrsp[$_]);
		    shift @selord;
		    $corhold = $_;
		    if ($corinc == 0) {
			for (0 .. $#selord) {
			    if ($selord[$_] ne 'xxx') {
				($x = &get_label_index($corord[0],$selord[$_]))++;
				$y = $corord[$x];
				
				#$ncountidx = int($_ * $#corord + $y);
				$ncountidx = int($y * $#corord + $_);
			    } else {
				$ncountidx = int(($#corord * $#corord ) + $_);
			    }
			    $qstatc[$ncountidx]++;
			}
		    }
		    $_ = $corhold;
		    @selord = ();
		    @corord = ();
		} else {
		    $qstatc[$#qstatc]++;
		}
	    } elsif ($qstatsqf[$qidx] eq 'ord') {
		$ncountidx = $#qstatc - 2;
		$qresp = $qrsp[$_];
		$qresp =~ s/xxx//g;
		### DED 10/18/02 Changed for 
		###	 random answers and new format
		$qresp =~ s/\?//g;
		if ($qresp ne '') {
		    # 
		    # if answered, Determine from the score summary
		    # if answered correctly
		    #
		    $corinc = substr($corincs[$_], 0, 1);
		    if ($corinc == 0) {
			$ncountidx++;
		    }
		    $qstatc[$ncountidx]++;

		    #
		    # Count occurrence of each incorrect order
		    # &o.2.3.4.1.0::ORDERED.0:1:1:0
		    # &34521 [Old format]
		    # &?3?4?5?2?1 [New]
		    #
		    #$qansseq[$qidx] =~ s/\&//g;
		    $qansseq[$_] =~ s/\&//g;
		    $qrsp[$_] =~ s/\&//g;
		    #@corord = split(/\./, $qansseq[$qidx]);
		    @corord = split(/\./, $qansseq[$_]);
		    #@selord = split(//,$qrsp[$_]);
		    @selord = split(/\?/,$qrsp[$_]);
		    shift @selord;
		    $corhold = $_;
		    if ($corinc == 0) {
			for (1 .. $#corord) {
			    $ncountidx = int(($corord[$_]) * $#corord);
			    $x = int($_ - 1);
			    if ($selord[$x] ne 'xxx') {
				$ncountidx = $ncountidx + int($selord[$x]) - 1;
			    } else {
				$ncountidx = int(($#corord * $#corord) + $_ - 1);
			    }
			    $qstatc[$ncountidx]++;
			}
		    }
		    $_ = $corhold;
		    @selord = ();
		    @corord = ();
		} else {
		    $qstatc[$#qstatc]++;
		}
	    }
	    ### DED 8/20/2002 If checked, don't count 
	    ###	"No Response" in statistics
	    if ($FORM{'exnoresp'}) {
		if ($qstatsqc[$qidx] > $qstatc[$#qstatc]) {
		    $denom = $qstatsqc[$qidx] - $qstatc[$#qstatc];
		} else {
		    $denom = 1;
		}
		for (my $i = 0; $i <= $#qstatc-1; $i++ ) {
		    $qstatp[$i] = format_percent($qstatc[$i] / $denom);
		}
	    } else {
		for (my $i = 0; $i <= $#qstatc; $i++ ) {
		    $qstatp[$i] = format_percent($qstatc[$i] / $qstatsqc[$qidx]);
		}
	    }
	    
	    $qstatsqrc[$qidx] = "";
	    foreach $qstat (@qstatc) {
		$qstatsqrc[$qidx] = join('', $qstatsqrc[$qidx], "$qstat\;");
	    }
	    $qstatsqrp[$qidx] = "";
	    ### DED 8/22/2002 Exclude "No Response"
	    ### 	from statistics
	    if ($FORM{'exnoresp'}) {
		$count = $#qstatc-1;
	    } else {
		$count = $#qstatp
		}
	    for (0 .. $count) {
		$qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstatp[$_]\;");
	    }
	}
	if (($qstatsqf[$qidx] eq 'mcm') || ($qstatsqf[$qidx] eq 'mch') || ($qstatsqf[$qidx] eq 'ord') || ($qstatsqf[$qidx] eq 'mtx') || ($qstatsqf[$qidx] eq 'mtr')) {
	    $npctidxend = $#qstatc - 3;
	    $nincidx = $#qstatc - 1;
	    $ntotinc = $qstatc[$nincidx];
	    for (my $i = 0; $i <= $npctidxend; $i++ ) {
		if ($ntotinc == 0) {
		    $qstatp[$i] = 0;
		} else {
		    $qstatp[$i] = format_percent($qstatc[$i] / $ntotinc);
		}
	    }
	    $qstatsqrp[$qidx] = "";
	    foreach $qstat (@qstatp) {
		$qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
	    }
	} elsif ($qstatsqf[$qidx] eq 'esa') {
	    $npctidxend = $#qstatc - 3;
	    $ncoridx = $#qstatc - 2;
	    $nincidx = $#qstatc - 1;
	    $ntotcor = $qstatc[$ncoridx];
	    $ntotinc = $qstatc[$nincidx];
	    for (my $i = 0; $i <= $npctidxend; $i++ ) {
		if ($ntotcor == 0) {
		    $qstatp[$i] = 0;
		} else {
		    $qstatp[$i] = format_percent($qstatc[$i] / $ntotcor);
		}
	    }
	    $qstatsqrp[$qidx] = "";
	    foreach $qstat (@qstatp) {
		$qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
	    }
	    $nincidx = $#qstatc - 1;
	    $ntotinc = $qstatc[$nincidx];
	    for (my $i = 0; $i <= $#qstatsqwc; $i++ ) {
		if ($ntotinc == 0) {
		    $qstatsqwp[$i] = 0;
		} else {
		    $qstatsqwp[$i] = format_percent($qstatsqwc[$i] / $ntotinc);
		}
	    }
	}
	@qstato = ();
	@qstatc = ();
	@qstatp = ();
    }
}

if ($#qucmts != -1) {
    @qsumry=sort @qucmts;
    @qucmts=@qsumry;
    @qsumry=();
}

    print HTMLHeaderPlain("Question Response Statistics");
    print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>$TEST{'desc'}<br>Question Response Statistics</b></font><br><br>\n";
    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
    if ($FORM{'uberheader'} ne "") {
        print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
    } elsif (defined $idlist) {
	my $groups = getGroups($CLIENT{'clid'});
	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
	    .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
    } else {
	#print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Organization-wide Report</b></font><br>\n";
	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b></b></font><br>\n";
    }
    print $timestamp;
    print "</center>\n";
    print "<blockquote>\n";

print "<font size=2><I>$nresponses Completed Responses</I></font>
<TABLE cellpadding=2 cellspacing=2 border=0 width=100%>
	<TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>
";
$sobsolete = "";
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
    $incresponse = "";
} else {
    $incresponse = "INCORRECT";
}
for (1 ..$#questions) {
    ($test,$qid) = split(/\./, $qstatsid[$_]);
    if (!($FORM{'exunans'} && $qstatsqc[$qid] < $FORM{'minunans'})) {
        if ($qstatsqf[$qid] eq 'obs') {
	    if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
	        $sobs =  "
	    <TR>
		    <TD valign=top><I>$qstatsid[$_]</I></TD>
		    <TD colspan=2 valign=top><font size=1>INACTIVE</font></TD>
		    <TD colspan=3 valign=top>$qstatsqt[$qid]</TD>
	    </TR>
	    <TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>
    ";
	        $sobsolete = join('', $sobsolete, $sobs);
	    }
        } else {
	    if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || ($qstatsqf[$qid] eq 'esa') || ($qstatsqf[$qid] eq 'mtx') || ($qstatsqf[$qid] eq 'mtr')) {
	        if ($qstatsqf[$qid] eq 'mch') {
		    @qstato = split(/<BR>/, $qstatsqr[$qid]);
	        } else {
		    @qstato = split(/\;/, $qstatsqr[$qid]);
	        }
	        if ($qstatsqf[$qid] eq 'esa') {
		    @qstatw = split(/\;/, $qstatsqw[$qid]);
		    shift @qstatw;
	        }
	        $rowspan1 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4;
	        $rowspan2 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4;
	    } else {
	        @qstato = split(/\;/, $qstatsqr[$qid]);
	        if ( $qstatsqf[$qid] eq 'nrt' ){
		    $qstato[1] =~ s/\/\//<BR>/g;
		    $qstato[1] =~ s/\//<BR>/g;
		    $qstato[1] =~ s/:/<BR>/g;
		    $qstato[1] =~ s/\+/ /g;
	        }
	        $rowspan1 = 2;
	        $rowspan2 = 2;
	    }
	    if ($FORM{'showcmts'} eq 'withq') {
	        $rowspan1++;
	        $rowspan2++;
	    }
	    $outary[$_] .= "
	    <TR>
		    <TD rowspan=$rowspan1 valign=top><I>$qstatsid[$_]</I></TD>
		    <TD rowspan=$rowspan2 valign=top>$qstatsqc[$qid]</TD>
		    <TD rowspan=$rowspan2 valign=top>$qstatsqp[$qid]\%</TD>
		    <TD colspan=3 valign=top>$qstatsqt[$qid]</font></TD>
	    </TR>";
    
	    @qstatc = split(/\;/, $qstatsqrc[$qid]);
	    @qstatp = split(/\;/, $qstatsqrp[$qid]);
	    if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || $qstatsqf[$qid] eq 'esa' || $qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') {
	        $ncountidx = $#qstatc - 2;
	        $qstatccor = $qstatc[$ncountidx];
	        $qstatpcor = $qstatp[$ncountidx];
	        $qstatcinc = $qstatc[$ncountidx+1];
	        $qstatpinc = $qstatp[$ncountidx+1];
	        $qstatcnor = $qstatc[$ncountidx+2];
	        $qstatpnor = $qstatp[$ncountidx+2];
	        if ($TEST{'seq'} ne svy && $TEST{'seq'} ne dmg) {
		    $outary[$_] .= "
	    <TR>
		    <TD valign=top><font size=2>$qstatccor</font></TD>
		    <TD valign=top><font size=2>$qstatpcor\%</font></TD>
		    <TD valign=top><font size=2>$xlatphrase[137]</font></TD>
	    </TR>";
		    $outary[$_] .= "
	    <TR>
		    <TD valign=top><font size=2>$qstatcinc</font></TD>
		    <TD valign=top><font size=2>$qstatpinc\%</font></TD>
		    <TD valign=top><font size=2>INCORRECT</font></TD>
	    </TR>";
	        } else {
		    $outary[$_] .= "
	    <TR>
		    <TD valign=top><font size=2>$qstatcinc</font></TD>
		    <TD valign=top><font size=2>$qstatpinc\%</font></TD>
		    <TD valign=top><font size=2>RESPONSES</font></TD>
	    </TR>";
	        }
	        $outary[$_] .= "
	    <TR>
		    <TD valign=top><font size=2>$qstatcnor</font></TD>";
	        if ($FORM{'exnoresp'}) {
		    $outary[$_] .= "<TD valign=top><font size=2>&nbsp;</font></TD>\n";
	        } else {
		    $outary[$_] .= "<TD valign=top><font size=2>$qstatpnor\%</font></TD>\n";
	        }
	        $outary[$_] .= "<TD valign=top><font size=2>$xlatphrase[670]</font></TD>
	    </TR>
    ";
	    }
	    if (($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord')) {
	        if ($qstatsqf[$qid] eq 'mch') {
		    $sphrase = "(matched to \&gt\;\&gt\;\&gt\;)";
		    @matchwords = ();
		    @matchtos = ();
		    foreach $qstat (@qstato) {
		        ($matchword, $matchto) = split(/\=\=\=/, $qstat);
		        push @matchwords, $matchword;
		        push @matchtos, $matchto;
		    }
		    push @matchtos, "Left Blank";
	        } else {
		    $sphrase = "(ordered as number \&gt\;\&gt\;\&gt\;)";
		    @matchwords = ();
		    @matchtos = @qstato;
		    $matchidx = 1;
		    foreach $qstat (@qstato) {
		        push @matchwords, "$matchidx";
		        $matchidx++;
		    }
		    push @matchtos, "Not Used";
	        }
	        $colspan = int((($#matchwords + 1) * 2) + 1);
	        $outary[$_] .= "<TR>
		    <TD colspan=3>
			    <TABLE cellpadding=2 cellspacing=0 border=1>
				    <TR>
					    <TD colspan=$colspan align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD>
				    </TR>
				    <TR>
					    <TD rowspan=2 align=right valign=top><font size=2><NOBR>$sphrase</NOBR></font></TD>";
	        foreach $matchword (@matchwords) {
		    $outary[$_] .= "
					    <TD colspan=2 align=center><font size=2>$matchword</font></TD>";
	        }
	        $outary[$_] .= "
				    </TR>
				    <TR>";
	        foreach $matchword (@matchwords) {
		    $outary[$_] .= "
					    <TD align=center><font size=2>Cnt</font></TD>
					    <TD align=center><font size=2>Pct</font></TD>";
	        }
	        $outary[$_] .= "
				    </TR>";
	        $matchidx = 0;
	        foreach $matchto (@matchtos) {
		    $outary[$_] .= "
				    <TR>";
		    if ($matchto eq $matchtos[$#matchtos]) {
		        $outary[$_] .= "
					    <TD align=right valign=top><font size=2>$matchto</font></TD>";
		    } else {
		        $outary[$_] .= "
					    <TD valign=top><font size=2>$matchto</font></TD>";
		    }
		    foreach $matchword (@matchwords) {
		        $outary[$_] .= "
					    <TD align=center valign=top><font size=2>$qstatc[$matchidx]</font></TD>
					    <TD align=center valign=top><font size=2>$qstatp[$matchidx]\%</font></TD>";
		        $matchidx++;
		    }
		    $outary[$_] .= "
				    </TR>";
	        }
	        $outary[$_] .= "
			    </TABLE>
		    </TD>
	    </TR>";
	    } elsif ($qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') {
	        ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qid]);
	        ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
	        @qiar = split("\;", $qiar);
	        @qiac = split("\;", $qiac);
	        $holdmcm = $_;
	        if ($qstatsqf[$qid] eq 'mtr') 
	        {
		    $colspan = ($#qiac + 1) * 3 + 1;
		    $colspan2 = 3;
	        }
	        else
	        {
		    $colspan = ($#qiac + 1) * 2 + 1;
		    $colspan2 = 2;
	        }
	        $outary[$_] .= "
	    <TR>
		    <TD colspan=3>
			    <TABLE cellpadding=2 cellspacing=0 border=1>
				    <TR>
					    <TD colspan=$colspan align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD>
				    </TR>
				    <TR>
					    <TD>&nbsp;</TD>";
	        foreach $qiacol (@qiac)
	        {
		    $outary[$_] .= "<TD colspan=$colspan2 align=center>$qiacol</TD>";
	        }
	        $outary[$_] .= "\n</TR>
				    <TR>
					    <TD>&nbsp;</TD>";
	        foreach $qiacol (@qiac)
	        {
		    if ($qstatsqf[$qid] eq 'mtr') 
		    {
		        $outary[$_] .= "<TD align=center><font size=2><NOBR>Rank</NOBR></font></TD>";
		    }
		    $outary[$_] .= "<TD align=center><font size=2><NOBR>Cnt</NOBR></font></TD>
						    <TD align=center><font size=2><NOBR>Pct</NOBR></font></TD>";
	        }
	        $outary[$_] .= "\n</TR>\n";
	        $i=0;
	        foreach $qiarow (@qiar)
	        {
		    $outary[$_] .= "<TR>
					    <TD>$qiarow</TD>";
		    foreach $qiacol (@qiac)
		    {
		        if ($qstatsqf[$qid] eq 'mtr') 
		        {
			    $outary[$_] .= "<TD align=center>";
			    for $irank (1 .. 10) 
			    {
			        $outary[$_] .= "$irank<br>";
			    }
			    $outary[$_] .= "</TD>";
			    $outary[$_] .= "<TD align=center>";
			    for $irank (1 .. 10) 
			    {
			        $outary[$_] .= "$qstatc[$i+$irank-1]<br>";
			    }
			    $outary[$_] .= "</TD>";
			    $outary[$_] .= "<TD align=center>";
			    for $irank (1 .. 10) 
			    {
			        $outary[$_] .= "$qstatp[$i+$irank-1]\%<br>";
			    }
			    $outary[$_] .= "</TD>";
			    $i += 10;
		        }
		        else
		        {
			    $outary[$_] .= "<TD align=center>$qstatc[$i]</TD>";
			    $outary[$_] .= "<TD align=center>$qstatp[$i]\%</TD>";
			    $i++;
		        }
		    }
		    $outary[$_] .= "\n</TR>\n";
	        }
	        $outary[$_] .= "\n</TABLE>
		    </TD>
	    </TR>";
	    } elsif ($qstatsqf[$qid] eq 'mcm') {
	        $outary[$_] .= "
	    <TR>
		    <TD colspan=3>
			    <TABLE cellpadding=2 cellspacing=0 border=1>
				    <TR>
					    <TD colspan=3 align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD>
				    </TR>
				    <TR>
					    <TD valign=top><font size=2><NOBR>Response Option</NOBR></font></TD>
					    <TD valign=top><font size=2><NOBR>Cnt</NOBR></font></TD>
					    <TD valign=top><font size=2><NOBR>Pct</NOBR></font></TD>
				    </TR>
				    <TR>
					    <TD valign=top><font size=2><NOBR>";
	        foreach $qstat (@qstato) {
		    $outary[$_] .= "$qstat<BR>";
	        }
	        $outary[$_] .= "</NOBR></font>
					    </TD>
					    <TD valign=top><font size=2><NOBR>";
	        $holdmcm = $_;
	        $endidx = $#qstatc - 3;
	        for (0 .. $endidx) {
		    $outary[$_] .= "$qstatc[$_]<BR>";
	        }
	        $outary[$_] .= "</NOBR></font>
					    </TD>
					    <TD valign=top><font size=2><NOBR>";
	        for (0 .. $endidx) {
		    $outary[$_] .= "$qstatp[$_]\%<BR>";
	        }
	        $_ = $holdmcm;
	        $outary[$_] .= "</NOBR></font>
					    </TD>
				    </TR>
			    </TABLE>
		    </TD>
	    </TR>";
	    } elsif ($qstatsqf[$qid] eq 'esa') {
	        $outary[$_] .= "
	    <TR>
		    <TD colspan=3>
			    <TABLE cellpadding=2 cellspacing=0 border=1>
				    <TR>
					    <TD colspan=3 align=center><font size=2>BREAKDOWN OF $xlatphrase[137] RESPONSES<font></TD>
				    </TR>
				    <TR>
					    <TD valign=top><font size=2><NOBR>Response Option</NOBR></font></TD>
					    <TD valign=top><font size=2><NOBR>Cnt</NOBR></font></TD>
					    <TD valign=top><font size=2><NOBR>Pct</NOBR></font></TD>
				    </TR>
				    <TR>
					    <TD valign=top><font size=2><NOBR>";
	        foreach $qstat (@qstato) {
		    $outary[$_] .= "$qstat<BR>";
	        }
	        $outary[$_] .= "</NOBR></font>
					    </TD>
					    <TD valign=top><font size=2><NOBR>";
	        $holdmcm = $_;
	        $endidx = $#qstatc - 3;
	        for (0 .. $endidx) {
		    $outary[$_] .= "$qstatc[$_]<BR>";
	        }
	        $outary[$_] .= "</NOBR></font>
					    </TD>
					    <TD valign=top><font size=2><NOBR>";
	        for (0 .. $endidx) {
		    $outary[$_] .= "$qstatp[$_]\%<BR>";
	        }
	        $_ = $holdmcm;
	        $outary[$_] .= "</NOBR></font>
					    </TD>
				    </TR>
			    </TABLE>
	    <p>";
	        $outary[$_] .= "
			    <TABLE cellpadding=2 cellspacing=0 border=1>
				    <TR>
					    <TD colspan=3 align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD>
				    </TR>
				    <TR>
					    <TD valign=top><font size=2><NOBR>Response Option</NOBR></font></TD>
					    <TD valign=top><font size=2><NOBR>Cnt</NOBR></font></TD>
					    <TD valign=top><font size=2><NOBR>Pct</NOBR></font></TD>
				    </TR>
				    <TR>
					    <TD valign=top><font size=2><NOBR>";
	        foreach $qstat (@qstatw) {
		    $outary[$_] .= "$qstat<BR>";
	        }
	        $outary[$_] .= "</NOBR></font>
					    </TD>
					    <TD valign=top><font size=2><NOBR>";
	        $holdmcm = $_;
	        foreach (@qstatsqwc) {
		    $outary[$_] .= "$_<BR>";
	        }
	        $outary[$_] .= "</NOBR></font>
					    </TD>
					    <TD valign=top><font size=2><NOBR>";
	        foreach (@qstatsqwp) {
		    $outary[$_] .= "$_\%<BR>";
	        }
	        $_ = $holdmcm;
	        $outary[$_] .= "</NOBR></font>
					    </TD>
				    </TR>
			    </TABLE>
		    </TD>
	    </TR>";
	    } elsif ($qstatsqf[$qid] eq 'nrt' ) {
                
	        ##### v ADT - 7/03/2002 ################################################
	        # If you want to remove the NRT statistics, delete between these comments
	        ########################################################################
	        $outary[$_] .= "
	    <TR>
		    <TD valign=top><font size=2><NOBR>";
	        if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
		    $outary[$_] .="$qstatc[2]<BR>$qstatc[1]";
	        } else {
		    $outary[$_] .="<B>$qstatc[0]</B><BR>$qstatc[2]<BR>$qstatc[1]";
	        }
	        $outary[$_] .= "</NOBR></font>
		    </TD>
		    <TD valign=top><font size=2><NOBR>";
	        if ($FORM{'exnoresp'}) {
		    if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
		        $outary[$_] .="&nbsp;<BR>$qstatp[1]\%";
		    } else {
		        $outary[$_] .="<B>$qstatp[0]\%</B><BR>&nbsp;<BR>$qstatp[1]\%";
		    }
	        } else {
		    if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
		        $outary[$_] .="$qstatp[2]\%<BR>$qstatp[1]\%";
		    } else {
		        $outary[$_] .="<B>$qstatp[0]\%</B><BR>$qstatp[2]\%<BR>$qstatp[1]\%";
		    }
	        }
	        $outary[$_] .= "</NOBR></font>
		    </TD>
		    <TD valign=top><font size=2><NOBR>";
	        if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
		    $outary[$_] .="$qstato[1]<BR>$qstato[0]";
	        } else {
		    $outary[$_] .="<B>$qstato[0]</B><BR>$qstato[2]<BR>$qstato[1]";
	        }
	        $outary[$_] .= "</NOBR>";
	        $outary[$_] .= "</font>
		    </TD>
		    <TD>&nbsp;</TD>
	    </TR>";
	        $outary[$_] .= "
	    <TR>
		    <TD valign=top colspan=3>&nbsp;</TD>";
	        $outary[$_] .= "
		    <TD valign=top colspan=3><font size=2>";
	        if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
		    $outary[$_] .="<BR>$qstato[2]";
	        } else {
		    $outary[$_] .="<BR>$qstato[3]";
	        }
	        $outary[$_] .= "</font>
		    </TD>
	    </TR>";
	        ##### ^ ADT - 7/03/2002 - End Delete ###################################
	        
	        ##### v ADT - 7/03/2002 ################################################
	        #  Added code to print NRT answers in the form of the comments
	        ########################################################################
                #print "\n\t<TR>\n\t\t<TD colspan=3>";
                #print "\n\t\t\t<TABLE>\n\t\t\t\t<TR>\n";
                #print "\t\t\t\t\t<TD align=right valign=top><font size=2><b><i>Answers:</i></b><br></font></td>\n";
                #print "\t\t\t\t\t<TD><font size=2>";
	        #for $i (0 .. $#qresponses) {
	        #@columns=split(/\&/, $qresponses[$i]);
	        #if ($columns[0] eq $qid) {
	        #print "<b>$columns[1]\:</b><br>\n";
	        #while (length($columns[2]) > 50) {
	        #$j=index($columns[2]," ",45);
	        #if ($j==-1) {
	        #$qresponse=substr($columns[2],0,50);
	        #$columns[2]=substr($columns[2],50);
	        #} else {
	        #$qresponse=substr($columns[2],0,$j);
	        #$j++;
	        #$columns[2]=substr($columns[2],$j);
	        #}
	        #print "$qresponse<br>\n";
	        #}
	        #print "$columns[2]<br>\n";
	        #}
	        #}
	        #
                #print "</font></TD>\n";
                #print "\t\t\t\t</TR>\n";
                #print "\t\t\t</TABLE>\n\t\t</TD>\n\t</TR>\n";
	        ##### ^ ADT - 7/03/2002 ################################################
	        
	    } else {
	        if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
		    $bs = "";
		    $be = "";
	        } else {
		    $bs = "<B>";
		    $be = "</B>";
	        }
	        $outary[$_] .= "
	    <TR>
		    <TD valign=top><font size=2><NOBR>";
	        $boldtag = $bs;
	        $boldtagend = $be;
	        foreach $qstat (@qstatc) {
		    $outary[$_] .= "$boldtag$qstat$boldtagend<BR>";
		    $boldtag = "";
		    $boldtagend = "";
	        }
	        $outary[$_] .= "</NOBR></font>
		    </TD>
		    <TD valign=top><font size=2><NOBR>";
	        $boldtag = $bs;
	        $boldtagend = $be;
	        foreach $qstat (@qstatp) {
		    $outary[$_] .= "$boldtag$qstat\%$boldtagend<BR>";
		    $boldtag = "";
		    $boldtagend = "";
	        }
	        $outary[$_] .= "</NOBR></font>
		    </TD>
		    <TD valign=top><font size=2><NOBR>";
	        $boldtag = $bs;
	        $boldtagend = $be;
	        foreach $qstat (@qstato) {
		    $outary[$_] .= "$boldtag$qstat$boldtagend<BR>";
		    $boldtag = "";
		    $boldtagend = "";
	    	}
	        $outary[$_] .= "</NOBR></font>
		    </TD>
	    </TR>\n";
	    }
	    if (($FORM{'showcmts'} eq 'withq') && ($#qucmts != -1)) {
	        ##### v ADT - 7/03/2002 ################################################
	        #  Modified code to add the comments to the same table cell as the
	        #  answers if the question is a Narrative question
	        ########################################################################
                #if( $qstatsqf[$qid] ne 'nrt' ) {
		    print "\t<TR>\n\t\t<TD colspan=3>\n\t\t\t<TABLE>";
                #}
	        $outary[$_] .= "<TR>
					    <TD align=right valign=top>\n<font size=2><b><i>Comments:</i></b><br></font></td>
					    <TD><font size=2>\n";
	        ##### ^ ADT - 7/03/2002 ################################################
	        for $i (0 .. $#qucmts) {
		    @columns=split(/\&/, $qucmts[$i]);
		    if ($columns[0] eq $qid) {
		        $outary[$_] .= "<b>$columns[1]\:</b><br>\n";
		        while (length($columns[2]) > 50) {
			    $j=index($columns[2]," ",45);
			    if ($j==-1) {
			        $qucmt=substr($columns[2],0,50);
			        $columns[2]=substr($columns[2],50);
			    } else {
			        $qucmt=substr($columns[2],0,$j);
			        $j++;
			        $columns[2]=substr($columns[2],$j);
			    }
			    $outary[$_] .= "$qucmt<br>\n";
		        }
		        $outary[$_] .= "$columns[2]<br>\n";
		    }
	        }
	        $outary[$_] .= "</font></TD>
				    </TR>
			    </TABLE>
		    </TD>
	    </TR>\n";
	    }
	    $outary[$_] .= "
	    <TR>
		    <TD colspan=6><HR WIDTH=\"100\%\"></TD>
	    </TR>\n";
	    @qstato = ();
	    @qstatc = ();
	    @qstatp = ();
        }
    }
}
if (($FORM{'showcmts'} =~ /^atend/) && ($#qucmts != -1)) {
    $outary[$_] .= "<TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>\n";
    $outary[$_] .= "<TR><TD colspan=6 align=center><B>Comments</B>" ;
		if ($HBI_Debug_IntegroTS  ) {
			print " Debug Tested showcmts." ;
		}
		$outary[$_] .= "</TD></TR>\n";
    $outary[$_] .= "<TR><TD colspan=6>\n";
    $outary[$_] .= "<TABLE><TR><TD><B>ID</B></TD><TD><B>User</B></TD><TD><B>Comments</B></TD></TR>\n";
    for (1 ..$#questions) {
	($test,$qid) = split(/\./, $qstatsid[$_]);
	if ($qstatsqf[$qid] ne 'obs') {
	    for $i (0 .. $#qucmts) {
		@columns=split(/\&/, $qucmts[$i]);
		if ($columns[0] eq $qid) {
		    $outary[$_] .= "<TR>\n";
		    $outary[$_] .= "<TD valign=top><font size=2>$qstatsid[$_]</font></td>\n";
		    $outary[$_] .= "<TD valign=top><font size=2>$columns[1]</font></td>\n";
		    $outary[$_] .= "<TD valign=top><font size=2>\n";
		    while (length($columns[2]) > 70) {
			$j=index($columns[2]," ",65);
			if ($j==-1) {
			    $qucmt=substr($columns[2],0,70);
			    $columns[2]=substr($columns[2],70);
			} else {
			    $qucmt=substr($columns[2],0,$j);
			    $j++;
			    $columns[2]=substr($columns[2],$j);
			}
			$outary[$_] .= "$qucmt<br>\n";
		    }
		    $outary[$_] .= "$columns[2]<br>\n";
		    $outary[$_] .= "</font></td>\n";
		    $outary[$_] .= "</TR>\n";
		}
	    }
	    $outary[$_] .= "<TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>\n";
	}
    }
    $outary[$_] .= "</TD>\n</TR>\n</TABLE>\n</TD>\n</TR>\n";
}
@qucmts=();
# Read in .rgo file which defines question presentation order
if ($FORM{'tstid'} =~ /SAS/) {
	$lookupfile = join($pathsep,$dataroot,"IntegroSAS.rgo");
  } elsif ($FORM{'tstid'} =~ /^TAQ/) {
  	$lookupfile = join($pathsep,$dataroot,"IntegroTAQ.rgo");
}
if (-e $lookupfile) {
	my $fh = new FileHandle;
	if ($fh->open($lookupfile)) {
		$out = "";
		my @lines = <$fh>;
		$fh->close();
		shift @lines;
		foreach (@lines) {
			chomp;
			my @line = split(/\&/,$_);
			my $section = shift @line;
			if ($section ne "") {
				$out .= "<tr><td colspan=6><font size=+1><b>$section</b></font></td></tr>\n";
				$out .= "<tr><td colspan=6><hr width=\"100\%\"></td></tr>\n";
			}
			foreach my $sub (@line) {
				my ($subheader, $quess) = split(/:/,$sub);
				if ($subheader ne "") {
					$out .= "<tr><td colspan=6><b>$subheader:</b></td></tr>\n";
				}
				@ques = split(/\,/,$quess);
				foreach my $quesid (@ques) {
					$out .= $outary[$quesid];
				}
			}
		}
		print $out;
	}
} else {
	for (1 ..$#questions) {
		print $outary[$_];
	}
}
if ($FORM{'showobs'}) {
    print "$sobsolete";
}
print "</TABLE>\n";
print "</blockquote>\n";
print HTMLFooter();
}

sub HTMLHeaderPlain {
    return "<html>\n<head>\n<title>$_[0]</title>\n".
	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
	"<BODY>\n";
}

sub HTMLFooter {
    my $year = `date +%Y`;
    return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) 2004-$year, Integro Leadership Institute<center></font></body>\n</html>\n";
}

#
#
#