You can not select more than 25 topics
			Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
		
		
		
		
		
			
		
			
				
					
					
						
							2531 lines
						
					
					
						
							76 KiB
						
					
					
				
			
		
		
		
			
			
			
				
					
				
				
					
				
			
		
		
	
	
							2531 lines
						
					
					
						
							76 KiB
						
					
					
				
								#!/usr/bin/perl
							 | 
						|
								#
							 | 
						|
								# $Id: teststats.pl,v 1.39 2006/11/17 21:26:03 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';
							 | 
						|
								require 'LikertData.pl';
							 | 
						|
								use InMem ;
							 | 
						|
								
							 | 
						|
								#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 );
							 | 
						|
								
							 | 
						|
								$HBI_Debug_Cycle_Count = 1 ;
							 | 
						|
								
							 | 
						|
								&app_initialize;
							 | 
						|
								
							 | 
						|
								$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
							 | 
						|
								
							 | 
						|
								&LanguageSupportInit();
							 | 
						|
								&get_session($FORM{'tid'});
							 | 
						|
								&get_client_profile($SESSION{'clid'});
							 | 
						|
								my @sortbys = qw(Name LoginID Date Score);
							 | 
						|
								my ($bExport,$idlist);
							 | 
						|
								if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
							 | 
						|
								    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
							 | 
						|
								}
							 | 
						|
								    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'}";
							 | 
						|
								
							 | 
						|
								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;
							 | 
						|
								}
							 | 
						|
								
							 | 
						|
								$HBI_Debug_Cycle_Count ++ ;
							 | 
						|
								warn "HBI_Debug_Cycle_Count $HBI_Debug_Cycle_Count \n" ;
							 | 
						|
								
							 | 
						|
								if (&get_session($FORM{'tid'})) {
							 | 
						|
								    if ($FORM{'testsummary'} eq 'composite') {
							 | 
						|
								  warn "Call show_test_composite $idlist " ;
							 | 
						|
									&show_test_composite($idlist);
							 | 
						|
								    } elsif ($FORM{'testsummary'} eq 'bycnd') {
							 | 
						|
									warn "Call show_test_resultsbycnd $idlist " ;
							 | 
						|
									warn "HBI_Debug_Cycle_Count $HBI_Debug_Cycle_Count \n" ;
							 | 
						|
									&show_test_resultsbycnd($idlist);
							 | 
						|
									warn "HBI_Debug_Cycle_Count Done \n" ;
							 | 
						|
								    } else {
							 | 
						|
									warn "Call extract_test_data " ;
							 | 
						|
									&extract_test_data();
							 | 
						|
								    }
							 | 
						|
								}
							 | 
						|
								if ($bExport) {
							 | 
						|
								    exit(0);
							 | 
						|
								}
							 | 
						|
								
							 | 
						|
								sub extract_test_data() {
							 | 
						|
								    &LanguageSupportInit();
							 | 
						|
								    &get_client_profile($SESSION{'clid'});
							 | 
						|
								    &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
							 | 
						|
								    if ($FORM{'shwpending'}) {
							 | 
						|
									$testdir = $testpending;
							 | 
						|
									$testhdr = "Pending";
							 | 
						|
								    } else {
							 | 
						|
									$testdir = $testcomplete;
							 | 
						|
									$testhdr = "Completed Responses";
							 | 
						|
								    }
							 | 
						|
								    my @filelist = &get_test_result_files($testdir, "$CLIENT{'clid'}","$TEST{'id'}");
							 | 
						|
								    my @converter;
							 | 
						|
									if ($SESSION{'uid'} ne '') {
							 | 
						|
										my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar");
							 | 
						|
										if ($imaregistrar eq 'Y') {
							 | 
						|
								    			foreach $rotator (@filelist) {
							 | 
						|
												my @cnd = split(/\./, $rotator);
							 | 
						|
												my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby");
							 | 
						|
												push(@converter, $rotator) unless $creator ne $SESSION{'uid'};
							 | 
						|
											}
							 | 
						|
											@filelist = @converter;
							 | 
						|
								    		}
							 | 
						|
									} else {
							 | 
						|
										&logger::logerr("No SESSION{uid} set!");
							 | 
						|
									}
							 | 
						|
								    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{'cnddat'}) {
							 | 
						|
									push @colhdrs,"left:Date";
							 | 
						|
								    }
							 | 
						|
								    if ($FORM{'excnd1'}) {
							 | 
						|
									push @colhdrs,"left:$CLIENT{'clcnd1'}";
							 | 
						|
								    }
							 | 
						|
								    if ($FORM{'excnd2'}) {
							 | 
						|
									push @colhdrs,"left:$CLIENT{'clcnd2'}";
							 | 
						|
								    }
							 | 
						|
								    if ($FORM{'excnd3'}) {
							 | 
						|
									push @colhdrs,"left:$CLIENT{'clcnd3'}";
							 | 
						|
								    }
							 | 
						|
								    if ($FORM{'excnd4'}) {
							 | 
						|
									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;
							 | 
						|
								    $cnd1_filter = $FORM{'cnd1'};
							 | 
						|
								    $cnd2_filter = $FORM{'cnd2'};
							 | 
						|
								    $cnd3_filter = $FORM{'cnd3'};
							 | 
						|
								    $cnd4_filter = $FORM{'cnd4'};
							 | 
						|
								    ($i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar) = &prepFilter($CLIENT{'clid'});
							 | 
						|
								    for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
							 | 
						|
									$user = $filelist[$fidx];
							 | 
						|
									$user =~ s/.$TEST{'id'}$//;
							 | 
						|
									$user =~ s/^$CLIENT{'clid'}.//;
							 | 
						|
									$filtered = &makeMeFilter($user, $CLIENT{'clid'}, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar);
							 | 
						|
									if (!$filtered) {
							 | 
						|
										my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'});
							 | 
						|
										if (not defined $history) {
							 | 
						|
											$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($testdir.$pathsep.$filelist[$fidx]))[9];
							 | 
						|
											$history->{'end'} = $mtime;
							 | 
						|
											$history->{'start'} = $history->{'end'};
							 | 
						|
										}
							 | 
						|
										$completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'});
							 | 
						|
										$displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'});
							 | 
						|
										if (&date_out_of_range($completedat,$datefm,$dateto)) {
							 | 
						|
											next;
							 | 
						|
										}
							 | 
						|
										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{'cnddat'}) {
							 | 
						|
										    $row=join($joint,$row,"$displaydate");
							 | 
						|
										}
							 | 
						|
										if ($FORM{'excnd1'}) {
							 | 
						|
										    $row=join($joint,$row,"$CANDIDATE{'cnd1'}");
							 | 
						|
										}
							 | 
						|
										if ($FORM{'excnd2'}) {
							 | 
						|
										    $row=join($joint,$row,"$CANDIDATE{'cnd2'}");
							 | 
						|
										}
							 | 
						|
										if ($FORM{'excnd3'}) {
							 | 
						|
										    $row=join($joint,$row,"$CANDIDATE{'cnd3'}");
							 | 
						|
										}
							 | 
						|
										if ($FORM{'excnd4'}) {
							 | 
						|
										    $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=();
							 | 
						|
								    &print_report_dataextract_header($#sorted+1,@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'} ($TEST{'id'})\n";
							 | 
						|
									print "Raw Data Extraction\n";
							 | 
						|
									print "$ncount $testhdr\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'} ($TEST{'id'})</B><BR>\n";
							 | 
						|
									print "<B>Raw Data Extraction</B><BR>\n";
							 | 
						|
									print "<font size=2><I>$ncount $testhdr</I></font>\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";
							 | 
						|
								    }
							 | 
						|
								}
							 | 
						|
								
							 | 
						|
								
							 | 
						|
								$^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;
							 | 
						|
								    } elsif ($sortby eq 'Score') {
							 | 
						|
									#print STDERR "by Score\n";
							 | 
						|
									my $scoreidx=$#{$rows[0]->{'columns'}}-1;
							 | 
						|
									return sort {$a->{'columns'}->[$scoreidx] <=> $b->{'columns'}->[$scoreidx];} @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 @converter;
							 | 
						|
								        if ($SESSION{'uid'} ne '') {
							 | 
						|
								                my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar");
							 | 
						|
								                if ($imaregistrar eq 'Y') {
							 | 
						|
								                	foreach $rotator (@filelist) {
							 | 
						|
								                       	 	my @cnd = split(/\./, $rotator);
							 | 
						|
								                                my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby");
							 | 
						|
								                                push(@converter, $rotator) unless $creator ne $SESSION{'uid'};
							 | 
						|
								                        }
							 | 
						|
								        		@filelist = @converter;
							 | 
						|
								                }
							 | 
						|
									} else {
							 | 
						|
										&logger::logerr("No SESSION{uid} set!");
							 | 
						|
									}
							 | 
						|
								    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;
							 | 
						|
									
							 | 
						|
								    $cnd1_filter = $FORM{'cnd1'};
							 | 
						|
								    $cnd2_filter = $FORM{'cnd2'};
							 | 
						|
								    $cnd3_filter = $FORM{'cnd3'};
							 | 
						|
								    $cnd4_filter = $FORM{'cnd4'};
							 | 
						|
								    ($i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar) = &prepFilter($CLIENT{'clid'});
							 | 
						|
								    for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
							 | 
						|
									$user = $filelist[$fidx];
							 | 
						|
									$user =~ s/.$TEST{'id'}$//;
							 | 
						|
									$user =~ s/^$CLIENT{'clid'}.//;
							 | 
						|
								
							 | 
						|
									$creator = &get_a_key("cnd.$CLIENT{'clid'}", $user, "createdby");
							 | 
						|
								
							 | 
						|
									$filtered = &makeMeFilter($user, $CLIENT{'clid'}, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar);
							 | 
						|
									if (!$filtered) {
							 | 
						|
										my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'});
							 | 
						|
										if (not defined $history) {
							 | 
						|
											$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'};
							 | 
						|
										}
							 | 
						|
										$completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'});
							 | 
						|
										$displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'});
							 | 
						|
										my $excuser="inc$user";
							 | 
						|
										if ($FORM{$excuser} || &date_out_of_range($completedat,$datefm,$dateto)) {
							 | 
						|
									    		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'};
							 | 
						|
										my @historic_tests = getHistoricTests($testcomplete,$CLIENT{'clid'},$FORM{'tstid'},$user);
							 | 
						|
										my $numhistoric = $#historic_tests;
							 | 
						|
										if ($numhistoric >= 0) {
							 | 
						|
											$row->{'numprevious'} = "<a href=/cgi-bin/creports003.pl?tid=$FORM{'tid'}&frm=4&rptno=ACT-C-003&cndid=$user&clid=$CLIENT{'clid'}&tstid=$FORM{'tstid'}&multiple=0&tstsel=$FORM{'tstid'} target=_blank>".$numhistoric."</a>";
							 | 
						|
										} else {
							 | 
						|
											$row->{'numprevious'} = "No History";
							 | 
						|
										}
							 | 
						|
										$historic_tests = ();
							 | 
						|
										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];
							 | 
						|
									}
							 | 
						|
									if ($TEST{'minpass'} ne '') {
							 | 
						|
										$pf = ($qsumry[2] >= $TEST{'minpass'}) ? '<font color=green>P</font>' : '<font color=red>F</font>';
							 | 
						|
									} else {
							 | 
						|
										$pf = "N/A";
							 | 
						|
									}
							 | 
						|
									push @{$row->{'columns'}},$qsumry[0],$qsumry[1],$qsumry[2], $pf;
							 | 
						|
									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($#sorted+1,$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 = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'start'}))[0..2]));
							 | 
						|
									    $end = sprintf("%02d:%02d:%02d",reverse((gmtime($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[-4] + $cols[-3];
							 | 
						|
									    
							 | 
						|
									    my $params = "tid=$SESSION{'tid'}&clid=$CLIENT{'clid'}&cndid=".
							 | 
						|
										uri_escape($cols[1]).
							 | 
						|
										"&tstid=$FORM{'tstid'}&correct=$cols[-4]&incorrect=$cols[-3]&total=$total&percent=$cols[-2]";
							 | 
						|
									    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) {
							 | 
						|
									    print "\t\t<TD rowspan=$rowspan align=left valign=top>$row->{'numprevious'}</TD>\n";
							 | 
						|
									    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-3;
							 | 
						|
										    if ($bExport) {
							 | 
						|
											print "$cols[$fidx++]\t";
							 | 
						|
											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";
							 | 
						|
											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-3;
							 | 
						|
									    if ($bExport) {
							 | 
						|
										print "$cols[$j++]\t";
							 | 
						|
										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";
							 | 
						|
										print "\t\t<TD rowspan=$rowspan align=left valign=top>$row->{'numprevious'}</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";
							 | 
						|
										    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=6 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>\ \;<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=7 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=11 valign=cemter><HR width=100\%></TD>\n";
							 | 
						|
									    print "\t</TR>\n";
							 | 
						|
									}
							 | 
						|
								    } else {
							 | 
						|
									if ($bExport == 0) {
							 | 
						|
									    print "\t<TR>\n";
							 | 
						|
									    print "\t\t<TD colspan=11 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+4;
							 | 
						|
								    if ($bysubj) {
							 | 
						|
									$colspan2+=6;
							 | 
						|
									$titlesfx=" (Subject Area)";
							 | 
						|
								    } else {
							 | 
						|
									$colspan2=11;
							 | 
						|
								    }
							 | 
						|
								    my $sortspan = int($colspan2/8);  # wac changed 4 to 8 to make columns closer
							 | 
						|
								    if ($bExport) {
							 | 
						|
									print "$TEST{'desc'} ($TEST{'id'})\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'} ($TEST{'id'})</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 "\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> <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 rowspan=2 valign=bottom><font size=2><B># Previous</B></font></TD>\n";
							 | 
						|
									    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 rowspan=2 valign=bottom><font size=2><B># Previous</B></font></TD>\n";
							 | 
						|
									}	    
							 | 
						|
									print "\t\t<TD colspan=4 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>\ \;</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\t<TD align=center valign=top><font size=2><B>P/F</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;
							 | 
						|
										my %Likert_points = () ;
							 | 
						|
										my %Likert_score = () ;
							 | 
						|
								    &get_client_profile($SESSION{'clid'});
							 | 
						|
								    &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
							 | 
						|
								    @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
							 | 
						|
								    my @converter;
							 | 
						|
								        if ($SESSION{'uid'} ne '') {
							 | 
						|
								                my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar");
							 | 
						|
								                if ($imaregistrar eq 'Y') {
							 | 
						|
								                	foreach $rotator (@filelist) {
							 | 
						|
								                        	my @cnd = split(/\./, $rotator);
							 | 
						|
								                                my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby");
							 | 
						|
								                                push(@converter, $rotator) unless $creator ne $SESSION{'uid'};
							 | 
						|
								                        }
							 | 
						|
								        		@filelist = @converter;
							 | 
						|
								                }
							 | 
						|
									} else {
							 | 
						|
										&logger::logerr("No SESSION{uid} set!");
							 | 
						|
									}
							 | 
						|
										# Get the questions for the test.
							 | 
						|
								    @questions = &get_question_list($TEST{'id'},$CLIENT{'clid'});
							 | 
						|
								    $qhdr = shift @questions;
							 | 
						|
										# Load field ids into a hash. The key is the field id. The value is the array index.
							 | 
						|
										my @field_ids = split(/\&/, $qhdr) ;
							 | 
						|
										my %field_ids = () ;
							 | 
						|
										my @qstatsscores = () ;
							 | 
						|
										my @qstatssupercat = () ;
							 | 
						|
										my %qids_supercat = () ;
							 | 
						|
										my @qstatspts = () ;
							 | 
						|
										for (0 .. $#field_ids) {
							 | 
						|
											# The first field_ids is the hash, the second is the array.
							 | 
						|
											my $field_token = $field_ids[$_] ;
							 | 
						|
											$field_token =~ s/\s$// ;  # Clean white space off the end.
							 | 
						|
											$field_ids{$field_token} = $_ ;
							 | 
						|
										}
							 | 
						|
								    @sorted = sort @questions;
							 | 
						|
								    @questions = @sorted;
							 | 
						|
								    unshift @questions, $qhdr;
							 | 
						|
								    @sorted = ();
							 | 
						|
								    for (1 .. $#questions) {
							 | 
						|
									# Preprocess each of the questions, by loading data
							 | 
						|
									#   about each of the questions into a series of arrays.
							 | 
						|
									#   Each array has a specific kind of data about every question.
							 | 
						|
									#  Do not process $questions[0] because that is the line with field ids.
							 | 
						|
									($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$_]);
							 | 
						|
									my @Q_array = split(/\&/, $questions[$_]);
							 | 
						|
									my $SCat ;
							 | 
						|
									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
							 | 
						|
								  $qstatpts[$qid] = $Q_array[$field_ids{'pts'}] ;
							 | 
						|
									# Fill in Scores and Category for likert scale question.
							 | 
						|
									if ($qtp eq 'lik') {
							 | 
						|
										$qstatsscores[$qid] = $Q_array[$field_ids{'scores'}] ;
							 | 
						|
										$SCat = $Q_array[$field_ids{'supercat'}] ;
							 | 
						|
										$SCat =~ s/\s+$// ;
							 | 
						|
										$qstatssupercat[$qid] = $SCat ;
							 | 
						|
								  } else {
							 | 
						|
										$SCat = "" ;
							 | 
						|
										$qstatsscores[$qid] = "" ; # Scores for likert scale question.
							 | 
						|
										$qstatssupercat[$qid] = "" ; # Category for likert scale question.
							 | 
						|
									}
							 | 
						|
									if ($qids_supercat{$SCat}) {
							 | 
						|
										push (@{$qids_supercat{$SCat}}, $qid) ;
							 | 
						|
									} else {
							 | 
						|
										$qids_supercat{$SCat} = [$qid] ;
							 | 
						|
									}
							 | 
						|
									# $qallans is all answers separated by semi-colons.
							 | 
						|
									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";
							 | 
						|
									    }
							 | 
						|
									    if ($qtp eq 'esa') { $qallans =~ s/\,/\;/g; }
							 | 
						|
									    $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') {
							 | 
						|
								
							 | 
						|
										@qstato = split(/\;/, $qallans);
							 | 
						|
										if ($qtp eq 'mtr') 
							 | 
						|
										{
							 | 
						|
										### ASSUMES rank=1..10 - need to allow for other ranks
							 | 
						|
										    # 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 = ();
							 | 
						|
								    } 
							 | 
						|
								# End of Preprocessing questions.
							 | 
						|
								# HBI - Prepare to process answers from Candidates.
							 | 
						|
								    $ncount = $#filelist + 1;
							 | 
						|
								    @qucmts=();
							 | 
						|
								    $nresponses=$#filelist+1;
							 | 
						|
								# HBI - Loop for each Candidate.
							 | 
						|
								    for (my $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) {
							 | 
						|
									    	$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'};
							 | 
						|
									}
							 | 
						|
									$completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'});
							 | 
						|
									$displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'});
							 | 
						|
									if (&date_out_of_range($completedat,$datefm,$dateto)) {
							 | 
						|
									       $nresponses--;
							 | 
						|
										next;
							 | 
						|
									}
							 | 
						|
									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});
							 | 
						|
									# warn "Client $CLIENT{'clid'}, User ID $user, Test $TEST{'id'} " ;
							 | 
						|
									# warn "SUBTEST_QUESTIONS $SUBTEST_QUESTIONS{2} \n";
							 | 
						|
									# warn "SUBTEST_RESPONSES $SUBTEST_RESPONSES{2} \n";
							 | 
						|
									# warn "SUBTEST_SUMMARY $SUBTEST_SUMMARY{2} \n";
							 | 
						|
									if ($qsumry[5] eq "TIME EXPIRED") {
							 | 
						|
										@corincs = split(/\//, $qsumry[6]);
							 | 
						|
									} else {
							 | 
						|
										@corincs = split(/\//, $qsumry[5]);
							 | 
						|
									}
							 | 
						|
									@qsumry = ();
							 | 
						|
									@qsumry = split(/\&/, $SUBTEST_ANSWERS{2});
							 | 
						|
									# warn "SUBTEST_ANSWERS $SUBTEST_ANSWERS{2} " ;
							 | 
						|
									@qansseq = ();
							 | 
						|
									$fqid="";
							 | 
						|
									$fqididx="";
							 | 
						|
								# HBI - Now loop thru each answer given by $user.
							 | 
						|
								# HBI - $_ will be the sequential number of the question.
							 | 
						|
									for (1 .. $#qids) {
							 | 
						|
									    ($test,$qidx) = split(/\./, $qids[$_]);
							 | 
						|
											unless ($Comments{$qidx}) {
							 | 
						|
												$Comments{$qidx} = {} ;
							 | 
						|
											}
							 | 
						|
											unless ($Text_Responses{$qidx}) {
							 | 
						|
												$Text_Responses{$qidx} = {} ;
							 | 
						|
											}
							 | 
						|
									    ($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
							 | 
						|
									    if ($qucmt ne '') {
							 | 
						|
												$qucmt =~ tr/+/ /;
							 | 
						|
												$qucmt =~ tr/'//d;
							 | 
						|
												if ($FORM{'anoncmts'}) {
							 | 
						|
													push @qucmts, "$qidx\&User $fidx\&$qucmt";
							 | 
						|
													&InMem::InsertQuesComment($SESSION{'clid'}, "User $fidx", $FORM{'tstid'}, "complete", $_, $qucmt) ;
							 | 
						|
												} else {
							 | 
						|
													push @qucmts, "$qidx\&$user\&$qucmt";
							 | 
						|
													&InMem::InsertQuesComment($SESSION{'clid'}, $user, $FORM{'tstid'}, "complete", $_, $qucmt) ;
							 | 
						|
													warn "Comment $SESSION{'clid'}, $user, $FORM{'tstid'}, complete, $_, $qucmt \n" ;
							 | 
						|
												}
							 | 
						|
									    }
							 | 
						|
									    ### 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]);
							 | 
						|
											# warn "fqididx $fqididx qansseq $qansseq[$fqididx] " ;
							 | 
						|
									    shift @fqansseq;
							 | 
						|
									    @fans=split(/\&/,$FORM{'answer'});
							 | 
						|
											# warn "answer $FORM{'answer'} " ;
							 | 
						|
									    shift @fans;
							 | 
						|
									    foreach $fans (@fans) {
							 | 
						|
												# warn "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;
							 | 
						|
										}
							 | 
						|
										# warn "fqididx II $fqididx qrsp $qrsp[$fqididx] fresp $fresp fmatch $fmatch " ;
							 | 
						|
										@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 '') {
							 | 
						|
										    $qresp = lc($qresp);
							 | 
						|
										    # 
							 | 
						|
										    # 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'){
							 | 
						|
										if ($qrsp[$_] ne '') {
							 | 
						|
										    $qstatc[1]++;
							 | 
						|
										    $qrsp[$_] =~ s/\;/\:/g;
							 | 
						|
										    $qrsp[$_] =~ s/\r//g;
							 | 
						|
										    $qrsp[$_] =~ s/\n/\\n/g;
							 | 
						|
												if ($qrsp[$_]) {
							 | 
						|
									    		if ($FORM{'anoncmts'}) {
							 | 
						|
														push @qresponses, "$qidx\&User $fidx\&$qrsp[$_]";
							 | 
						|
														&InMem::InsertQuesResp($SESSION{'clid'}, "User $fidx", $FORM{'tstid'}, "complete", $_, $qrsp[$_]) ;
							 | 
						|
									    		} else {
							 | 
						|
														push @qresponses, "$qidx\&$user\&$qrsp[$_]";
							 | 
						|
														&InMem::InsertQuesResp($SESSION{'clid'}, $user, $FORM{'tstid'}, "complete", $_, $qrsp[$_]) ;
							 | 
						|
														# warn "Response $SESSION{'clid'}, $user, $FORM{'tstid'}, complete, $_, $qrsp[$_] \n" ;
							 | 
						|
									    		}
							 | 
						|
												}
							 | 
						|
										    
							 | 
						|
										    $qstatsqr[$qidx] = join('<br>',$qstatsqr[$qidx],$qrsp[$_]);
							 | 
						|
										} else {
							 | 
						|
										    $qstatc[2]++;
							 | 
						|
										}
							 | 
						|
									    } elsif ($qstatsqf[$qidx] eq 'mcs' || $qstatsqf[$qidx] eq 'mca' ) {
							 | 
						|
										### DED Filter out "?" and "xxx" in qrsp so will match
							 | 
						|
										$qrsp[$_] =~ s/\?//g;
							 | 
						|
										$qrsp[$_] =~ s/xxx//g;
							 | 
						|
										@qansord = split(/\?/, $qansseq[$_]);
							 | 
						|
										shift @qansord;
							 | 
						|
										$found = 0;
							 | 
						|
										if ($qrsp[$_] ne '') {
							 | 
						|
										    $qstatc[$qansord[$qrsp[$_]]]++;
							 | 
						|
										    $found = 1;
							 | 
						|
										}
							 | 
						|
										unless ($found) { 
							 | 
						|
										    # increment "No Response"
							 | 
						|
										    $qstatc[$#qstatc]++;
							 | 
						|
										}
							 | 
						|
										@qansord = ();
							 | 
						|
									    } elsif ($qstatsqf[$qidx] eq 'lik') {
							 | 
						|
										# Process Likert Scale questions.
							 | 
						|
										my @Lik_score = split(/\,/ , $qstatsscores[$qidx]) ;
							 | 
						|
										$Likert_points{$qstatssupercat[$qidx]} += $qstatpts[$qidx] ;
							 | 
						|
										# warn "qidx $qidx supercat $qstatssupercat[$qidx] Likert_points $Likert_points{$qstatssupercat[$qidx]}" ;
							 | 
						|
										# warn "pts $qstatpts[$qidx] " ;
							 | 
						|
										# warn "qstatsqf $qstatsqf[$qidx] response $qrsp[$_] " ;
							 | 
						|
										### DED Filter out "?" and "xxx" in qrsp so will match
							 | 
						|
										$qrsp[$_] =~ s/\?//g;
							 | 
						|
										$qrsp[$_] =~ s/xxx//g;
							 | 
						|
										@qansord = split(/\?/, $qansseq[$_]);
							 | 
						|
										shift @qansord;
							 | 
						|
										$found = 0;
							 | 
						|
										if ($qrsp[$_] ne '') {
							 | 
						|
										    $qstatc[$qansord[$qrsp[$_]]]++;
							 | 
						|
												$Likert_score{$qstatssupercat[$qidx]} += $Lik_score[$qansord[$qrsp[$_]]] ;
							 | 
						|
												# warn "Inc answer ub $_ qrsp $qrsp[$_] qansord $qansord[$qrsp[$_]] qstatc $qstatc[$qansord[$qrsp[$_]]] " ;
							 | 
						|
												# warn "score $Lik_score[$_] qidx $qidx supercat $qstatssupercat[$qidx] TOT $Likert_score{$qstatssupercat[$qidx]} . " ;
							 | 
						|
										    $found = 1;
							 | 
						|
										}
							 | 
						|
										unless ($found) { 
							 | 
						|
										    # increment "No Response"
							 | 
						|
												# No Response is zero points on the Likert Scale.
							 | 
						|
										    $qstatc[$#qstatc]++;
							 | 
						|
												# warn "Inc No Resp. $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 = ();
							 | 
						|
								    }
							 | 
						|
								}
							 | 
						|
								# HBI - End of loop for each Candidate.
							 | 
						|
								
							 | 
						|
								if ($#qucmts != -1) {
							 | 
						|
								    @qsumry=sort @qucmts;
							 | 
						|
								    @qucmts=@qsumry;
							 | 
						|
								    @qsumry=();
							 | 
						|
								}
							 | 
						|
								# HBI - Begin to write the html output.
							 | 
						|
								print "<HTML>
							 | 
						|
								<HEAD>
							 | 
						|
								<!--
							 | 
						|
								$mymsg
							 | 
						|
								-->
							 | 
						|
								</HEAD>
							 | 
						|
								<BODY>
							 | 
						|
								<CENTER>
							 | 
						|
								<B>$TEST{'desc'} ($TEST{'id'})</B><BR>
							 | 
						|
								<B>Question Response Statistics</B><BR>";
							 | 
						|
								if (defined $idlist) {
							 | 
						|
								    print "<B>Groups: ".join(", ",split(/,/,$FORM{'idlist'}))."</b><br>\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>
							 | 
						|
									<TR>
							 | 
						|
										<TD rowspan=2 valign=top><B>ID</B></TD>
							 | 
						|
										<TD rowspan=2 valign=top><B>Occ</B></TD>
							 | 
						|
										<TD rowspan=2 valign=top><B>Pct</B></TD>
							 | 
						|
										<TD colspan=3 valign=top><B>Question Text</B></TD>
							 | 
						|
									</TR>
							 | 
						|
									<TR>
							 | 
						|
										<TD valign=top><font size=2><B>Cnt</B></font></TD>
							 | 
						|
										<TD valign=top><font size=2><B>Pct</B></font></TD>
							 | 
						|
										<TD valign=top><font size=2><B><NOBR>Options</NOBR></B></font></TD>
							 | 
						|
									</TR>
							 | 
						|
									<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);
							 | 
						|
									    }
							 | 
						|
								        } elsif ($qstatsqf[$qid] eq 'plc') {
							 | 
						|
										next;
							 | 
						|
								        } 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 = ( $qstatsqf[$qid] eq 'nrt' ) ? 3 : 2;
							 | 
						|
									        $rowspan2 = ( $qstatsqf[$qid] eq 'nrt' ) ? 3 : 2;
							 | 
						|
									    }
							 | 
						|
									    if (($FORM{'showcmts'} eq 'withq') && ($#qucmts != -1)) {
							 | 
						|
									        $rowspan1++;
							 | 
						|
									        $rowspan2++;
							 | 
						|
									    }
							 | 
						|
									    print "
							 | 
						|
									    <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) {
							 | 
						|
										    print "
							 | 
						|
									    <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>";
							 | 
						|
										    print "
							 | 
						|
									    <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 {
							 | 
						|
										    print "
							 | 
						|
									    <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>";
							 | 
						|
									        }
							 | 
						|
									        print "
							 | 
						|
									    <TR>
							 | 
						|
										    <TD valign=top><font size=2>$qstatcnor</font></TD>";
							 | 
						|
									        if ($FORM{'exnoresp'}) {
							 | 
						|
										    print "<TD valign=top><font size=2> </font></TD>\n";
							 | 
						|
									        } else {
							 | 
						|
										    print "<TD valign=top><font size=2>$qstatpnor\%</font></TD>\n";
							 | 
						|
									        }
							 | 
						|
									        print "<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 \>\;\>\;\>\;)";
							 | 
						|
										    @matchwords = ();
							 | 
						|
										    @matchtos = ();
							 | 
						|
										    foreach $qstat (@qstato) {
							 | 
						|
										        ($matchword, $matchto) = split(/\=\=\=/, $qstat);
							 | 
						|
										        push @matchwords, $matchword;
							 | 
						|
										        push @matchtos, $matchto;
							 | 
						|
										    }
							 | 
						|
										    push @matchtos, "Left Blank";
							 | 
						|
									        } else {
							 | 
						|
										    $sphrase = "(ordered as number \>\;\>\;\>\;)";
							 | 
						|
										    @matchwords = ();
							 | 
						|
										    @matchtos = @qstato;
							 | 
						|
										    $matchidx = 1;
							 | 
						|
										    foreach $qstat (@qstato) {
							 | 
						|
										        push @matchwords, "$matchidx";
							 | 
						|
										        $matchidx++;
							 | 
						|
										    }
							 | 
						|
										    push @matchtos, "Not Used";
							 | 
						|
									        }
							 | 
						|
									        $colspan = int((($#matchwords + 1) * 2) + 1);
							 | 
						|
									        print "<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) {
							 | 
						|
										    print "
							 | 
						|
													    <TD colspan=2 align=center><font size=2>$matchword</font></TD>";
							 | 
						|
									        }
							 | 
						|
									        print "
							 | 
						|
												    </TR>
							 | 
						|
												    <TR>";
							 | 
						|
									        foreach $matchword (@matchwords) {
							 | 
						|
										    print "
							 | 
						|
													    <TD align=center><font size=2>Cnt</font></TD>
							 | 
						|
													    <TD align=center><font size=2>Pct</font></TD>";
							 | 
						|
									        }
							 | 
						|
									        print "
							 | 
						|
												    </TR>";
							 | 
						|
									        $matchidx = 0;
							 | 
						|
									        foreach $matchto (@matchtos) {
							 | 
						|
										    print "
							 | 
						|
												    <TR>";
							 | 
						|
										    if ($matchto eq $matchtos[$#matchtos]) {
							 | 
						|
										        print "
							 | 
						|
													    <TD align=right valign=top><font size=2>$matchto</font></TD>";
							 | 
						|
										    } else {
							 | 
						|
										        print "
							 | 
						|
													    <TD valign=top><font size=2>$matchto</font></TD>";
							 | 
						|
										    }
							 | 
						|
										    foreach $matchword (@matchwords) {
							 | 
						|
										        print "
							 | 
						|
													    <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++;
							 | 
						|
										    }
							 | 
						|
										    print "
							 | 
						|
												    </TR>";
							 | 
						|
									        }
							 | 
						|
									        print "
							 | 
						|
											    </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;
							 | 
						|
									        }
							 | 
						|
									        print "
							 | 
						|
									    <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> </TD>";
							 | 
						|
									        foreach $qiacol (@qiac)
							 | 
						|
									        {
							 | 
						|
										    print "<TD colspan=$colspan2 align=center>$qiacol</TD>";
							 | 
						|
									        }
							 | 
						|
									        print "\n</TR>
							 | 
						|
												    <TR>
							 | 
						|
													    <TD> </TD>";
							 | 
						|
									        foreach $qiacol (@qiac)
							 | 
						|
									        {
							 | 
						|
										    if ($qstatsqf[$qid] eq 'mtr') 
							 | 
						|
										    {
							 | 
						|
										        print "<TD align=center><font size=2><NOBR>Rank</NOBR></font></TD>";
							 | 
						|
										    }
							 | 
						|
										    print "<TD align=center><font size=2><NOBR>Cnt</NOBR></font></TD>
							 | 
						|
														    <TD align=center><font size=2><NOBR>Pct</NOBR></font></TD>";
							 | 
						|
									        }
							 | 
						|
									        print "\n</TR>\n";
							 | 
						|
									        $i=0;
							 | 
						|
									        foreach $qiarow (@qiar)
							 | 
						|
									        {
							 | 
						|
										    print "<TR>
							 | 
						|
													    <TD>$qiarow</TD>";
							 | 
						|
										    foreach $qiacol (@qiac)
							 | 
						|
										    {
							 | 
						|
										        if ($qstatsqf[$qid] eq 'mtr') 
							 | 
						|
										        {
							 | 
						|
											    print "<TD align=center>";
							 | 
						|
											    for $irank (1 .. 10) 
							 | 
						|
											    {
							 | 
						|
											        print "$irank<br>";
							 | 
						|
											    }
							 | 
						|
											    print "</TD>";
							 | 
						|
											    print "<TD align=center>";
							 | 
						|
											    for $irank (1 .. 10) 
							 | 
						|
											    {
							 | 
						|
											        print "$qstatc[$i+$irank-1]<br>";
							 | 
						|
											    }
							 | 
						|
											    print "</TD>";
							 | 
						|
											    print "<TD align=center>";
							 | 
						|
											    for $irank (1 .. 10) 
							 | 
						|
											    {
							 | 
						|
											        print "$qstatp[$i+$irank-1]\%<br>";
							 | 
						|
											    }
							 | 
						|
											    print "</TD>";
							 | 
						|
											    $i += 10;
							 | 
						|
										        }
							 | 
						|
										        else
							 | 
						|
										        {
							 | 
						|
											    print "<TD align=center>$qstatc[$i]</TD>";
							 | 
						|
											    print "<TD align=center>$qstatp[$i]\%</TD>";
							 | 
						|
											    $i++;
							 | 
						|
										        }
							 | 
						|
										    }
							 | 
						|
										    print "\n</TR>\n";
							 | 
						|
									        }
							 | 
						|
									        print "\n</TABLE>
							 | 
						|
										    </TD>
							 | 
						|
									    </TR>";
							 | 
						|
									    } elsif ($qstatsqf[$qid] eq 'mcm') {
							 | 
						|
									        print "
							 | 
						|
									    <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) {
							 | 
						|
										    print "$qstat<BR>";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
													    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        $holdmcm = $_;
							 | 
						|
									        $endidx = $#qstatc - 3;
							 | 
						|
									        for (0 .. $endidx) {
							 | 
						|
										    print "$qstatc[$_]<BR>";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
													    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        for (0 .. $endidx) {
							 | 
						|
										    print "$qstatp[$_]\%<BR>";
							 | 
						|
									        }
							 | 
						|
									        $_ = $holdmcm;
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
												    </TR>
							 | 
						|
											    </TABLE>
							 | 
						|
										    </TD>
							 | 
						|
									    </TR>";
							 | 
						|
									    } elsif ($qstatsqf[$qid] eq 'esa') {
							 | 
						|
									        print "
							 | 
						|
									    <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) {
							 | 
						|
										    print "$qstat<BR>";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
													    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        $holdmcm = $_;
							 | 
						|
									        $endidx = $#qstatc - 3;
							 | 
						|
									        for (0 .. $endidx) {
							 | 
						|
										    print "$qstatc[$_]<BR>";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
													    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        for (0 .. $endidx) {
							 | 
						|
										    print "$qstatp[$_]\%<BR>";
							 | 
						|
									        }
							 | 
						|
									        $_ = $holdmcm;
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
												    </TR>
							 | 
						|
											    </TABLE>
							 | 
						|
									    <p>";
							 | 
						|
									        print "
							 | 
						|
											    <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) {
							 | 
						|
										    print "$qstat<BR>";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
													    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        $holdmcm = $_;
							 | 
						|
									        foreach (@qstatsqwc) {
							 | 
						|
										    print "$_<BR>";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
													    </TD>
							 | 
						|
													    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        foreach (@qstatsqwp) {
							 | 
						|
										    print "$_\%<BR>";
							 | 
						|
									        }
							 | 
						|
									        $_ = $holdmcm;
							 | 
						|
									        print "</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
							 | 
						|
									        ########################################################################
							 | 
						|
									        print "
							 | 
						|
									    <TR>
							 | 
						|
										    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
							 | 
						|
										    print"$qstatc[2]<BR>$qstatc[1]";
							 | 
						|
									        } else {
							 | 
						|
										    print"<B>$qstatc[0]</B><BR>$qstatc[2]<BR>$qstatc[1]";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
										    </TD>
							 | 
						|
										    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        if ($FORM{'exnoresp'}) {
							 | 
						|
										    if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
							 | 
						|
										        print" <BR>$qstatp[1]\%";
							 | 
						|
										    } else {
							 | 
						|
										        print"<B>$qstatp[0]\%</B><BR> <BR>$qstatp[1]\%";
							 | 
						|
										    }
							 | 
						|
									        } else {
							 | 
						|
										    if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
							 | 
						|
										        print"$qstatp[2]\%<BR>$qstatp[1]\%";
							 | 
						|
										    } else {
							 | 
						|
										        print"<B>$qstatp[0]\%</B><BR>$qstatp[2]\%<BR>$qstatp[1]\%";
							 | 
						|
										    }
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
										    </TD>
							 | 
						|
										    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
							 | 
						|
										    print"$qstato[1]<BR>$qstato[0]";
							 | 
						|
									        } else {
							 | 
						|
										    print"<B>$qstato[0]</B><BR>$qstato[2]<BR>$qstato[1]";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR>";
							 | 
						|
									        print "</font>
							 | 
						|
										    </TD>
							 | 
						|
									    </TR>";
							 | 
						|
									        print "<TR>
							 | 
						|
											<TD colspan=3>
							 | 
						|
											    <TABLE>\n";
							 | 
						|
									        print "		<TR>
							 | 
						|
													    <TD align=right valign=top colspan=3>\n<font size=2><b><i>Responses:</i></b><br></font></td>
							 | 
						|
													    <TD><font size=2>\n";
							 | 
						|
									        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) {
							 | 
						|
											        $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);
							 | 
						|
											    }
							 | 
						|
											    print "$qucmt<br>\n";
							 | 
						|
										        }
							 | 
						|
										        print "$columns[2]<br>\n";
							 | 
						|
										    }
							 | 
						|
									        }
							 | 
						|
									        print "</font></TD>
							 | 
						|
												    </TR>
							 | 
						|
											    </TABLE>
							 | 
						|
										    </TD>
							 | 
						|
									    </TR>\n";
							 | 
						|
									        ##### ^ ADT - 7/03/2002 - End Delete ###################################
							 | 
						|
									    } else {
							 | 
						|
									        if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
							 | 
						|
										    $bs = "";
							 | 
						|
										    $be = "";
							 | 
						|
									        } else {
							 | 
						|
										    $bs = "<B>";
							 | 
						|
										    $be = "</B>";
							 | 
						|
									        }
							 | 
						|
									        print "
							 | 
						|
									    <TR>
							 | 
						|
										    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        $boldtag = $bs;
							 | 
						|
									        $boldtagend = $be;
							 | 
						|
									        foreach $qstat (@qstatc) {
							 | 
						|
										    print "$boldtag$qstat$boldtagend<BR>";
							 | 
						|
										    $boldtag = "";
							 | 
						|
										    $boldtagend = "";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
										    </TD>
							 | 
						|
										    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        $boldtag = $bs;
							 | 
						|
									        $boldtagend = $be;
							 | 
						|
									        foreach $qstat (@qstatp) {
							 | 
						|
										    print "$boldtag$qstat\%$boldtagend<BR>";
							 | 
						|
										    $boldtag = "";
							 | 
						|
										    $boldtagend = "";
							 | 
						|
									        }
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
										    </TD>
							 | 
						|
										    <TD valign=top><font size=2><NOBR>";
							 | 
						|
									        $boldtag = $bs;
							 | 
						|
									        $boldtagend = $be;
							 | 
						|
									        foreach $qstat (@qstato) {
							 | 
						|
										    print "$boldtag$qstat$boldtagend<BR>";
							 | 
						|
										    $boldtag = "";
							 | 
						|
										    $boldtagend = "";
							 | 
						|
									    	}
							 | 
						|
									        print "</NOBR></font>
							 | 
						|
										    </TD>
							 | 
						|
									    </TR>\n";
							 | 
						|
									    }
							 | 
						|
									    if (($FORM{'showcmts'} eq 'withq') && ($#qucmts != -1)) {
							 | 
						|
									        print "<TR>
							 | 
						|
											<TD colspan=3>
							 | 
						|
											    <TABLE>\n";
							 | 
						|
									        print "		<TR>
							 | 
						|
													    <TD align=right valign=top colspan=3>\n<font size=2><b><i>Comments:</i></b><br></font></td>
							 | 
						|
													    <TD><font size=2>\n";
							 | 
						|
									        for $i (0 .. $#qucmts) {
							 | 
						|
										    @columns=split(/\&/, $qucmts[$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) {
							 | 
						|
											        $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);
							 | 
						|
											    }
							 | 
						|
											    print "$qucmt<br>\n";
							 | 
						|
										        }
							 | 
						|
										        print "$columns[2]<br>\n";
							 | 
						|
										    }
							 | 
						|
									        }
							 | 
						|
									        print "</font></TD>
							 | 
						|
												    </TR>
							 | 
						|
											    </TABLE>
							 | 
						|
										    </TD>
							 | 
						|
									    </TR>\n";
							 | 
						|
									    }
							 | 
						|
									    print "
							 | 
						|
									    <TR>
							 | 
						|
										    <TD colspan=6><HR WIDTH=\"100\%\"></TD>
							 | 
						|
									    </TR>\n";
							 | 
						|
									    @qstato = ();
							 | 
						|
									    @qstatc = ();
							 | 
						|
									    @qstatp = ();
							 | 
						|
								        }
							 | 
						|
								    }
							 | 
						|
								}
							 | 
						|
								if (($FORM{'showcmts'} eq 'atend') && ($#qucmts != -1)) {
							 | 
						|
								    print "<TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>\n";
							 | 
						|
								    print "<TR><TD colspan=6 align=center><B>Comments</B></TD></TR>\n";
							 | 
						|
								    print "<TR><TD colspan=6>\n";
							 | 
						|
								    print "<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) {
							 | 
						|
										    print "<TR>\n";
							 | 
						|
										    print "<TD valign=top><font size=2>$qstatsid[$_]</font></td>\n";
							 | 
						|
										    print "<TD valign=top><font size=2>$columns[1]</font></td>\n";
							 | 
						|
										    print "<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);
							 | 
						|
											}
							 | 
						|
											print "$qucmt<br>\n";
							 | 
						|
										    }
							 | 
						|
										    print "$columns[2]<br>\n";
							 | 
						|
										    print "</font></td>\n";
							 | 
						|
										    print "</TR>\n";
							 | 
						|
										}
							 | 
						|
									    }
							 | 
						|
									    print "<TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>\n";
							 | 
						|
									}
							 | 
						|
								    }
							 | 
						|
								    print "</TD>\n</TR>\n</TABLE>\n</TD>\n</TR>\n";
							 | 
						|
								}
							 | 
						|
								@qucmts=();
							 | 
						|
								if ($FORM{'showobs'}) {
							 | 
						|
								    print "$sobsolete";
							 | 
						|
								}
							 | 
						|
								print "
							 | 
						|
								</TABLE>
							 | 
						|
								" ;
							 | 
						|
								
							 | 
						|
								my %SpecLikertReportClients =
							 | 
						|
									(sandbox => 1
							 | 
						|
										,tgwall => 1
							 | 
						|
										,rutgers => 1
							 | 
						|
									) ;
							 | 
						|
								
							 | 
						|
								# PRINT the NRT responses and comments by Likert category and user. - HBI
							 | 
						|
								if ($SpecLikertReportClients{$SESSION{'clid'}}) {
							 | 
						|
								print "<br><br>\n" ;
							 | 
						|
								# print "<HR>\n" ;
							 | 
						|
								print "<H2 align=\"left\">Comments</H2>\n" ;
							 | 
						|
								print "<p align=\"left\">\n" ;
							 | 
						|
								my $outcat ; my $rpy ;
							 | 
						|
								my @qid_list ;
							 | 
						|
								my @Cat_Users = keys %{$GlobalData->{'CLIENTS'}->{$SESSION{'clid'}}->{'CANDIDATES'}} ;
							 | 
						|
								# print "Number of Users is $#Cat_Users " . join(" ", @Cat_Users) . "  <br>\n" ;
							 | 
						|
								foreach $outcat (sort keys %qids_supercat) {
							 | 
						|
									@qid_list = @{$qids_supercat{$outcat}} ;
							 | 
						|
									# print "Number of Questions is $#qid_list " . join(" ", @qid_list) . "  <br>\n" ;
							 | 
						|
									print "<br><br>" ;
							 | 
						|
									print "CATEGORY - " . $outcat if ($outcat) ;
							 | 
						|
									print "<br>\n" ;
							 | 
						|
									foreach $qid (@qid_list) {
							 | 
						|
										$qid =~ s/^[\s0]+// ; # Trim leading zeros and white space.
							 | 
						|
										print "<br>\n" ;
							 | 
						|
										print "Question $qid - $qstatsqt[$qid]\n" ;
							 | 
						|
										print "<br>\n" ;
							 | 
						|
										foreach $user (sort @Cat_Users) {
							 | 
						|
											$rpy = $GlobalData->{'CLIENTS'}->{$SESSION{'clid'}}->{'CANDIDATES'}->{$user}->{'Tests'}->{$FORM{'tstid'}}->{"complete"}->{$qid}->{'Resp'} ;
							 | 
						|
											if ($rpy) {
							 | 
						|
												# print "User - $user - Reply - $rpy <br>\n" ;
							 | 
						|
												print "$rpy <br>\n" ;
							 | 
						|
											}
							 | 
						|
											$rpy = $GlobalData->{'CLIENTS'}->{$SESSION{'clid'}}->{'CANDIDATES'}->{$user}->{'Tests'}->{$FORM{'tstid'}}->{"complete"}->{$qid}->{'Comment'} ;
							 | 
						|
											if ($rpy) {
							 | 
						|
												# print "User - $user - Comment - $rpy <br>\n" ;
							 | 
						|
												print "$rpy <br>\n" ;
							 | 
						|
											}
							 | 
						|
										}
							 | 
						|
									}
							 | 
						|
								}
							 | 
						|
								print "<br><br>\n" ;
							 | 
						|
								} # end of Executing Likert comments.
							 | 
						|
								print "<HR>\n" ;
							 | 
						|
								
							 | 
						|
								# FINISHED - PRINT the NRT responses and comments by Likert category and user.
							 | 
						|
								
							 | 
						|
								# Printing the raw Likert Scale data openly.
							 | 
						|
								# if (%Likert_points) {
							 | 
						|
									# print "Likert Category and scores. \<br\>\n" ;
							 | 
						|
									# for $cat (sort keys %Likert_points) {
							 | 
						|
										# print "$cat $Likert_points{$cat} $Likert_score{$cat}\<br\>\n" ;
							 | 
						|
									# }
							 | 
						|
								# }
							 | 
						|
								if (%Likert_points) {
							 | 
						|
									my ($Tot_possible, $Tot_earned) ;
							 | 
						|
									$Tot_possible = $Tot_earned = 0;
							 | 
						|
									print "<br><br>\n" ;
							 | 
						|
									print "<table border>\n" ;
							 | 
						|
									print "<tr>" ;
							 | 
						|
									print "<TH colspan=\"4\">Likert Category and scores</TH>\n" ;
							 | 
						|
									print "</tr>\n" ;
							 | 
						|
									print "<tr>" ;
							 | 
						|
									print "<TH>Category</TH>" ;
							 | 
						|
									print "<TH>Possible</TH>" ;
							 | 
						|
									print "<TH>Earned</TH>" ;
							 | 
						|
									print "<TH>\% Earned</TH>" ;
							 | 
						|
									print "</tr>\n" ;
							 | 
						|
									my $percent ;
							 | 
						|
									my @img_labels = () ;
							 | 
						|
									my @img_data = () ;
							 | 
						|
									for $cat (sort keys %Likert_points) {
							 | 
						|
										$percent = int ((100.0 * $Likert_score{$cat} / $Likert_points{$cat}) +0.5) ;
							 | 
						|
										push @img_labels, $cat ;
							 | 
						|
										push @img_data, $percent ;
							 | 
						|
										print "<tr>" ;
							 | 
						|
										print "<TH align=\"left\">$cat</TH>" ;
							 | 
						|
										print "<td align=\"right\">$Likert_points{$cat}</td>" ;
							 | 
						|
										$Tot_possible += $Likert_points{$cat} ;
							 | 
						|
										print "<td align=\"right\">$Likert_score{$cat}</td>" ;
							 | 
						|
										$Tot_earned += $Likert_score{$cat} ;
							 | 
						|
										print "<td align=\"right\">" ;
							 | 
						|
										printf "%i", $percent ;
							 | 
						|
										print " \%" ;
							 | 
						|
										print "</td>" ;
							 | 
						|
										print "</tr>\n" ;
							 | 
						|
									}
							 | 
						|
									# Print a total Line.
							 | 
						|
										print "<tr>" ;
							 | 
						|
										$cat = "Total" ;
							 | 
						|
										print "<TH align=\"left\">$cat</TH>" ;
							 | 
						|
										print "<td align=\"right\">$Tot_possible</td>" ;
							 | 
						|
										print "<td align=\"right\">$Tot_earned</td>" ;
							 | 
						|
										$percent = int ((100.0 * $Tot_earned / $Tot_possible) +0.5) ;
							 | 
						|
										push @img_labels, $cat ;
							 | 
						|
										push @img_data, $percent ;
							 | 
						|
										print "<td align=\"right\">" ;
							 | 
						|
										printf "%i", $percent ;
							 | 
						|
										print " \%" ;
							 | 
						|
										print "</td>" ;
							 | 
						|
										print "</tr>\n" ;
							 | 
						|
									# Finish the table.
							 | 
						|
									print "</table>\n" ;
							 | 
						|
									print "<br><br><hr /><br><br>\n" ;
							 | 
						|
									# The list parameters are: labels, values, and values2.
							 | 
						|
									my @values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme ;
							 | 
						|
									# The scalar parameters are: xdim, ydim, hbar, title, xlabel, ylabel, ymax, ymin, yticknum
							 | 
						|
									@values2 = () ;
							 | 
						|
									($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) =
							 | 
						|
										(800, 300, 1, "Likert Category Percents", "Category", "Percent for Category", 100, 0, 10, 1) ;
							 | 
						|
									$ydim = $#img_data * 20 + 50 ;
							 | 
						|
									my $ymax = 100 ;
							 | 
						|
									$ydim = $ymax if ($ydim < $ymax) ;
							 | 
						|
									($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ;
							 | 
						|
									print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, $ydim, $hbar, $title, $xlabel, 
							 | 
						|
										$ylabel, $ymax, $ymin, $yticknum, $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ;
							 | 
						|
									print "\<br\>\n" ;
							 | 
						|
									print "<br><br><hr /><br><br>\n" ;
							 | 
						|
								}
							 | 
						|
								
							 | 
						|
								print "
							 | 
						|
								</BODY>
							 | 
						|
								</HTML>
							 | 
						|
								";
							 | 
						|
								}
							 | 
						|
								
							 |