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.
2422 lines
76 KiB
2422 lines
76 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# teststats-tgwall101.pl
|
||
|
|
#
|
||
|
|
# Source File: teststats-tgwall101.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 ;
|
||
|
|
|
||
|
|
require 'grepa.pm' ;
|
||
|
|
|
||
|
|
#use strict;
|
||
|
|
use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
|
||
|
|
%SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS);
|
||
|
|
use vars qw(%SYSTEM %REPORT %SUBTEST_RESPONSES @xlatphrase) ;
|
||
|
|
|
||
|
|
use vars qw($testcomplete $cgiroot $pathsep $dataroot );
|
||
|
|
use vars qw(@rptparams $testinprog $testpending);
|
||
|
|
|
||
|
|
my $HBI_teststats_Debug = 0 ;
|
||
|
|
my $HBI_Routines_Called = "" ;
|
||
|
|
|
||
|
|
&app_initialize;
|
||
|
|
|
||
|
|
$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma. HBI
|
||
|
|
|
||
|
|
&LanguageSupportInit();
|
||
|
|
|
||
|
|
my $env_vars ;
|
||
|
|
|
||
|
|
# If the flag is set to flip include-Exclude, Flip the inc values.
|
||
|
|
if ($FORM{"Flip-Exclude-Include"}) {
|
||
|
|
my @srkey; my $SRkey ; my $incUserID ;
|
||
|
|
@srkeys = grep /^sr/, keys %FORM ;
|
||
|
|
foreach $SRkey (@srkeys) {
|
||
|
|
# next unless ($FORM{$SRkey} eq "Y") ;
|
||
|
|
$incUserID = $SRkey ;
|
||
|
|
$incUserID =~ s/^sr// ;
|
||
|
|
if ($FORM{"inc$incUserID"} eq $incUserID) {
|
||
|
|
delete $FORM{"inc$incUserID"} ;
|
||
|
|
} else {
|
||
|
|
$FORM{"inc$incUserID"} = $incUserID ;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
&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;
|
||
|
|
}
|
||
|
|
|
||
|
|
if (&get_session($FORM{'tid'})) {
|
||
|
|
if ($FORM{'testsummary'} eq 'composite') {
|
||
|
|
warn "Call show_test_composite $idlist " ;
|
||
|
|
$HBI_Routines_Called .= "show_test_composite " ;
|
||
|
|
&show_test_composite($idlist);
|
||
|
|
} elsif ($FORM{'testsummary'} eq 'bycnd') {
|
||
|
|
warn "Call show_test_resultsbycnd $idlist " ;
|
||
|
|
$HBI_Routines_Called .= "show_test_resultsbycnd " ;
|
||
|
|
&show_test_resultsbycnd($idlist);
|
||
|
|
} else {
|
||
|
|
warn "Call extract_test_data " ;
|
||
|
|
$HBI_Routines_Called .= "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-tgwall101.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=();
|
||
|
|
my %question_has_comments = () ;
|
||
|
|
$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;
|
||
|
|
}Q_array
|
||
|
|
&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) ;
|
||
|
|
$question_has_comments{$qidx} = 1 ;
|
||
|
|
} else {
|
||
|
|
push @qucmts, "$qidx\&$user\&$qucmt";
|
||
|
|
&InMem::InsertQuesComment($SESSION{'clid'}, $user, $FORM{'tstid'}, "complete", $_, $qucmt) ;
|
||
|
|
$question_has_comments{$qidx} = 1 ;
|
||
|
|
# 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[$_]) ;
|
||
|
|
$question_has_comments{$qidx} = 1 ; # Unique for TG Wall
|
||
|
|
} else {
|
||
|
|
push @qresponses, "$qidx\&$user\&$qrsp[$_]";
|
||
|
|
&InMem::InsertQuesResp($SESSION{'clid'}, $user, $FORM{'tstid'}, "complete", $_, $qrsp[$_]) ;
|
||
|
|
$question_has_comments{$qidx} = 1 ; # Unique for TG Wall
|
||
|
|
# 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 teststats-tgwall101 $HBI_Routines_Called Responses</B><BR>";
|
||
|
|
if (defined $idlist) {
|
||
|
|
print "<B>Groups: ".join(", ",split(/,/,$FORM{'idlist'}))."</b><br>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
# Part A deleted - lines 1841 -2432 approx.
|
||
|
|
|
||
|
|
if ($HBI_teststats_Debug) {
|
||
|
|
print " HBI_teststats_Debug tested atend.<BR>\n" ;
|
||
|
|
print "teststats-tgwall101.pl ENV VARS<BR>\n" ;
|
||
|
|
foreach $env_vars (sort keys %ENV) {
|
||
|
|
print "KEY $env_vars VAL $ENV{$env_vars}<BR>\n" ;
|
||
|
|
}
|
||
|
|
print "teststats-tgwall101.pl ENV VARS END<BR>\n" ;
|
||
|
|
print "teststats-tgwall101.pl FORM VARS<BR>\n" ;
|
||
|
|
foreach $env_vars (sort keys %FORM) {
|
||
|
|
print "KEY $env_vars VAL $FORM{$env_vars}<BR>\n" ;
|
||
|
|
}
|
||
|
|
print "teststats-tgwall101.pl FORM VARS END<BR>\n" ;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
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 "<br><br>" ;
|
||
|
|
print "CATEGORY - " . $outcat if ($outcat) ;
|
||
|
|
print "<br>\n" ;
|
||
|
|
# HBI Debug
|
||
|
|
# print "Number of Questions is $#qid_list " . join(" ", @qid_list) . " <br>\n" ;
|
||
|
|
foreach $qid (@qid_list) {
|
||
|
|
warn "HBIX showcmts $FORM{'showcmts'} qid $qid question-comments $question_has_comments{$qid}\n"
|
||
|
|
if ($HBI_teststats_Debug) ;
|
||
|
|
next if (($FORM{'showcmts'} eq "atendwonocomm") and (! $question_has_comments{$qid}) ) ;
|
||
|
|
$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'} ;
|
||
|
|
# HBI Debug
|
||
|
|
# $rpy .= "<br>Client ID $SESSION{'clid'} Candidate $user Test ID $FORM{'tstid'} Question ID $qid" ;
|
||
|
|
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 * 30 + 150 ;
|
||
|
|
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>
|
||
|
|
";
|
||
|
|
} # END show_test_composite
|
||
|
|
|
||
|
|
|
||
|
|
# FROM Source File: Likert_Gen_Groups.pl
|
||
|
|
|
||
|
|
|
||
|
|
# Get the group filters, if any
|
||
|
|
my ($idlist,$groups);
|
||
|
|
if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
|
||
|
|
#my @tmp = split(/,/,$FORM{'idlist'});
|
||
|
|
my @tmp = param('idlist');
|
||
|
|
$FORM{'idlist'} = join(',', @tmp);
|
||
|
|
@{$groups}{@tmp} = @tmp;
|
||
|
|
$idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
|
||
|
|
}
|
||
|
|
|
||
|
|
# Get the time stamp style
|
||
|
|
my $timestamp;
|
||
|
|
if ($FORM{'timestamp'} eq 'currenttime') {
|
||
|
|
$timestamp = scalar(localtime(time));
|
||
|
|
} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
|
||
|
|
$timestamp = $FORM{'customtime'};
|
||
|
|
} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
|
||
|
|
my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
|
||
|
|
my $fh = new FileHandle;
|
||
|
|
if ($fh->open($file)) {
|
||
|
|
my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
|
||
|
|
# print "<pre>".Dumper(\@history)."</pre>";
|
||
|
|
if (defined $idlist) {
|
||
|
|
foreach (reverse @history) {
|
||
|
|
if (exists $idlist->{$_->[2]}) {
|
||
|
|
$timestamp = scalar(localtime(toGMSeconds($_->[0])));
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
print STDERR "Could not open $file in Integro.pl\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if (defined $timestamp) {
|
||
|
|
$timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
|
||
|
|
} else {
|
||
|
|
$timestamp = "<br>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
# HBI NEW REPORT
|
||
|
|
|
||
|
|
# Generate the reports
|
||
|
|
# if ($FORM{'reportname'} eq 'LikertWQ') {
|
||
|
|
# &LikertWQ($idlist, $groups, $timestamp);
|
||
|
|
# } elsif ($FORM{'reportname'} eq 'LikertWQG') {
|
||
|
|
# &LikertWQG($idlist, $groups, $timestamp);
|
||
|
|
# } else {
|
||
|
|
# &ReportChooser();
|
||
|
|
# }
|
||
|
|
|
||
|
|
&LikertWQG($idlist, $groups, $timestamp);
|
||
|
|
|
||
|
|
# There should only be function definitions beyond this point.
|
||
|
|
exit(0);
|
||
|
|
|
||
|
|
# sub HTMLHeader {
|
||
|
|
# return "<html>\n<head>\n<title>$_[0]</title>\n".
|
||
|
|
# "<!--Integro3.pl-->\n".
|
||
|
|
# "<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
|
||
|
|
# "<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
|
||
|
|
# " TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
|
||
|
|
# " VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
|
||
|
|
#}
|
||
|
|
|
||
|
|
sub HTMLHeaderPlain {
|
||
|
|
return "" ;
|
||
|
|
# return "<html>\n<head>\n<title>$_[0]</title>\n".
|
||
|
|
# "<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
|
||
|
|
# "<BODY>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub HTMLFooter {
|
||
|
|
my $year = `date +%Y`;
|
||
|
|
my $ionline;
|
||
|
|
if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
|
||
|
|
$ionline = "<br>Copyright (c) $year, Integro Learning Company";
|
||
|
|
}
|
||
|
|
return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline<center></font></body>\n</html>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub LikertWQ {
|
||
|
|
# This does the Summary on the Likert Scale questions,
|
||
|
|
# for everybody, or the Groups selected.
|
||
|
|
# $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen.
|
||
|
|
# It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
|
||
|
|
# $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen.
|
||
|
|
# It is a reference to a hash. The keys are the group ids, and the values are the group ids.
|
||
|
|
# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
|
||
|
|
# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
|
||
|
|
# $FORM{'grouping'} is "all" when the report should cover everybody.
|
||
|
|
my ($idlist,$groups,$timestamp) = @_;
|
||
|
|
my $ResponseRequired = 1 ; # Do not count a question if it is not responded to.
|
||
|
|
my $all_groups = getGroups($CLIENT{'clid'}) ;
|
||
|
|
my $group_membership_required ;
|
||
|
|
if ($groups) {
|
||
|
|
$group_membership_required = 1 ;
|
||
|
|
my $group_p ;
|
||
|
|
for $group_p (keys %{$all_groups}) {
|
||
|
|
unless ($groups->{$group_p}) {
|
||
|
|
undef $all_groups->{$group_p} ;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$group_membership_required = 0 ;
|
||
|
|
}
|
||
|
|
my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required, $ResponseRequired) ;
|
||
|
|
# warn "sumdata" ;
|
||
|
|
# warn &Dumper(\$sumdata) ;
|
||
|
|
# warn "grpdata" ;
|
||
|
|
# warn &Dumper(\$grpdata) ;
|
||
|
|
|
||
|
|
print HTMLHeaderPlain("Likert Scale General Results");
|
||
|
|
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
|
||
|
|
print "<b>Likert Scale General Results<br>" ;
|
||
|
|
print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
|
||
|
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
|
||
|
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
|
||
|
|
if ($FORM{'uberheader'} ne "") {
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
|
||
|
|
} elsif (defined $idlist) {
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
|
||
|
|
.join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
|
||
|
|
} else {
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
|
||
|
|
}
|
||
|
|
print $timestamp;
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
|
||
|
|
|
||
|
|
my (@img_labels, @img_data) ;
|
||
|
|
my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ;
|
||
|
|
my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ;
|
||
|
|
@img_labels = () ; @img_data = () ; @values2 = () ;
|
||
|
|
($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ;
|
||
|
|
($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) =
|
||
|
|
(800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ;
|
||
|
|
|
||
|
|
# Print HTML for heading.
|
||
|
|
print "<b><table border>\n";
|
||
|
|
|
||
|
|
# Print first row.
|
||
|
|
print "<tr>" ;
|
||
|
|
print "<th colspan=\"5\">Category Scores</th>" ;
|
||
|
|
print "</tr>\n" ;
|
||
|
|
|
||
|
|
# Print second row. Heading for each column.
|
||
|
|
print "<tr>" ;
|
||
|
|
print "<th>Category</th>" ;
|
||
|
|
print "<th>Questions</th>" ;
|
||
|
|
print "<th>Points Possible</th>" ;
|
||
|
|
print "<th>Points Earned</th>" ;
|
||
|
|
print "<th>% Earned</th>" ;
|
||
|
|
print "</tr>\n" ;
|
||
|
|
|
||
|
|
# Loop for Categories.
|
||
|
|
my $tot_poss = 0 ; my $tot_earned = 0 ;
|
||
|
|
my $supercat ; my $text_summ = "<p align=left></b>" ;
|
||
|
|
$text_summ .= '<font face="Times New Roman, Times New Roman, Times New Roman, Times New Roman" size=3>' ;
|
||
|
|
$text_summ .= "Category: Percent<br>\n" ;
|
||
|
|
my @supercats = sort keys %{$sumdata} ;
|
||
|
|
for $supercat (@supercats) {
|
||
|
|
my $questions = "" ;
|
||
|
|
my $possible = 0 ;
|
||
|
|
my $earned = 0 ;
|
||
|
|
$questions = join(", ", sort map { $_ + 1 } keys %{$sumdata->{$supercat}->{'Questions'}}) ;
|
||
|
|
$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
|
||
|
|
$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
|
||
|
|
$tot_poss += $possible ;
|
||
|
|
$tot_earned += $earned ;
|
||
|
|
print "<tr>" ;
|
||
|
|
print "<th>$supercat</th>" ;
|
||
|
|
print "<td>$questions</td>" ;
|
||
|
|
print "<td>$possible</td>" ;
|
||
|
|
print &rep_cell_str($earned, $possible) ;
|
||
|
|
push @img_labels, $supercat ;
|
||
|
|
my ($percent) = int ((100.0 * $earned / $possible) +0.5) ;
|
||
|
|
push @img_data, $percent ;
|
||
|
|
$text_summ .= $supercat . ": " . $percent . " %<br>\n" ;
|
||
|
|
$ydim += 15 ; # add length to the chart for another row.
|
||
|
|
print "</tr>\n" ;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Print Total row.
|
||
|
|
print "<tr>" ;
|
||
|
|
print "<th colspan=\"2\">Total</th>" ;
|
||
|
|
print "<td>$tot_poss</td>" ;
|
||
|
|
push @img_labels, "Total" ;
|
||
|
|
my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ;
|
||
|
|
push @img_data, $percent ;
|
||
|
|
$text_summ .= "Total" . ": " . $percent . " %<br>\n" ;
|
||
|
|
$ydim += 15 ; # add length to the chart for another row.
|
||
|
|
print &rep_cell_str($tot_earned, $tot_poss) ;
|
||
|
|
print "</tr>\n" ;
|
||
|
|
|
||
|
|
print "</tr>\n" ;
|
||
|
|
print "</table>\n" ;
|
||
|
|
print $text_summ ;
|
||
|
|
|
||
|
|
if (@supercats) {
|
||
|
|
print "<br><br>\n" ;
|
||
|
|
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><br>\n" ;
|
||
|
|
}
|
||
|
|
|
||
|
|
print HTMLFooter();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub LikertWQG {
|
||
|
|
# This does the Summary on the Likert Scale questions,
|
||
|
|
# for everybody, or just groups, and lists group results.
|
||
|
|
# $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen.
|
||
|
|
# It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
|
||
|
|
# $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen.
|
||
|
|
# It is a reference to a hash. The keys are the group ids, and the values are the group ids.
|
||
|
|
# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
|
||
|
|
# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
|
||
|
|
# $FORM{'grouping'} is "all" when the report should cover everybody.
|
||
|
|
# HBI - Pick it up here.
|
||
|
|
my ($idlist,$groups,$timestamp) = @_;
|
||
|
|
my $ResponseRequired = 1 ; # Do not count questions if there was no response.
|
||
|
|
my $all_groups = getGroups($CLIENT{'clid'}) ;
|
||
|
|
my $group_membership_required ;
|
||
|
|
if ($groups) {
|
||
|
|
$group_membership_required = 1 ;
|
||
|
|
my $group_p ;
|
||
|
|
for $group_p (keys %{$all_groups}) {
|
||
|
|
unless ($groups->{$group_p}) {
|
||
|
|
undef $all_groups->{$group_p} ;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$group_membership_required = 0 ;
|
||
|
|
}
|
||
|
|
my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required,$ResponseRequired) ;
|
||
|
|
# warn "sumdata" ;
|
||
|
|
# warn &Dumper(\$sumdata) ;
|
||
|
|
# warn "grpdata" ;
|
||
|
|
# warn &Dumper(\$grpdata) ;
|
||
|
|
|
||
|
|
print HTMLHeaderPlain("Likert Scale Group Results");
|
||
|
|
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
|
||
|
|
print "<b>Likert Scale Group Results<br>" ;
|
||
|
|
print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
|
||
|
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
|
||
|
|
# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
|
||
|
|
if ($FORM{'uberheader'} ne "") {
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
|
||
|
|
} elsif (defined $idlist) {
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
|
||
|
|
.join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
|
||
|
|
} else {
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
|
||
|
|
}
|
||
|
|
print $timestamp;
|
||
|
|
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
|
||
|
|
|
||
|
|
# Print HTML for heading.
|
||
|
|
print "<b><table border>\n";
|
||
|
|
|
||
|
|
my $cat_count = keys %{$sumdata} ; # Number of categories.
|
||
|
|
# Print first row.
|
||
|
|
print "<tr>" ;
|
||
|
|
print "<th ></th>" ;
|
||
|
|
my $supercat ;
|
||
|
|
foreach $supercat (sort keys %{$sumdata}) {
|
||
|
|
print "<th >$supercat</th>\n" ;
|
||
|
|
}
|
||
|
|
print "<th >Total</th>" ;
|
||
|
|
print "</tr>\n" ;
|
||
|
|
|
||
|
|
# Print second row. Heading for each column.
|
||
|
|
# Loop for Categories.
|
||
|
|
my $tot_poss = 0 ; my $tot_earned = 0 ;
|
||
|
|
print "<tr>" ;
|
||
|
|
print "<td >Overall</td >\n" ;
|
||
|
|
my @supercats = sort keys %{$sumdata} ;
|
||
|
|
for $supercat (@supercats) {
|
||
|
|
# my $questions = "" ;
|
||
|
|
my $possible = 0 ;
|
||
|
|
my $earned = 0 ;
|
||
|
|
# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
|
||
|
|
$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
|
||
|
|
$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
|
||
|
|
$tot_poss += $possible ;
|
||
|
|
$tot_earned += $earned ;
|
||
|
|
print &rep_cell_str($earned, $possible, 1) ;
|
||
|
|
}
|
||
|
|
print &rep_cell_str($tot_earned, $tot_poss, 1) ;
|
||
|
|
print "</tr>\n" ;
|
||
|
|
|
||
|
|
# Print heading for Groups.
|
||
|
|
my $col_count = $cat_count + 2 ;
|
||
|
|
print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n" ;
|
||
|
|
|
||
|
|
print "<tr><th >Supervisor</th >" ;
|
||
|
|
for $supercat (@supercats) {
|
||
|
|
print "<th >$supercat</th >" ;
|
||
|
|
}
|
||
|
|
print "<th >Total</th ></tr >\n" ;
|
||
|
|
|
||
|
|
unless ($grpdata) {
|
||
|
|
print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n" ;
|
||
|
|
} else {
|
||
|
|
my $group ;
|
||
|
|
foreach $group (sort keys %{$grpdata}) {
|
||
|
|
if ($group) {
|
||
|
|
print "<tr >" ;
|
||
|
|
print "<td >" ;
|
||
|
|
# print "$group " ;
|
||
|
|
print $all_groups->{$group}->{'grpnme'} ;
|
||
|
|
print "</td >" ;
|
||
|
|
my $tot_poss = 0 ; my $tot_earned = 0 ;
|
||
|
|
for $supercat (@supercats) {
|
||
|
|
my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
|
||
|
|
my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
|
||
|
|
$tot_poss += $possible ;
|
||
|
|
$tot_earned += $earned ;
|
||
|
|
print &rep_cell_str($earned, $possible, 1) ;
|
||
|
|
}
|
||
|
|
print &rep_cell_str($tot_earned, $tot_poss, 1) ;
|
||
|
|
print "</tr>\n" ;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
print "</table>\n" ;
|
||
|
|
|
||
|
|
print HTMLFooter();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub rep_cell_str {
|
||
|
|
# Parameters
|
||
|
|
# $count - required, number for the cell, integer.
|
||
|
|
# $total - dividend for the percent, integer.
|
||
|
|
# $skip_tot - Optional, default false.
|
||
|
|
# If true, do not print total.
|
||
|
|
# Returned Value
|
||
|
|
# $html_str - html string to print for the cell.
|
||
|
|
my ($count, $total, $skip_tot) = @_ ;
|
||
|
|
my $html_str ;
|
||
|
|
$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
|
||
|
|
my ($percent, $percent_str, $count_str) ;
|
||
|
|
$count_str = sprintf("%4i", $count) ;
|
||
|
|
if ($total == 0) {
|
||
|
|
# total is 0, percent is undefined.
|
||
|
|
$percent_str = "- - %" ;
|
||
|
|
} else {
|
||
|
|
$percent = 100.0 * $count / $total ;
|
||
|
|
$percent_str = sprintf("%5.1f %%", $percent) ;
|
||
|
|
}
|
||
|
|
$html_str .= "$count_str</td>" unless ($skip_tot) ;
|
||
|
|
$html_str .= "<td align=\"right\">" ;
|
||
|
|
$html_str .= "$percent_str</td>" ;
|
||
|
|
return $html_str ;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub ret_test_chooser_mod {
|
||
|
|
# Return strings of html to pick a survey.
|
||
|
|
# The parameter is an array of arrays with test descriptions and ids.
|
||
|
|
# The returned value is an array with two strings.
|
||
|
|
# The first string is JavaScript for the test chooser.
|
||
|
|
# The second string is html for the tables to drive the test chooser.
|
||
|
|
my @trecs = @_;
|
||
|
|
# print STDERR Dumper(\@trecs) ;
|
||
|
|
my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
|
||
|
|
my $html_str = "" ;
|
||
|
|
my $js = "function setTest(oform,test) {\n\t".
|
||
|
|
"oform.tstid.value=test;\n\t".
|
||
|
|
"oform.submit();\n};\n";
|
||
|
|
for (0 .. $#trecs) {
|
||
|
|
my ($desc,$id) ;
|
||
|
|
$desc = $trecs[$_][0] ;
|
||
|
|
$id = $trecs[$_][1] ;
|
||
|
|
# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
|
||
|
|
$testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
|
||
|
|
$testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
|
||
|
|
$testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
|
||
|
|
$href="javascript:setTest(document.testform1,\'$id\')\;";
|
||
|
|
my $radio_tst_button ;
|
||
|
|
$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
|
||
|
|
'" > ' . $id ;
|
||
|
|
$tstoption = " <TR>" .
|
||
|
|
# "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
|
||
|
|
"<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
|
||
|
|
"<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
|
||
|
|
"<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
|
||
|
|
"<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
|
||
|
|
"<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
|
||
|
|
$tstoptions = join('', $tstoptions, $tstoption);
|
||
|
|
}
|
||
|
|
$html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
|
||
|
|
# "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
|
||
|
|
# "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
|
||
|
|
# "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
|
||
|
|
# "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
|
||
|
|
# "</form>" .
|
||
|
|
"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
|
||
|
|
"<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
|
||
|
|
"<TR>" .
|
||
|
|
"<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
|
||
|
|
"<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
|
||
|
|
"<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
|
||
|
|
"<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
|
||
|
|
"<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
|
||
|
|
"</TR>" .
|
||
|
|
"<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
|
||
|
|
$tstoptions .
|
||
|
|
"<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
|
||
|
|
"</TABLE> " ;
|
||
|
|
return ($js, $html_str) ;
|
||
|
|
}
|
||
|
|
|
||
|
|
|