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.
860 lines
26 KiB
860 lines
26 KiB
#!/usr/bin/perl
|
|
#
|
|
# $Id: tocrinp.pl
|
|
#
|
|
# Source File: tocrinp.pl
|
|
|
|
# Get config
|
|
require 'sitecfg.pl';
|
|
require 'testlib.pl';
|
|
|
|
print "Content-Type: text/html\n\n";
|
|
|
|
&app_initialize;
|
|
|
|
if (&get_session($FORM{'tid'})) {
|
|
my $show_template = "selectpg";
|
|
&LanguageSupportInit();
|
|
$FORM{'respmsg'} = "";
|
|
if ($FORM{'dbop'} eq 'hc') {
|
|
# client selection header frame
|
|
$show_template="tocrclient";
|
|
} elsif ($FORM{'dbop'} eq 'ht') {
|
|
# test selection header frame
|
|
&get_client_profile($FORM{'clid'});
|
|
$show_template=($FORM{'clid'} eq '') ? "selectpg" : "tocrtest";
|
|
} elsif ($FORM{'dbop'} eq 'hu') {
|
|
# candidate selection header frame
|
|
unless ($FORM{'clid'}) {
|
|
warn "ERROR: No Client ID" ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_client_profile($FORM{'clid'});
|
|
unless (%CLIENT) {
|
|
warn "ERROR: Invalid Client ID $FORM{'clid'} " ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
$FORM{'testcandidates'}=&get_test_candidates($FORM{'clid'},$FORM{'tstid'},$FORM{'unscored'},$FORM{'completed'});
|
|
$FORM{'tccount'}=($FORM{'testcandidates'} eq '') ? 0 : 1;
|
|
$show_template=($FORM{'tstid'} eq '') ? "selectpg" : "tocrcnd";
|
|
} elsif ($FORM{'dbop'} eq 'dtl') {
|
|
if ($FORM{'cndid'} eq '') {
|
|
$show_template="selectpg";
|
|
} else {
|
|
my $dir = ($FORM{'unscored'} eq 'P') ? $testpending : $testcomplete;
|
|
unless ($FORM{'clid'}) {
|
|
warn "ERROR: No Client ID" ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
unless ($FORM{'tstid'}) {
|
|
warn "ERROR: No Test ID" ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_client_profile($FORM{'clid'});
|
|
unless (%CLIENT) {
|
|
warn "ERROR: Invalid Client ID $FORM{'clid'} " ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_test_profile($FORM{'clid'},$FORM{'tstid'});
|
|
unless (%TEST) {
|
|
warn "ERROR: Invalid Test ID $FORM{'tstid'} " ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_candidate_profile($FORM{'clid'},$FORM{'cndid'});
|
|
unless (%CANDIDATE) {
|
|
warn "ERROR: Invalid Candidate ID $FORM{'cndid'} " ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_test_sequence( $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'}, $dir);
|
|
&CreateOCRInputForm();
|
|
$show_template="";
|
|
}
|
|
} elsif ($FORM{'dbop'} eq 'post') {
|
|
# test replication detail save
|
|
if ($FORM{'cndid'} eq '') {
|
|
$show_template="selectpg";
|
|
} else {
|
|
$endtime = &format_date_time("dd-mmm-yyyy hh:nn:ss GMT", "1", "0");
|
|
my $dir = ($FORM{'unscored'} eq 'P') ? $testpending : $testcomplete;
|
|
unless ($FORM{'clid'}) {
|
|
warn "ERROR: No Client ID" ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
unless ($FORM{'tstid'}) {
|
|
warn "ERROR: No Test ID" ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_client_profile($FORM{'clid'});
|
|
unless (%CLIENT) {
|
|
warn "ERROR: Invalid Client ID $FORM{'clid'} " ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_test_profile($FORM{'clid'},$FORM{'tstid'});
|
|
unless (%TEST) {
|
|
warn "ERROR: Invalid Test ID $FORM{'tstid'} " ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_candidate_profile($FORM{'clid'},$FORM{'cndid'});
|
|
unless (%CANDIDATE) {
|
|
warn "ERROR: Invalid Candidate ID $FORM{'cndid'} " ;
|
|
&show_illegal_access_warning ;
|
|
exit ;
|
|
}
|
|
&get_test_sequence( $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'}, $dir);
|
|
&promote_test_sequence( $testpending, $testinprog, $TEST_STATES{'_PENDING'});
|
|
$tetmplt = 'tsubend';
|
|
$tsubtest = 2;
|
|
$TEST_SESSION{'subtest'} = $FORM{'tstid'};
|
|
&single_form_test_done($dir);
|
|
&make_anonymous();
|
|
$show_template="";
|
|
}
|
|
}
|
|
unless ($show_template eq '') { &show_template($show_template);}
|
|
} else {
|
|
&show_illegal_access_warning;
|
|
}
|
|
|
|
sub get_test_candidates {
|
|
my ($clid,$tstid,$unscoredflag,$completedflag) = @_;
|
|
my $html="";
|
|
my @cnds=();
|
|
my @recs=();
|
|
my $rec;
|
|
my $reclid;
|
|
my $recndid;
|
|
my $rectst;
|
|
if ($unscoredflag ne '') {
|
|
opendir (TMPDIR, "$testpending");
|
|
@cnds = readdir(TMPDIR);
|
|
closedir TMPDIR;
|
|
my @recs=grep( /^$clid\.(.*)\.$tstid/ , @cnds);
|
|
@cnds=();
|
|
foreach $rec (@recs) {
|
|
($reclid,$recndid,$rectst)=&split_test_filename($rec,$clid,$tstid);
|
|
if (($reclid eq $clid) && ($rectst eq $tstid)) {
|
|
if (&get_candidate_profile($clid,$recndid)) {
|
|
$uniquenml = "$CANDIDATE{'nml'}:$CANDIDATE{'uid'}";
|
|
push(@cndsnml,$uniquenml);
|
|
}
|
|
}
|
|
}
|
|
@scndsnml = sort(@cndsnml);
|
|
@cndsnml=();
|
|
foreach $cnml (@scndsnml) {
|
|
($trash, $tmpcndid) = split(/:/,$cnml);
|
|
if (&get_candidate_profile($clid,$tmpcndid)) {
|
|
$html=join('',$html,"<option value=\"P$CANDIDATE{'uid'}\">$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}\n");
|
|
}
|
|
}
|
|
@scndsnml=();
|
|
@recs=();
|
|
}
|
|
if ($completedflag ne '') {
|
|
opendir (TMPDIR, "$testcomplete");
|
|
@cnds = readdir(TMPDIR);
|
|
closedir TMPDIR;
|
|
my @recs=grep( /^$clid\.(.*)\.$tstid/ , @cnds);
|
|
@cnds=();
|
|
foreach $rec (@recs) {
|
|
($reclid,$recndid,$rectst)=&split_test_filename($rec,$clid,$tstid);
|
|
if (($reclid eq $clid) && ($rectst eq $tstid)) {
|
|
if (&get_candidate_profile($clid,$recndid)) {
|
|
$uniquenml = "$CANDIDATE{'nml'}:$CANDIDATE{'uid'}";
|
|
push(@cndsnml,$uniquenml);
|
|
}
|
|
}
|
|
}
|
|
@scndsnml = sort(@cndsnml);
|
|
@cndsnml=();
|
|
foreach $cnml (@scndsnml) {
|
|
($trash, $tmpcndid) = split(/:/,$cnml);
|
|
if (&get_candidate_profile($clid,$tmpcndid)) {
|
|
$html=join('',$html,"<option value=\"C$CANDIDATE{'uid'}\">\*$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}\n");
|
|
}
|
|
}
|
|
@scndsnml=();
|
|
@recs=();
|
|
}
|
|
return $html;
|
|
}
|
|
|
|
sub CreateOCRInputForm() {
|
|
if ($TEST{'seq'} eq 'svy') {
|
|
@skilllevel = ( '','','','' );
|
|
$itemdescription = "Survey";
|
|
} else {
|
|
@skilllevel = ( 'Basic','Intermediate','Advanced','' );
|
|
$itemdescription = "Test";
|
|
}
|
|
|
|
$oshowqid = ($FORM{'showqid'} ne '') ? 1 : 0;
|
|
$oshowsubj = ($FORM{'showsubj'} ne '') ? 1 : 0;
|
|
$oshowskill = ($FORM{'showskill'} ne '') ? 1 : 0;
|
|
$oblackoutthrowoffs = ($FORM{'blackoutthrowoffs'} ne '') ? 1 : 0;
|
|
$tcolor=$FORM{'ocrtextcolor'};
|
|
|
|
$printwidth = "100\%";
|
|
$titlewidth = "40\%";
|
|
$titlecolwidth = "30\%";
|
|
$refpage = ($FORM{'showgraphics'} eq 'refpage') ? 1 : 0;
|
|
if ($refpage) {
|
|
$showgraphics = 1;
|
|
} else {
|
|
$showgraphics = ($FORM{'showgraphics'} eq 'ON') ? 1 : 0;
|
|
}
|
|
|
|
$ocrstyle=($FORM{'ocrstyle'} ne '') ? 1 : 0;
|
|
if ($ocrstyle) {
|
|
$scoreboxwarning = "MARK THE CIRCLES UNDER THE CORRECT ANSWER LABEL FOR EACH QUESTION USING A \#2 LEAD PENCIL ONLY.";
|
|
} else {
|
|
$printscoreboxes = ($FORM{'showscoreboxes'} ne '') ? 1 : 0;
|
|
$scoreboxwarning = ($printscoreboxes) ? "DO NOT MARK BOXES TO THE RIGHT OF THE QUESTION. (FOR SCORING USE ONLY)" : "";
|
|
}
|
|
if ($FORM{'showdates'} ne '') {
|
|
$testavailabilitydates = "Take On/After:<BR>$TEST{'availon'}<BR>Take On/Before:<BR>$TEST{'availthru'} <BR>\n";
|
|
} else {
|
|
$testavailabilitydates = "";
|
|
}
|
|
@questions = split(/&/,$SUBTEST_QUESTIONS{2});
|
|
@keyanswers = split(/&/,$SUBTEST_ANSWERS{2});
|
|
$masterid = 1;
|
|
|
|
$timed = ($TEST{'tmd'} eq 'Y') ? "Allotted Time: $TEST{'maxtm'} mins" : "";
|
|
$testmasterdir = join($pathsep, $secroot, "tests", "master");
|
|
|
|
# $scoreboxwarning = "MARK THE CIRCLES UNDER THE CORRECT ANSWER LABEL FOR EACH QUESTION USING A \#2 LEAD PENCIL ONLY.";
|
|
$scoreboxwarning = "";
|
|
$keyhdr = "ANSWER SHEET";
|
|
&PrintPageHeader();
|
|
&PrintSectionHeader();
|
|
&PrintQuestionsOCR();
|
|
&PrintSection();
|
|
@pagequestions = ();
|
|
print "</TABLE>\n";
|
|
print "<input type=submit name=\"recSave\" value=\"Post Data\"><br>\n";
|
|
print "$referencepage\n";
|
|
print "</FORM>\n";
|
|
print "</BODY>\n</HTML>\n";
|
|
}
|
|
|
|
sub PrintPageHeader {
|
|
my $tdate = &format_date_time("mm/dd/yyyy","2", "-10000", time);
|
|
my $scored = ($FORM{'unscored'} eq 'P') ? $xlatphrase[442] : $xlatphrase[11];
|
|
if ($FORM{'unscored'} ne 'P') {
|
|
my $qscore=$SUBTEST_SUMMARY{2};
|
|
my @qscores=split(/&/, $qscore);
|
|
$qtotal=$qscores[0]+$qscores[1];
|
|
$scored=join(' ',$scored,"<font size=1>$qscores[2]\% ($qscores[0] of $qtotal)</font>");
|
|
}
|
|
print "<HTML>
|
|
<HEAD>
|
|
<SCRIPT language=\"JavaScript\">
|
|
<!--
|
|
function onWdwLoad() {
|
|
var hasFocus = null;
|
|
|
|
// Determine which form element has focus
|
|
FlagFocus();
|
|
|
|
document.tocrform.tdate.focus();
|
|
}
|
|
|
|
function FlagFocus(){
|
|
for (var x=0; x<document.tocrform.length; ++x) {
|
|
document.tocrform.elements[x].onfocus = function(){
|
|
hasFocus = this;
|
|
}
|
|
}
|
|
}
|
|
|
|
function RadioSelect(event) {
|
|
var charCode = event.keyCode;
|
|
|
|
if (hasFocus.type == \"radio\"){
|
|
if (charCode > 47 && charCode < 58) {
|
|
if (document.tocrform.elements[hasFocus.name][charCode - 49] != undefined){
|
|
document.tocrform.elements[hasFocus.name][charCode - 49].checked = true;
|
|
NextFocus();
|
|
}
|
|
}
|
|
else if (charCode > 95 && charCode < 106) {
|
|
if (document.tocrform.elements[hasFocus.name][charCode - 97] != undefined){
|
|
document.tocrform.elements[hasFocus.name][charCode - 97].checked = true;
|
|
NextFocus();
|
|
}
|
|
}
|
|
else if (charCode > 64 && charCode < 91) {
|
|
if (document.tocrform.elements[hasFocus.name][charCode - 65] != undefined){
|
|
document.tocrform.elements[hasFocus.name][charCode - 65].checked = true;
|
|
NextFocus();
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
function NextFocus() {
|
|
var RadioFound = false
|
|
|
|
for (var x=0; x<document.tocrform.length; ++x) {
|
|
if (document.tocrform.elements[x].name == hasFocus.name){
|
|
RadioFound = true;
|
|
}
|
|
if ((document.tocrform.elements[x].name != hasFocus.name) && RadioFound) {
|
|
document.tocrform.elements[x].focus();
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
window.onload=onWdwLoad;
|
|
//-->
|
|
</SCRIPT>
|
|
</HEAD>
|
|
<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
|
|
TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
|
|
VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\" onKeyUp=\"RadioSelect(event);\">
|
|
<FORM METHOD=POST ACTION=\"$PATHS{'cgiroot'}/tocrinp.pl\" Name=\"tocrform\">
|
|
<INPUT NAME=\"tid\" TYPE=HIDDEN VALUE=\"$SESSION{'tid'}\">
|
|
<INPUT NAME=\"clid\" TYPE=HIDDEN VALUE=\"$FORM{'clid'}\">
|
|
<INPUT NAME=\"tstid\" TYPE=HIDDEN VALUE=\"$FORM{'tstid'}\">
|
|
<INPUT NAME=\"cndid\" TYPE=HIDDEN VALUE=\"$FORM{'cndid'}\">
|
|
<INPUT NAME=\"unscored\" TYPE=HIDDEN VALUE=\"$FORM{'unscored'}\">
|
|
<INPUT NAME=\"completed\" TYPE=HIDDEN VALUE=\"$FORM{'completed'}\">
|
|
<INPUT NAME=\"lang\" TYPE=HIDDEN VALUE=\"$SESSION{'lang'}\">
|
|
<INPUT NAME=\"dbop\" TYPE=HIDDEN VALUE=\"post\">
|
|
<CENTER>
|
|
<TABLE cellpadding=0 cellspacing=0 border=1 width=$printwidth $bordercolor>
|
|
<TR>
|
|
<TD colspan=2 valign=top width=$titlecolwidth>
|
|
<font size=2 $textcolor><B>
|
|
Test: $CLIENT{'clid'}.$CANDIDATE{'uid'}.$TEST{'id'}<BR>
|
|
Questions: $#questions<BR>
|
|
</B></font>
|
|
</TD>
|
|
<TD align=center valign=middle width=$titlewidth>
|
|
<font size=4 $textcolor><B>$TEST{'desc'}<BR>$keyhdr</B></font>
|
|
</TD>
|
|
</TR>
|
|
</TABLE>
|
|
<TABLE cellpadding=0 cellspacing=0 border=0 width=$printwidth $bordercolor>
|
|
<TR><TD colspan=5><FONT SIZE=1 $textcolor>\ \;<BR></FONT></TD></TR>
|
|
<TR>
|
|
<TD align=right valign=middle>
|
|
<font $textcolor>
|
|
<B>Date:\ \;</B>
|
|
</font>
|
|
</TD>
|
|
<TD valign=middle>
|
|
<B><input type=textbox name=\"tdate\" value=\"$tdate\" size=10></B>
|
|
</TD>
|
|
<TD valign=middle>
|
|
<B>\ \;</B><br>
|
|
</TD>
|
|
<TD align=right valign=middle>
|
|
<font $textcolor>
|
|
<B>Name:\ \;</B>
|
|
</font>
|
|
</TD>
|
|
<TD valign=middle>
|
|
<B>$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}</B>
|
|
</TD>
|
|
</TR>
|
|
<TR>
|
|
<TD valign=middle>
|
|
<font $textcolor>
|
|
\ \;<br>
|
|
</font>
|
|
</TD>
|
|
<TD valign=middle>
|
|
<font $textcolor>
|
|
<B>$scored</B>
|
|
</font>
|
|
</TD>
|
|
<TD valign=middle>
|
|
<font $textcolor>
|
|
\ \;<br>
|
|
</font>
|
|
</TD>
|
|
<TD align=right valign=middle>
|
|
<font $textcolor>
|
|
<B>Email:\ \;</B>
|
|
</font>
|
|
</TD>
|
|
<TD align=left valign=middle>
|
|
<B><input type=textbox name=\"eml\" size=25 value=\"$CANDIDATE{'eml'}\"></B>
|
|
</TD>
|
|
</TR>
|
|
</TABLE>
|
|
";
|
|
}
|
|
sub PrintSectionHeader {
|
|
my $noq=$#questions;
|
|
@ocrcoltbl0=();
|
|
@ocrcoltbl1=();
|
|
@ocrcoltbl2=();
|
|
$ocrcolumns = int($noq/50);
|
|
my $vernoq = $ocrcolumns*50;
|
|
if ($vernoq != $noq) {
|
|
$ocrcolumns++;
|
|
}
|
|
$ocrtblwidth=510/$ocrcolumns;
|
|
print "<TABLE cellpadding=0 cellspacing=0 border=1 width=$printwidth $bordercolor>\n";
|
|
}
|
|
|
|
sub PrintSection {
|
|
my $i;
|
|
print "<TR>\n<TD>\n";
|
|
print "<TABLE cellpadding=0 cellspacing=0 border=0 width=$ocrtblwidth $bordercolor>\n";
|
|
for $i (0 .. $#ocrcoltbl0) {
|
|
print "$ocrcoltbl0[$i]";
|
|
}
|
|
print "</TABLE>\n</TD>\n";
|
|
if ($ocrcolumns > 1) {
|
|
print "<TD>\n";
|
|
print "<TABLE cellpadding=0 cellspacing=0 border=0 width=$ocrtblwidth $bordercolor>\n";
|
|
for $i (0 .. $#ocrcoltbl1) {
|
|
print "$ocrcoltbl1[$i]";
|
|
}
|
|
print "</TABLE>\n</TD>\n";
|
|
}
|
|
if ($ocrcolumns > 2) {
|
|
print "<TD>\n";
|
|
print "<TABLE cellpadding=0 cellspacing=0 border=0 width=$ocrtblwidth $bordercolor>\n";
|
|
for $i (0 .. $#ocrcoltbl2) {
|
|
print "$ocrcoltbl2[$i]";
|
|
}
|
|
print "</TABLE>\n</TD>\n";
|
|
}
|
|
print "<\TR>\n";
|
|
}
|
|
|
|
sub PrintQuestionsOCR() {
|
|
my $trash;
|
|
my $r=0;
|
|
my $c=0;
|
|
my $rowhtml;
|
|
my $questionindex;
|
|
my $backcolor="";
|
|
$referencepage = "";
|
|
$allowupdate = 0;
|
|
$scored = 1;
|
|
my $prevanswer=$SUBTEST_RESPONSES{2};
|
|
my @prevanswers=split(/&/, $prevanswer);
|
|
$prevanswer="";
|
|
my $qscore=$SUBTEST_SUMMARY{2};
|
|
my @qscores=split(/\//, $qscore);
|
|
$qscore="";
|
|
my $etc = "";
|
|
foreach $questionindex (1 .. $#questions) {
|
|
&get_question_definition($TEST{'id'},$CLIENT{'clid'},$questions[$questionindex]);
|
|
$qtype = $QUESTION{'qtp'};
|
|
$anstype = $QUESTION{'qalb'};
|
|
($qsubj, $sklvl) = split(/\./, $QUESTION{'subj'});
|
|
if ($sklvl eq '') { $sklvl = 3; }
|
|
($keyresponse,$kflags) = split(/::/, $keyanswers[$questionindex]);
|
|
|
|
$scoreable = 1;
|
|
$credit = $noanswertag;
|
|
$checked = "";
|
|
$answerkey = "";
|
|
$studentkey = "";
|
|
$qanswermatch = "";
|
|
@txts = ();
|
|
$prevanswer = $prevanswers[$questionindex];
|
|
$prevanswer =~ s/\'//;
|
|
if ($qscores[$questionindex] eq '') {
|
|
$backcolor="";
|
|
} else {
|
|
($qscore,$etc) = split(/\./,$qscores[$questionindex]);
|
|
$backcolor=($qscore == 0) ? "bgcolor=red" : "";
|
|
}
|
|
|
|
if ($qtype eq 'nrt') {
|
|
&PrintQuestionNRT($TEST{'seq'},$questionindex,$prevanswer);
|
|
} elsif ($qtype eq 'tf') {
|
|
&PrintQuestionTF($TEST{'seq'},$questionindex,$prevanswer);
|
|
} elsif ($qtype eq 'esa') {
|
|
&PrintQuestionESA($TEST{'seq'},$questionindex,$prevanswer);
|
|
} elsif ($qtype eq 'mcs') {
|
|
&PrintQuestionMCS($TEST{'seq'},$questionindex,$prevanswer);
|
|
} elsif ($qtype eq 'mcm') {
|
|
&PrintQuestionMCM($TEST{'seq'},$questionindex,$prevanswer);
|
|
} elsif ($qtype eq 'mch') {
|
|
&PrintQuestionMCH($TEST{'seq'},$questionindex,$prevanswer);
|
|
} elsif ($qtype eq 'ord') {
|
|
&PrintQuestionORD($TEST{'seq'},$questionindex,$prevanswer);
|
|
} elsif ($qtype eq 'mtx') {
|
|
&PrintQuestionMTX($TEST{'seq'},$questionindex,$prevanswer);
|
|
}
|
|
$rowhtml = join('',"<TR>","<TD align=center valign=\"top\" width=50 $backcolor><font $textcolor><b>\n");
|
|
$rowhtml = join('',$rowhtml,"$questionindex.\n");
|
|
$rowhtml = join('',$rowhtml,"<!-- $keyresponse -->\n");
|
|
$rowhtml = join('',$rowhtml,"</b></font></TD>\n<TD colspan=2>\n");
|
|
$rowhtml = join('',$rowhtml,"<TABLE cellpadding=0 cellspacing=0 border=0>\n<TR>\n");
|
|
$rowhtml = join('',$rowhtml,$answerkey,"</TR>\n</TABLE>\n</TD>\n</TR>\n");
|
|
$c=int(($questionindex-1) / 50);
|
|
$r=(($questionindex-1) % 50);
|
|
if ($c == 0) {
|
|
push @ocrcoltbl0,$rowhtml;
|
|
} elsif ($c==1) {
|
|
push @ocrcoltbl1,$rowhtml;
|
|
} elsif ($c==2) {
|
|
push @ocrcoltbl2,$rowhtml;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub PrintQuestionNRT {
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevans,$prevucmt)=split(/::/,$prvresp);
|
|
$prevans=unmunge($prevans);
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"<textarea name=\"q$qi-qrs\" rows=10 cols=60>$prevans</textarea>");
|
|
$answerkey = join('',$answerkey,"</font></td>\n");
|
|
$colspan=2;
|
|
}
|
|
|
|
sub PrintQuestionTF {
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevans,$prevucmt)=split(/::/,$prvresp);
|
|
$checked=($prevans eq 'TRUE') ? "CHECKED" : "";
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"T");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"<input type=\"radio\" name=\"q$qi-qrs\" value=\"TRUE\" $checked>");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
$checked=($prevans eq 'FALSE') ? "CHECKED" : "";
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"F");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"<input type=\"radio\" name=\"q$qi-qrs\" value=\"FALSE\" $checked>");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
$colspan=2;
|
|
}
|
|
|
|
sub PrintQuestionESA {
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevans,$prevucmt)=split(/::/,$prvresp);
|
|
$answerkey = join('',$answerkey,"<td valign=top width=550><font $textcolor>\n");
|
|
$lenresponse = length($keyresponse) + 4;
|
|
if ($keyprint == 1) {
|
|
$answerkey = "<input type=text size=$lenresponse value=\"$keyresponse\">";
|
|
} else {
|
|
$answerkey = "<input type=text size=$lenresponse value=\"$prevans\">";
|
|
}
|
|
$colspan=2;
|
|
$answerkey = join('',$answerkey,"</font></td>\n");
|
|
}
|
|
|
|
sub PrintQuestionMCS {
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevanslong,$prevucmt)=split(/::/,$prvresp);
|
|
my @prevansary = split(/\?/,$prevanslong);
|
|
foreach (@prevansary) {
|
|
if ($_ ne "xxx") {
|
|
$prevans=$_;
|
|
}
|
|
}
|
|
if ($ttyp eq 'svy') {
|
|
@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);
|
|
@albls=&set_answer_labels($anstype);
|
|
foreach $j (1 .. $#kans) {
|
|
$jidx = $j-1;
|
|
@indexs = split(/=/, $kans[$j]);
|
|
$checked = ("$jidx" eq "$prevans") ? "CHECKED" : "";
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"<input type=\"radio\" name=\"q$qi-qrs\" value=\"$jidx\" $checked>");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"$albls[$jidx].");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
}
|
|
} else {
|
|
push @txts, $QUESTION{'qca'};
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
|
foreach $qia (@txts_wro) {
|
|
push @txts, $qia;
|
|
}
|
|
@kans = split(/\?/,$keyresponse);
|
|
@albls=&set_answer_labels($anstype);
|
|
foreach $j (1 .. $#kans) {
|
|
$jidx = $j-1;
|
|
@indexs = split(/=/, $kans[$j]);
|
|
$checked = ("$jidx" eq "$prevans") ? "CHECKED" : "";
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>");
|
|
$answerkey = join('',$answerkey,"\ $albls[$jidx].");
|
|
$answerkey = join('',$answerkey,"</font></td>\n<td align=center valign=top width=10><font $textcolor>");
|
|
$answerkey = join('',$answerkey,"<input type=radio name=\"q$qi-qrs\" value=\"$jidx\" $checked>");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
}
|
|
}
|
|
$colspan=2;
|
|
}
|
|
|
|
sub PrintQuestionMCM {
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevans,$prevucmt)=split(/::/,$prvresp);
|
|
if ($ttyp eq 'svy') {
|
|
@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);
|
|
@albls=&set_answer_labels($anstype);
|
|
foreach $j (1 .. $#kans) {
|
|
$jidx = $j-1;
|
|
@indexs = split(/=/, $kans[$j]);
|
|
$checked = ("$prevans"=~ /$jidx/) ? "CHECKED" : "";
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"<input type=\"checkbox\" name=\"q$qi-qrs$jidx\" value=\"$jidx\" $checked>");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
|
|
$answerkey = join('',$answerkey,"$albls[$jidx].");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
}
|
|
} else {
|
|
push @txts, $QUESTION{'qca'};
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
|
foreach $qia (@txts_wro) {
|
|
push @txts, $qia;
|
|
}
|
|
@kans = split(/\?/,$keyresponse);
|
|
@albls=&set_answer_labels($anstype);
|
|
foreach $j (1 .. $#kans) {
|
|
$jidx = $j-1;
|
|
@indexs = split(/=/, $kans[$j]);
|
|
$checked = ("$prevans"=~ /$jidx/) ? "CHECKED" : "";
|
|
$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>");
|
|
$answerkey = join('',$answerkey,"\ $albls[$jidx].");
|
|
$answerkey = join('',$answerkey,"</font></td>\n<td align=center valign=top width=10><font $textcolor>");
|
|
$answerkey = join('',$answerkey,"<input type=checkbox name=\"q$qi-qrs$jidx\" value=\"$jidx\" $checked>");
|
|
$answerkey = join('',$answerkey,"\ </font></td>\n");
|
|
}
|
|
}
|
|
$colspan=2;
|
|
}
|
|
|
|
sub PrintQuestionMCH {
|
|
#&tutor.009
|
|
#&a.4.3.6.5.7.8.0.1.2::MATCH.0:1:1:0
|
|
#&xxxxxxxxx::
|
|
#/0.ghibadcef.xxxxxxxxx
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevans,$prevucmt)=split(/::/,$prvresp);
|
|
my @prevanss=split(//,$prevans);
|
|
for (0 .. $#prevanss) {
|
|
$prevanss[$_] =~ s/x//;
|
|
}
|
|
if ($ttyp eq 'svy') {
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
|
@ansopts = split(/\./, $keyresponse);
|
|
$ansopt = 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) {
|
|
$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
|
|
if ($keyprint == 1) {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$cansord[$_]\"><BR>\n");
|
|
} else {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$prevanss[$_]\"><BR>\n");
|
|
}
|
|
$answerkey = join('',$answerkey,"</font></td>\n");
|
|
}
|
|
@cansord = ();
|
|
} else {
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
|
@txts_wro = split(/\n/, $QUESTION{'qia'});
|
|
@ansopts = split(/\./, $keyresponse);
|
|
$trash = shift @ansopts;
|
|
@albls=&set_answer_labels($anstype);
|
|
$keyresponse = "";
|
|
for (0 .. $#ansopts) {
|
|
$cansord[$ansopts[$_]] = $albls[$_];
|
|
# $qanswermatch = join('',$qanswermatch, "$cansord[$ansopts[$_]].\ \;\ \;$txts_wro[$ansopts[$_]]<BR>\n");
|
|
}
|
|
foreach $cansord (@cansord) {
|
|
$keyresponse = join('', $keyresponse, $cansord);
|
|
}
|
|
for (0 .. $#ansopts) {
|
|
$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
|
|
if ($keyprint == 1) {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=2 value=\"$cansord[$_]\"><BR>\n");
|
|
} else {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=2 value=\"$prevanss[$_]\"><BR>\n");
|
|
}
|
|
$answerkey = join('',$answerkey,"</font></td>\n");
|
|
}
|
|
@cansord = ();
|
|
}
|
|
}
|
|
|
|
sub PrintQuestionORD {
|
|
#&tutor.010
|
|
#&o.3.4.1.0.2::ORDERED.0:1:1:0
|
|
#&xxxxx::
|
|
#/0.45213.xxxxx
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevans,$prevucmt)=split(/::/,$prvresp);
|
|
my @prevanss=split(//,$prevans);
|
|
for (0 .. $#prevanss) {
|
|
$prevanss[$_] =~ s/x//;
|
|
}
|
|
if ($ttyp eq 'svy') {
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
|
@ansopts = split(/\./, $keyresponse);
|
|
$trash = shift @ansopts;
|
|
@albls=&set_answer_labels($anstype);
|
|
for (0 .. $#ansopts) {
|
|
$ansopt = $ansopts[$_];
|
|
$ansopt++;
|
|
$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
|
|
if ($keyprint == 1) {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$ansopt\"><BR>\n");
|
|
} else {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$prevanss[$_]\"><BR>\n");
|
|
}
|
|
$answerkey = join('',$answerkey,"</font></td>\n");
|
|
}
|
|
} else {
|
|
@txts = split(/\n/, $QUESTION{'qca'});
|
|
@ansopts = split(/\./, $keyresponse);
|
|
$trash = shift @ansopts;
|
|
@albls=&set_answer_labels($anstype);
|
|
for (0 .. $#ansopts) {
|
|
$ansopt = $ansopts[$_];
|
|
$ansopt++;
|
|
$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
|
|
if ($keyprint == 1) {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$ansopt\"><BR>\n");
|
|
} else {
|
|
$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$prevanss[$_]\"><BR>\n");
|
|
}
|
|
$answerkey = join('',$answerkey,"</font></td>\n");
|
|
}
|
|
}
|
|
$colspan=2;
|
|
}
|
|
|
|
#PrintQuestionMTX($TEST{'seq'},$questionindex,$prevanswer);
|
|
sub PrintQuestionMTX {
|
|
my ($ttyp,$qi,$prvresp) = @_;
|
|
my ($prevanslong,$prevucmt)=split(/::/,$prvresp);
|
|
my @optvalues = split(/\?/,$prevanslong);
|
|
|
|
# Split qia into row and col headers
|
|
$qia = $QUESTION{'qia'};
|
|
$qia =~ s/\r/\n/g;
|
|
$qia =~ s/\n\n/\n/g;
|
|
@qia = split(/::/, $qia);
|
|
if ($qia[0] =~ /\n/) {
|
|
@qrowhdr = split(/\n/, $qia[0]);
|
|
@qcolhdr = split(/\n/, $qia[3]);
|
|
$qrowcount = $qia[1];
|
|
$qcolcount = $qia[2];
|
|
} else {
|
|
$qrowcount = $qia[0];
|
|
$qcolcount = $qia[1];
|
|
@qlbllist = split(/\n/, $qia[2]);
|
|
}
|
|
@qia = ();
|
|
|
|
# "CHECKBOX" version
|
|
|
|
# Mark previous selections with "CHECKED"
|
|
shift @optvalues;
|
|
$i=0;
|
|
foreach $row (0 .. $qrowcount-1)
|
|
{
|
|
foreach $col (0 .. $qcolcount-1)
|
|
{
|
|
if ($optvalues[$i] != "xxx")
|
|
{
|
|
$chmatrix[$row][$col]="CHECKED";
|
|
}
|
|
else
|
|
{
|
|
$chmatrix[$row][$col]="";
|
|
}
|
|
$i++;
|
|
}
|
|
}
|
|
|
|
# Build matrix html
|
|
$outline = "<td align=center valign=top colspan=2>";
|
|
$outline .= "<table border=2>\n";
|
|
if ($#qlbllist == -1) {
|
|
$outline .= " <tr>\n <td> </td>";
|
|
foreach (0 .. $#qcolhdr) {
|
|
$outline .= "<td>$qcolhdr[$_]</td>";
|
|
}
|
|
$outline .= "</tr>\n";
|
|
}
|
|
$i=0;
|
|
foreach $row (0 .. $qrowcount-1) {
|
|
$outline .= "<tr>";
|
|
if ($#qlbllist == -1) {
|
|
$outline .= "<td>$qrowhdr[$row]</td>";
|
|
}
|
|
foreach $col (0 .. $qcolcount-1) {
|
|
if ($#qlbllist == -1) {
|
|
$outline .= "<td align=center>";
|
|
} else {
|
|
$outline .= "<td>";
|
|
$outline .= "<table border=0 width=100%><tr><td align=left>$qlbllist[$i]</td><td align=right>";
|
|
}
|
|
if( $ttyp eq 'svy' || ($ttyp eq 'dmg' && $TEST{'group'} eq 'Y')) {
|
|
$outline .= "<input type=checkbox name=\"q$qi-qrs$row$col\" value=\"1\" $chmatrix[$row][$col]>";
|
|
} else {
|
|
$outline .= "<input type=checkbox name=\"qrs$row$col\" value=\"1\" $chmatrix[$row][$col]>";
|
|
}
|
|
if ($#qlbllist != -1) {
|
|
$outline .= "</td></tr></table>";
|
|
}
|
|
$outline .= "</td>";
|
|
$i++;
|
|
}
|
|
$outline .= "</tr>\n";
|
|
}
|
|
$outline .= "</table>\n";
|
|
$outline .= "</td>\n";
|
|
@qrowhdr = ();
|
|
@qcolhdr = ();
|
|
@qlbllist = ();
|
|
@chmatrix = ();
|
|
|
|
$answerkey = $outline;
|
|
$colspan=2;
|
|
}
|
|
|