#!/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>\&nbsp\;<BR></FONT></TD></TR>
	<TR>
		<TD align=right valign=middle>
			<font $textcolor>
			<B>Date:\&nbsp\;</B>
			</font>
		</TD>
		<TD valign=middle>
			<B><input type=textbox name=\"tdate\" value=\"$tdate\" size=10></B>
		</TD>
		<TD valign=middle>
			<B>\&nbsp\;</B><br>
		</TD>
		<TD align=right valign=middle>
			<font $textcolor>
			<B>Name:\&nbsp\;</B>
			</font>
		</TD>
		<TD valign=middle>
			<B>$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}</B>
		</TD>
	</TR>
	<TR>
		<TD valign=middle>
			<font $textcolor>
			\&nbsp\;<br>
			</font>
		</TD>
		<TD valign=middle>
			<font $textcolor>
			<B>$scored</B>
			</font>
		</TD>
		<TD valign=middle>
			<font $textcolor>
			\&nbsp\;<br>
			</font>
		</TD>
		<TD align=right valign=middle>
			<font $textcolor>
			<B>Email:\&nbsp\;</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,"\&nbsp;</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,"\&nbsp;</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,"\&nbsp;</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,"\&nbsp;</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,"\&nbsp;</font></td>\n");
			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
			$answerkey = join('',$answerkey,"$albls[$jidx].");
			$answerkey = join('',$answerkey,"\&nbsp;</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,"\&nbsp;$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,"\&nbsp;</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,"\&nbsp;</font></td>\n");
			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
			$answerkey = join('',$answerkey,"$albls[$jidx].");
			$answerkey = join('',$answerkey,"\&nbsp;</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,"\&nbsp;$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,"\&nbsp;</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[$_]].\&nbsp\;\&nbsp\;$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>&nbsp;</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;
}