#!/usr/bin/perl # # $Id: teststats.pl,v 1.39 2006/11/17 21:26:03 ddoughty Exp $ # # Source File: teststats.pl # Get config # use strict; use FileHandle; use Time::Local; use Data::Dumper; use URI::Escape; require 'sitecfg.pl'; require 'testlib.pl'; require 'tstatlib.pl'; require 'ui.pl'; require 'LikertData.pl'; use InMem ; #use strict; use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS); use vars qw($testcomplete $cgiroot $pathsep $dataroot ); &app_initialize; $FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma. HBI &LanguageSupportInit(); &get_session($FORM{'tid'}); &get_client_profile($SESSION{'clid'}); my @sortbys = qw(Name LoginID Date Score); my ($bExport,$idlist); if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') { $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'}); } if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";} if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";} if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";} if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";} my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}"; my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}"; if ($FORM{'export'}) { print "Content-Type: application/doc\n\n"; $bExport=1; } elsif ($FORM{'csv'}) { print "Content-Type: text/x-csv\n\n"; } else { print "Content-Type: text/html\n\n"; $bExport=0; } if (&get_session($FORM{'tid'})) { if ($FORM{'testsummary'} eq 'composite') { warn "Call show_test_composite $idlist " ; &show_test_composite($idlist); } elsif ($FORM{'testsummary'} eq 'bycnd') { warn "Call show_test_resultsbycnd $idlist " ; &show_test_resultsbycnd($idlist); } else { warn "Call extract_test_data " ; &extract_test_data(); } } if ($bExport) { exit(0); } sub extract_test_data() { &LanguageSupportInit(); &get_client_profile($SESSION{'clid'}); &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); if ($FORM{'shwpending'}) { $testdir = $testpending; $testhdr = "Pending"; } else { $testdir = $testcomplete; $testhdr = "Completed Responses"; } my @filelist = &get_test_result_files($testdir, "$CLIENT{'clid'}","$TEST{'id'}"); my @converter; if ($SESSION{'uid'} ne '') { my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar"); if ($imaregistrar eq 'Y') { foreach $rotator (@filelist) { my @cnd = split(/\./, $rotator); my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby"); push(@converter, $rotator) unless $creator ne $SESSION{'uid'}; } @filelist = @converter; } } else { &logger::logerr("No SESSION{uid} set!"); } my @colhdrs=(); push @colhdrs,""; if ($FORM{'cndnme'}) { push @colhdrs,"left:Last Name"; push @colhdrs,"left:First Name"; push @colhdrs,"left:MI"; } push @colhdrs,"left:User ID"; if ($FORM{'cndeml'}) { push @colhdrs,"left:Email Address"; } if ($FORM{'cnddat'}) { push @colhdrs,"left:Date"; } if ($FORM{'excnd1'}) { push @colhdrs,"left:$CLIENT{'clcnd1'}"; } if ($FORM{'excnd2'}) { push @colhdrs,"left:$CLIENT{'clcnd2'}"; } if ($FORM{'excnd3'}) { push @colhdrs,"left:$CLIENT{'clcnd3'}"; } if ($FORM{'excnd4'}) { push @colhdrs,"left:$CLIENT{'clcnd4'}"; } if ($FORM{'cndscr'}) { push @colhdrs,"center:Correct"; push @colhdrs,"center:Incorrect"; push @colhdrs,"right:Score"; } my @dataflds=(); my @unsorted=(); my $row=""; my @qsumry=(); my $user=""; my $joint="\&"; my $colhdr; my $colalgn; my $fidx; $cnd1_filter = $FORM{'cnd1'}; $cnd2_filter = $FORM{'cnd2'}; $cnd3_filter = $FORM{'cnd3'}; $cnd4_filter = $FORM{'cnd4'}; ($i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar) = &prepFilter($CLIENT{'clid'}); for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) { $user = $filelist[$fidx]; $user =~ s/.$TEST{'id'}$//; $user =~ s/^$CLIENT{'clid'}.//; $filtered = &makeMeFilter($user, $CLIENT{'clid'}, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar); if (!$filtered) { my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'}); if (not defined $history) { $history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'}); } else { #print STDERR "$user from log.\n"; } if (not defined $history) { # no log file entry for this test #print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n"; my $mtime = (stat($testdir.$pathsep.$filelist[$fidx]))[9]; $history->{'end'} = $mtime; $history->{'start'} = $history->{'end'}; } $completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'}); $displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'}); if (&date_out_of_range($completedat,$datefm,$dateto)) { next; } my $excuser="inc$user"; if ($FORM{$excuser}) { next; } &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); &get_candidate_profile($CLIENT{'clid'},$user); if ($FORM{'cndnme'}) { $row=join($joint,$row,"$CANDIDATE{'nml'}"); $row=join($joint,$row,"$CANDIDATE{'nmf'}"); $row=join($joint,$row,"$CANDIDATE{'nmm'}"); } $row=join($joint,$row,"$user"); if ($FORM{'cndeml'}) { $row=join($joint,$row,"$CANDIDATE{'eml'}"); } if ($FORM{'cnddat'}) { $row=join($joint,$row,"$displaydate"); } if ($FORM{'excnd1'}) { $row=join($joint,$row,"$CANDIDATE{'cnd1'}"); } if ($FORM{'excnd2'}) { $row=join($joint,$row,"$CANDIDATE{'cnd2'}"); } if ($FORM{'excnd3'}) { $row=join($joint,$row,"$CANDIDATE{'cnd3'}"); } if ($FORM{'excnd4'}) { $row=join($joint,$row,"$CANDIDATE{'cnd4'}"); } if ($FORM{'cndscr'}) { $row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]); } push @unsorted, $row; $row=""; } } my @sorted=sort @unsorted; @unsorted=(); &print_report_dataextract_header($#sorted+1,@colhdrs,@colalign); my ($i); for $i (0 .. $#sorted) { @dataflds=split($joint, $sorted[$i]); if ($bExport) { for $i (1 .. $#dataflds) { print "$dataflds[$i]"; if ($i == $#dataflds) { print "\n"; } else { print "\t"; } } } else { print "<TR>\n"; for $i (1 .. $#dataflds) { ($colalgn,$colhdr) = split(/:/,$colhdrs[$i]); print "\t\t<td align=$colalgn valign=top>$dataflds[$i]</td>\n"; } print "<TR>\n"; } } &print_report_bycnd_footer(); @sorted=(); } sub print_report_dataextract_header { my ($ncount,@cols)= @_; my $colhdr; my $colalgn; my $i; if ($bExport) { print "$TEST{'desc'} ($TEST{'id'})\n"; print "Raw Data Extraction\n"; print "$ncount $testhdr\n"; for $i (1 .. $#cols) { ($colalgn,$colhdr) = split(/:/,$cols[$i]); print "$colhdr"; if ($i == $#cols) { print "\n"; } else { print "\t"; } } } else { print "<HTML>\n"; print "<HEAD>\n"; print "\t<TITLE>Test Data Extraction</TITLE>\n"; print "\t<SCRIPT language=\"JavaScript\">\n"; print "\t<\!--\n"; print "\t function wdwOnLoad() {\n"; print "\t window.focus();\n"; print "\t }\n"; print "\t window.onload=wdwOnLoad;\n"; print "\t//-->\n"; print "\t</SCRIPT>\n"; print "</HEAD>\n"; print "<BODY>\n"; print "<CENTER>\n"; print "<B>$TEST{'desc'} ($TEST{'id'})</B><BR>\n"; print "<B>Raw Data Extraction</B><BR>\n"; print "<font size=2><I>$ncount $testhdr</I></font>\n"; print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n"; print "\t<TR>\n"; for $i (1 .. $#cols) { ($colalgn,$colhdr) = split(/:/,$cols[$i]); print "\t\t<td align=$colalgn valign=top><b>$colhdr</b></td>\n"; } print "\t<\TR>\n"; } } $^W=1; sub sort_test_results { my ($sortby,@rows) = @_; if ($sortby eq 'Name') { #print STDERR "by Name\n"; return sort {$a->{'columns'}->[0] cmp $b->{'columns'}->[0];} @rows; } elsif ($sortby eq 'LoginID') { #print STDERR "by LoginID\n"; return sort {$a->{'columns'}->[1] cmp $b->{'columns'}->[1];} @rows; } elsif ($sortby eq 'Date') { #print STDERR "by Date\n"; return sort {$a->{'end'} <=> $b->{'end'};} @rows; } elsif ($sortby eq 'Score') { #print STDERR "by Score\n"; my $scoreidx=$#{$rows[0]->{'columns'}}-1; return sort {$a->{'columns'}->[$scoreidx] <=> $b->{'columns'}->[$scoreidx];} @rows; } else { #print STDERR "by Nothing\n"; return @rows; } } sub show_test_resultsbycnd { &LanguageSupportInit(); &get_client_profile($SESSION{'clid'}); &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}"); my @converter; if ($SESSION{'uid'} ne '') { my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar"); if ($imaregistrar eq 'Y') { foreach $rotator (@filelist) { my @cnd = split(/\./, $rotator); my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby"); push(@converter, $rotator) unless $creator ne $SESSION{'uid'}; } @filelist = @converter; } } else { &logger::logerr("No SESSION{uid} set!"); } my ($url) = ("$cgiroot/teststats.pl?"); if (not $FORM{'sortby'}) {$FORM{'sortby'}=$sortbys[0];} if (not $FORM{'reverse'}) {$FORM{'reverse'}=0;} foreach (keys %FORM) { if (($_ ne 'sortby') and ($_ ne 'reverse') and ($FORM{$_} !~ /\s+/)) { #print STDERR "$_=$FORM{$_}\n"; $url .= "&$_=$FORM{$_}"; } else { #print STDERR "NOT $_=$FORM{$_}\n"; } } my $csvurl = $url."&csv=1&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); my $reverseurl = $url."&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); my %sorturls; foreach my $sorter (@sortbys) { $sorturls{$sorter} = $url."&sortby=$sorter"; } my @sorted=(); my @unsorted=(); my $user; my $test; my $qidx; my $trash; my $subjskl; my $subj; my $sklvl; my $subjlist=","; my @qids=(); my @qsumry=(); my @corincs=(); my $bysubjflag = ($FORM{'statsbysubj'} ne '') ? 1 : 0; my @subjects=(); my @subjcnts=(); my @subjtot=(); my @subjmean=(); my @subjmedian=(); my @meanscore=split('\,',"0,0,0,0,100,0,0"); my @medianscore=(); my $i=0; my $j=0; my $fidx; my @rows=(); my $row={}; my @answ=(); my $qid; my $usrnm; #my $nresultcount=$#filelist+1; my $mtime; my $completedat; my $displaydate; $cnd1_filter = $FORM{'cnd1'}; $cnd2_filter = $FORM{'cnd2'}; $cnd3_filter = $FORM{'cnd3'}; $cnd4_filter = $FORM{'cnd4'}; ($i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar) = &prepFilter($CLIENT{'clid'}); for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) { $user = $filelist[$fidx]; $user =~ s/.$TEST{'id'}$//; $user =~ s/^$CLIENT{'clid'}.//; $creator = &get_a_key("cnd.$CLIENT{'clid'}", $user, "createdby"); $filtered = &makeMeFilter($user, $CLIENT{'clid'}, $i_am_grpowner, $grpmembers, $grpowners, $mygrp, $i_am_registrar); if (!$filtered) { my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'}); if (not defined $history) { $history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'}); } else { #print STDERR "$user from log.\n"; } if (not defined $history) { # no log file entry for this test #print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n"; my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9]; $history->{'end'} = $mtime; $history->{'start'} = $history->{'end'}; } $completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'}); $displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'}); my $excuser="inc$user"; if ($FORM{$excuser} || &date_out_of_range($completedat,$datefm,$dateto)) { next; } &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); @answ=split(/\&/,$SUBTEST_ANSWERS{2}); @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); @corincs = split(/\//, $qsumry[$#qsumry]); for $i (0 .. $#subjects) { $subjcnts[$i][0]=0; $subjcnts[$i][1]=0; $subjcnts[$i][2]=0; $subjcnts[$i][3]=0; } &get_candidate_profile($CLIENT{'clid'},$user); $usrnm="$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}"; $row={'columns' => [$usrnm,$user,$displaydate]}; $row->{'start'} = $history->{'start'}; $row->{'end'} = $history->{'end'}; my @historic_tests = getHistoricTests($testcomplete,$CLIENT{'clid'},$FORM{'tstid'},$user); my $numhistoric = $#historic_tests; if ($numhistoric >= 0) { $row->{'numprevious'} = "<a href=/cgi-bin/creports003.pl?tid=$FORM{'tid'}&frm=4&rptno=ACT-C-003&cndid=$user&clid=$CLIENT{'clid'}&tstid=$FORM{'tstid'}&multiple=0&tstsel=$FORM{'tstid'} target=_blank>".$numhistoric."</a>"; } else { $row->{'numprevious'} = "No History"; } $historic_tests = (); if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { for $qid (1 .. $#qids) { ($test,$qidx) = split(/\./, $qids[$qid]); ($trash,$subjskl) = split(/::/, $answ[$qid]); ($subj,$sklvl,$trash)=split(/\.|\:/,$subjskl); unless ($subjlist =~ /\,$subj\,/i) { $subjlist = join('',$subjlist,"$subj\,"); push @subjects,"$subj"; $i=$#subjects; $subjcnts[$i][0]=0; # questions in subject area $subjcnts[$i][1]=0; # correct answers $subjcnts[$i][2]=0; # incorrect answers $subjcnts[$i][3]=0; # pct correct $subjtot[$i][0]=0; $subjtot[$i][1]=0; $subjtot[$i][2]=0; $subjtot[$i][3]=0; $subjmean[$i][0]=0; # population count $subjmean[$i][1]=0; # population value summation $subjmean[$i][2]=0; # population mean $subjmean[$i][3]=0; # population standard deviation $subjmean[$i][4]=100; # population range-low $subjmean[$i][5]=0; # population range-high } for $i (0 .. $#subjects) { if ($subj eq $subjects[$i]) { $subjcnts[$i][0]++; $subjtot[$i][0]++; if (substr($corincs[$qid],0,1) eq '1') { $subjcnts[$i][1]++; $subjtot[$i][1]++; } else { $subjcnts[$i][2]++; $subjtot[$i][2]++; } $subjcnts[$i][3]=int((($subjcnts[$i][1]/$subjcnts[$i][0])*100)); $subjtot[$i][3]=int((($subjtot[$i][1]/$subjtot[$i][0])*100)); last; } } } if ($bysubjflag) { for $i (0 .. $#subjects) { push @{$row->{'columns'}},$subjcnts[$i][0],$subjcnts[$i][1],$subjcnts[$i][2],$subjcnts[$i][3]; $subjmean[$i][0]++; $subjmean[$i][1]+=$subjcnts[$i][3]; $subjmean[$i][2]=int(($subjmean[$i][1]/$subjmean[$i][0])); #$subjmean[$i][4]=(($subjcnts[$i][3] < $subjmean[$i][4]) || ($subjmean[$i][4] == 0)) ? $subjcnts[$i][3] : $subjmean[$i][4]; $subjmean[$i][4]=($subjcnts[$i][3] < $subjmean[$i][4]) ? $subjcnts[$i][3] : $subjmean[$i][4]; $subjmean[$i][5]=($subjcnts[$i][3] > $subjmean[$i][5]) ? $subjcnts[$i][3] : $subjmean[$i][5]; $subjmedian[$i][$fidx]=$subjcnts[$i][3]; $subjcnts[$i][0]=0; $subjcnts[$i][1]=0; $subjcnts[$i][2]=0; $subjcnts[$i][3]=0; } } $meanscore[0]++; # data count $meanscore[1]+=$qsumry[2]; # sum of values $meanscore[2]=int(($meanscore[1]/$meanscore[0])); # unbiased population mean $meanscore[4]=($qsumry[2] < $meanscore[4]) ? $qsumry[2] : $meanscore[4]; $meanscore[5]=($qsumry[2] > $meanscore[5]) ? $qsumry[2] : $meanscore[5]; $medianscore[$fidx]=$qsumry[2]; } if ($TEST{'minpass'} ne '') { $pf = ($qsumry[2] >= $TEST{'minpass'}) ? '<font color=green>P</font>' : '<font color=red>F</font>'; } else { $pf = "N/A"; } push @{$row->{'columns'}},$qsumry[0],$qsumry[1],$qsumry[2], $pf; push @rows, $row; } } @sorted=sort {$a <=> $b} @medianscore; $j=$#sorted/2; $i=$sorted[$j]; if (($#sorted % 2) == 0) { @medianscore=(); $medianscore[0]=$i; } else { $j++; $i+=$sorted[$j]; @medianscore=(); $medianscore[0]=int(($i/2)); } my @scores=(); for $i (0 .. $#subjects) { for $j (0 .. $#filelist) { $scores[$j]=$subjmedian[$i][$j]; } @sorted=sort {$a <=> $b} @scores; @scores=(); $j=$#sorted/2; $qid=$sorted[$j]; if (($#sorted % 2) == 0) { $subjmedian[$i][0]=$qid; } else { $j++; $qid+=$sorted[$j]; $subjmedian[$i][0]=int(($qid/2)); } } # The sorting block if ($FORM{'reverse'}) { @sorted = reverse &sort_test_results($FORM{'sortby'},@rows); } else { @sorted = &sort_test_results($FORM{'sortby'},@rows); } # end of the sorting block @rows=(); if ($FORM{'csv'}) { &print_report_bycnd_csv(@sorted); return; } my $colspan=&print_report_bycnd_header($#sorted+1,$bysubjflag,\%sorturls,$FORM{'sortby'},$csvurl,$reverseurl,@subjects); @unsorted=(); @subjcnts=(); my $symbol=""; my @cols=(); my @rowhdrs=('Questions','Correct','Incorrect','Pct Correct'); my $rowspan=($bysubjflag) ? ($#rowhdrs+1) : 1; foreach my $row (@sorted) { @cols=@{$row->{'columns'}}; my ($start,$end,$duration,$datestamp,$total); if ($bExport) { print "$cols[0]\t$cols[1]\t$cols[2]\t"; if ($bysubjflag) { print "\n";} } else { $start = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'start'}))[0..2])); $end = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'end'}))[0..2])); $duration = &fmtDuration($row->{'end'} - $row->{'start'}); if ($end == "Unknown" ) { $datestamp = ""; } else { my $gmend = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'end'}))[0..2])); $datestamp = "$cols[2] $gmend GMT"; $datestamp =~ s/ /_/g; } $total = $cols[-4] + $cols[-3]; my $params = "tid=$SESSION{'tid'}&clid=$CLIENT{'clid'}&cndid=". uri_escape($cols[1]). "&tstid=$FORM{'tstid'}&correct=$cols[-4]&incorrect=$cols[-3]&total=$total&percent=$cols[-2]"; print "\t<TR>\n"; print "\t\t<TD rowspan=$rowspan valign=top><a href=\"$cgiroot/testreport.pl?$params\" TARGET=\"testreport\">$cols[0]</a></TD>\n"; print "\t\t<TD rowspan=$rowspan valign=top>$cols[1]</TD>\n"; print "\t\t<TD rowspan=$rowspan valign=top>$cols[2]</TD>\n"; } if ($bysubjflag) { print "\t\t<TD rowspan=$rowspan align=left valign=top>$row->{'numprevious'}</TD>\n"; for $j (0 .. $#rowhdrs) { $symbol=($j==3) ? "\%" : ""; if ($j > 0) { if ($bExport == 0) { print "\t<TR>\n"; } } if ($bExport) { print "\t\t$rowhdrs[$j]\t"; } else { print "\t\t<TD align=right valign=top><font size=2><i>$rowhdrs[$j]</i></font></TD>\n"; } for $fidx (0 .. $#subjects) { $qid=($fidx*4)+$j+3; if ($bExport) { print "$cols[$qid]\t"; } else { print "\t\t<TD align=center valign=top>$cols[$qid]$symbol</TD>\n"; } if ($j==3) { $subjmean[$fidx][3]+=(($subjmean[$fidx][2]-$cols[$qid])*($subjmean[$fidx][2]-$cols[$qid])); } } if ($j == 0) { $fidx=$#cols-3; if ($bExport) { print "$cols[$fidx++]\t"; print "$cols[$fidx++]\t"; print "$cols[$fidx++]\t"; print "$cols[$fidx]\t"; } else { print "\t\t<TD rowspan=$rowspan align=center valign=bottom>$cols[$fidx++]</TD>\n"; print "\t\t<TD rowspan=$rowspan align=center valign=bottom>$cols[$fidx++]</TD>\n"; print "\t\t<TD rowspan=$rowspan align=center valign=bottom>$cols[$fidx++]\%</TD>\n"; print "\t\t<TD rowspan=$rowspan align=center valign=bottom>$cols[$fidx]</TD>\n"; } } if ($bExport) { print "\n"; } else { print "\t</TR>\n"; } } } else { $j=$#cols-3; if ($bExport) { print "$cols[$j++]\t"; print "$cols[$j++]\t"; print "$cols[$j++]\t"; print "$cols[$j]\n"; } else { print "\t\t<TD rowspan=$rowspan align=left valign=top>$start</TD>\n"; print "\t\t<TD rowspan=$rowspan align=left valign=top>$end</TD>\n"; print "\t\t<TD rowspan=$rowspan align=left valign=top>$duration</TD>\n"; print "\t\t<TD rowspan=$rowspan align=left valign=top>$row->{'numprevious'}</TD>\n"; if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { print "\t\t<TD rowspan=$rowspan align=center valign=top>$cols[$j++]</TD>\n"; print "\t\t<TD rowspan=$rowspan align=center valign=top>$cols[$j++]</TD>\n"; print "\t\t<TD rowspan=$rowspan align=center valign=top>$cols[$j++]\%</TD>\n"; print "\t\t<TD rowspan=$rowspan align=center valign=top>$cols[$j]</TD>\n"; } else { print "\t\t<TD rowspan=$rowspan align=center valign=top colspan=3>Not Scored by Definition</TD>\n"; } print "\t</TR>\n"; } } if ($bysubjflag) { if ($bExport==0) { print "\t<TR>\n"; print "\t\t<TD colspan=$colspan valign=cemter><HR width=100\%></TD>\n"; print "\t</TR>\n"; } } $meanscore[3]+=(($meanscore[2]-$cols[$#cols])*($meanscore[2]-$cols[$#cols])); @cols=(); } $meanscore[3]=int((sqrt($meanscore[3]/($#sorted+1)))); if ($bysubjflag) { @rowhdrs=('Questions','Correct','Incorrect','Pct Correct','Unbiased Mean','Std. Dev.','Range-Low','Range-High','Median'); $rowspan=$#rowhdrs+1; for $j (0 .. $#rowhdrs) { if ($bExport == 0) { print "\t<TR>\n"; } if ($j == 0) { if ($bExport) { print "\n\tComposite\t"; } else { print "\t\t<TD rowspan=$rowspan colspan=6 align=right valign=top><font size=2><b><i>Composite</i></b></font></TD>\n"; } } else { if ($bExport) { print "\t\t"; } } if ($bExport) { print "$rowhdrs[$j]\t"; } else { print "\t\t<TD align=right valign=top><font size=2><i>$rowhdrs[$j]</i></font></TD>\n"; } if ($j < 4) { $symbol=($j==3) ? "\%" : ""; for $fidx (0 .. $#subjects) { if ($bExport) { print "$subjtot[$fidx][$j]\t"; } else { print "\t\t<TD align=center valign=top><b>$subjtot[$fidx][$j]</b>$symbol</TD>\n"; } } if ($j == 0) { if ($bExport) { print "\t\t"; } else { print "\t\t<TD rowspan=3 colspan=3 align=center valign=top>\ \;<br></TD>\n"; } } elsif ($j == 3) { if ($bExport) { print "\tOverall\t"; } else { print "\t\t<TD colspan=3 align=center valign=top><b><i>Overall</i><b></TD>\n"; } } } else { $symbol="\%"; $i=$j-2; for $fidx (0 .. $#subjects) { if ($i == 6) { if ($bExport) { print "$subjmedian[$fidx][0]\t"; } else { print "\t\t<TD align=center valign=top><b>$subjmedian[$fidx][0]</b>$symbol</TD>\n"; } } else { if ($i==3) { $subjmean[$fidx][3]=int((sqrt(($subjmean[$fidx][3]/$subjmean[$fidx][0])))); if ($bExport) { print "$subjmean[$fidx][$i]\t"; } else { print "\t\t<TD align=center valign=top>\&\#177<b>$subjmean[$fidx][$i]</b>$symbol</TD>\n"; } } else { if ($bExport) { print "$subjmean[$fidx][$i]\t"; } else { print "\t\t<TD align=center valign=top><b>$subjmean[$fidx][$i]</b>$symbol</TD>\n"; } } } } $i=$j-2; if ($i==3) { if ($bExport) { print "\t$meanscore[$i]\t"; } else { print "\t\t<TD colspan=3 align=center valign=top>\&\#177<b>$meanscore[$i]</b>$symbol</TD>\n"; } } elsif ($i==6) { if ($bExport) { print "\t$medianscore[0]\t"; } else { print "\t\t<TD colspan=3 align=center valign=top><b>$medianscore[0]</b>$symbol</TD>\n"; } } else { if ($bExport) { print "\t$meanscore[$i]\t"; } else { print "\t\t<TD colspan=3 align=center valign=top><b>$meanscore[$i]</b>$symbol</TD>\n"; } } } if ($bExport) { print "\n"; } else { print "\t</TR>\n"; } } if ($bExport == 0) { print "\t<TR>\n"; print "\t\t<TD colspan=$colspan valign=cemter><HR width=100\%></TD>\n"; print "\t</TR>\n"; } } elsif ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { @rowhdrs=('Unbiased Mean','Std. Dev.','Range-Low','Range-High','Median'); $rowspan=$#rowhdrs+1; $symbol="\%"; #print STDERR Dumper(\@meanscore); for $j (0 .. $#rowhdrs) { $i=$j+2; if ($bExport == 0) { print "\t<TR>\n"; } if ($j==0) { if ($bExport) { print "\tComposite\n"; } else { print "\t\t<TD rowspan=$rowspan colspan=7 align=right valign=top><font size=2><b><i>Composite</i></b></font></TD>\n"; } } if ($bExport) { print "\t$rowhdrs[$j]\t"; } else { print "\t\t<TD align=right colspan=2 valign=top><font size=2><i>$rowhdrs[$j]</i></font></TD>\n"; } if ($j==1) { if ($bExport) { print "\t\t$meanscore[$i]"; } else { print "\t\t<TD align=center valign=top>\&\#177<b>$meanscore[$i]</b>$symbol</TD>\n"; } } elsif ($j==4) { if ($bExport) { print "\t\t$medianscore[0]"; } else { print "\t\t<TD align=center valign=top><b>$medianscore[0]</b>$symbol</TD>\n"; } } else { if ($bExport) { print "\t\t$meanscore[$i]"; } else { print "\t\t<TD align=center valign=top><b>$meanscore[$i]</b>$symbol</TD>\n"; } } if ($bExport) { print "\n"; } else { print "\t</TR>\n"; } } if ($bExport == 0) { print "\t<TR>\n"; print "\t\t<TD colspan=11 valign=cemter><HR width=100\%></TD>\n"; print "\t</TR>\n"; } } else { if ($bExport == 0) { print "\t<TR>\n"; print "\t\t<TD colspan=11 valign=cemter><HR width=100\%></TD>\n"; print "\t</TR>\n"; } } &print_report_bycnd_footer(); @subjtot=(); @subjects=(); @sorted=(); } $^W=0; sub print_report_bycnd_header { my ($ncount,$bysubj,$sorturls,$sortby,$csvurl,$reverseurl,@subjects) = @_; my $i; my $titlesfx=""; my $nsubjects = $#subjects; my $colspan=$nsubjects+2; my $colspan2=$nsubjects+4; if ($bysubj) { $colspan2+=6; $titlesfx=" (Subject Area)"; } else { $colspan2=11; } my $sortspan = int($colspan2/8); # wac changed 4 to 8 to make columns closer if ($bExport) { print "$TEST{'desc'} ($TEST{'id'})\n"; print "Question$titlesfx Response Statistics\n"; print "$ncount Completed Responses\n"; print "Candidate\tDate\t"; if ($bysubj) { print "BD\t"; for $i (0 .. $nsubjects) { print "$subjects[$i]\t"; } }; print "TC\tTI\tTS\n"; } else { print "<HTML>\n"; print "<HEAD>\n"; print "\t<TITLE>Question Response Statistics</TITLE>\n"; print "\t<SCRIPT language=\"JavaScript\">\n"; print "\t<\!--\n"; print "\t function wdwOnLoad() {\n"; print "\t window.focus();\n"; print "\t }\n"; print "\t window.onload=wdwOnLoad;\n"; print "\t//-->\n"; print "\t</SCRIPT>\n"; print "</HEAD>\n"; print "<BODY>\n"; print "<CENTER>\n"; print "<B>$TEST{'desc'} ($TEST{'id'})</B><BR>\n"; print "<B>Question$titlesfx Response Statistics</B><BR>\n"; print "<font size=2><I>$ncount Completed Responses</I></font>\n"; print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n"; print "\t<TR>\n"; print "\t\t<TD colspan=$sortspan valign=center>\n"; foreach (@sortbys) { if ($_ ne $sortby) { print "\t\t\t<a href=\"$sorturls->{$_}\">Sort by $_</a><br>\n"; } else { print "\t\t\tSorted by $_<br>\n"; } } print "\t\t\t</td><TD colspan=".($colspan2-$sortspan)." valign=center>"; print "<a href=\"$csvurl\">CSV Report</a>\n\t\t\t<br> <br>"; print "<A href=\"$reverseurl\">Change to ".($FORM{'reverse'}?'ascending':'descending')."</a>\n\t\t</TD>\n"; print "\t</TR>\n"; print "\t<TR><TD colspan=$colspan2><HR WIDTH=\"100\%\"></TD></TR>\n"; print "\t<TR>\n"; print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Candidate</B></font></TD>\n"; print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>LoginID</B></TD>\n"; print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Date</B></font></TD>\n"; if ($bysubj) { print "\t\t<TD rowspan=2 valign=bottom><font size=2><B># Previous</B></font></TD>\n"; print "\t\t<TD colspan=$colspan align=center valign=top><font size=2><B>Subject Areas</B></font></TD>\n"; } else { print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Start</B></TD>\n"; print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>End</B></font></TD>\n"; print "\t\t<TD rowspan=2 valign=bottom><font size=2><B>Duration</B></font></TD>\n"; print "\t\t<TD rowspan=2 valign=bottom><font size=2><B># Previous</B></font></TD>\n"; } print "\t\t<TD colspan=4 align=center valign=bottom><font size=2><B>Overall</B></font></TD>\n"; print "\t</TR>\n"; print "\t<TR>\n"; if ($bysubj) { print "\t\t<TD align=center valign=top><font size=2><B>\ \;</B></font></TD>\n"; for $i (0 .. $nsubjects) { print "\t\t<TD align=center valign=top><font size=2><B>$subjects[$i]</B></font></TD>\n"; } }; print "\t\t<TD align=center valign=top><font size=2><B>Correct</B></font></TD>\n"; print "\t\t<TD align=center valign=top><font size=2><B>Incorrect</B></font></TD>\n"; print "\t\t<TD align=center valign=top><font size=2><B>Score</B></font></TD>\n"; print "\t\t<TD align=center valign=top><font size=2><B>P/F</B></font></TD>\n"; print "\t</TR>\n"; print "\t<TR><TD colspan=$colspan2><HR WIDTH=\"100\%\"></TD></TR>\n"; } return $colspan2; } sub print_report_bycnd_footer { if ($bExport) { return;} print "</TABLE>\n"; print "</BODY>\n"; print "</HTML>\n"; } sub print_report_bycnd_csv { print "userid,testname,date,score\n"; my %testlookup; my $lookupfile = join($pathsep,$dataroot,"namelookup.$CLIENT{'clid'}"); #print STDERR "Opening $lookupfile\n"; if (-e $lookupfile) { my $fh = new FileHandle; if ($fh->open($lookupfile)) { while ($_ = <$fh>) { chomp; my @line = split(/\s+/,$_,2); $testlookup{$line[0]} = $line[1]; } } } foreach (@_) { my @row = @{$_->{'columns'}}; my ($userid,$testid,$date,$score) = ($row[1],$TEST{'id'},$row[2],$row[$#row]); if ($testlookup{$testid}) {$testid = $testlookup{$testid};} print join(',',$userid,$testid,$date,$score)."\n"; } } sub show_test_composite { my ($idlist) = @_; &LanguageSupportInit(); $mymsg = ""; my $nresponses=0; my %Likert_points = () ; my %Likert_score = () ; &get_client_profile($SESSION{'clid'}); &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}"); my @converter; if ($SESSION{'uid'} ne '') { my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar"); if ($imaregistrar eq 'Y') { foreach $rotator (@filelist) { my @cnd = split(/\./, $rotator); my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby"); push(@converter, $rotator) unless $creator ne $SESSION{'uid'}; } @filelist = @converter; } } else { &logger::logerr("No SESSION{uid} set!"); } # Get the questions for the test. @questions = &get_question_list($TEST{'id'},$CLIENT{'clid'}); $qhdr = shift @questions; # Load field ids into a hash. The key is the field id. The value is the array index. my @field_ids = split(/\&/, $qhdr) ; my %field_ids = () ; my @qstatsscores = () ; my @qstatssupercat = () ; my %qids_supercat = () ; my @qstatspts = () ; for (0 .. $#field_ids) { # The first field_ids is the hash, the second is the array. my $field_token = $field_ids[$_] ; $field_token =~ s/\s$// ; # Clean white space off the end. $field_ids{$field_token} = $_ ; } @sorted = sort @questions; @questions = @sorted; unshift @questions, $qhdr; @sorted = (); for (1 .. $#questions) { # Preprocess each of the questions, by loading data # about each of the questions into a series of arrays. # Each array has a specific kind of data about every question. # Do not process $questions[0] because that is the line with field ids. ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$_]); my @Q_array = split(/\&/, $questions[$_]); my $SCat ; if ( $qtp eq 'nrt' ) { $qca = 'N/A'; } $qtx =~ s/\;/<BR>/g; ($test,$qid) = split(/\./, $id); $qstatsid[$qid] = $id; $qstatsqc[$qid] = 0; # occurrences of question $qstatsqp[$qid] = 0; # percent occurrences of question $qstatsqt[$qid] = $qtx; # question text $qstatpts[$qid] = $Q_array[$field_ids{'pts'}] ; # Fill in Scores and Category for likert scale question. if ($qtp eq 'lik') { $qstatsscores[$qid] = $Q_array[$field_ids{'scores'}] ; $SCat = $Q_array[$field_ids{'supercat'}] ; $SCat =~ s/\s+$// ; $qstatssupercat[$qid] = $SCat ; } else { $SCat = "" ; $qstatsscores[$qid] = "" ; # Scores for likert scale question. $qstatssupercat[$qid] = "" ; # Category for likert scale question. } if ($qids_supercat{$SCat}) { push (@{$qids_supercat{$SCat}}, $qid) ; } else { $qids_supercat{$SCat} = [$qid] ; } # $qallans is all answers separated by semi-colons. if ($qil eq 'Y') { $qstatsqf[$qid] = "obs"; # question type } else { $qstatsqf[$qid] = $qtp; # question type $qallans = ""; if ($qtp eq 'tf') { $qallans = "$qca\;$qia\;$xlatphrase[670]"; #670=No Response } elsif ($qtp eq 'mcs' || $qtp eq 'mca' || $qtp eq 'lik') { if ($qca eq '') { $qallans = "$qia\;$xlatphrase[670]"; } else { $qallans = "$qca\;$qia\;$xlatphrase[670]"; } } elsif ($qtp eq 'mtx' || $qtp eq 'mtr') { # DED When qca is saved correctly in tdef, # put this back and delte rest: # $qallans = "$qca"; ### DED 2/25/05 Assumes RC labels, not lblall ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); @qiar = split("\;", $qiar); @qiac = split("\;", $qiac); $qallans = ""; foreach $qiarow (@qiar) { foreach $qiacol (@qiac) { $qallans .= "xxx\;"; } } } elsif ($qtp eq 'mcm') { if ($qca eq '') { $qallans = "$qia"; } else { $qallans = "$qca\;$qia"; } } elsif ($qtp eq 'esa') { if ($qca eq '') { $qallans = ""; } else { $qallans = "$qca"; } } elsif ($qtp eq 'nrt') { if ($qca eq 'N/A') { $qallans = "Other\;$xlatphrase[670]\;"; } else { $qallans = "$qca\;Other\;$xlatphrase[670]\;"; } } elsif ($qtp eq 'mch') { @qcans = split(/\;/, $qca); @qians = split(/\;/, $qia); for (my $i = 0; $i <= $#qcans; $i++ ) { $qallans = join('', $qallans, "$qcans[$i]===$qians[$i]<BR>"); } } elsif ($qtp eq 'ord') { $qallans = "$qca"; } if ($qtp eq 'esa') { $qallans =~ s/\,/\;/g; } $qallans =~ s/\;\;/\;/g; $qstatsqr[$qid] = $qallans; # response options $fqstatsqr[$qid] = $qallans; ### DED for FBQ $qstatsqw[$qid] = (); if (($qtp eq 'mch') || ($qtp eq 'ord')) { if ($qtp eq 'mch') { @qstato = split(/<BR>/, $qallans); } else { @qstato = split(/\;/, $qallans); } $ncount = $#qstato + 1; $ncount = int(($ncount * ($ncount + 1)) + 3); for (my $i = 0; $i <= $ncount; $i++ ) { $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage } } elsif ($qtp eq 'mcm' || $qtp eq 'esa' || $qtp eq 'mtx' || $qtp eq 'mtr') { @qstato = split(/\;/, $qallans); if ($qtp eq 'mtr') { ### ASSUMES rank=1..10 - need to allow for other ranks # Have to allow for [1..10] in # each answer, so make it big! $ncount = (($#qstato + 1) * 10) + 3; } else { $ncount = $#qstato + 3; } for (my $i = 0; $i <= $ncount; $i++ ) { $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage } } else { @qstato = split(/\;/, $qallans); foreach $qstat (@qstato) { $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage } } } @qstato = (); } # End of Preprocessing questions. # HBI - Prepare to process answers from Candidates. $ncount = $#filelist + 1; @qucmts=(); $nresponses=$#filelist+1; # HBI - Loop for each Candidate. for (my $fidx = 0; $fidx <= $#filelist; $fidx++ ) { $user = $filelist[$fidx]; $user =~ s/.$TEST{'id'}$//; $user =~ s/^$CLIENT{'clid'}.//; my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'}); if (not defined $history) { $history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'}); } else { #print STDERR "$user from log.\n"; } if (not defined $history) { # no log file entry for this test #print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n"; my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9]; $history->{'end'} = $mtime; $history->{'start'} = $history->{'end'}; } $completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'}); $displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'}); if (&date_out_of_range($completedat,$datefm,$dateto)) { $nresponses--; next; } if (defined $idlist and not $idlist->{$user}) { $nresponses--; next; } my $excuser="inc$user"; if ($FORM{$excuser}) { $nresponses--; next; } &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); @qrsp = split(/\&/, $SUBTEST_RESPONSES{2}); @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); # warn "Client $CLIENT{'clid'}, User ID $user, Test $TEST{'id'} " ; # warn "SUBTEST_QUESTIONS $SUBTEST_QUESTIONS{2} \n"; # warn "SUBTEST_RESPONSES $SUBTEST_RESPONSES{2} \n"; # warn "SUBTEST_SUMMARY $SUBTEST_SUMMARY{2} \n"; if ($qsumry[5] eq "TIME EXPIRED") { @corincs = split(/\//, $qsumry[6]); } else { @corincs = split(/\//, $qsumry[5]); } @qsumry = (); @qsumry = split(/\&/, $SUBTEST_ANSWERS{2}); # warn "SUBTEST_ANSWERS $SUBTEST_ANSWERS{2} " ; @qansseq = (); $fqid=""; $fqididx=""; # HBI - Now loop thru each answer given by $user. # HBI - $_ will be the sequential number of the question. for (1 .. $#qids) { ($test,$qidx) = split(/\./, $qids[$_]); unless ($Comments{$qidx}) { $Comments{$qidx} = {} ; } unless ($Text_Responses{$qidx}) { $Text_Responses{$qidx} = {} ; } ($qansord,$trash) = split(/::/, $qsumry[$_]); $qansord =~ s/\=([0-1])//g; $qansseq[$_] = $qansord; ($qresp,$qucmt) = split(/::/, $qrsp[$_]); $qresp=~ tr/+/ /; $qresp=~ tr/'//d; $qrsp[$_]=$qresp; ##### v ADT - 7/03/2002 ################################### # Added code to print NRT answers in the form of the comments if ($qucmt ne '') { $qucmt =~ tr/+/ /; $qucmt =~ tr/'//d; if ($FORM{'anoncmts'}) { push @qucmts, "$qidx\&User $fidx\&$qucmt"; &InMem::InsertQuesComment($SESSION{'clid'}, "User $fidx", $FORM{'tstid'}, "complete", $_, $qucmt) ; } else { push @qucmts, "$qidx\&$user\&$qucmt"; &InMem::InsertQuesComment($SESSION{'clid'}, $user, $FORM{'tstid'}, "complete", $_, $qucmt) ; warn "Comment $SESSION{'clid'}, $user, $FORM{'tstid'}, complete, $_, $qucmt \n" ; } } ### DED 10/28/2002 Support for filter-by-question (FBQ) if ($FORM{'question'} eq $qids[$_]) { $fqididx=$_; ($trash,$fqid)=split(/\./,$qids[$_]); } } ### DED 10/28/2002 Support for filter-by-question (fbq) #print "<p>FormQues= $FORM{'question'} Ans= $FORM{'answer'} Qansseq= $qansseq[$fqididx]<p>\n"; if ($fqid ne "" && $FORM{'answer'} ne "") { $fmatch=0; if ($qstatsqf[$fqid] eq 'mcs' || $qstatsqf[$fqid] eq 'mca' || $qstatsqf[$fqid] eq 'lik') { @fqansseq=split(/\?/,$qansseq[$fqididx]); # warn "fqididx $fqididx qansseq $qansseq[$fqididx] " ; shift @fqansseq; @fans=split(/\&/,$FORM{'answer'}); # warn "answer $FORM{'answer'} " ; shift @fans; foreach $fans (@fans) { # warn "fans $fans " ; @ffresp=(); $fresp=""; for (0 .. $#fqansseq) { $fqseqans[$fqansseq[$_]]=$_; $ffresp[$_]="xxx"; } if ($fans ne "No+Response") { $ffresp[$fqseqans[$fans]]=$fqseqans[$fans]; } if ($ffresp[0] eq "") { $fresp=""; } else { foreach (@ffresp) { $fresp=join('?',$fresp,$_); } } if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { $fmatch=1; } # warn "fqididx II $fqididx qrsp $qrsp[$fqididx] fresp $fresp fmatch $fmatch " ; @ffresp=(); if ($fmatch == 1) { break; } } @fqansseq=(); @fans=(); } elsif ($qstatsqf[$fqid] eq 'mcm') { @fqansseq=split(/\?/,$qansseq[$fqididx]); shift @fqansseq; @fans=split(/\&/,$FORM{'answer'}); shift @fans; @ffresp=(); $fresp=""; for (0 .. $#fqansseq) { $fqseqans[$fqansseq[$_]]=$_; $ffresp[$_]="xxx"; } if ($fans[0] ne "No+Response") { foreach (@fans) { $ffresp[$fqseqans[$_]]=$fqseqans[$_]; } } if ($ffresp[0] eq "") { $fresp=""; } else { foreach (@ffresp) { $fresp=join('?',$fresp,$_); } } if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { $fmatch=1; } @fqansseq=(); @fans=(); @ffresp=(); } elsif ($qstatsqf[$fqid] eq 'tf') { if ($FORM{'answer'} eq "\&0" ) { $fresp=$qansseq[$fqididx]; } elsif ($FORM{'answer'} eq "\&1" ) { SWITCH: for ($qansseq[$fqididx]) { $fresp = /TRUE/ && "FALSE" || /FALSE/ && "TRUE" || /YES/ && "NO" || /NO/ && "YES" || "bad"; } } elsif ($FORM{'answer'} eq "\&No+Response") { $fresp=""; } else { $fresp="bad"; } if ($qrsp[$fqididx] eq $fresp && $fresp ne "bad") { $fmatch=1; } } elsif ($qstatsqf[$fqid] eq 'esa') { ($fqstatsqr,$trash)=split(/\;Other/,$fqstatsqr[$fqid]); @fqr=split(/\;/,$fqstatsqr); @fans=split(/\&/,$FORM{'answer'}); shift @fans; if ($fans[0] eq "No+Response") { $fqr=""; if ($fqr eq $qrsp[$fqididx]) { $fmatch=1; } } else { foreach (@fans) { $fqr=lc($fqr[$_]); $fqrsp=lc($qrsp[$fqididx]); if ($fqr eq $fqrsp && $fqr ne "") { $fmatch=1; last; } } } @fqr=(); @fans=(); } #print "<p>FQid= $fqid Qtp= $qstatsqf[$fqid] Qstatsid= $qstatsid[$fqid] Fresp= $fresp Qrsp=$qrsp[$fqididx]<p>\n"; if ($fmatch == 0) { ### Don't count this one #print "...Skipping..."; $nresponses--; @fqucmts = @qucmts; @qucmts = (); foreach (@fqucmts) { if (!($_ =~ /\&$user\&/)) { push @qucmts, "$_"; } } next; } $fresp=""; } ### DED End fbq support @qsumry=(); for (1 .. $#qids) { ($test,$qidx) = split(/\./, $qids[$_]); if ($qstatsqf[$qidx] ne 'obs') { $qstatsqc[$qidx]++; $qstatsqp[$qidx] = format_percent(($qstatsqc[$qidx] / $ncount), { fmt => "%.0f" } ); @qstatc = split(/\;/, $qstatsqrc[$qidx]); @qstatp = split(/\;/, $qstatsqrp[$qidx]); if ($qstatsqf[$qidx] eq 'tf') { @qstato = split(/\;/, $qstatsqr[$qidx]); if ($qrsp[$_] eq $qstato[0]) { $qstatc[0]++; } elsif ($qrsp[$_] eq $qstato[1]) { $qstatc[1]++; } else { $qstatc[2]++; } }elsif ($qstatsqf[$qidx] eq 'esa'){ $ncountidx = $#qstatc - 2; $qresp = $qrsp[$_]; $qresp =~ s/\+/ /g; if ($qresp ne '') { $qresp = lc($qresp); # # if answered, Determine from the score summary # if answered correctly # $corinc = substr($corincs[$_], 0, 1); if ($corinc == 0) { $ncountidx++; } $qstatc[$ncountidx]++; if ($corinc == 1) { @qansord = split(/\,/, $qansseq[$_]); for $q (0 .. $#qansord) { if ($qansord[$q] eq $qresp) { $qstatc[$q]++; last; } } } else { # incorrect $found=0; @qstatw=split(/\;/,$qstatsqw[$qidx]); shift(@qstatw); for $q (0 .. $#qstatw) { if ($qstatw[$q] eq $qresp) { $qstatsqwc[$q]++; $found=1; last; } } if ($found != 1) { $qstatsqwc[$#qstatw+1]=1; $qstatsqw[$qidx]=join(';',$qstatsqw[$qidx],$qresp); } @qstatq=(); } } else { $qstatc[$#qstatc]++; } @qansord = (); }elsif ($qstatsqf[$qidx] eq 'nrt'){ if ($qrsp[$_] ne '') { $qstatc[1]++; $qrsp[$_] =~ s/\;/\:/g; $qrsp[$_] =~ s/\r//g; $qrsp[$_] =~ s/\n/\\n/g; if ($qrsp[$_]) { if ($FORM{'anoncmts'}) { push @qresponses, "$qidx\&User $fidx\&$qrsp[$_]"; &InMem::InsertQuesResp($SESSION{'clid'}, "User $fidx", $FORM{'tstid'}, "complete", $_, $qrsp[$_]) ; } else { push @qresponses, "$qidx\&$user\&$qrsp[$_]"; &InMem::InsertQuesResp($SESSION{'clid'}, $user, $FORM{'tstid'}, "complete", $_, $qrsp[$_]) ; # warn "Response $SESSION{'clid'}, $user, $FORM{'tstid'}, complete, $_, $qrsp[$_] \n" ; } } $qstatsqr[$qidx] = join('<br>',$qstatsqr[$qidx],$qrsp[$_]); } else { $qstatc[2]++; } } elsif ($qstatsqf[$qidx] eq 'mcs' || $qstatsqf[$qidx] eq 'mca' ) { ### DED Filter out "?" and "xxx" in qrsp so will match $qrsp[$_] =~ s/\?//g; $qrsp[$_] =~ s/xxx//g; @qansord = split(/\?/, $qansseq[$_]); shift @qansord; $found = 0; if ($qrsp[$_] ne '') { $qstatc[$qansord[$qrsp[$_]]]++; $found = 1; } unless ($found) { # increment "No Response" $qstatc[$#qstatc]++; } @qansord = (); } elsif ($qstatsqf[$qidx] eq 'lik') { # Process Likert Scale questions. my @Lik_score = split(/\,/ , $qstatsscores[$qidx]) ; $Likert_points{$qstatssupercat[$qidx]} += $qstatpts[$qidx] ; # warn "qidx $qidx supercat $qstatssupercat[$qidx] Likert_points $Likert_points{$qstatssupercat[$qidx]}" ; # warn "pts $qstatpts[$qidx] " ; # warn "qstatsqf $qstatsqf[$qidx] response $qrsp[$_] " ; ### DED Filter out "?" and "xxx" in qrsp so will match $qrsp[$_] =~ s/\?//g; $qrsp[$_] =~ s/xxx//g; @qansord = split(/\?/, $qansseq[$_]); shift @qansord; $found = 0; if ($qrsp[$_] ne '') { $qstatc[$qansord[$qrsp[$_]]]++; $Likert_score{$qstatssupercat[$qidx]} += $Lik_score[$qansord[$qrsp[$_]]] ; # warn "Inc answer ub $_ qrsp $qrsp[$_] qansord $qansord[$qrsp[$_]] qstatc $qstatc[$qansord[$qrsp[$_]]] " ; # warn "score $Lik_score[$_] qidx $qidx supercat $qstatssupercat[$qidx] TOT $Likert_score{$qstatssupercat[$qidx]} . " ; $found = 1; } unless ($found) { # increment "No Response" # No Response is zero points on the Likert Scale. $qstatc[$#qstatc]++; # warn "Inc No Resp. $qstatc[$#qstatc] " ; } @qansord = (); } elsif ($qstatsqf[$qidx] eq 'mtx') { $ncountidx = $#qstatc - 2; $qresp = $qrsp[$_]; $qresp =~ s/xxx//g; $qresp =~ s/\?//g; if ($qresp ne '') { # # if answered, Determine from the score summary # if answered correctly # $corinc = substr($corincs[$_], 0, 1); if ($corinc == 0) { $ncountidx++; } $qstatc[$ncountidx]++; if ($corinc == 0) { ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]); ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); @qiar = split("\;", $qiar); @qiac = split("\;", $qiac); # skipping answer sequence part (no rand answ) $holding3 = $_; @qresps = split(/\?/, $qrsp[$_]); shift @qresps; $i=0; foreach $qiarow (@qiar) { foreach $qiacol (@qiac) { if ($qresps[$i] ne "xxx") { $qstatc[$i]++; } $i++; } } } } else { # increment No Response counter $qstatc[$#qstatc]++; } @qansord = (); $_ = $holding3; } elsif ($qstatsqf[$qidx] eq 'mtr') { $ncountidx = $#qstatc - 2; $qresp = $qrsp[$_]; $qresp =~ s/xxx//g; $qresp =~ s/\?//g; if ($qresp ne '') { # # if answered, Determine from the score summary # if answered correctly # $corinc = substr($corincs[$_], 0, 1); if ($corinc == 0) { $ncountidx++; } $qstatc[$ncountidx]++; if ($corinc == 0) { ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]); ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); @qiar = split("\;", $qiar); @qiac = split("\;", $qiac); # skipping answer sequence part (no rand answ) $holding3 = $_; @qresps = split(/\?/, $qrsp[$_]); shift @qresps; $iqresps=0; $iqstatc=0; foreach $qiarow (@qiar) { foreach $qiacol (@qiac) { if ($qresps[$iqresps] ne "xxx") { # $qresps[$iqresps] will be [1..10], so adjust index accordingly $irank = $iqstatc + $qresps[$iqresps] - 1; $qstatc[$irank]++; } $iqresps++; $iqstatc += 10; } } } } else { # increment No Response counter $qstatc[$#qstatc]++; } @qansord = (); $_ = $holding3; } elsif ($qstatsqf[$qidx] eq 'mcm') { $ncountidx = $#qstatc - 2; $qresp = $qrsp[$_]; $qresp =~ s/xxx//g; $qresp =~ s/\?//g; if ($qresp ne '') { # # if answered, Determine from the score summary # if answered correctly # $corinc = substr($corincs[$_], 0, 1); if ($corinc == 0) { $ncountidx++; } $qstatc[$ncountidx]++; if ($corinc == 0) { @qansord = split(/\?/, $qansseq[$_]); shift @qansord; $holding3 = $_; #$found = 0; ### DED 10/18/02 Changed to allow for ### randomized answers & new format @qresps = split(/\?/, $qrsp[$_]); shift @qresps; foreach $qresp (@qresps) { if ($qresp ne "xxx") { $qstatc[$qansord[$qresp]]++; } } } } else { $qstatc[$#qstatc]++; } @qansord = (); $_ = $holding3; } elsif ($qstatsqf[$qidx] eq 'mch') { $ncountidx = $#qstatc - 2; $qresp = $qrsp[$_]; $qresp =~ s/xxx//g; $qresp =~ s/\?//g; if ($qresp ne '') { # # if answered, Determine from the score summary # if answered correctly # $corinc = substr($corincs[$_], 0, 1); if ($corinc == 0) { $ncountidx++; } $qstatc[$ncountidx]++; ### DED 10/18/02 Changed for ### random answers and new format # # Count occurrence of each match # $qansseq[$qidx] [Wrong! DED] # $qansseq[$_] # &a.3.2.0.6.5.8.4.7.1::MATCH.0:1:1:0 # $qrsp[$_] # &dgihbfcea [Old format] # &?d?g?i?h?b?f?c?e?a [New] #$qansseq[$qidx] =~ s/\&//g; $qansseq[$_] =~ s/\&//g; $qrsp[$_] =~ s/\&//g; $qrsp[$_] =~ s/ //g; #@corord = split(/\./, $qansseq[$qidx]); @corord = split(/\./, $qansseq[$_]); #@selord = split(//,$qrsp[$_]); @selord = split(/\?/,$qrsp[$_]); shift @selord; $corhold = $_; if ($corinc == 0) { for (0 .. $#selord) { if ($selord[$_] ne 'xxx') { ($x = &get_label_index($corord[0],$selord[$_]))++; $y = $corord[$x]; #$ncountidx = int($_ * $#corord + $y); $ncountidx = int($y * $#corord + $_); } else { $ncountidx = int(($#corord * $#corord ) + $_); } $qstatc[$ncountidx]++; } } $_ = $corhold; @selord = (); @corord = (); } else { $qstatc[$#qstatc]++; } } elsif ($qstatsqf[$qidx] eq 'ord') { $ncountidx = $#qstatc - 2; $qresp = $qrsp[$_]; $qresp =~ s/xxx//g; ### DED 10/18/02 Changed for ### random answers and new format $qresp =~ s/\?//g; if ($qresp ne '') { # # if answered, Determine from the score summary # if answered correctly # $corinc = substr($corincs[$_], 0, 1); if ($corinc == 0) { $ncountidx++; } $qstatc[$ncountidx]++; # # Count occurrence of each incorrect order # &o.2.3.4.1.0::ORDERED.0:1:1:0 # &34521 [Old format] # &?3?4?5?2?1 [New] # #$qansseq[$qidx] =~ s/\&//g; $qansseq[$_] =~ s/\&//g; $qrsp[$_] =~ s/\&//g; #@corord = split(/\./, $qansseq[$qidx]); @corord = split(/\./, $qansseq[$_]); #@selord = split(//,$qrsp[$_]); @selord = split(/\?/,$qrsp[$_]); shift @selord; $corhold = $_; if ($corinc == 0) { for (1 .. $#corord) { $ncountidx = int(($corord[$_]) * $#corord); $x = int($_ - 1); if ($selord[$x] ne 'xxx') { $ncountidx = $ncountidx + int($selord[$x]) - 1; } else { $ncountidx = int(($#corord * $#corord) + $_ - 1); } $qstatc[$ncountidx]++; } } $_ = $corhold; @selord = (); @corord = (); } else { $qstatc[$#qstatc]++; } } ### DED 8/20/2002 If checked, don't count ### "No Response" in statistics if ($FORM{'exnoresp'}) { if ($qstatsqc[$qidx] > $qstatc[$#qstatc]) { $denom = $qstatsqc[$qidx] - $qstatc[$#qstatc]; } else { $denom = 1; } for (my $i = 0; $i <= $#qstatc-1; $i++ ) { $qstatp[$i] = format_percent($qstatc[$i] / $denom); } } else { for (my $i = 0; $i <= $#qstatc; $i++ ) { $qstatp[$i] = format_percent($qstatc[$i] / $qstatsqc[$qidx]); } } $qstatsqrc[$qidx] = ""; foreach $qstat (@qstatc) { $qstatsqrc[$qidx] = join('', $qstatsqrc[$qidx], "$qstat\;"); } $qstatsqrp[$qidx] = ""; ### DED 8/22/2002 Exclude "No Response" ### from statistics if ($FORM{'exnoresp'}) { $count = $#qstatc-1; } else { $count = $#qstatp } for (0 .. $count) { $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstatp[$_]\;"); } } if (($qstatsqf[$qidx] eq 'mcm') || ($qstatsqf[$qidx] eq 'mch') || ($qstatsqf[$qidx] eq 'ord') || ($qstatsqf[$qidx] eq 'mtx') || ($qstatsqf[$qidx] eq 'mtr')) { $npctidxend = $#qstatc - 3; $nincidx = $#qstatc - 1; $ntotinc = $qstatc[$nincidx]; for (my $i = 0; $i <= $npctidxend; $i++ ) { if ($ntotinc == 0) { $qstatp[$i] = 0; } else { $qstatp[$i] = format_percent($qstatc[$i] / $ntotinc); } } $qstatsqrp[$qidx] = ""; foreach $qstat (@qstatp) { $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;"); } } elsif ($qstatsqf[$qidx] eq 'esa') { $npctidxend = $#qstatc - 3; $ncoridx = $#qstatc - 2; $nincidx = $#qstatc - 1; $ntotcor = $qstatc[$ncoridx]; $ntotinc = $qstatc[$nincidx]; for (my $i = 0; $i <= $npctidxend; $i++ ) { if ($ntotcor == 0) { $qstatp[$i] = 0; } else { $qstatp[$i] = format_percent($qstatc[$i] / $ntotcor); } } $qstatsqrp[$qidx] = ""; foreach $qstat (@qstatp) { $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;"); } $nincidx = $#qstatc - 1; $ntotinc = $qstatc[$nincidx]; for (my $i = 0; $i <= $#qstatsqwc; $i++ ) { if ($ntotinc == 0) { $qstatsqwp[$i] = 0; } else { $qstatsqwp[$i] = format_percent($qstatsqwc[$i] / $ntotinc); } } } @qstato = (); @qstatc = (); @qstatp = (); } } # HBI - End of loop for each Candidate. if ($#qucmts != -1) { @qsumry=sort @qucmts; @qucmts=@qsumry; @qsumry=(); } # HBI - Begin to write the html output. print "<HTML> <HEAD> <!-- $mymsg --> </HEAD> <BODY> <CENTER> <B>$TEST{'desc'} ($TEST{'id'})</B><BR> <B>Question Response Statistics</B><BR>"; if (defined $idlist) { print "<B>Groups: ".join(", ",split(/,/,$FORM{'idlist'}))."</b><br>\n"; } print "<font size=2><I>$nresponses Completed Responses</I></font> <TABLE cellpadding=2 cellspacing=2 border=0 width=100%> <TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR> <TR> <TD rowspan=2 valign=top><B>ID</B></TD> <TD rowspan=2 valign=top><B>Occ</B></TD> <TD rowspan=2 valign=top><B>Pct</B></TD> <TD colspan=3 valign=top><B>Question Text</B></TD> </TR> <TR> <TD valign=top><font size=2><B>Cnt</B></font></TD> <TD valign=top><font size=2><B>Pct</B></font></TD> <TD valign=top><font size=2><B><NOBR>Options</NOBR></B></font></TD> </TR> <TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR> "; $sobsolete = ""; if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { $incresponse = ""; } else { $incresponse = "INCORRECT"; } for (1 ..$#questions) { ($test,$qid) = split(/\./, $qstatsid[$_]); if (!($FORM{'exunans'} && $qstatsqc[$qid] < $FORM{'minunans'})) { if ($qstatsqf[$qid] eq 'obs') { if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') { $sobs = " <TR> <TD valign=top><I>$qstatsid[$_]</I></TD> <TD colspan=2 valign=top><font size=1>INACTIVE</font></TD> <TD colspan=3 valign=top>$qstatsqt[$qid]</TD> </TR> <TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR> "; $sobsolete = join('', $sobsolete, $sobs); } } elsif ($qstatsqf[$qid] eq 'plc') { next; } else { if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || ($qstatsqf[$qid] eq 'esa') || ($qstatsqf[$qid] eq 'mtx') || ($qstatsqf[$qid] eq 'mtr')) { if ($qstatsqf[$qid] eq 'mch') { @qstato = split(/<BR>/, $qstatsqr[$qid]); } else { @qstato = split(/\;/, $qstatsqr[$qid]); } if ($qstatsqf[$qid] eq 'esa') { @qstatw = split(/\;/, $qstatsqw[$qid]); shift @qstatw; } $rowspan1 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4; $rowspan2 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4; } else { @qstato = split(/\;/, $qstatsqr[$qid]); if ( $qstatsqf[$qid] eq 'nrt' ){ $qstato[1] =~ s/\/\//<BR>/g; $qstato[1] =~ s/\//<BR>/g; $qstato[1] =~ s/:/<BR>/g; $qstato[1] =~ s/\+/ /g; } $rowspan1 = ( $qstatsqf[$qid] eq 'nrt' ) ? 3 : 2; $rowspan2 = ( $qstatsqf[$qid] eq 'nrt' ) ? 3 : 2; } if (($FORM{'showcmts'} eq 'withq') && ($#qucmts != -1)) { $rowspan1++; $rowspan2++; } print " <TR> <TD rowspan=$rowspan1 valign=top><I>$qstatsid[$_]</I></TD> <TD rowspan=$rowspan2 valign=top>$qstatsqc[$qid]</TD> <TD rowspan=$rowspan2 valign=top>$qstatsqp[$qid]\%</TD> <TD colspan=3 valign=top>$qstatsqt[$qid]</font></TD> </TR>"; @qstatc = split(/\;/, $qstatsqrc[$qid]); @qstatp = split(/\;/, $qstatsqrp[$qid]); if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || $qstatsqf[$qid] eq 'esa' || $qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') { $ncountidx = $#qstatc - 2; $qstatccor = $qstatc[$ncountidx]; $qstatpcor = $qstatp[$ncountidx]; $qstatcinc = $qstatc[$ncountidx+1]; $qstatpinc = $qstatp[$ncountidx+1]; $qstatcnor = $qstatc[$ncountidx+2]; $qstatpnor = $qstatp[$ncountidx+2]; if ($TEST{'seq'} ne svy && $TEST{'seq'} ne dmg) { print " <TR> <TD valign=top><font size=2>$qstatccor</font></TD> <TD valign=top><font size=2>$qstatpcor\%</font></TD> <TD valign=top><font size=2>$xlatphrase[137]</font></TD> </TR>"; print " <TR> <TD valign=top><font size=2>$qstatcinc</font></TD> <TD valign=top><font size=2>$qstatpinc\%</font></TD> <TD valign=top><font size=2>INCORRECT</font></TD> </TR>"; } else { print " <TR> <TD valign=top><font size=2>$qstatcinc</font></TD> <TD valign=top><font size=2>$qstatpinc\%</font></TD> <TD valign=top><font size=2>RESPONSES</font></TD> </TR>"; } print " <TR> <TD valign=top><font size=2>$qstatcnor</font></TD>"; if ($FORM{'exnoresp'}) { print "<TD valign=top><font size=2> </font></TD>\n"; } else { print "<TD valign=top><font size=2>$qstatpnor\%</font></TD>\n"; } print "<TD valign=top><font size=2>$xlatphrase[670]</font></TD> </TR> "; } if (($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord')) { if ($qstatsqf[$qid] eq 'mch') { $sphrase = "(matched to \>\;\>\;\>\;)"; @matchwords = (); @matchtos = (); foreach $qstat (@qstato) { ($matchword, $matchto) = split(/\=\=\=/, $qstat); push @matchwords, $matchword; push @matchtos, $matchto; } push @matchtos, "Left Blank"; } else { $sphrase = "(ordered as number \>\;\>\;\>\;)"; @matchwords = (); @matchtos = @qstato; $matchidx = 1; foreach $qstat (@qstato) { push @matchwords, "$matchidx"; $matchidx++; } push @matchtos, "Not Used"; } $colspan = int((($#matchwords + 1) * 2) + 1); print "<TR> <TD colspan=3> <TABLE cellpadding=2 cellspacing=0 border=1> <TR> <TD colspan=$colspan align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD> </TR> <TR> <TD rowspan=2 align=right valign=top><font size=2><NOBR>$sphrase</NOBR></font></TD>"; foreach $matchword (@matchwords) { print " <TD colspan=2 align=center><font size=2>$matchword</font></TD>"; } print " </TR> <TR>"; foreach $matchword (@matchwords) { print " <TD align=center><font size=2>Cnt</font></TD> <TD align=center><font size=2>Pct</font></TD>"; } print " </TR>"; $matchidx = 0; foreach $matchto (@matchtos) { print " <TR>"; if ($matchto eq $matchtos[$#matchtos]) { print " <TD align=right valign=top><font size=2>$matchto</font></TD>"; } else { print " <TD valign=top><font size=2>$matchto</font></TD>"; } foreach $matchword (@matchwords) { print " <TD align=center valign=top><font size=2>$qstatc[$matchidx]</font></TD> <TD align=center valign=top><font size=2>$qstatp[$matchidx]\%</font></TD>"; $matchidx++; } print " </TR>"; } print " </TABLE> </TD> </TR>"; } elsif ($qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') { ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qid]); ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); @qiar = split("\;", $qiar); @qiac = split("\;", $qiac); $holdmcm = $_; if ($qstatsqf[$qid] eq 'mtr') { $colspan = ($#qiac + 1) * 3 + 1; $colspan2 = 3; } else { $colspan = ($#qiac + 1) * 2 + 1; $colspan2 = 2; } print " <TR> <TD colspan=3> <TABLE cellpadding=2 cellspacing=0 border=1> <TR> <TD colspan=$colspan align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD> </TR> <TR> <TD> </TD>"; foreach $qiacol (@qiac) { print "<TD colspan=$colspan2 align=center>$qiacol</TD>"; } print "\n</TR> <TR> <TD> </TD>"; foreach $qiacol (@qiac) { if ($qstatsqf[$qid] eq 'mtr') { print "<TD align=center><font size=2><NOBR>Rank</NOBR></font></TD>"; } print "<TD align=center><font size=2><NOBR>Cnt</NOBR></font></TD> <TD align=center><font size=2><NOBR>Pct</NOBR></font></TD>"; } print "\n</TR>\n"; $i=0; foreach $qiarow (@qiar) { print "<TR> <TD>$qiarow</TD>"; foreach $qiacol (@qiac) { if ($qstatsqf[$qid] eq 'mtr') { print "<TD align=center>"; for $irank (1 .. 10) { print "$irank<br>"; } print "</TD>"; print "<TD align=center>"; for $irank (1 .. 10) { print "$qstatc[$i+$irank-1]<br>"; } print "</TD>"; print "<TD align=center>"; for $irank (1 .. 10) { print "$qstatp[$i+$irank-1]\%<br>"; } print "</TD>"; $i += 10; } else { print "<TD align=center>$qstatc[$i]</TD>"; print "<TD align=center>$qstatp[$i]\%</TD>"; $i++; } } print "\n</TR>\n"; } print "\n</TABLE> </TD> </TR>"; } elsif ($qstatsqf[$qid] eq 'mcm') { print " <TR> <TD colspan=3> <TABLE cellpadding=2 cellspacing=0 border=1> <TR> <TD colspan=3 align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD> </TR> <TR> <TD valign=top><font size=2><NOBR>Response Option</NOBR></font></TD> <TD valign=top><font size=2><NOBR>Cnt</NOBR></font></TD> <TD valign=top><font size=2><NOBR>Pct</NOBR></font></TD> </TR> <TR> <TD valign=top><font size=2><NOBR>"; foreach $qstat (@qstato) { print "$qstat<BR>"; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; $holdmcm = $_; $endidx = $#qstatc - 3; for (0 .. $endidx) { print "$qstatc[$_]<BR>"; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; for (0 .. $endidx) { print "$qstatp[$_]\%<BR>"; } $_ = $holdmcm; print "</NOBR></font> </TD> </TR> </TABLE> </TD> </TR>"; } elsif ($qstatsqf[$qid] eq 'esa') { print " <TR> <TD colspan=3> <TABLE cellpadding=2 cellspacing=0 border=1> <TR> <TD colspan=3 align=center><font size=2>BREAKDOWN OF $xlatphrase[137] RESPONSES<font></TD> </TR> <TR> <TD valign=top><font size=2><NOBR>Response Option</NOBR></font></TD> <TD valign=top><font size=2><NOBR>Cnt</NOBR></font></TD> <TD valign=top><font size=2><NOBR>Pct</NOBR></font></TD> </TR> <TR> <TD valign=top><font size=2><NOBR>"; foreach $qstat (@qstato) { print "$qstat<BR>"; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; $holdmcm = $_; $endidx = $#qstatc - 3; for (0 .. $endidx) { print "$qstatc[$_]<BR>"; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; for (0 .. $endidx) { print "$qstatp[$_]\%<BR>"; } $_ = $holdmcm; print "</NOBR></font> </TD> </TR> </TABLE> <p>"; print " <TABLE cellpadding=2 cellspacing=0 border=1> <TR> <TD colspan=3 align=center><font size=2>BREAKDOWN OF $incresponse RESPONSES<font></TD> </TR> <TR> <TD valign=top><font size=2><NOBR>Response Option</NOBR></font></TD> <TD valign=top><font size=2><NOBR>Cnt</NOBR></font></TD> <TD valign=top><font size=2><NOBR>Pct</NOBR></font></TD> </TR> <TR> <TD valign=top><font size=2><NOBR>"; foreach $qstat (@qstatw) { print "$qstat<BR>"; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; $holdmcm = $_; foreach (@qstatsqwc) { print "$_<BR>"; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; foreach (@qstatsqwp) { print "$_\%<BR>"; } $_ = $holdmcm; print "</NOBR></font> </TD> </TR> </TABLE> </TD> </TR>"; } elsif ($qstatsqf[$qid] eq 'nrt' ) { ##### v ADT - 7/03/2002 ################################################ # If you want to remove the NRT statistics, delete between these comments ######################################################################## print " <TR> <TD valign=top><font size=2><NOBR>"; if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { print"$qstatc[2]<BR>$qstatc[1]"; } else { print"<B>$qstatc[0]</B><BR>$qstatc[2]<BR>$qstatc[1]"; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; if ($FORM{'exnoresp'}) { if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { print" <BR>$qstatp[1]\%"; } else { print"<B>$qstatp[0]\%</B><BR> <BR>$qstatp[1]\%"; } } else { if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { print"$qstatp[2]\%<BR>$qstatp[1]\%"; } else { print"<B>$qstatp[0]\%</B><BR>$qstatp[2]\%<BR>$qstatp[1]\%"; } } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { print"$qstato[1]<BR>$qstato[0]"; } else { print"<B>$qstato[0]</B><BR>$qstato[2]<BR>$qstato[1]"; } print "</NOBR>"; print "</font> </TD> </TR>"; print "<TR> <TD colspan=3> <TABLE>\n"; print " <TR> <TD align=right valign=top colspan=3>\n<font size=2><b><i>Responses:</i></b><br></font></td> <TD><font size=2>\n"; for $i (0 .. $#qresponses) { @columns=split(/\&/, $qresponses[$i]); if ($columns[0] eq $qid) { print "<b>$columns[1]\:</b><br>\n"; while (length($columns[2]) > 50) { $j=index($columns[2]," ",45); if ($j==-1) { $qucmt=substr($columns[2],0,50); $columns[2]=substr($columns[2],50); } else { $qucmt=substr($columns[2],0,$j); $j++; $columns[2]=substr($columns[2],$j); } print "$qucmt<br>\n"; } print "$columns[2]<br>\n"; } } print "</font></TD> </TR> </TABLE> </TD> </TR>\n"; ##### ^ ADT - 7/03/2002 - End Delete ################################### } else { if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { $bs = ""; $be = ""; } else { $bs = "<B>"; $be = "</B>"; } print " <TR> <TD valign=top><font size=2><NOBR>"; $boldtag = $bs; $boldtagend = $be; foreach $qstat (@qstatc) { print "$boldtag$qstat$boldtagend<BR>"; $boldtag = ""; $boldtagend = ""; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; $boldtag = $bs; $boldtagend = $be; foreach $qstat (@qstatp) { print "$boldtag$qstat\%$boldtagend<BR>"; $boldtag = ""; $boldtagend = ""; } print "</NOBR></font> </TD> <TD valign=top><font size=2><NOBR>"; $boldtag = $bs; $boldtagend = $be; foreach $qstat (@qstato) { print "$boldtag$qstat$boldtagend<BR>"; $boldtag = ""; $boldtagend = ""; } print "</NOBR></font> </TD> </TR>\n"; } if (($FORM{'showcmts'} eq 'withq') && ($#qucmts != -1)) { print "<TR> <TD colspan=3> <TABLE>\n"; print " <TR> <TD align=right valign=top colspan=3>\n<font size=2><b><i>Comments:</i></b><br></font></td> <TD><font size=2>\n"; for $i (0 .. $#qucmts) { @columns=split(/\&/, $qucmts[$i]); if ($columns[0] eq $qid) { print "<b>$columns[1]\:</b><br>\n"; while (length($columns[2]) > 50) { $j=index($columns[2]," ",45); if ($j==-1) { $qucmt=substr($columns[2],0,50); $columns[2]=substr($columns[2],50); } else { $qucmt=substr($columns[2],0,$j); $j++; $columns[2]=substr($columns[2],$j); } print "$qucmt<br>\n"; } print "$columns[2]<br>\n"; } } print "</font></TD> </TR> </TABLE> </TD> </TR>\n"; } print " <TR> <TD colspan=6><HR WIDTH=\"100\%\"></TD> </TR>\n"; @qstato = (); @qstatc = (); @qstatp = (); } } } if (($FORM{'showcmts'} eq 'atend') && ($#qucmts != -1)) { print "<TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>\n"; print "<TR><TD colspan=6 align=center><B>Comments</B></TD></TR>\n"; print "<TR><TD colspan=6>\n"; print "<TABLE><TR><TD><B>ID</B></TD><TD><B>User</B></TD><TD><B>Comments</B></TD></TR>\n"; for (1 ..$#questions) { ($test,$qid) = split(/\./, $qstatsid[$_]); if ($qstatsqf[$qid] ne 'obs') { for $i (0 .. $#qucmts) { @columns=split(/\&/, $qucmts[$i]); if ($columns[0] eq $qid) { print "<TR>\n"; print "<TD valign=top><font size=2>$qstatsid[$_]</font></td>\n"; print "<TD valign=top><font size=2>$columns[1]</font></td>\n"; print "<TD valign=top><font size=2>\n"; while (length($columns[2]) > 70) { $j=index($columns[2]," ",65); if ($j==-1) { $qucmt=substr($columns[2],0,70); $columns[2]=substr($columns[2],70); } else { $qucmt=substr($columns[2],0,$j); $j++; $columns[2]=substr($columns[2],$j); } print "$qucmt<br>\n"; } print "$columns[2]<br>\n"; print "</font></td>\n"; print "</TR>\n"; } } print "<TR><TD colspan=6><HR WIDTH=\"100\%\"></TD></TR>\n"; } } print "</TD>\n</TR>\n</TABLE>\n</TD>\n</TR>\n"; } @qucmts=(); if ($FORM{'showobs'}) { print "$sobsolete"; } print " </TABLE> " ; # PRINT the NRT responses and comments by Likert category and user. - HBI print "<br><br>\n" ; # print "<HR>\n" ; print "<H2 align=\"left\">Comments</H2>\n" ; print "<p align=\"left\">\n" ; my $outcat ; my $rpy ; my @qid_list ; my @Cat_Users = keys %{$GlobalData->{'CLIENTS'}->{$SESSION{'clid'}}->{'CANDIDATES'}} ; # print "Number of Users is $#Cat_Users " . join(" ", @Cat_Users) . " <br>\n" ; foreach $outcat (sort keys %qids_supercat) { @qid_list = @{$qids_supercat{$outcat}} ; # print "Number of Questions is $#qid_list " . join(" ", @qid_list) . " <br>\n" ; print "<br><br>" ; print "CATEGORY - " . $outcat if ($outcat) ; print "<br>\n" ; foreach $qid (@qid_list) { $qid =~ s/^[\s0]+// ; # Trim leading zeros and white space. print "<br>\n" ; print "Question $qid - $qstatsqt[$qid]\n" ; print "<br>\n" ; foreach $user (sort @Cat_Users) { $rpy = $GlobalData->{'CLIENTS'}->{$SESSION{'clid'}}->{'CANDIDATES'}->{$user}->{'Tests'}->{$FORM{'tstid'}}->{"complete"}->{$qid}->{'Resp'} ; if ($rpy) { # print "User - $user - Reply - $rpy <br>\n" ; print "$rpy <br>\n" ; } $rpy = $GlobalData->{'CLIENTS'}->{$SESSION{'clid'}}->{'CANDIDATES'}->{$user}->{'Tests'}->{$FORM{'tstid'}}->{"complete"}->{$qid}->{'Comment'} ; if ($rpy) { # print "User - $user - Comment - $rpy <br>\n" ; print "$rpy <br>\n" ; } } } } print "<br><br>\n" ; print "<HR>\n" ; # FINISHED - PRINT the NRT responses and comments by Likert category and user. # Printing the raw Likert Scale data openly. # if (%Likert_points) { # print "Likert Category and scores. \<br\>\n" ; # for $cat (sort keys %Likert_points) { # print "$cat $Likert_points{$cat} $Likert_score{$cat}\<br\>\n" ; # } # } if (%Likert_points) { my ($Tot_possible, $Tot_earned) ; $Tot_possible = $Tot_earned = 0; print "<br><br>\n" ; print "<table border>\n" ; print "<tr>" ; print "<TH colspan=\"4\">Likert Category and scores</TH>\n" ; print "</tr>\n" ; print "<tr>" ; print "<TH>Category</TH>" ; print "<TH>Possible</TH>" ; print "<TH>Earned</TH>" ; print "<TH>\% Earned</TH>" ; print "</tr>\n" ; my $percent ; my @img_labels = () ; my @img_data = () ; for $cat (sort keys %Likert_points) { $percent = int ((100.0 * $Likert_score{$cat} / $Likert_points{$cat}) +0.5) ; push @img_labels, $cat ; push @img_data, $percent ; print "<tr>" ; print "<TH align=\"left\">$cat</TH>" ; print "<td align=\"right\">$Likert_points{$cat}</td>" ; $Tot_possible += $Likert_points{$cat} ; print "<td align=\"right\">$Likert_score{$cat}</td>" ; $Tot_earned += $Likert_score{$cat} ; print "<td align=\"right\">" ; printf "%i", $percent ; print " \%" ; print "</td>" ; print "</tr>\n" ; } # Print a total Line. print "<tr>" ; $cat = "Total" ; print "<TH align=\"left\">$cat</TH>" ; print "<td align=\"right\">$Tot_possible</td>" ; print "<td align=\"right\">$Tot_earned</td>" ; $percent = int ((100.0 * $Tot_earned / $Tot_possible) +0.5) ; push @img_labels, $cat ; push @img_data, $percent ; print "<td align=\"right\">" ; printf "%i", $percent ; print " \%" ; print "</td>" ; print "</tr>\n" ; # Finish the table. print "</table>\n" ; print "<br><br><hr /><br><br>\n" ; # The list parameters are: labels, values, and values2. my @values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme ; # The scalar parameters are: xdim, ydim, hbar, title, xlabel, ylabel, ymax, ymin, yticknum @values2 = () ; ($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) = (800, 300, 1, "Likert Category Percents", "Category", "Percent for Category", 100, 0, 10, 1) ; $ydim = $#img_data * 20 + 50 ; my $ymax = 100 ; $ydim = $ymax if ($ydim < $ymax) ; ($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ; print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ; print "\<br\>\n" ; print "<br><br><hr /><br><br>\n" ; } print " </BODY> </HTML> "; }