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.
1462 lines
50 KiB
1462 lines
50 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: testreport.pl,v 1.27 2006/09/14 21:24:44 ddoughty Exp $
|
||
|
|
#
|
||
|
|
# Source File: testreport.pl
|
||
|
|
|
||
|
|
|
||
|
|
# Get config
|
||
|
|
use Data::Dumper;
|
||
|
|
require 'sitecfg.pl';
|
||
|
|
require 'testlib.pl';
|
||
|
|
require 'tstatlib.pl';
|
||
|
|
|
||
|
|
&app_initialize;
|
||
|
|
|
||
|
|
$FORM{'frm'}="";
|
||
|
|
if ($ARGV[0]) {
|
||
|
|
$FORM{'tid'} = $ARGV[0];
|
||
|
|
$FORM{'clid'} = $ARGV[1];
|
||
|
|
$FORM{'cndid'} = $ARGV[2];
|
||
|
|
$FORM{'tstid'} = $ARGV[3];
|
||
|
|
$FORM{'testdates'} = "$ARGV[4]";
|
||
|
|
$FORM{'correct'} = "$ARGV[5]";
|
||
|
|
$FORM{'incorrect'} = $ARGV[6];
|
||
|
|
$FORM{'total'} = $ARGV[7];
|
||
|
|
$FORM{'percent'} = $ARGV[8];
|
||
|
|
$FORM{'format'} = $ARGV[9];
|
||
|
|
$tofile = 1;
|
||
|
|
} else {
|
||
|
|
$tofile = 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
if (&get_session($FORM{'tid'})) {
|
||
|
|
&LanguageSupportInit();
|
||
|
|
&get_client_profile($SESSION{'clid'});
|
||
|
|
#($mycndid,$mytacl)=split(/\./,$FORM{'cndid'});
|
||
|
|
$testdate="";
|
||
|
|
if ($mytacl eq '') {
|
||
|
|
&get_candidate_profile( $SESSION{'clid'}, $FORM{'cndid'});
|
||
|
|
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
|
||
|
|
if ($FORM{'testdates'} ne '') {
|
||
|
|
$testdate = $FORM{'testdates'};
|
||
|
|
my $spc=" ";
|
||
|
|
$testdate =~ s/\,//g;
|
||
|
|
$testdate =~ s/\_/$spc/g;
|
||
|
|
}
|
||
|
|
if ($FORM{'testdates'} ne '' && !$ARGV[0]) {
|
||
|
|
if (!&get_test_sequence_from_history($testcomplete, $CLIENT{'clid'}, $FORM{'cndid'}, $TEST{'id'}, $testdate)) {
|
||
|
|
$msg = "<b>No entry in history file.</b>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
&get_test_sequence( $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'}, $testcomplete);
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
&get_candidate_profile( $SESSION{'clid'}, $mycndid);
|
||
|
|
&get_tacl_profile();
|
||
|
|
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
|
||
|
|
if ($FORM{'testdates'} ne '') {
|
||
|
|
$testdate = $FORM{'testdates'};
|
||
|
|
my $spc=" ";
|
||
|
|
$testdate =~ s/\,//g;
|
||
|
|
$testdate =~ s/\_/$spc/g;
|
||
|
|
}
|
||
|
|
if ($FORM{'testdates'} ne '' && !$ARGV[0]) {
|
||
|
|
if (!&get_test_sequence_from_history($testcomplete, $CLIENT{'clid'}, $FORM{'cndid'}, $TEST{'id'}, $testdate)) {
|
||
|
|
$msg = "<b>No entry in history file.</b>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
&get_test_sequence( $CLIENT{'clid'}, $FORM{'cndid'}, $TEST{'id'}, $testcomplete);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ADT - 2/15/2002 -- Moved these variable declarations here so they can be modified
|
||
|
|
# by the UpdateScore routine if need be.
|
||
|
|
@questions = split(/&/,$SUBTEST_QUESTIONS{2});
|
||
|
|
@keyanswers = split(/&/,$SUBTEST_ANSWERS{2});
|
||
|
|
@studentanswers = split(/&/,$SUBTEST_RESPONSES{2});
|
||
|
|
if ($FORM{'submit'} eq 'Update') {
|
||
|
|
&UpdateScore();
|
||
|
|
}
|
||
|
|
($correctans, $incorrectans, $score, $trash) = split(/&/, $SUBTEST_SUMMARY{2});
|
||
|
|
# convert $testdate to new format (dd-mmm-yyyy) DED 1/9/04
|
||
|
|
my @datestamparray = split(/ /, $testdate);
|
||
|
|
my @datearray = split(/-/, $datestamparray[0]);
|
||
|
|
if (length($datearray[0]) == 4) {
|
||
|
|
my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
|
||
|
|
$datearray[1]--;
|
||
|
|
$datestamparray[0] = "$datearray[2]-$months[$datearray[1]]-$datearray[0]";
|
||
|
|
$testdate = join(" ", @datestamparray);
|
||
|
|
}
|
||
|
|
@datestamparray = ();
|
||
|
|
@datearray = ();
|
||
|
|
if ($FORM{'format'} eq "csv") {
|
||
|
|
&PrintCSV($tofile);
|
||
|
|
} else {
|
||
|
|
&PrintForm($tofile);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# ADT 9/25/2001
|
||
|
|
# This subroutine was here. However, it was empty. I'm filling it!
|
||
|
|
# ADT 2/25/2001 -- Modified this function greatly to coordinate changes with
|
||
|
|
# what is on the production server.
|
||
|
|
sub UpdateScore()
|
||
|
|
{
|
||
|
|
# Retrieve the number of essay answers to which credit was given
|
||
|
|
my $creditGiven = $FORM{'graded'};
|
||
|
|
my $msg = "Score Updated.";
|
||
|
|
my $numCorrectAnswers, $numIncorrectAnswers, $score, $answerString;
|
||
|
|
my @answers, $answer;
|
||
|
|
my $answerCntr, @questionIds;
|
||
|
|
my $result, $studentAnswer, $correctAnswer;
|
||
|
|
my $keyResponse, $kFlags;
|
||
|
|
my $manuallyScored, $keyComments;
|
||
|
|
|
||
|
|
# Split the summary
|
||
|
|
( $numCorrectAnswers, $numIncorrectAnswers, $score, $jpeg, $length, $answerString )
|
||
|
|
= split( /&/, $SUBTEST_SUMMARY{2} );
|
||
|
|
|
||
|
|
# Calculate the new score
|
||
|
|
$numCorrectAnswers += $creditGiven;
|
||
|
|
$numIncorrectAnswers -= $creditGiven;
|
||
|
|
$numTotal = $numCorrectAnswers + $numIncorrectAnswers;
|
||
|
|
if ($numTotal == 0) {
|
||
|
|
$score = 0;
|
||
|
|
} else {
|
||
|
|
$score = sprintf( "%3.1f", $numCorrectAnswers / ( $numTotal ) * 100 );
|
||
|
|
}
|
||
|
|
|
||
|
|
@answers = split( /\//, $answerString );
|
||
|
|
$questionCntr = 0;
|
||
|
|
|
||
|
|
foreach $question ( @questions )
|
||
|
|
{
|
||
|
|
( $result, $correctAnswer, $studentAnswer ) = split( /\./, @answers[$questionCntr], 3 );
|
||
|
|
( $keyResponse, $kFlags ) = split( /::/, $keyanswers[$questionCntr] );
|
||
|
|
( $manuallyScored, $keyComments ) = split( /\./, $keyresponse );
|
||
|
|
my $comment = "cm".$questions[$questionCntr];
|
||
|
|
$keyComments = $FORM{$comment};
|
||
|
|
$keyComments =~ tr/\r\n\&:\.//d; # Remove characters that can mess up the file
|
||
|
|
$manuallyScored = 0;
|
||
|
|
$result = 0;
|
||
|
|
|
||
|
|
if( defined( $FORM{$questions[$questionCntr]} ) )
|
||
|
|
{
|
||
|
|
if( $FORM{$questions[$questionCntr]} eq "on" )
|
||
|
|
{
|
||
|
|
$manuallyScored = 1;
|
||
|
|
$result = 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$answers[$questionCntr] = join( '.', $result, $correctAnswer, $studentAnswer );
|
||
|
|
$keyResponse = join( '.', $manuallyScored, $keyComments );
|
||
|
|
$keyanswers[$questionCntr] = join( "::", $keyResponse, $kFlags );
|
||
|
|
$questionCntr++;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Put the answers back together
|
||
|
|
$answerString = join( '/', @answers );
|
||
|
|
$SUBTEST_SUMMARY{2} = join( '&', $numCorrectAnswers, $numIncorrectAnswers,
|
||
|
|
$score, $jpeg, $length, $answerString );
|
||
|
|
$SUBTEST_ANSWERS{2} = join( '&', @keyanswers );
|
||
|
|
|
||
|
|
# Save the changes to the file
|
||
|
|
&put_test_sequence( $testcomplete, $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'} );
|
||
|
|
}
|
||
|
|
# END ADT
|
||
|
|
|
||
|
|
sub PrintForm() {
|
||
|
|
if ($FORM{'remed'} == "") { $FORM{'remed'} = 0; }
|
||
|
|
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
|
||
|
|
@skilllevel = ( '','','','' );
|
||
|
|
$itemdescription = "Survey";
|
||
|
|
} elsif ($FORM{'remed'} == 1) {
|
||
|
|
$TEST{'seq'} = 'svy';
|
||
|
|
@skilllevel = ( '','','','' );
|
||
|
|
$itemdescription = "Test";
|
||
|
|
} elsif ($FORM{'remed'} == 2) {
|
||
|
|
$TEST{'seq'} = 'svy';
|
||
|
|
@skilllevel = ( '','','','' );
|
||
|
|
$itemdescription = "Incorrect Test";
|
||
|
|
} else {
|
||
|
|
@skilllevel = ( 'Basic','Intermediate','Advanced','' );
|
||
|
|
$itemdescription = "Test";
|
||
|
|
}
|
||
|
|
|
||
|
|
if (!$_[0]) { print "Content-Type: text/html\n\n"; }
|
||
|
|
print "<HTML>\n";
|
||
|
|
print "<HEAD>\n";
|
||
|
|
print "</HEAD>\n";
|
||
|
|
print "<BODY>\n";
|
||
|
|
print "<FORM name=\"form1\" method=\"POST\">\n";
|
||
|
|
print "<input type=hidden name=\"tid\" value=\"$SESSION{'tid'}\">\n";
|
||
|
|
print "<input type=hidden name=\"cndid\" value=\"$CANDIDATE{'uid'}\">\n";
|
||
|
|
print "<input type=hidden name=\"tstid\" value=\"$TEST{'id'}\">\n";
|
||
|
|
print "<input type=hidden name=\"graded\" value=\"0\">\n";
|
||
|
|
print "<CENTER><B><U>$itemdescription Results</U></B><BR>\n";
|
||
|
|
print "<B>Site: $CLIENT{'clid'}</B><BR>\n";
|
||
|
|
print "<B>Test: $TEST{'id'} - $TEST{'desc'}</B><BR>\n";
|
||
|
|
if ($FORM{'testdates'} ne '') {
|
||
|
|
print "<B>Date: $testdate</B><BR>\n";
|
||
|
|
}
|
||
|
|
print "</CENTER>\n";
|
||
|
|
print "<TABLE cellpadding=0 cellspacing=0 border=0 width=\"100\%\">\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD>\n";
|
||
|
|
print "<B>Candidate:</B><BR>\n";
|
||
|
|
print "$CANDIDATE{'sal'} $CANDIDATE{'nmf'} $CANDIDATE{'nmm'} $CANDIDATE{'nml'}<BR>\n";
|
||
|
|
print "$CANDIDATE{'adr'}<BR>\n";
|
||
|
|
print "$CANDIDATE{'cty'}, $CANDIDATE{'ste'} $CANDIDATE{'pst'}<BR>\n";
|
||
|
|
print "$CANDIDATE{'ctry'}<BR>\n";
|
||
|
|
print "</TD>\n";
|
||
|
|
print "<TD>\n";
|
||
|
|
print "$CANDIDATE{'eml'}<BR>\n";
|
||
|
|
print "$CANDIDATE{'cnd1'}<BR>\n";
|
||
|
|
print "$CANDIDATE{'cnd2'}<BR>\n";
|
||
|
|
print "$CANDIDATE{'cnd3'}<BR>\n";
|
||
|
|
print "$CANDIDATE{'cnd4'}<BR>\n";
|
||
|
|
print "</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
print "</TABLE>\n";
|
||
|
|
if (($FORM{'testdates'} ne '' || $FORM{'percent'} ne '') && $FORM{'remed'} == 0) {
|
||
|
|
print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n";
|
||
|
|
print "<TR><TD colspan=3><HR WIDTH=\"100\%\"></TD></TR>\n";
|
||
|
|
if ($FORM{'testdates'} ne '') {
|
||
|
|
my $history = get_testhistory_from_log($CLIENT{'clid'},$CANDIDATE{'uid'},$TEST{'id'},$testdate);
|
||
|
|
if (not defined $history) {
|
||
|
|
print "<TR><TD colspan=3>Test Log Not Available</TD</TR>\n";
|
||
|
|
$msg = '';
|
||
|
|
} else {
|
||
|
|
foreach my $event (@{$history->{'history'}}) {
|
||
|
|
my $action = $event->{'action'};
|
||
|
|
if ($action eq 'Start' or $action eq 'Pause' or $action eq 'Resume' or $action eq 'Complete') {
|
||
|
|
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($event->{'time'});
|
||
|
|
my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
|
||
|
|
$year += 1900;
|
||
|
|
if ($mday < 10) { $mday = "0$mday"; }
|
||
|
|
if ($sec < 10) { $sec = "0$sec"; }
|
||
|
|
if ($min < 10) { $min = "0$min"; }
|
||
|
|
if ($hour < 10) { $hour = "0$hour"; }
|
||
|
|
print "<TR><TD>$action</TD><TD>$mday-$months[$mon]-$year $hour:$min:$sec GMT</td><td> </td></tr>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
print "<tr><td>Total Time</td><td>".fmtDuration($history->{'total'})."</td><td> </td></tr>\n";
|
||
|
|
print "<tr><td>Actual Time</td><td>".fmtDuration($history->{'actual'})."</td><td> </td></tr>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($FORM{'percent'} ne '') {
|
||
|
|
print "<TR><TD colspan=3> </TD></TR>\n";
|
||
|
|
print "<TR><TD width=20%>Correct Answers:</TD><TD width=20%>$FORM{'correct'}</TD><TD> </TD></TR>\n";
|
||
|
|
print "<TR><TD width=20%>Incorrect Answers:</TD><TD width=20%>$FORM{'incorrect'}</TD><TD> </TD></TR>\n";
|
||
|
|
print "<TR><TD width=20%>Total Number of Questions:</TD><TD width=20%>$FORM{'total'}</TD><TD> </TD></TR>\n";
|
||
|
|
print "<TR><TD colspan=3> </TD></TR>\n";
|
||
|
|
print "<TR><TD width=20%>Score:</TD><TD width=20%>$FORM{'percent'} %</TD><TD> </TD></TR>\n";
|
||
|
|
$minpass = ($TEST{'minpass'} eq "") ? "Not Specified" : $TEST{'minpass'}." \%";
|
||
|
|
print "<TR><TD width=20%>Passing Score:</TD><TD width=20%>$minpass</TD><TD> </TD></TR>\n";
|
||
|
|
}
|
||
|
|
print "</TABLE>\n";
|
||
|
|
}
|
||
|
|
if ($msg) {
|
||
|
|
print "<HR WIDTH=100%><BR>\n";
|
||
|
|
print "$msg";
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
print "<TABLE cellpadding=3 cellspacing=2 border=0>\n";
|
||
|
|
if ($FORM{'remed'} != 1) {
|
||
|
|
print "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
|
||
|
|
print "<TD valign=top><B>Credit</B></TD>\n";
|
||
|
|
}
|
||
|
|
print "<TD colspan=4 valign=top><B>Question</B></TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD colspan=2>\ </TD>\n";
|
||
|
|
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
|
||
|
|
#print "<TD colspan=2>\ </TD>\n";
|
||
|
|
print "<TD colspan=3 valign=top><B>$itemdescription-Taker Response</B></TD>\n";
|
||
|
|
} else {
|
||
|
|
print "<TD valign=top><B>ID<BR>Subject<BR>Skill Level</B></TD>\n";
|
||
|
|
print "<TD valign=top><B>Correct Response</B></TD>\n";
|
||
|
|
print "<TD valign=top><B>$itemdescription-Taker Response</B></TD>\n";
|
||
|
|
}
|
||
|
|
print "</TR>\n";
|
||
|
|
}
|
||
|
|
print "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>\n";
|
||
|
|
|
||
|
|
# ADT 2/15/2002 -- Moved variables to main routine so they could be modified
|
||
|
|
# by the UpdateScore Routine
|
||
|
|
|
||
|
|
$allowupdate = 0;
|
||
|
|
$scored = 1;
|
||
|
|
$correctanswertag = "<FONT COLOR=\"green\" SIZE=1>$xlatphrase[137]</FONT>";
|
||
|
|
$incorrectanswertag = "<FONT COLOR=\"red\" SIZE=1>INCORRECT</FONT>";
|
||
|
|
$noanswertag = "<FONT COLOR=\"red\" SIZE=1>UNANSWERED</FONT>";
|
||
|
|
@myalbls=();
|
||
|
|
foreach $questionindex (1 .. $#questions) {
|
||
|
|
&get_question_definition($TEST{'id'},$CLIENT{'clid'},$questions[$questionindex]);
|
||
|
|
$qtype = $QUESTION{'qtp'};
|
||
|
|
if ($qtype eq 'plc') { next; }
|
||
|
|
$myqalb = $QUESTION{'qalb'};
|
||
|
|
($qsubj, $sklvl) = split(/\./, $QUESTION{'subj'});
|
||
|
|
if ($sklvl eq '') { $sklvl = 3; }
|
||
|
|
# v sac start changes to support question optional comments
|
||
|
|
# (replace)
|
||
|
|
# $studentresponse = $studentanswers[$questionindex];
|
||
|
|
# (with)
|
||
|
|
my $trash = $studentanswers[$questionindex];
|
||
|
|
($studentresponse,$studentcomments) = split(/::/,lc($studentanswers[$questionindex]));
|
||
|
|
$studentcomments =unmunge($studentcomments);
|
||
|
|
$studentcomments =~ s/\"/\"/g;
|
||
|
|
$studentcomments =~ s/\+/" "/g;
|
||
|
|
# ^ sac start changes to support question optional comments
|
||
|
|
|
||
|
|
($keyresponse,$kflags) = split(/::/, lc($keyanswers[$questionindex]));
|
||
|
|
|
||
|
|
$scoreable = 1;
|
||
|
|
$credit = $noanswertag;
|
||
|
|
$checked = "";
|
||
|
|
$answerkey = "";
|
||
|
|
$studentkey = "";
|
||
|
|
$qanswermatch = "";
|
||
|
|
@txts = ();
|
||
|
|
|
||
|
|
if (($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') || $FORM{'remed'} == 2) {
|
||
|
|
if ($qtype eq 'nrt') {
|
||
|
|
$scored = 0;
|
||
|
|
$scoreable = 0;
|
||
|
|
$tmpsr = $studentresponse;
|
||
|
|
$tmpsr =~ s/\?//g;
|
||
|
|
$tmpsr =~ s/xxx//g;
|
||
|
|
$tmpsr =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') {
|
||
|
|
$credit = $noanswertag;
|
||
|
|
} else {
|
||
|
|
# ADT - 2/25/2002 -- Modified so the checkbox would be printed even if
|
||
|
|
# the keyresponse has something in it.
|
||
|
|
$credit = "unscoreable";
|
||
|
|
if ($keyresponse ne '') {
|
||
|
|
($manuallyscored,$keycomments) = split(/\./, $keyresponse);
|
||
|
|
}
|
||
|
|
# end ADT
|
||
|
|
}
|
||
|
|
$studentkey = "<U>$studentresponse</U>\n";
|
||
|
|
$studentkey =~ s/\%0D\%0A/\<br\>/g;
|
||
|
|
$studentkey = unmunge($studentkey);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'tf') {
|
||
|
|
$answerkey = $keyresponse;
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'esa') {
|
||
|
|
$answerkey = $keyresponse;
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
if ($answerkey =~ /\,/) {
|
||
|
|
@txts = split(/\,/, $keyresponse);
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
foreach $answerkey (@txts) {
|
||
|
|
if (lc($studentresponse) eq lc($answerkey)) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$answerkey =~ s/\,/<br>/g;
|
||
|
|
} else {
|
||
|
|
if (lc($studentresponse) eq lc($keyresponse)) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mcs') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
push @txts, $QUESTION{'qca'};
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
$checked = ($indexs[1] == '1') ? " CHECKED" : "";
|
||
|
|
$answerkey = join('',$answerkey,"<input type=\"radio\"$checked>$myalbls[$jidx]. $txts[$indexs[0]]<BR>\n");
|
||
|
|
$checked = ($studentresponse =~ /\?$jidx\?/ || $studentresponse =~ /\?$jidx$/) ? " CHECKED" : "";
|
||
|
|
$studentkey = join('',$studentkey,"<input type=\"radio\"$checked>$myalbls[$jidx]. $txts[$indexs[0]]<BR>\n");
|
||
|
|
}
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mcm') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
$checked = ($indexs[1] == '1') ? " CHECKED" : "";
|
||
|
|
$answerkey = join('',$answerkey,"<input type=\"checkbox\"$checked> $txts[$indexs[0]]<BR>\n");
|
||
|
|
$checked = ($studentresponse =~ /\?$jidx\?/ || $studentresponse =~ /\?$jidx$/) ? " CHECKED" : "";
|
||
|
|
$studentkey = join('',$studentkey,"<input type=\"checkbox\"$checked> $txts[$indexs[0]]<BR>\n");
|
||
|
|
}
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mch') {
|
||
|
|
$qanswermatch = "\ <BR>\n";
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$anstype = shift @ansopts;
|
||
|
|
@albls=&set_answer_labels($anstype);
|
||
|
|
$keyresponse = "";
|
||
|
|
### DED-02 7/17/2002 Added following 2 lines
|
||
|
|
### and changed studentkey join below
|
||
|
|
### to allow for "?" delimiter in response
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$cansord[$ansopts[$_]] = $albls[$_];
|
||
|
|
$qanswermatch = join('',$qanswermatch, "<I>($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]</I><BR>\n");
|
||
|
|
}
|
||
|
|
foreach $cansord (@cansord) {
|
||
|
|
$keyresponse = join('', $keyresponse, $cansord);
|
||
|
|
}
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$answerkey = join('',$answerkey,"($cansord[$_]) $txts[$_]<BR>\n");
|
||
|
|
### DED-06 7/23/2002 added following if
|
||
|
|
### to print " " instead of "xxx"
|
||
|
|
### for blank response
|
||
|
|
if ( $studentresponse[$_] eq "xxx" ) {
|
||
|
|
$studentresponse[$_] = " ";
|
||
|
|
}
|
||
|
|
### DED-02 changed
|
||
|
|
#$studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$_]<BR>\n");
|
||
|
|
### to
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]<BR>\n");
|
||
|
|
}
|
||
|
|
@cansord = ();
|
||
|
|
### DED-02 vvv
|
||
|
|
$studentresponse="";
|
||
|
|
for (0 .. $#studentresponse) {
|
||
|
|
if ($studentresponse[$_] ne ' ') {
|
||
|
|
$studentresponse=join('', $studentresponse, $studentresponse[$_]);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
### END DED-02
|
||
|
|
if ($studentresponse eq $keyresponse) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'ord') {
|
||
|
|
### DED 8/10/2002 Got rid of labels because
|
||
|
|
### "o" designator now working
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$ansopt = shift @ansopts;
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$ansopt = $ansopts[$_];
|
||
|
|
$ansopt++;
|
||
|
|
$answerkey = join('',$answerkey,"($ansopt) $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
### DED-07 7/23/2002 added following if
|
||
|
|
### to print " " instead of "xxx"
|
||
|
|
### for blank response
|
||
|
|
if ( $studentresponse[$_] eq "xxx" ) {
|
||
|
|
$studentresponse[$_] = " ";
|
||
|
|
}
|
||
|
|
### DED-03 changed
|
||
|
|
#$studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
### to
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
}
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
#$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
if ($qtype eq 'nrt') {
|
||
|
|
$studentkey = "<U>$studentresponse</U>\n";
|
||
|
|
$studentkey =~ s/\%0D\%0A/\<br\>/g;
|
||
|
|
$studentkey = unmunge($studentkey);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'tf') {
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'esa') {
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mcs' || $qtype eq 'mca') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
@txts = ();
|
||
|
|
if ($QUESTION{'qca'} ne '') {
|
||
|
|
push @txts, $QUESTION{'qca'};
|
||
|
|
}
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
my $srstring = $studentresponse."?";
|
||
|
|
$checked = ($srstring =~ /\?$jidx\?/) ? " CHECKED" : "";
|
||
|
|
$studentkey = join('',$studentkey,"<input type=\"radio\"$checked>($myalbls[$jidx]) $txts[$indexs[0]]<BR>\n");
|
||
|
|
}
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mtx' || $qtype eq 'mtr') {
|
||
|
|
$studentkey="";
|
||
|
|
|
||
|
|
# Split qia into row and col headers
|
||
|
|
$qia = $QUESTION{'qia'};
|
||
|
|
$qia =~ s/\r/\n/g;
|
||
|
|
$qia =~ s/\n\n/\n/g;
|
||
|
|
($qrowhdr, $numqrowhdr, $numqcolhdr, $qcolhdr) = split(/::/,$qia);
|
||
|
|
@qrowhdr = split(/\n/, $qrowhdr);
|
||
|
|
@qcolhdr = split(/\n/, $qcolhdr);
|
||
|
|
|
||
|
|
if ($qtype eq 'mtx') {
|
||
|
|
# Mark selections with "CHECKED"
|
||
|
|
@optvalues = split(/\?/, $studentresponse);
|
||
|
|
shift @optvalues;
|
||
|
|
$i=0;
|
||
|
|
foreach $row (0 .. $#qrowhdr)
|
||
|
|
{
|
||
|
|
foreach $col (0 .. $#qcolhdr)
|
||
|
|
{
|
||
|
|
if ($optvalues[$i] eq "xxx" || $optvalues[$i] eq "")
|
||
|
|
{
|
||
|
|
$chmatrix[$row][$col]="";
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$chmatrix[$row][$col]="CHECKED";
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# Mark selections with "SELECTED"
|
||
|
|
@optvalues = split(/\?/, $studentresponse);
|
||
|
|
shift @optvalues;
|
||
|
|
$i=0;
|
||
|
|
foreach $row (0 .. $#qrowhdr)
|
||
|
|
{
|
||
|
|
foreach $col (0 .. $#qcolhdr)
|
||
|
|
{
|
||
|
|
$rank = $optvalues[$i];
|
||
|
|
foreach $irank (0 .. 10)
|
||
|
|
{
|
||
|
|
if ($irank eq $rank)
|
||
|
|
{
|
||
|
|
$chmatrix[$i][$irank]="SELECTED";
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$chmatrix[$i][$irank]="";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Build matrix html
|
||
|
|
$studentkey="<table border=2>\n<tr><td> </td>";
|
||
|
|
foreach (0 .. $#qcolhdr) {
|
||
|
|
$studentkey .= "<td>$qcolhdr[$_]</td>";
|
||
|
|
}
|
||
|
|
$studentkey .= "</tr>\n";
|
||
|
|
$i=0;
|
||
|
|
foreach $row (0 .. $#qrowhdr) {
|
||
|
|
$studentkey .= "<tr><td>$qrowhdr[$row]</td>";
|
||
|
|
foreach $col (0 .. $#qcolhdr) {
|
||
|
|
if ($qtype eq 'mtx') {
|
||
|
|
$studentkey .= "<td align=center><input type=checkbox name=\"qrs$row$col\" value=\"1\" $chmatrix[$row][$col]></td>";
|
||
|
|
} else {
|
||
|
|
$studentkey .= "<td align=center><select name=\"qrs$row$col\"><option value='' $chmatrix[$i][0]>\ \;</option><option value=1 $chmatrix[$i][1]>1</option><option value=2 $chmatrix[$i][2]>2</option><option value=3 $chmatrix[$i][3]>3</option><option value=4 $chmatrix[$i][4]>4</option><option value=5 $chmatrix[$i][5]>5</option><option value=6 $chmatrix[$i][6]>6</option><option value=7 $chmatrix[$i][7]>7</option><option value=8 $chmatrix[$i][8]>8</option><option value=9 $chmatrix[$i][9]>9</option><option value=10 $chmatrix[$i][10]>10</option></select></td>";
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
$studentkey .= "</tr>\n";
|
||
|
|
}
|
||
|
|
$studentkey .= "</table>\n";
|
||
|
|
@qrowhdr = ();
|
||
|
|
@qcolhdr = ();
|
||
|
|
@chmatrix = ();
|
||
|
|
|
||
|
|
#$studentkey = join('',$studentkey,"<input type=\"checkbox\"$checked>($myalbls[$jidx]) $txts[$indexs[0]]<BR>\n");
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
if ($qtype eq 'mcm') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
@txts = ();
|
||
|
|
if ($QUESTION{'qca'} ne '') {
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
}
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
my $srstring = $studentresponse."?";
|
||
|
|
$checked = ($srstring =~ /\?$jidx\?/) ? " CHECKED" : "";
|
||
|
|
$studentkey = join('',$studentkey,"<input type=\"checkbox\"$checked>($myalbls[$jidx]) $txts[$indexs[0]]<BR>\n");
|
||
|
|
}
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mch') {
|
||
|
|
### DED-04 7/17/2002 Same as DED-02
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
$qanswermatch = "\ <BR>\n";
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$anstype = shift @ansopts;
|
||
|
|
@albls=&set_answer_labels($anstype);
|
||
|
|
$keyresponse = "";
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$cansord[$ansopts[$_]] = $albls[$_];
|
||
|
|
$qanswermatch = join('',$qanswermatch, "<I>($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]</I><BR>\n");
|
||
|
|
}
|
||
|
|
foreach $cansord (@cansord) {
|
||
|
|
$keyresponse = join('', $keyresponse, $cansord);
|
||
|
|
}
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
### DED-04 changed
|
||
|
|
# $studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$_]<BR>\n");
|
||
|
|
### to
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]<BR>\n");
|
||
|
|
}
|
||
|
|
@cansord = ();
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'ord') {
|
||
|
|
### DED-05 7/17/2002 Same as DED-02
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
@albls = &set_answer_labels($QUESTION{'qalb'});
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$ansopt = shift @ansopts;
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$ansopt = $ansopts[$_];
|
||
|
|
$ansopt++;
|
||
|
|
### DED-05 changed
|
||
|
|
# $studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
### to
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
}
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
|
||
|
|
print "<TR>\n";
|
||
|
|
if ($scoreable) {
|
||
|
|
print "<TD rowspan=3 valign=\"top\">$credit</TD>\n";
|
||
|
|
} else {
|
||
|
|
if ($credit eq $noanswertag) {
|
||
|
|
print "<TD rowspan=3 valign=\"top\">$credit</TD>\n";
|
||
|
|
} else {
|
||
|
|
$checked = ($manuallyscored) ? " CHECKED" : "";
|
||
|
|
print "<TD rowspan=3 valign=\"top\"><FONT SIZE=1><input type=\"checkbox\" name=\"$QUESTION{'id'}\" onClick=\"onCheck(this)\"$checked><B>Credit</B></FONT></TD>\n";
|
||
|
|
$allowupdate = 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
print "<TD rowspan=3 valign=\"top\">$questionindex. </TD>\n";
|
||
|
|
print "<TD rowspan=3 valign=\"top\">$QUESTION{'id'} <BR>$qsubj <BR>$skilllevel[$sklvl] </TD>\n";
|
||
|
|
print "<TD colspan=2 valign=\"top\">$QUESTION{'qtx'}</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD colspan=2 valign=\"top\">\ <BR>$qanswermatch</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
if (($qtype eq 'nrt') && ($studentresponse ne '')) {
|
||
|
|
if ($keycomments eq '') {
|
||
|
|
print "<TD valign=\"top\" width=\"40\%\"><FONT SIZE=1>Comments:<BR></FONT><TEXTAREA name=\"cm$QUESTION{'id'}\" ROWS=5 COLS=30>$QUESTION{'qrm'}</TEXTAREA></TD>\n";
|
||
|
|
} else {
|
||
|
|
print "<TD valign=\"top\" width=\"40\%\"><FONT SIZE=1>Comments:<BR></FONT><TEXTAREA name=\"cm$QUESTION{'id'}\" ROWS=5 COLS=30>$keycomments</TEXTAREA></TD>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
print "<TD valign=\"top\" width=\"40\%\">$answerkey</TD>\n";
|
||
|
|
}
|
||
|
|
print "<TD valign=\"top\" width=\"40\%\">$studentkey</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
|
||
|
|
&& ($SESSION{'uac'} eq 'cnd')) {
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD colspan=2> </TD>\n";
|
||
|
|
print "<TD colspan=3 valign=\"top\">$QUESTION{'qrm'}</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
}
|
||
|
|
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
print "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
print "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
print "<TD colspan=2 valign=\"top\"><i>\ <BR><u>(Student Comments) $QUESTION{'qcprmpt'}</u><br>$studentcomments</i></TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
unless ($FORM{'remed'} == 2 && $credit eq $correctanswertag) {
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD rowspan=3 valign=\"top\">$questionindex. </TD>\n";
|
||
|
|
if ($FORM{'remed'} == 0) {
|
||
|
|
print "<TD rowspan=3 valign=\"top\">$QUESTION{'id'} <BR>$qsubj <BR>$skilllevel[$sklvl] </TD>\n";
|
||
|
|
}
|
||
|
|
print "<TD colspan=4 valign=\"top\">$QUESTION{'qtx'}</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
#print "<TD colspan=2 valign=\"top\">\ </TD>\n";
|
||
|
|
print "<TD colspan=4 valign=\"top\">\ <BR>$qanswermatch</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
print "<TR>\n";
|
||
|
|
#print "<TD colspan=2 valign=\"top\">\ </TD>\n";
|
||
|
|
print "<TD colspan=4 valign=\"top\">$studentkey</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
|
||
|
|
&& ($SESSION{'uac'} eq 'cnd')) {
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD colspan=2> </TD>\n";
|
||
|
|
print "<TD colspan=2 valign=\"top\">$QUESTION{'qrm'}</TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
}
|
||
|
|
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
|
||
|
|
print "<TR>\n";
|
||
|
|
print "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
print "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
print "<TD colspan=4 valign=\"top\"><i>\ <BR><u>(Student Comments) $QUESTION{'qcprmpt'}</u><br>$studentcomments</i></TD>\n";
|
||
|
|
print "</TR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
unless ($FORM{'remed'} == 2 && $credit eq $correctanswertag) {
|
||
|
|
print "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
|
||
|
|
if ($allowupdate) {
|
||
|
|
print "<TR><TD align=center colspan=5><input type=submit name=submit value=Update></td></tr>\n";
|
||
|
|
} else {
|
||
|
|
print "<TR><TD align=center colspan=5>Test has been scored.</td></tr>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
print "</TABLE>\n";
|
||
|
|
print "</FORM>\n";
|
||
|
|
print "</BODY>\n";
|
||
|
|
print "</HTML>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub PrintCSV() {
|
||
|
|
print "Content-Disposition: attachment;filename=report.csv\n\n";
|
||
|
|
#if (!$_[0]) { print "Content-Type: text/html\n\n"; }
|
||
|
|
#print "<HTML><pre>\n";
|
||
|
|
if ($FORM{'remed'} == "") { $FORM{'remed'} = 0; }
|
||
|
|
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
|
||
|
|
@skilllevel = ( '','','','' );
|
||
|
|
$itemdescription = "Survey";
|
||
|
|
} elsif ($FORM{'remed'} == 1) {
|
||
|
|
$TEST{'seq'} = 'svy';
|
||
|
|
@skilllevel = ( '','','','' );
|
||
|
|
$itemdescription = "Test";
|
||
|
|
} elsif ($FORM{'remed'} == 2) {
|
||
|
|
$TEST{'seq'} = 'svy';
|
||
|
|
@skilllevel = ( '','','','' );
|
||
|
|
$itemdescription = "Incorrect Test";
|
||
|
|
} else {
|
||
|
|
@skilllevel = ( 'Basic','Intermediate','Advanced','' );
|
||
|
|
$itemdescription = "Test";
|
||
|
|
}
|
||
|
|
|
||
|
|
$header = "Site,Test";
|
||
|
|
$outline = "\"".$CLIENT{'clid'}."\",\"$TEST{'id'} - $TEST{'desc'}\"";
|
||
|
|
if ($FORM{'testdates'} ne '') {
|
||
|
|
$header .= ",Date";
|
||
|
|
$outline .= ",$testdate";
|
||
|
|
}
|
||
|
|
$header .= ",\"Last Name\",\"First Name\",\"Middle Initial\"";
|
||
|
|
$outline .= ",\"$CANDIDATE{'nml'}\",\"$CANDIDATE{'nmf'}\",\"$CANDIDATE{'nmm'}\"";
|
||
|
|
$header .= ",Address,City,State,\"Postal Code\",Country,E-mail";
|
||
|
|
$outline .= ",\"$CANDIDATE{'adr'}\",\"$CANDIDATE{'cty'}\",\"$CANDIDATE{'ste'}\",\"$CANDIDATE{'pst'}\",\"$CANDIDATE{'ctry'}\",\"$CANDIDATE{'eml'}\"";
|
||
|
|
if ($CLIENT{'clcnd1'} ne "") {
|
||
|
|
$header .= ",\"Custom Field 1\"";
|
||
|
|
$outline .= ",\"$CANDIDATE{'cnd1'}\"";
|
||
|
|
}
|
||
|
|
if ($CLIENT{'clcnd2'} ne "") {
|
||
|
|
$header .= ",\"Custom Field 2\"";
|
||
|
|
$outline .= ",\"$CANDIDATE{'cnd2'}\"";
|
||
|
|
}
|
||
|
|
if ($CLIENT{'clcnd3'} ne "") {
|
||
|
|
$header .= ",\"Custom Field 3\"";
|
||
|
|
$outline .= ",\"$CANDIDATE{'cnd3'}\"";
|
||
|
|
}
|
||
|
|
if ($CLIENT{'clcnd4'} ne "") {
|
||
|
|
$header .= ",\"Custom Field 4\"";
|
||
|
|
$outline .= ",\"$CANDIDATE{'cnd4'}\"";
|
||
|
|
}
|
||
|
|
if (($FORM{'testdates'} ne '' || $FORM{'percent'} ne '') && $FORM{'remed'} == 0) {
|
||
|
|
if ($FORM{'testdates'} ne '') {
|
||
|
|
my $history = get_testhistory_from_log($CLIENT{'clid'},$CANDIDATE{'uid'},$TEST{'id'},$testdate);
|
||
|
|
if (not defined $history) {
|
||
|
|
$header .= ",\"Start Time\"";
|
||
|
|
$outline .= ",\"Test Log Not Available\"";
|
||
|
|
$header .= ",\"Stop Time\"";
|
||
|
|
$outline .= ",\"Test Log Not Available\"";
|
||
|
|
$header .= ",\"Total Time\"";
|
||
|
|
$outline .= ",\"Test Log Not Available\"";
|
||
|
|
$header .= ",\"Actual Time\"";
|
||
|
|
$outline .= ",\"Test Log Not Available\"";
|
||
|
|
} else {
|
||
|
|
foreach my $event (@{$history->{'history'}}) {
|
||
|
|
my $action = $event->{'action'};
|
||
|
|
if ($action eq 'Start' or $action eq 'Pause' or $action eq 'Resume' or $action eq 'Complete') {
|
||
|
|
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($event->{'time'});
|
||
|
|
my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
|
||
|
|
$year += 1900;
|
||
|
|
if ($mday < 10) { $mday = "0$mday"; }
|
||
|
|
if ($sec < 10) { $sec = "0$sec"; }
|
||
|
|
if ($min < 10) { $min = "0$min"; }
|
||
|
|
if ($hour < 10) { $hour = "0$hour"; }
|
||
|
|
$header .= ",\"$action Time\"";
|
||
|
|
$outline .= ",\"$mday-$months[$mon]-$year $hour:$min:$sec GMT\"";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$header .= ",\"Total Time\"";
|
||
|
|
$outline .= ",\"".fmtDuration($history->{'total'})."\"";
|
||
|
|
$header .= ",\"Actual Time\"";
|
||
|
|
$outline .= ",\"".fmtDuration($history->{'actual'})."\"";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($FORM{'percent'} ne '') {
|
||
|
|
$header .= ",\"Correct Answers\"";
|
||
|
|
$outline .= ",".$FORM{'correct'};
|
||
|
|
$header .= ",\"Incorrect Answers\"";
|
||
|
|
$outline .= ",".$FORM{'incorrect'};
|
||
|
|
$header .= ",\"Total Number of Questions\"";
|
||
|
|
$outline .= ",".$FORM{'total'};
|
||
|
|
$header .= ",\"Score\"";
|
||
|
|
$outline .= ",\"".$FORM{'percent'}." %\"";
|
||
|
|
$minpass = ($TEST{'minpass'} eq "") ? "Not Specified" : $TEST{'minpass'}." \%";
|
||
|
|
$header .= ",\"Passing Score\"";
|
||
|
|
$outline .= ",\"$minpass\"";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$allowupdate = 0;
|
||
|
|
$scored = 1;
|
||
|
|
$correctanswertag = "$xlatphrase[137]";
|
||
|
|
$incorrectanswertag = "INCORRECT";
|
||
|
|
$noanswertag = "UNANSWERED";
|
||
|
|
@myalbls=();
|
||
|
|
foreach $questionindex (1 .. $#questions) {
|
||
|
|
&get_question_definition($TEST{'id'},$CLIENT{'clid'},$questions[$questionindex]);
|
||
|
|
$qtype = $QUESTION{'qtp'};
|
||
|
|
if ($FORM{'remed'} != 1) {
|
||
|
|
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
|
||
|
|
$header .= ",Credit";
|
||
|
|
}
|
||
|
|
$header .= ",\"Question Number\"";
|
||
|
|
#if ($FORM{'remed'} == 0) {
|
||
|
|
#$header .= ",\"Question ID\",\"Subject Area\",\"Skill Level\"";
|
||
|
|
#}
|
||
|
|
#$header .= ",\"Question Text\"";
|
||
|
|
if ($qtype ne "mtx") {
|
||
|
|
if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
|
||
|
|
$header .= ",\"$itemdescription-Taker Response\"";
|
||
|
|
} else {
|
||
|
|
#$header .= ",\"Subject Skill Level\"";
|
||
|
|
#$header .= ",\"Correct Response\"";
|
||
|
|
$header .= ",\"$itemdescription-Taker Response\"";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($qtype eq 'plc') { next; }
|
||
|
|
$myqalb = $QUESTION{'qalb'};
|
||
|
|
($qsubj, $sklvl) = split(/\./, $QUESTION{'subj'});
|
||
|
|
if ($sklvl eq '') { $sklvl = 3; }
|
||
|
|
my $trash = $studentanswers[$questionindex];
|
||
|
|
($studentresponse,$studentcomments) = split(/::/,lc($studentanswers[$questionindex]));
|
||
|
|
$studentcomments =unmunge($studentcomments);
|
||
|
|
$studentcomments =~ s/\"/\"/g;
|
||
|
|
$studentcomments =~ s/\+/" "/g;
|
||
|
|
|
||
|
|
($keyresponse,$kflags) = split(/::/, lc($keyanswers[$questionindex]));
|
||
|
|
|
||
|
|
$scoreable = 1;
|
||
|
|
$credit = $noanswertag;
|
||
|
|
$checked = "";
|
||
|
|
$answerkey = "";
|
||
|
|
$studentkey = "";
|
||
|
|
$qanswermatch = "";
|
||
|
|
@txts = ();
|
||
|
|
|
||
|
|
if (($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') || $FORM{'remed'} == 2) {
|
||
|
|
if ($qtype eq 'nrt') {
|
||
|
|
$scored = 0;
|
||
|
|
$scoreable = 0;
|
||
|
|
$tmpsr = $studentresponse;
|
||
|
|
$tmpsr =~ s/\?//g;
|
||
|
|
$tmpsr =~ s/xxx//g;
|
||
|
|
$tmpsr =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') {
|
||
|
|
$credit = $noanswertag;
|
||
|
|
} else {
|
||
|
|
$credit = "unscoreable";
|
||
|
|
if ($keyresponse ne '') {
|
||
|
|
($manuallyscored,$keycomments) = split(/\./, $keyresponse);
|
||
|
|
}
|
||
|
|
# end ADT
|
||
|
|
}
|
||
|
|
$studentkey = "<U>$studentresponse</U>\n";
|
||
|
|
$studentkey =~ s/\%0D\%0A/\<br\>/g;
|
||
|
|
$studentkey = unmunge($studentkey);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'tf') {
|
||
|
|
$answerkey = $keyresponse;
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'esa') {
|
||
|
|
$answerkey = $keyresponse;
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
if ($answerkey =~ /\,/) {
|
||
|
|
@txts = split(/\,/, $keyresponse);
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
foreach $answerkey (@txts) {
|
||
|
|
if (lc($studentresponse) eq lc($answerkey)) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$answerkey =~ s/\,/<br>/g;
|
||
|
|
} else {
|
||
|
|
if (lc($studentresponse) eq lc($keyresponse)) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mcs') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
push @txts, $QUESTION{'qca'};
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
$checked = ($indexs[1] == '1') ? " CHECKED" : "";
|
||
|
|
$answerkey = join('',$answerkey,"<input type=\"radio\"$checked>$myalbls[$jidx]. $txts[$indexs[0]]<BR>\n");
|
||
|
|
$checked = ($studentresponse =~ /\?$jidx\?/ || $studentresponse =~ /\?$jidx$/) ? " CHECKED" : "";
|
||
|
|
$studentkey = join('',$studentkey,"<input type=\"radio\"$checked>$myalbls[$jidx]. $txts[$indexs[0]]<BR>\n");
|
||
|
|
}
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mcm') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
$checked = ($indexs[1] == '1') ? " CHECKED" : "";
|
||
|
|
$answerkey = join('',$answerkey,"<input type=\"checkbox\"$checked> $txts[$indexs[0]]<BR>\n");
|
||
|
|
$checked = ($studentresponse =~ /\?$jidx\?/ || $studentresponse =~ /\?$jidx$/) ? " CHECKED" : "";
|
||
|
|
$studentkey = join('',$studentkey,"<input type=\"checkbox\"$checked> $txts[$indexs[0]]<BR>\n");
|
||
|
|
}
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mch') {
|
||
|
|
$qanswermatch = "\ <BR>\n";
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$anstype = shift @ansopts;
|
||
|
|
@albls=&set_answer_labels($anstype);
|
||
|
|
$keyresponse = "";
|
||
|
|
### DED-02 7/17/2002 Added following 2 lines
|
||
|
|
### and changed studentkey join below
|
||
|
|
### to allow for "?" delimiter in response
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$cansord[$ansopts[$_]] = $albls[$_];
|
||
|
|
$qanswermatch = join('',$qanswermatch, "<I>($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]</I><BR>\n");
|
||
|
|
}
|
||
|
|
foreach $cansord (@cansord) {
|
||
|
|
$keyresponse = join('', $keyresponse, $cansord);
|
||
|
|
}
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$answerkey = join('',$answerkey,"($cansord[$_]) $txts[$_]<BR>\n");
|
||
|
|
if ( $studentresponse[$_] eq "xxx" ) {
|
||
|
|
$studentresponse[$_] = " ";
|
||
|
|
}
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]<BR>\n");
|
||
|
|
}
|
||
|
|
@cansord = ();
|
||
|
|
$studentresponse="";
|
||
|
|
for (0 .. $#studentresponse) {
|
||
|
|
if ($studentresponse[$_] ne ' ') {
|
||
|
|
$studentresponse=join('', $studentresponse, $studentresponse[$_]);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($studentresponse eq $keyresponse) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'ord') {
|
||
|
|
### DED 8/10/2002 Got rid of labels because
|
||
|
|
### "o" designator now working
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$ansopt = shift @ansopts;
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$ansopt = $ansopts[$_];
|
||
|
|
$ansopt++;
|
||
|
|
$answerkey = join('',$answerkey,"($ansopt) $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
if ( $studentresponse[$_] eq "xxx" ) {
|
||
|
|
$studentresponse[$_] = " ";
|
||
|
|
}
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
}
|
||
|
|
if ($studentkey eq $answerkey) {
|
||
|
|
$credit = $correctanswertag;
|
||
|
|
$corsc++;
|
||
|
|
} else {
|
||
|
|
$credit = $incorrectanswertag;
|
||
|
|
#$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
### Must be a svy or dmg
|
||
|
|
if ($qtype eq 'nrt') {
|
||
|
|
$studentkey = unmunge($studentresponse);
|
||
|
|
$studentkey = "$studentkey";
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'tf') {
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'esa') {
|
||
|
|
$studentkey = $studentresponse;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mcs' || $qtype eq 'mca') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
@txts = ();
|
||
|
|
if ($QUESTION{'qca'} ne '') {
|
||
|
|
push @txts, $QUESTION{'qca'};
|
||
|
|
}
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
my $srstring = $studentresponse."?";
|
||
|
|
$checked = ($srstring =~ /\?$jidx\?/) ? "1" : "0";
|
||
|
|
if ($checked) {
|
||
|
|
$studentkey .= "$myalbls[$jidx]) $txts[$indexs[0]]";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mtx' || $qtype eq 'mtr') {
|
||
|
|
$studentkey="";
|
||
|
|
|
||
|
|
# Split qia into row and col headers
|
||
|
|
$qia = $QUESTION{'qia'};
|
||
|
|
$qia =~ s/\r/\n/g;
|
||
|
|
$qia =~ s/\n\n/\n/g;
|
||
|
|
($qrowhdr, $numqrowhdr, $numqcolhdr, $qcolhdr) = split(/::/,$qia);
|
||
|
|
@qrowhdr = split(/\n/, $qrowhdr);
|
||
|
|
@qcolhdr = split(/\n/, $qcolhdr);
|
||
|
|
|
||
|
|
if ($qtype eq 'mtx') {
|
||
|
|
# Mark selections with "CHECKED"
|
||
|
|
@optvalues = split(/\?/, $studentresponse);
|
||
|
|
shift @optvalues;
|
||
|
|
$i=0;
|
||
|
|
foreach $row (0 .. $#qrowhdr)
|
||
|
|
{
|
||
|
|
foreach $col (0 .. $#qcolhdr)
|
||
|
|
{
|
||
|
|
if ($optvalues[$i] eq "xxx" || $studentresponse eq "")
|
||
|
|
{
|
||
|
|
$chmatrix[$row][$col]="0";
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$chmatrix[$row][$col]="1";
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# Mark selections with "SELECTED"
|
||
|
|
@optvalues = split(/\?/, $studentresponse);
|
||
|
|
shift @optvalues;
|
||
|
|
$i=0;
|
||
|
|
foreach $row (0 .. $#qrowhdr)
|
||
|
|
{
|
||
|
|
foreach $col (0 .. $#qcolhdr)
|
||
|
|
{
|
||
|
|
$rank = $optvalues[$i];
|
||
|
|
foreach $irank (0 .. 10)
|
||
|
|
{
|
||
|
|
if ($irank eq $rank)
|
||
|
|
{
|
||
|
|
$chmatrix[$i][$irank]="SELECTED";
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$chmatrix[$i][$irank]="";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Build matrix data
|
||
|
|
$i=0;
|
||
|
|
$mtxoutline = "";
|
||
|
|
foreach $row (0 .. $#qrowhdr) {
|
||
|
|
foreach $col (0 .. $#qcolhdr) {
|
||
|
|
$header .= ",\"$qrowhdr[$row]:$qcolhdr[$col]\"";
|
||
|
|
if ($qtype eq 'mtx') {
|
||
|
|
$mtxoutline .= ",\"$chmatrix[$row][$col]\"";
|
||
|
|
} else {
|
||
|
|
$studentkey .= "<td align=center><select name=\"qrs$row$col\"><option value='' $chmatrix[$i][0]>\ \;</option><option value=1 $chmatrix[$i][1]>1</option><option value=2 $chmatrix[$i][2]>2</option><option value=3 $chmatrix[$i][3]>3</option><option value=4 $chmatrix[$i][4]>4</option><option value=5 $chmatrix[$i][5]>5</option><option value=6 $chmatrix[$i][6]>6</option><option value=7 $chmatrix[$i][7]>7</option><option value=8 $chmatrix[$i][8]>8</option><option value=9 $chmatrix[$i][9]>9</option><option value=10 $chmatrix[$i][10]>10</option></select></td>";
|
||
|
|
}
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#$studentkey = $mtxoutline;
|
||
|
|
@qrowhdr = ();
|
||
|
|
@qcolhdr = ();
|
||
|
|
@chmatrix = ();
|
||
|
|
|
||
|
|
#$studentkey = join('',$studentkey,"<input type=\"checkbox\"$checked>($myalbls[$jidx]) $txts[$indexs[0]]<BR>\n");
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
if ($qtype eq 'mcm') {
|
||
|
|
@myalbls=&set_answer_labels($myqalb);
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
@txts = ();
|
||
|
|
if ($QUESTION{'qca'} ne '') {
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
}
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
foreach $qia (@txts_wro) {
|
||
|
|
push @txts, $qia;
|
||
|
|
}
|
||
|
|
@kans = split(/\?/,$keyresponse);
|
||
|
|
foreach $j (1 .. $#kans) {
|
||
|
|
$jidx = $j-1;
|
||
|
|
@indexs = split(/=/, $kans[$j]);
|
||
|
|
my $srstring = $studentresponse."?";
|
||
|
|
$checked = ($srstring =~ /\?$jidx\?/) ? " CHECKED" : "";
|
||
|
|
$studentkey = join('',$studentkey,"<input type=\"checkbox\"$checked>($myalbls[$jidx]) $txts[$indexs[0]]<BR>\n");
|
||
|
|
}
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'mch') {
|
||
|
|
### DED-04 7/17/2002 Same as DED-02
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
$qanswermatch = "\ <BR>\n";
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$anstype = shift @ansopts;
|
||
|
|
@albls=&set_answer_labels($anstype);
|
||
|
|
$keyresponse = "";
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$cansord[$ansopts[$_]] = $albls[$_];
|
||
|
|
$qanswermatch = join('',$qanswermatch, "<I>($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]</I><BR>\n");
|
||
|
|
}
|
||
|
|
foreach $cansord (@cansord) {
|
||
|
|
$keyresponse = join('', $keyresponse, $cansord);
|
||
|
|
}
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
### DED-04 changed
|
||
|
|
# $studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$_]<BR>\n");
|
||
|
|
### to
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$_]<BR>\n");
|
||
|
|
}
|
||
|
|
@cansord = ();
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($qtype eq 'ord') {
|
||
|
|
### DED-05 7/17/2002 Same as DED-02
|
||
|
|
@studentresponse = split(/\?/, $studentresponse);
|
||
|
|
shift @studentresponse;
|
||
|
|
@albls = &set_answer_labels($QUESTION{'qalb'});
|
||
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
||
|
|
@ansopts = split(/\./, $keyresponse);
|
||
|
|
$ansopt = shift @ansopts;
|
||
|
|
for (0 .. $#ansopts) {
|
||
|
|
$ansopt = $ansopts[$_];
|
||
|
|
$ansopt++;
|
||
|
|
### DED-05 changed
|
||
|
|
# $studentkey = join('',$studentkey,"(",substr($studentresponse,$_,1),") $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
### to
|
||
|
|
$studentkey = join('',$studentkey,"(",$studentresponse[$_],") $txts[$ansopts[$_]]<BR>\n");
|
||
|
|
}
|
||
|
|
$studentresponse =~ s/xxx//g;
|
||
|
|
$studentresponse =~ s/\?//g;
|
||
|
|
$studentresponse =~ s/ //g;
|
||
|
|
if ($studentresponse eq '') { $credit = $noanswertag;}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') {
|
||
|
|
$outline .= "<TR>\n";
|
||
|
|
if ($scoreable) {
|
||
|
|
$outline .= "<TD rowspan=3 valign=\"top\">$credit</TD>\n";
|
||
|
|
} else {
|
||
|
|
if ($credit eq $noanswertag) {
|
||
|
|
$outline .= "<TD rowspan=3 valign=\"top\">$credit</TD>\n";
|
||
|
|
} else {
|
||
|
|
$checked = ($manuallyscored) ? " CHECKED" : "";
|
||
|
|
$outline .= "<TD rowspan=3 valign=\"top\"><FONT SIZE=1><input type=\"checkbox\" name=\"$QUESTION{'id'}\" onClick=\"onCheck(this)\"$checked><B>Credit</B></FONT></TD>\n";
|
||
|
|
$allowupdate = 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$outline .= "<TD rowspan=3 valign=\"top\">$questionindex. </TD>\n";
|
||
|
|
$outline .= "<TD rowspan=3 valign=\"top\">$QUESTION{'id'} <BR>$qsubj <BR>$skilllevel[$sklvl] </TD>\n";
|
||
|
|
$outline .= "<TD colspan=2 valign=\"top\">$QUESTION{'qtx'}</TD>\n";
|
||
|
|
$outline .= "</TR>\n";
|
||
|
|
$outline .= "<TR>\n";
|
||
|
|
$outline .= "<TD colspan=2 valign=\"top\">\ <BR>$qanswermatch</TD>\n";
|
||
|
|
$outline .= "</TR>\n";
|
||
|
|
$outline .= "<TR>\n";
|
||
|
|
if (($qtype eq 'nrt') && ($studentresponse ne '')) {
|
||
|
|
if ($keycomments eq '') {
|
||
|
|
$outline .= "<TD valign=\"top\" width=\"40\%\"><FONT SIZE=1>Comments:<BR></FONT><TEXTAREA name=\"cm$QUESTION{'id'}\" ROWS=5 COLS=30>$QUESTION{'qrm'}</TEXTAREA></TD>\n";
|
||
|
|
} else {
|
||
|
|
$outline .= "<TD valign=\"top\" width=\"40\%\"><FONT SIZE=1>Comments:<BR></FONT><TEXTAREA name=\"cm$QUESTION{'id'}\" ROWS=5 COLS=30>$keycomments</TEXTAREA></TD>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$outline .= "<TD valign=\"top\" width=\"40\%\">$answerkey</TD>\n";
|
||
|
|
}
|
||
|
|
$outline .= "<TD valign=\"top\" width=\"40\%\">$studentkey</TD>\n";
|
||
|
|
$outline .= "</TR>\n";
|
||
|
|
if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
|
||
|
|
&& ($SESSION{'uac'} eq 'cnd')) {
|
||
|
|
$outline .= "<TR>\n";
|
||
|
|
$outline .= "<TD colspan=2> </TD>\n";
|
||
|
|
$outline .= "<TD colspan=3 valign=\"top\">$QUESTION{'qrm'}</TD>\n";
|
||
|
|
$outline .= "</TR>\n";
|
||
|
|
}
|
||
|
|
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
|
||
|
|
$outline .= "<TR>\n";
|
||
|
|
$outline .= "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
$outline .= "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
$outline .= "<TD valign=\"top\"> <br></TD>\n";
|
||
|
|
$outline .= "<TD colspan=2 valign=\"top\"><i>\ <BR><u>(Student Comments) $QUESTION{'qcprmpt'}</u><br>$studentcomments</i></TD>\n";
|
||
|
|
$outline .= "</TR>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
### Must be a svy or dmg
|
||
|
|
unless ($FORM{'remed'} == 2 && $credit eq $correctanswertag) {
|
||
|
|
$outline .= ",\"$questionindex. \"";
|
||
|
|
#if ($FORM{'remed'} == 0) {
|
||
|
|
#$outline .= ",\"$QUESTION{'id'}\",\"$qsubj\",\"$skilllevel[$sklvl]\"";
|
||
|
|
#}
|
||
|
|
#$outline .= ",\"$QUESTION{'qtx'}\"";
|
||
|
|
#$outline .= ",\"$qanswermatch\"";
|
||
|
|
if ($qtype eq "mtx") {
|
||
|
|
$outline .= $mtxoutline ;
|
||
|
|
} else {
|
||
|
|
$outline .= ",\"$studentkey\"";
|
||
|
|
}
|
||
|
|
#if (($TEST{'remt'} ne '0') && ($TEST{'emlcndopt'} eq 'Y')
|
||
|
|
#&& ($SESSION{'uac'} eq 'cnd')) {
|
||
|
|
#$outline .= ",\"$QUESTION{'qrm'}\"";
|
||
|
|
#}
|
||
|
|
if ($QUESTION{'qcmtprmpt'} eq 'Y') {
|
||
|
|
$header .= ",\"(Student Comments) $QUESTION{'qcprmpt'}\"";
|
||
|
|
$outline .= ",\"$studentcomments\"";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$header =~ s/\n/ /g;
|
||
|
|
$outline =~ s/\n/ /g;
|
||
|
|
$outline =~ s/<br>/ /g;
|
||
|
|
$outline =~ s/<p>/ /g;
|
||
|
|
$outline =~ s/<\/p>/ /g;
|
||
|
|
print "$header\n";
|
||
|
|
print "$outline\n";
|
||
|
|
#print "</pre></HTML>\n";
|
||
|
|
}
|