survey-manager/survey-nginx/cgi-bin/testlib.pl.bu20190822A

#!/usr/bin/perl
#
# $Id: testlib.pl,v 1.53 2006/11/10 00:52:01 ddoughty Exp $
# 12/31/01 merged various changes from production site, marked with ##wac
# Source File: testlib.pl

use Data::Dumper;
use MIME::Base64 qw(encode_base64 decode_base64) ;
require 'genutil.pl';

%TEST_STATES = ( _PENDING => 0, _IN_PROGRESS => 1,
				_PAUSED_BY_USER => 2, _DECLINED => 3,
				_TIME_EXPIRED => 4, _TERMINATED => 5, _COMPLETED => 6 );

%TEST_STATE_DESCRIPTION = ( '0' => 'Pending', '1' => 'In Progress',
				'2' => 'Paused by User', '3' => 'Confidentiality Declined',
				'4' => 'Time Expired', '5' => 'Terminated by Administrator',
				'6' => 'Completed' );

%TEST_SEGMENT_DESCRIPTION = ( '0' => 'Confidentiality', '1' => 'Pretest Survey/Profile',
				'2' => 'Core Test', '3' => 'Posttest Profile',
				'4' => 'Posttest Survey');

my $HBI_Debug_redirect = 0 ;

# The following variables are	used for formatting email messages.
# The email creation and formats of data in the emails
#  is not strictly modular.  On the down side these values 
#  are global, created, and used ala side effects.  On the
#  plus side, flexibility is gained.  The variables will all
#  be multi-line strings.  $MIME_start will be used once and only 
# once in each email message, at the very beginning of the email
# message.  Its purpose is to tell the email client that the email
# has different sections, with potentially different kinds of data.
# $mm_7bit_text and $mm_encoded_html go at the front of a section
# with its kind of data.  $mm_7bit_text is normal 7-bit ASCII
# characters without any special formatting.  $mm_encoded_html
# is for base64 uuencoded HTML data.
$MIME_start = "" ;
$mm_7bit_text = "" ;
$mm_encoded_html = "";

sub remove_pending_tests {
	my ($clid, $target_cndid) = @_;
	opendir(DIR, $testpending);
    @dots = readdir(DIR);
    closedir DIR;
	foreach $rmfile (@dots) {
		if ($rmfile =~ /^$clid\.$target_cndid\./ ) {
			$ulinkfile = join($pathsep, $testpending, $rmfile);
			$cnt = unlink $ulinkfile;
		}
	}
	@dots = ();
}

#hkh 01/04 remove test in progress - indicated by '*' at end of $atest
sub remove_inprogtest {
     	my ($clid, $target_cndid, $authtests) = @_;
	opendir(DIR, $testinprog);
	@dots = readdir(DIR);
	closedir DIR;
	$chgauthtests = "N";
	@atests = split(/\;/, $authtests);
	foreach $rmfile (@dots) {
		$match = "N";
		if ($rmfile =~ /^$clid\.$target_cndid\./ ) {
			foreach $atest (@atests) {
				if ($atest =~ /\*/) {
					$_ = $atest;
					s/\*//;
				if (($rmfile =~ /^$clid\.$target_cndid\.$_/) || ($rmfile =~ /^$clid\.$target_cndid\.$_.tim/)) {
					$match = "Y";
				}
				}
			}
			if ($match eq "N") {
				$ulinkfile = join($pathsep, $testinprog, $rmfile);
				$cnt = unlink $ulinkfile;
				$chgauthtests = "Y";
			}
		}
	}
	@dots = ();
	@atests = ();
} 

#hkh 01/04 only remove tests in PENDING directory if they were removed in 
#          candidate registration screen. 
sub remove_pending_oldtests {
     	my ($clid, $target_cndid, $authtests) = @_;
	opendir(DIR, $testpending);
	@dots = readdir(DIR);
	closedir DIR;
	my $filename = "tests.$clid";
	my @lines = &get_data($filename);
	foreach $i (@lines) {
        	my @banana = split('&', $i);
        	my $funkey = &get_a_key($filename, $banana[0], "availto");
        	$funkey =~ s/\./ /;
        	if ($funkey eq '') {		#If funkey eq Y, that means that it IS selfreg. But we want it to find things that are NOT selfreg.
               		 $funkey = "Y ";
        	} else {
                	$funkey =~ /^\w\s/;
                	$funkey = $&;
        	}
		if ($funkey eq "N ") {
			my $pendofile = "../secure_html/tests/pending/$clid.$cndid.$banana[0]";
			my $pwd = `pwd`;
			if ( -e $pendofile) {
				if ($authtests ne '') { $authtests .= "\;"; }
				$authtests .= "$banana[0]";
			}
		}
	}
	@atests = split(/\;/, $authtests);
	foreach $rmfile (@dots) {
		$match = "N";
		if ($rmfile =~ /^$clid\.$target_cndid\./ ) {
			foreach $atest (@atests) {
				if ($rmfile =~ /^$clid\.$target_cndid\.$atest/) {
					$match = "Y";
					last;
				}
			}
			if ($match eq "N") {
				$ulinkfile = join($pathsep, $testpending, $rmfile);
				$cnt = unlink $ulinkfile;
				$chgauthtests = "Y";
			}
		}
	}
	@dots = ();
	@atests = ();
} 

#hkh 01/04 add new tests added in candidate registration (--->) 
sub create_newtests_list {
     	my ($clid, $target_cndid, $authtests) = @_;
	opendir(DIR, $testpending);
	my @dots = readdir(DIR);
	closedir DIR;
	@newtests = ();
	my @atests = split(/\;/, $authtests);
	foreach $atest (@atests) {
		if ($atest ne '') {
			$match = "N";
			foreach $rmfile (@dots) {
				if ($rmfile =~ /^$clid\.$target_cndid\.$atest/) {
					$match = "Y";
				} else {
					if ($atest=~ /\*/) {
						$match = "Y";
					}
				}	
			}
			if ($match eq "N") {
				push(@newtests, $atest);
			}
		}
	}
#hkh 01/04 if nothing is changed on cand. reg. screen, do not pop-up 'Tests
#          Registered' message
	if (($#newtests == -1) && ($chgauthtests eq "N")) {
		$FORM{'respmsg'} = "";
	}
	@dots = ();
	@atests = ();
	return @newtests;
} 

sub get_pending_tests {
	my ($clid, $target_cndid, $opts) = @_;
	return &get_tests($clid, $target_cndid, $testpending, $opts);
}

sub get_inprog_tests {
	my ($clid, $target_cndid, $opts) = @_;
	return &get_tests($clid, $target_cndid, $testinprog, $opts);
}

sub get_completed_tests {
	my ($clid, $target_cndid, $opts) = @_;
	return &get_tests($clid, $target_cndid, $testcomplete, $opts);
}

sub get_tests {
	my ($clid, $target_cndid, $testdir, $opts) = @_;
	opendir(DIR, $testdir);
        my @files = readdir(DIR);
        closedir DIR;
	$authtests = "";
	foreach $file (@files) {
		if ($file =~ /^$clid\.$target_cndid\.(\S+)$/ and $file !~ /\.tim$/) {
		    my $testid = $1;
		    $bob=&within_availability_window($clid, $testid, time);
		    $bobt=time;
		    if ( ! $opts->{restrict_to_availability_window} ||
			 &within_availability_window($clid, $testid, time) ) {
			
			$authtests = join(';', $authtests, $testid);
		    }
		}
	}
	return $authtests;
}

#
# @filelist = &get_test_result_files($directory, $clid, $testid);
#
# Return:  List of matching files, or undef if there was an error.
#
sub get_test_result_files {
	my ($dir, $clid, $testid) = @_;

	if ( ! defined($clid) ) {
		&logger::logerr("Undefined client ID for directory '$dir', testid '$testid'");
		return undef;
	}

	if ( ! defined($testid) ) {
		&logger::logerr("Undefined test ID for directory '$dir', client ID '$clid'");
		return undef;
	}

	return get_matching_files($dir, "^$clid".'\.\S+\.'."$testid\$");
}



#
# @filelist = &get_cnd_result_files($directory, $clid, $cndid);
#
# Return:  List of matching files, or undef if there was an error.
#
sub get_cnd_result_files {
	my ($dir, $clid, $cndid) = @_;

	if ( ! defined($clid) ) {
		&logger::logerr("Undefined client ID for directory '$dir', cndid '$cndid'");
		return undef;
	}

	if ( ! defined($cndid) ) {
		&logger::logerr("Undefined cnd ID for directory '$dir', client ID '$clid'");
		return undef;
	}

	return get_matching_files($dir, "^$clid".'\.'."$cndid".'\.\S+$');
}


#
# @filelist = &get_matching_files($directory, $regex);
#
# Return:  List of matching files, or undef if there was an error.
#
sub get_matching_files {
	my ($dir, $regex) = @_;

	if ( ! defined($dir) ) {
		&logger::logerr("Undefined directory for client ID '$clid', cndid '$cndid'");
		return undef;
	}

	if ( ! opendir (GDIR, $dir) ) {
		&logger::logerr("Unable to open directory '$dir' for reading:  $!");
		return undef;
	}

	my @filenames = readdir(GDIR);
	closedir GDIR;
	my @filelist = ();
	foreach $file (sort @filenames) {
		if (($file =~ /$regex/i )) {
			push @filelist, $file;
		}
	}
    	my @converter;
        if ($SESSION{'uid'} ne '') {
                my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar");
                if ($imaregistrar eq 'Y') {
                	foreach $rotator (@filelist) {
                       	 	my @cnd = split(/\./, $rotator);
                                my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby");
                                push(@converter, $rotator) unless $creator ne $SESSION{'uid'};
                        }
       		@filelist = @converter;
                }
	} else {
		&logger::logerr("No SESSION{uid} set!");
	}
	return @filelist;
}

	


sub get_test_sequence {
	$pathpassed = ($#_ == 3) ? 1 : 0;
	&get_test_profile($_[0], $_[2]);
	if ($pathpassed) {
		$trash2 = join($pathsep, "$_[3]", "$_[0].$_[1].$_[2]");
	} else {
		$trash1 = join($pathsep, $testpending, "$_[0].$_[1].$_[2]");
		$trash2 = join($pathsep, $testinprog, "$_[0].$_[1].$_[2]");
		$trash3 = join($pathsep, $testcomplete, "$_[0].$_[1].$_[2]");
	}
	$msg = "";
	open(TESTFILE, "<$trash2") or $msg="failed"; 
	if (($msg eq 'failed') && ($pathpassed == 0)) {
		$msg = "";
		open(TESTFILE,"<$trash1") or $msg="failed";
		if ($msg eq 'failed') {
			$msg = "";
			open(TESTFILE,"<$trash3") or $msg="failed";
		}
	}
	if ($msg eq "failed") {
		$msg = "";
	} else {
		@seqlines = <TESTFILE>;
		close TESTFILE;
		$isubtest = 1; $iidx = 0; $iaryidx = 1;
		foreach $seqline (@seqlines) {
			chop ($seqline);
			if ($iidx eq 0) {
				@status = split(/&/, $seqline);
				$ifld = 0;
				$TEST_SESSION{'clid'} = $status[$ifld++];
				$TEST_SESSION{'uid'} = $status[$ifld++];
				$TEST_SESSION{'tstid'} = $status[$ifld++];
				$TEST_SESSION{'state'} = $status[$ifld++];
				$TEST_SESSION{'dscl'} = $status[$ifld++];
				$TEST_SESSION{'profb'} = $status[$ifld++];
				$TEST_SESSION{'id'} = $status[$ifld++];
				$TEST_SESSION{'profa'} = $status[$ifld++];
				$TEST_SESSION{'srvy'} = $status[$ifld++];
				$TEST_SESSION{'ntfy'} = $status[$ifld++];
				$TEST_SESSION{'emlcnd'} = $status[$ifld++];
				@status = ();
				$iidx++;
			} else {
				if ($iaryidx eq 1) {$SUBTEST_QUESTIONS{$isubtest} = $seqline;}
				if ($iaryidx eq 2) {$SUBTEST_ANSWERS{$isubtest} = $seqline;}
				if ($iaryidx eq 3) {$SUBTEST_RESPONSES{$isubtest} = $seqline;}
				if ($iaryidx eq 4) {$SUBTEST_SUMMARY{$isubtest} = $seqline;}
				$iaryidx++;
				if ($iaryidx eq 5) {
					$iaryidx = 1;
					$isubtest++;
				}
			}
		}
	}
	@seqlines = ();
	return;
}

sub get_test_sequence_from_history {
	my ($dir,$clid,$cndid,$tstid,$testdate) = @_;
	my $testseconds = toGMSeconds($testdate);
	my @seqlines = ();

	&get_test_profile($clid, $tstid);
	my $trash = join($pathsep, $dir, "$clid.$tstid.history");
	$msg = "";
	open(TESTFILE, "<$trash") or $msg="failed to open history file";
	if ($msg eq "failed") {
		$msg = "";
	} else {
		@seqlines = <TESTFILE>;
		close TESTFILE;
		my @histentries;
		foreach (@seqlines) {
		    my ($timestamp,$trash) = split(/\<\<\>\>/, $_);
		    $timestamp = toGMSeconds($timestamp);
		    if (abs($testseconds-$timestamp) < 5 && $trash =~ "^$clid\&$cndid\&$tstid\&.*") {
			push @histentries, $_;
		    }
		}
		if (not @histentries) {
			# No entry in History file
			return 0;
		}
		####
		#my $sgrepfor = "^$testdate\<\<\>\>$clid\&$cndid\&$tstid\&(.*.)";
		#my @histentries = grep(/$sgrepfor/,@seqlines);
		#if ($histentries[0] == "") {
		#	# strip "GMT" and try again
		#	my $testdate0 = $testdate;
		#	$testdate0 =~ s/ GMT//g;
		#	my $sgrepfor = "^$testdate0\<\<\>\>$clid\&$cndid\&$tstid\&(.*.)";
		#	my @histentries = grep(/$sgrepfor/,@seqlines);
		#}
		#if ($histentries[0] == "") {
		#	# convert date to old format and try yet again
    		#	my %months = ("Jan" => 1, "Feb" => 2, "Mar" => 3, 
		#		      "Apr" => 4, "May" => 5, "Jun" => 6, 
		#		      "Jul" => 7, "Aug" => 8, "Sep" => 9, 
		#		      "Oct" => 10, "Nov" => 11, "Dec" => 12);
		#	my @datearray = split(/ /, $testdate);
		#	my ($day, $month, $year) = split(/-/, $datearray[0]);
		#	$datearray[0] = "$year-$months{$month}-$day";
		#	$testdate = join(" ", @datearray);
		#	my $sgrepfor = "^$testdate\<\<\>\>$clid\&$cndid\&$tstid\&(.*.)";
		#	@histentries = grep(/$sgrepfor/,@seqlines);
		#	@datearray = ();
		#}
		#if ($histentries[0] == "") {
		#	# No entry in History file
		#	return 0;
		#}
		####
		@seqlines = split(/\<\<\>\>/, $histentries[0]);
		my @status = split(/&/, $seqlines[1]);
		my $ifld = 0;
		$TEST_SESSION{'clid'} = $status[$ifld++];
		$TEST_SESSION{'uid'} = $status[$ifld++];
		$TEST_SESSION{'tstid'} = $status[$ifld++];
		$TEST_SESSION{'state'} = $status[$ifld++];
		$TEST_SESSION{'dscl'} = $status[$ifld++];
		$TEST_SESSION{'profb'} = $status[$ifld++];
		$TEST_SESSION{'id'} = $status[$ifld++];
		$TEST_SESSION{'profa'} = $status[$ifld++];
		$TEST_SESSION{'srvy'} = $status[$ifld++];
		$TEST_SESSION{'ntfy'} = $status[$ifld++];
		$TEST_SESSION{'emlcnd'} = $status[$ifld++];
		@status = ();
		$SUBTEST_QUESTIONS{2} = $seqlines[2];
		$SUBTEST_ANSWERS{2} = $seqlines[3];
		$SUBTEST_RESPONSES{2} = $seqlines[4];
		$SUBTEST_SUMMARY{2} = $seqlines[5];
	}
	@seqlines = ();
	return 1;
}

sub promote_test_sequence {
	$ffrom = join($pathsep, $_[0], "$TEST_SESSION{'clid'}.$TEST_SESSION{'uid'}.$TEST_SESSION{'tstid'}");
#	open(TESTFILE, "<$ffrom") or $msg="failed";
#&dbgprint("promote_test_sequence($_[0]):$_[1]:$_[2]\n");
	open(TESTFILE, "<$ffrom") or return;
#&dbgprint("\t$ffrom:-------:$msg\n");
	@seqlines = <TESTFILE>;
	close TESTFILE;
	@tsflds = split(/\./, $TEST_SESSION{'state'});
	$TEST_SESSION{'state'} = "$_[2].$tsflds[1].$tsflds[2]";
	@tsflds = ();
	$hdr = $TEST_SESSION{'clid'};
	$hdr = join('&', $hdr, $TEST_SESSION{'uid'});
	$hdr = join('&', $hdr, $TEST_SESSION{'tstid'});
	$hdr = join('&', $hdr, $TEST_SESSION{'state'});
	$hdr = join('&', $hdr, $TEST_SESSION{'dscl'});
	$hdr = join('&', $hdr, $TEST_SESSION{'profb'});
	$hdr = join('&', $hdr, $TEST_SESSION{'id'});
	$hdr = join('&', $hdr, $TEST_SESSION{'profa'});
	$hdr = join('&', $hdr, $TEST_SESSION{'srvy'});
	$hdr = join('&', $hdr, $TEST_SESSION{'ntfy'});
	$hdr = join('&', $hdr, $TEST_SESSION{'emlcnd'});

	$fto = join($pathsep, $_[1], "$TEST_SESSION{'clid'}.$TEST_SESSION{'uid'}.$TEST_SESSION{'tstid'}");
	open(TESTFILE, ">$fto") or $msg="failed";
	print TESTFILE "$hdr\n";
	for $iidx (1 .. $#seqlines) {
		print TESTFILE "$seqlines[$iidx]";
	}
	close TESTFILE;
	$chmodok = chmod 0666, $fto;
	$cnt = unlink $ffrom;
	@seqlines=();
#&dbgprint("\t$ffrom:$fto:$msg\n");
}

sub summarize_survey {
}

sub summarize_test {
	my $returnval="";
	# compute score
# HBI This subroutine is grading the test.
	$SUBTEST_RESPONSES{$_[0]} =~ s/\'//g;
#print STDERR "summarize_test($_[0]):$SUBTEST{'id'}:$SUBTEST{'scr'}\n";
#&dbgprint("summarize_test($_[0]):$SUBTEST{'id'}:$SUBTEST{'scr'}\n");
#&dbgprint("\t:$SUBTEST_ANSWERS{$_[0]}\n\t:$SUBTEST_RESPONSES{$_[0]}\n");
# warn "SUBTEST_ANSWERS:$SUBTEST_ANSWERS{$_[0]}\n" ;
# warn "SUBTEST_RESPONS:$SUBTEST_RESPONSES{$_[0]}\n" ;
	if ($SUBTEST{'scr'} eq '3') {
		$msg = "You have completed this unscored portion of the test.<BR>\n";
		$msg = join("", $msg, "Click the Continue button below to proceed.<BR>\n");
		$SUBTEST{'score'} = $msg; $msg = "";
		$summary = "Not Scored by Definition";
		$returnval="u";
	} else {
		@cans = split(/&/, $SUBTEST_ANSWERS{$_[0]});
# The format of an element of @cans is "answer::subject:weight:points:deduction"
# The default value for weight is one, for points is 100 for the entire test,
# The default for deduction is 0.
		@crsp = split(/&/, $SUBTEST_RESPONSES{$_[0]});
# The format of an element of @crsp is "response::comments"
# HBI patterns for scoring - 
# ($cans =~ /[0-9]=[0-1]/ ) - Answers are patterns of selected or unselected for multiple selection.
#          - separated by question marks, like 0=1?1=1?2=0  the first digit may be in any order.
# ($cans =~ /[anorR]\./ )
#   In get_label_index , the letters rR are used for Roman Numerals, Lower and Uppercase, respectively.
#   In get_label_index , the letter n is used for Arabic Numerals, 1, 2, 3, etc.
#   In get_label_index , the letters aA are used for letters; a,b,c, etc. ; Lower and Uppercase, respectively.
# ($cans =~ m/\,/) (If there is a comma, then there are multiple correct answers, and anyone earns the score.
# $iscorrect = ($cans eq $crsp) ? 1 : 0; # Looks to see if the answer matches the response.
# Builds the variable $byquestion.
		$correct = 0;
		$incorrect = 0;
		$totans = 0;
		$byquestion = "";
#&dbgprint("\t:261:$#cans:$#crsp\n");
		for (1 .. $#cans) {
			$ansmask = "";
			($cans, $scoring) = split(/::/, $cans[$_]);
			($scsubj, $scwght, $scpts, $scded) = split(/:/, $scoring);
			unless ($scwght) { $scwght = 1;}
			unless ($scpts) { $scpts = 100 / $#cans;}
			unless ($scded) { $scded = 0;}
			$cans = lc($cans);
			($crsp,$ccmts) = split(/::/, lc($crsp[$_]));
#&dbgprint("\t:271:$_:$cans:$crsp:$ccmts\n");
			$crsp =~ s/\'//;
			if ($cans =~ /[0-9]=[0-1]/ ) {
				@ansopts = split(/\?/, $cans);
				shift @ansopts;
				for (0 .. $#ansopts) {
					$ansdig = ($ansopts[$_] =~ /=1/ ) ? "$_" : "xxx" ;
					### DED-07 7/18/2002 
					#$ansmask = join('', $ansmask, $ansdig);
					$ansmask = join('?', $ansmask, $ansdig);
				}
				#$ansmask =~ s/x//g;
				#$crsp =~ s/x//g;
				$iscorrect = ($ansmask eq $crsp) ? 1 : 0;
				$byquestion = join('/', $byquestion, "$iscorrect.$ansmask.$crsp");
#&dbgprint("\t:284:$_:$#ansopts:$ansmask:$crsp\n");
            		} elsif ($cans =~ /[anorR]\./ ) {
				@ansopts = split(/\./, $cans);
				$anstype = shift @ansopts;
				if ($anstype eq 'o') {
					foreach $ansopt (@ansopts) {
						$ansopt++;
						### DED 7/17/2002
						# $ansmask = join('',$ansmask, $ansopt);
						$ansmask = join('?',$ansmask, $ansopt);
					}
				} else {
					@albls=&set_answer_labels($anstype);
					for (0 .. $#ansopts) {
						$cansord[$ansopts[$_]] = $albls[$_];
					}
					foreach $cansord (@cansord) {
						### DED 7/17/2002
						#$ansmask = join('', $ansmask, $cansord);
						$ansmask = join('?', $ansmask, $cansord);
					}
					@cansord = ();
				}
#&dbgprint("\t:303:$_:$#ansopts:$anstype:$asnmask:$crsp\n");
				$iscorrect = ($ansmask eq $crsp) ? 1 : 0;
				$byquestion = join('/', $byquestion, "$iscorrect.$ansmask.$crsp");
			} elsif ($cans =~ m/\,/) {
				@ansopts = split(/\,/,$cans);
				$iscorrect = 0;
				foreach $ansopt (@ansopts) {    
					if ($crsp eq $ansopt) {
						$iscorrect = 1;
					}
				}
#&dbgprint("\t:314:$_:$#ansopts:$crsp\n");
				$byquestion = join('/', $byquestion, "$iscorrect.$cans.$crsp");
			} else {
               my $cans_norm = $cans ; my $crsp_norm = $crsp ;
               # Normalize the answer given and the correct answer.
               # Strip leading and trailing white space.
               # Reduce multiple consecutive white space characters in the middle to a single space.
               $cans_norm =~ s/^\s+// ; $cans_norm =~ s/\s+$// ; $cans_norm =~ s/\s+/ /g ;
               $crsp_norm =~ s/^\s+// ; $crsp_norm =~ s/\s+$// ; $crsp_norm =~ s/\s+/ /g ;
               $iscorrect = ($cans_norm eq $crsp_norm) ? 1 : 0;
#&dbgprint("\t:318:$_:$cans:$crsp\n");
				$byquestion = join('/', $byquestion, "$iscorrect.$cans.$crsp");
			}
			if ($SUBTEST{'scr'} eq '1') {
				# weighted
				$correct += ($iscorrect) ? $scwght : 0;
				$incorrect += ($iscorrect) ? 0 : $scwght;
				$totans += $scwght;
			} elsif ($SUBTEST{'scr'} eq '2') {
				# cummulative
				$correct += ($iscorrect) ? $scpts : 0;
##wac v 01/04/02 this code was not scoring cummulative properly, remove 2 lines, added 1
				#remove this: $correct -= ($iscorrect) ? 0 : $scded;
				#remove this  $incorrect += ($iscorrect) ? 0 : $scpts;
                        # add next line, don't know why it referred to $scpts.
                        $incorrect += ($iscorrect) ? 0 : $scded;
##wac ^
				$totans += $scpts;
                         
			} else {
				# percent and default
				$totans++;
				$correct += ($iscorrect) ? 1 : 0;
				$incorrect += ($iscorrect) ? 0 : 1;
			}
			@ansopts = ();
		}
		if ($totans == 0) { $totans = 1; }
		if ($SUBTEST{'scr'} eq '1') {
			# weighted
			$score = int(($correct * 100) / $totans);
			$scpassing = $SUBTEST{'minpass'};
		} elsif ($SUBTEST{'scr'} eq '2') {
			# cummulative
			$score = ($correct - $incorrect);
			$scpassing = ($SUBTEST{'minpass'} / 100) * $totans;
		} else {
			$score = int(($correct * 100) / $totans);
			$scpassing = $SUBTEST{'minpass'};
		}
		@cans = ();
		@crsp = ();
		$SUBTEST{'correct'} = $correct;
		$SUBTEST{'incorrect'} = $incorrect;
		$SUBTEST{'score'} = $score;
		if ((defined $scpassing) and ($scpassing ne "") and ($score >= $scpassing)) {
			# Passed.
			$SUBTEST{'scorebar'} = "greenbar.jpg" ;
			$returnval = "p" ;
		} else {
			# Failed.
			$SUBTEST{'scorebar'} = "redbar.jpg" ;
			$returnval = "f" ;
		}
		$SUBTEST{'scorebarwidth'} = ($score * 3);
		$summary = join( '&', $SUBTEST{'correct'}, $SUBTEST{'incorrect'});
		$summary = join( '&', $summary, $SUBTEST{'score'}, $SUBTEST{'scorebar'});
		$summary = join( '&', $summary, $SUBTEST{'scorebarwidth'});
		if ($FORM{'submit'} eq 'timeexpired') {
			$summary = join( '&', $summary, "TIME EXPIRED");
		}
		$summary = join( '&', $summary, $byquestion);
	}
	warn "summarize_test RESULTS correct $correct incorrect $incorrect score $score scpassing $scpassing returnval $returnval \n" ;
	warn "summarize_test summary $summary \n" ;
	$SUBTEST_SUMMARY{$_[0]} = $summary;
	$summary = "";
	$score = "";
	return $returnval;
}

# ($tsubtest)
# remt
# 	0 Never
# 	1 On Posting of Answer
# 	2 Cumulative At End
# 	3 With Question
# rema
#	0 Not Applicable
#	1 Incorrect Answers
#	2 Correct Answers
#	3 Both
sub remediate_summary {
	$remediationtext="";
	if (($SUBTEST{'remt'} eq '2')
		&& ($SUBTEST{'rema'} ne '0')
		&& ($SUBTEST{'scr'} ne '3')) {
		@tqnos = split(/&/, $SUBTEST_QUESTIONS{$_[0]});
		@qrcans = split(/&/, $SUBTEST_ANSWERS{$_[0]});
		# jharding, 2004-06-22, corrected the retrieval of $byquestion
		# for tests that are timed out. BUG 184.
		@summary = split(/&/, $SUBTEST_SUMMARY{$_[0]});
		$correct = $summary[0];
		$incorrect = $summary[1];
		$score = $summary[2];
		$scorebar = $summary[3];
		$scorebarwidth = $summary[4];
		if ($#summary eq '5') {
			$byquestion = $summary[5];
		} else {
			$byquestion = $summary[6];
		}
		@remediations = split(/\//, $byquestion);
		for (1 .. $#remediations) {
			($cflag, $cans, $uresp) = split(/\./, $remediations[$_]);
			if ( ($SUBTEST{'rema'} eq '3')
			  || (($cflag eq '0') && ($SUBTEST{'rema'} eq '1'))
			  || (($cflag eq '1') && ($SUBTEST{'rema'} eq '2'))	) {
				%SQUESTION = %QUESTION;
				&get_question_definition($SUBTEST{'id'}, $SESSION{'clid'}, $tqnos[$_]);
				%TMPQUESTION = %QUESTION;
				%QUESTION = %SQUESTION;
				%SQUESTION=();
				if ($SUBTEST{'rema'} eq '1') {
					$descriptiontext = "The following lists the questions you answered incorrectly, for your review.";
				} elsif ($SUBTEST{'rema'} eq '2') {
					$descriptiontext = "The following lists the questions you answered correctly, for your review.";
				} else {
					$descriptiontext = "The following lists the questions and answers (both correct and incorrect) for your review.";
				}
				if ($remediationtext eq '') {
					$remediationtext="<HR width=100\%>
<FONT COLOR=\"\#FF0000\" SIZE=\"4\">
$descriptiontext<BR>
</FONT>
<HR width=100\%>\n";
				}
				($qrcans, $trash) = split(/::/, $qrcans[$_]);
				$remediation = &question_remediation($_, $cans, $uresp, $qrcans, $cflag);
				$remediationtext = join('', $remediationtext, $remediation, "<HR width=100\%>\n");
				%TMPQUESTION=();
			}
		}
		if ($remediationtext eq '') {
			$remediationtext="<HR width=100\%>
Congratulations on your perfect score.<BR>
<HR width=100\%>\n";
		}
		@remediations=();
		@qrcans=();
	}
	return $remediationtext;
}

sub question_remediation {
	$textofremediation="";
	$qtxt = $TMPQUESTION{'qtx'};
	$qtxt =~ s/<box>/________/g;
	if ($TMPQUESTION{'illustration'} eq '') {
		$qillus = "";
	} else {
		$qillus = "\n$TMPQUESTION{'illustration'}<BR>\n";
	}
	### DED 3/9/05 Have to split resp from comments
	($_[2]) = split(/::/, $_[2]);
	if ($_[4]) {
		$ctag = "<FONT COLOR=\"green\" SIZE=1>$xlatphrase[137]</FONT>";
	} else {
		$ctag = "<FONT COLOR=\"red\" SIZE=1>$xlatphrase[692]</FONT>";
	}

	if ($TMPQUESTION{'qtp'} eq 'mch' ) {
		### DED-05 7/17/2002  Replaced:
		#$quresp = $_[2];
		#$qcresp = $_[1];
		### with the following to print long answers during remediation

		@labels=&set_answer_labels($TMPQUESTION{'qalb'});
		$qanswermatch = "\&nbsp;<BR>\n";
		@txts = split(/\n/, $TMPQUESTION{'qca'});
		@txts_wro = split(/\n/, $TMPQUESTION{'qia'});
		@tmpquresp = split(/\?/, $_[2]);
		shift @tmpquresp;
		@ansopts = split(/\?/, $_[1]);
		shift @ansopts;
		$quresp = "";
		$qcresp = "<TABLE>\n<TR>\n<TD>\n";
		for (0 .. $#ansopts) {
			$ansopt = $ansopts[$_];
			$iansopt = &get_label_index($TMPQUESTION{'qalb'},$ansopt);
      if ($iansopt == -1) {
         $iansopt = 0 ; # HBI Actually an error.
      }
			$cansord[$iansopt] = $_;
			$qcresp = join('',$qcresp,"($ansopt) $txts[$_]<BR>\n");
		}
		$qcresp = join('',$qcresp, "</TD>\n<TD>&nbsp;</TD>\n<TD>\n");
		for (0 .. $#cansord) {
			$qcresp = join('',$qcresp, "<I>($labels[$_]) $txts_wro[$cansord[$_]]</I><BR>\n");
		}
		$qcresp = join('',$qcresp, "</TD>\n</TR>\n</TABLE>\n");
		for (0 .. $#tmpquresp) {
			### DED-11 7/23/2002 Print " " rather than "xxx"
			### 	for blank response (added following line)
			if ( $tmpquresp[$_] eq "xxx" ) { $tmpquresp[$_]=" "; }
			$quresp = join('',$quresp,"(",$tmpquresp[$_],") $txts[$_]<BR>\n");
		}
		@cansord = ();
		### END DED-05
	} elsif ($TMPQUESTION{'qtp'} eq 'ord' ) {
		### DED-04 7/16/2002  Replaced:
		#$quresp = $_[2];
		#$qcresp = $TMPQUESTION{'qca'};
		#$qcresp =~ s/\n/<BR>/g;
		### with the following to print long answers during remediation
		$quresp = "";
		$qcresp = "";
		@tmpquresp = split(/\?/, $_[2]);
		shift @tmpquresp;
		@txts = split(/\n/, $TMPQUESTION{'qca'});
		@ansopts = split(/\?/, $_[1]);
		shift @ansopts;
		for (0 .. $#ansopts) {
			$ansopt = $ansopts[$_];
			### DED 8/10/2002 Removed labels as "o" is used now
			$iansopt = $ansopt;
			$iansopt--;
			$qcresp = join('',$qcresp,"($ansopt) $txts[$iansopt]<BR>\n");
			### DED-12 7/23/2002 Print " " rather than "xxx"
			### 	for blank response (added following line)
			if ( $tmpquresp[$_] eq "xxx" ) { $tmpquresp[$_]=" "; }
			$quresp = join('',$quresp,"(",$tmpquresp[$_],") $txts[$iansopt]<BR>\n");
		}
		### END DED-04
		### DED-13 7/30/2002 Removed following and merged mcs logic
		###	with mcm logic for "?" delimiter
	#} else {
		#if ($TMPQUESTION{'qtp'} eq 'mcs' ) {
			#@qrans=split(/\n/, $TMPQUESTION{'qia'});
			#unshift @qrans, $TMPQUESTION{'qca'};
			#@qrcansidx = split(/\?/, $_[3]);
			#shift @qrcansidx;
			#($qurespidx, $trash) = split(/=/, $qrcansidx[$_[2]]);
			#$quresp = $qrans[$qurespidx];
			#$qcresp = $TMPQUESTION{'qca'};
#$qdx="\n<!--\n$_[2],$qrcansidx[$_[2]],$qurespidx,$qrans[$qurespidx],$quresp\n-->\n";
			#@qrcansidx = ();
			#@qrans=();
		#} elsif ($TMPQUESTION{'qtp'} eq 'mcm' ) {
	} elsif (($TMPQUESTION{'qtp'} eq 'mcm' ) || ($TMPQUESTION{'qtp'} eq 'mcs' ) || ($TMPQUESTION{'qtp'} eq 'lik' )) {
			### DED-06 7/17/2002  Replaced:
			#$quresp = $_[2];
			#$qcresp = $TMPQUESTION{'qca'};
			#$qcresp =~ s/\n/<BR>/g;
			### with the following to print long answers during remediation
			$qcresp = "";
			$quresp = "";
			@tmpquresp = split(/\?/, $_[2]);
			shift @tmpquresp;
			$keyresponse = $_[3];
			@txts = split(/\n/, $TMPQUESTION{'qca'});
			@txts_wro = split(/\n/, $TMPQUESTION{'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" : "";
				$qcresp = join('',$qcresp,"<input type=\"checkbox\"$checked>$txts[$indexs[0]]<BR>\n");
				$checked = ($tmpquresp[$jidx] eq $jidx) ? " CHECKED" : "";
				$quresp = join('',$quresp,"<input type=\"checkbox\"$checked>$txts[$indexs[0]]<BR>\n");
			}
			### END DED-06
	### DED-14 8/9/2002 Added "esa" section below to show multiple answers
	} elsif ($TMPQUESTION{'qtp'} eq 'esa' ) {
			$quresp = $_[2];
			$qcresp = $TMPQUESTION{'qca'};
			$qcresp =~ s/\n/\<br\>/g;
	### END DED-14
	} else {
			$quresp = $_[2];
			$qcresp = $TMPQUESTION{'qca'};
	}
	$textofremediation = "<TABLE border=0>
<TR>
	<TD colspan=1 align=\"left\" valign=top rowspan=3>
		$ctag
	</TD>
	<TD colspan=2 align=\"left\">
		$qillus
		<B><%=PHRASE.328%> $_[0].\&nbsp\;\&nbsp\;</B>
		$qtxt<BR>
	</TD>
</TR>
<TR>
	<TD align=\"left\">
		<B>YOUR ANSWER(S):</B><BR>
		$quresp<BR>$qdx
	</TD>
	<TD align=\"left\">
		<B>CORRECT ANSWER(S):</B><BR>
		$qcresp<BR>
	</TD>
</TR>
<TR>
	<TD colspan=2 align=\"left\">
";

	if ($TMPQUESTION{'qrm'} ne "") {
		$textofremediation .= "		<FONT SIZE=\"2\" COLOR=\"#FF0000\">
		<B>EXPLANATION:</B><BR>
		$TMPQUESTION{'qrm'}
		</FONT>
";
	}
	$textofremediation .= "
</TD>
</TR>
</TABLE>
";
	return $textofremediation;
}

################################################################
# REMEDIATION FIX
# if remediated on posting prepare the text of the remediation
################################################################
sub score_question {
	my ($tsubtest,$tqno,$qcans,$qresp) = @_;

#&dbgprint("REMEDIATION FIX:testlib:602 score_question: tsubtest:$tsubtest tqno:$tqno qcans:$qcans qresp:$qresp\n");
	my $ansmask = "";
	my $iscorrect=0;
	my ($cans,$trash) = split(/::/, lc($qcans));
	my ($crsp,$trash2) = split(/::/, lc($qresp));
	$crsp =~ s/\'//;
#&dbgprint("REMEDIATION FIX:testlib:614 score_question: cans:$cans crsp:$crsp\n");
	if ($cans =~ /[0-9]=[0-1]/ ) {
		my @ansopts = split(/\?/, $cans);
		shift @ansopts;
		for (0 .. $#ansopts) {
			my $ansdig = ($ansopts[$_] =~ /=1/ ) ? "$_" : "xxx" ;
			$ansmask = join('?', $ansmask, $ansdig);
		}
#&dbgprint("REMEDIATION FIX:testlib:622 score_question: ansmask:$ansmask crsp:$crsp\n");
		$iscorrect = ($ansmask eq $crsp) ? 1 : 0;
		@ansopts = ();
	} elsif ($cans =~ /[anorR]\./ ) {
		my @ansopts = split(/\./, $cans);
		my $anstype = shift @ansopts;
		if ($anstype eq 'o') {
			foreach my $ansopt (@ansopts) {
				$ansopt++;
				$ansmask = join('?',$ansmask, $ansopt);
			}
		} else {
			my @albls=&set_answer_labels($anstype);
			my @cansord=();
			for (0 .. $#ansopts) {
				$cansord[$ansopts[$_]] = $albls[$_];
			}
			foreach my $cansord (@cansord) {
				$ansmask = join('?', $ansmask, $cansord);
			}
			@cansord = ();
			@albls=();
		}
#&dbgprint("REMEDIATION FIX:testlib:645 score_question: ansmask:$ansmask crsp:$crsp\n");
		$iscorrect = ($ansmask eq $crsp) ? 1 : 0;
		@ansopts = ();
	} elsif ($cans =~ m/\;/) {
		my @ansopts = split(/\;/,$cans);
		$iscorrect = 0;
		foreach my $ansopt (@ansopts) {    
			if ($crsp eq $ansopt) {
				$iscorrect = 1;
			}
		}
#&dbgprint("REMEDIATION FIX:testlib:656 score_question: ansmask:$ansmask crsp:$crsp\n");
		@ansopts = ();
	} else {
#&dbgprint("REMEDIATION FIX:testlib:659 score_question: cans:$cans crsp:$crsp\n");
		my $cans_norm = $cans ; my $crsp_norm = $crsp ;
		# Normalize the answer given and the correct answer.
		# Strip leading and trailing white space.
		# Reduce multiple consecutive white space characters in the middle to a single space.
		$cans_norm =~ s/^\s+// ; $cans_norm =~ s/\s+$// ; $cans_norm =~ s/\s+/ /g ;
		$crsp_norm =~ s/^\s+// ; $crsp_norm =~ s/\s+$// ; $crsp_norm =~ s/\s+/ /g ;
		$iscorrect = ($cans_norm eq $crsp_norm) ? 1 : 0;
	}
	return $iscorrect;
}
################################################################
# REMEDIATION FIX
# if remediated on posting prepare the text of the remediation
################################################################
# ($tsubtest, $tqno)
#sub remediate_question {
#	return "";
#}
sub remediate_question {
	my ($tsubtest,$tqno) = @_;

#&dbgprint("REMEDIATION FIX:testlib:675 remediate_question: $tsubtest, $tqno\n");
#&dbgprint("REMEDIATION FIX:testlib:676 remediate_question: REMT:$TEST{'remt'} REMA:$TEST{'rema'}\n");
	if (($TEST{'remt'} ne '1')
		|| ($TEST{'rema'} eq '0')) {
		return "";
	}
		
	my $remediation="";
	my @tqnos = split(/&/, $SUBTEST_QUESTIONS{$tsubtest});
	my @qrcans = split(/&/, $SUBTEST_ANSWERS{$tsubtest});
	my @qresp = split(/&/, $SUBTEST_RESPONSES{$tsubtest});

	my $cans = $qrcans[$tqno]; # = $_[1] ###############
	my $uresp = $qresp[$tqno]; # = $_[2] ###############
	my $cflag = &score_question($tsubtest,$tqno,$cans,$uresp);

#&dbgprint("REMEDIATION FIX:testlib:691 remediate_question: cflag:$cflag cans:$cans uresp:$uresp\n");
	#
	# IF rema (='3') is remediate on both correct & incorrect answers)
	# OR uresp is incorrect (='0') and rema (='1') is remediate only on incorrect
	# OR uresp is correct (='1') and rema (='2') is remediate only on correct
	#
	if ( ($TEST{'rema'} eq '3')
	  || (($cflag eq '0') && ($TEST{'rema'} eq '1'))
	  || (($cflag eq '1') && ($TEST{'rema'} eq '2'))	) {
		%SQUESTION = %QUESTION;
		&get_question_definition($SUBTEST{'id'}, $SESSION{'clid'}, $tqnos[$tqno]);
		%TMPQUESTION = %QUESTION;
		%QUESTION = %SQUESTION;
		%SQUESTION=();
		my ($qrcans, $trash) = split(/::/, $cans);
		$remediation = ($cflag == 1) ? "<H1><font color=darkgreen><%=PHRASE.137%></font></H1>" : "<H1><font color=red><%=PHRASE.343%></font></H1>";
		my $qremediation = &question_remediation($tqno, $cans, $uresp, $qrcans);
		$remediation .= $qremediation;
my $remfixdbglen=length($remediation);
#&dbgprint("REMEDIATION FIX:testlib:708 question_remediation: FREM:$remfixdbglen\n");
		%TMPQUESTION=();
		$remediation .= "<TABLE border=0 width=\"100\%\">
<TR>
	<TD align=\"center\">
		<FONT SIZE=\"2\" COLOR=\"#FF0000\">
		<input type=submit name=submit value=\"<%=PHRASE.566%>\">
		</FONT>
	</TD>
</TR>
</TABLE>
";
	} else {
		$FORM{'remediated'} = "Y";
	}
	return $remediation;
}

sub create_test_sequence {
	$trash = join($pathsep, $testpending, "$_[0].$_[1].$_[2]");
	open(TESTFILE, ">$trash") or $msg="failed";
	@rows=&package_test_sequence();
	foreach $row (@rows) {
		print TESTFILE "$row\n";
	}
	close TESTFILE;
	$chmodok = chmod 0666, $trash;
############################################ 
#	addition Backup of registered test
#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
#	my $coreid = sprintf( "\%d", time);
#	$trash = join($pathsep, $testpending, "$_[0].$_[1].$_[2].$coreid");
#	open(TESTFILE, ">$trash") or $msg="failed";
#	foreach $row (@rows) {
#		print TESTFILE "$row\n";
#	}
#	close TESTFILE;
#	$chmodok = chmod 0666, $trash;
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
#	addition Backup of registered test
############################################ 
}

sub put_test_sequence {
	$trash = join($pathsep, $_[0], "$_[1].$_[2].$_[3]");
	open(TESTFILE, ">$trash") or $msg="failed";
	@pkg=&package_test_sequence();
	foreach $row (@pkg) {
		print TESTFILE "$row\n";
	}
	close TESTFILE;
	@pkg=();
}

sub package_test_sequence {
	@rows=();
	$hdr = $TEST_SESSION{'clid'};
	$hdr = join('&', $hdr, $TEST_SESSION{'uid'});
	$hdr = join('&', $hdr, $TEST_SESSION{'tstid'});
	$hdr = join('&', $hdr, $TEST_SESSION{'state'});
	$hdr = join('&', $hdr, $TEST_SESSION{'dscl'});
	$hdr = join('&', $hdr, $TEST_SESSION{'profb'});
	$hdr = join('&', $hdr, $TEST_SESSION{'id'});
	$hdr = join('&', $hdr, $TEST_SESSION{'profa'});
	$hdr = join('&', $hdr, $TEST_SESSION{'srvy'});
	$hdr = join('&', $hdr, $TEST_SESSION{'ntfy'});
	$hdr = join('&', $hdr, $TEST_SESSION{'emlcnd'});
	push @rows, $hdr;
	$ipts = 1;
	for $ipts (1 .. 4) {
		push @rows, $SUBTEST_QUESTIONS{$ipts};
		push @rows, $SUBTEST_ANSWERS{$ipts};
		push @rows, $SUBTEST_RESPONSES{$ipts};
		push @rows, $SUBTEST_SUMMARY{$ipts};
	}
	return @rows;
}

sub put_question_response {
	my	$questionNo = $_[1];
	$qrs = ($FORM{'marked'} ne '') ? "\'" : ""; 
	### DED 8/9/2002 Separated mcs logic from mcm
	### DED 9/2002   Added mca for adaptive
	if (($QUESTION{'qtp'} eq 'mcs') || ($QUESTION{'qtp'} eq 'mca') || ($QUESTION{'qtp'} eq 'lik')) {
		@ansc = split(/\n/, $QUESTION{'qca'});
		@answ = split(/\n/, $QUESTION{'qia'});
		$nanso = $#ansc + $#answ + 1;
		for $ipqr (0 .. $nanso) {
			### DED 8/20/2002
			#if (($ipqr != "") && ($ipqr == $FORM{'qrs'})) {
			if ( (($FORM{'qrs'} != "") || ($FORM{'qrs'} =~ /0/)) && ($ipqr == $FORM{'qrs'}) ) {
				$qrs = join('?', $qrs, $ipqr);
			} else {
				$qrs = join('?', $qrs, "xxx");
			}
		}
		### DED 6/28/04 Don't add unanswered to review list
		#$rdig = $qrs;
		#$rdig =~ s/xxx//g;
		#$rdig =~ s/\?//g;
		#if ($rdig eq '') { $qrs = join('', "\'", $qrs);}
	} elsif ($QUESTION{'qtp'} eq 'mcm') {
		@ansc = split(/\n/, $QUESTION{'qca'});
		@answ = split(/\n/, $QUESTION{'qia'});
		$nanso = $#ansc + $#answ + 1;
		for $ipqr (0 .. $nanso) {
				if( $TEST{'seq'} eq 'svy' || ($TEST{'seq'} eq 'dmg' && $TEST{'group'} eq 'Y'))
				{
					$rkey = "q$questionNo";
					$rkey = join( '-', $rkey, "qrs$ipqr" );
				}
				else
				{
					$rkey = "qrs$ipqr";
				}
			$rdig = ($FORM{$rkey} eq '') ? "xxx" : $FORM{$rkey};
			### DED 7/18/2002
			#$qrs = join('', $qrs, $rdig);
			$qrs = join('?', $qrs, $rdig);
		}
		### DED 6/28/04 Don't add unanswered to review list
		#$rdig = $qrs;
		#$rdig =~ s/xxx//g;
		#$rdig =~ s/\?//g;
		#if ($rdig eq '') { $qrs = join('', "\'", $qrs);}
	} elsif ($QUESTION{'qtp'} eq 'mtx' || $QUESTION{'qtp'} eq 'mtr') {
		($rows, $numrows, $numcols, $cols) = split(/::/, $QUESTION{'qia'});
		@rows = split(/\n/, $rows);
		@cols = split(/\n/, $cols);
		for $row (0 .. $#rows) {
			for (0 .. $#cols) {
				if( $TEST{'seq'} eq 'svy' || ($TEST{'seq'} eq 'dmg' && $TEST{'group'} eq 'Y'))
				{
					$rkey = "q$questionNo";
					$rkey = join( '-', $rkey, "qrs$row$_" );
				}
				else
				{
					$rkey = "qrs$row$_";
				}
				if ($FORM{$rkey} ne '') {
					$qrs = join('?', $qrs, $FORM{$rkey});
				} else {
					$qrs = join('?', $qrs, "xxx");
				}
			}
		}
		### DED 6/28/04 Don't add unanswered to review list
		#$resp = $qrs;
		#$resp =~ s/xxx//g;
		#$resp =~ s/\?//g;
		#if ($resp eq '') { $qrs = join('', "\'", $qrs);}
		#$resp = '';
	} elsif (($QUESTION{'qtp'} eq 'mch') || ($QUESTION{'qtp'} eq 'ord')) {
		@ansc = split(/\n/, $QUESTION{'qca'});
		$nanso = $#ansc;
		for $ipqr (0 .. $nanso) {
			if( $TEST{'seq'} eq 'svy' )
			{
				$rkey = "q$questionNo";
				$rkey = join( '-', $rkey, "qrs$ipqr" );
			}
			else
			{
				$rkey = "qrs$ipqr";
			}
			$rdig = ($FORM{$rkey} eq '') ? "xxx" : $FORM{$rkey};
			$rdig =~ s/\+/ /g;
			$rdig =~ s/\&/and/g;
			### DED-08 7/17/2002 Replaced
			#$qrs = join('', $qrs, $rdig);
			# with 
			$qrs = join('?', $qrs, $rdig);
			### END DED-08
		}
		### DED 6/28/04 Don't add unanswered to review list
		#if ($rdig =~ /xxx/ ) { $qrs = join('', "\'", $qrs);}
	} elsif ($QUESTION{'qtp'} eq 'esa' || $QUESTION{'qtp'} eq 'nrt') {
		### DED 6/28/04 Don't add unanswered to review list
		#if ($FORM{'qrs'} eq '') {
			#$qrs = "\'";
		#} else {
			$qrsu = $FORM{'qrs'};
			### DED-15 8/9/2002 Added line below to strip "+"s
			$qrsu =~ s/\+/ /g;
			$qcmt =~ s/\r\n/<BR>/g;
			$qcmt =~ s/\r/<BR>/g;
			$qrsu =~ s/\n/<BR>/g;
			$qrsu =~ s/\&/and/g;
			#$qrsu = munge($qrsu);
			$qrs = join('', $qrs, $qrsu);
		#}
	} else {
		$qrs = join('', $qrs, $FORM{'qrs'});
		### DED 6/28/04 Don't add unanswered to review list
		#if ($qrs eq '') { $qrs = "\'";}
	}
	@resps = split(/&/, $SUBTEST_ANSWERS{$_[0]});
	$nresps = $#resps;
##############################################
# added logging of question response
#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "9", "Q\:$questionNo\:$QUESTION{'qid'}\:\:\:\:A\:$resps[$questionNo]\:\:\:\:R\:$qrs");
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
##############################################
	@resps = split(/&/, $SUBTEST_RESPONSES{$_[0]});
	$rspflds = "";
	my $qcmt;
	for $ipqr (1 .. $nresps) {
		if ($_[1] eq $ipqr) {
			$qcmt = $FORM{'qcucmt'};
			$qcmt =~ s/\+/ /g ;
			$qcmt =~ s/\r\n/<BR>/g;
			$qcmt =~ s/\r/<BR>/g;
			$qcmt =~ s/\n/<BR>/g;
			$qcmt =~ s/\&/and/g;
			$rspflds = join('&', $rspflds, "$qrs\:\:$qcmt");
##############################################
# added logging of question response
#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
	if ($qcmt ne '') {
		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "9", "Q\:$questionNo\:$QUESTION{'qid'}\:\:\:\:C\:$qcmt");
	}
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
##############################################
		} else {
			$rspflds = join('&', $rspflds, $resps[$ipqr]);
		}
	}
	$SUBTEST_RESPONSES{$_[0]} = $rspflds;
	$rspflds = "";
	@resps = ();
	@ansc = ();
	@answ = ();
	@anso = ();
}

sub get_previous_response {
	@resps = split(/&/, $SUBTEST_RESPONSES{$_[0]});
	$resp = $resps[$_[1]];
#efl v 12/??/01
#old	$resp =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/g;
# replace with unmunge
	$resp = unmunge($resp);
#efl ^
	### DED 7/8/04 Moved out to tqrs.pl so marked questions stay marked
	#$resp =~ s/\'//; 
	@resps = ();
	return $resp;
}

sub find_next_marked {
	@resps = split(/&/, $SUBTEST_RESPONSES{$_[0]});
	$nmresps = $#resps;
	$nsresps = $_[1];
	$nsresps = ($_[1] eq $nmresps) ? 1 : $nsresps + 1;
	if ($nsresps > $nmresps) { $nsresps = 1;}
	for ($nsresps .. $#resps) {
		$resp = $resps[$_];
		if ($resp =~ /\'/) {
			return $_;
		}
	}
	$nsresps--;
	if ($nresps > 0) {
		for (1 .. $nsresps) {
			$resp = $resps[$_];
			if ($resp =~ /\'/) {
				return $_;
			}
		}
	}
	return 0;
}

sub find_next_unanswered {
	@resps = split(/&/, $SUBTEST_RESPONSES{$_[0]});
	$nmresps = $#resps;
	$nsresps = $_[1];
	$nsresps = ($_[1] eq $nmresps) ? 1 : $nsresps + 1;
	if ($nsresps > $nmresps) { $nsresps = 1;}
	for ($nsresps .. $#resps) {
		($resp, $trash) = split(/:/, $resps[$_]);
		$resp =~ s/\'//g;
		$resp =~ s/\?xxx//g;
		if ($resp eq '') {
			return $_;
		}
	}
	$nsresps--;
	if ($nresps > 0) {
		for (1 .. $nsresps) {
			($resp, $trash) = split(/:/, $resps[$_]);
			$resp =~ s/\'//g;
			$resp =~ s/\?xxx//g;
			if ($resp eq '') {
				return $_;
			}
		}
	}
	return 0;
}

sub find_marked_unanswered {
	my $marked = ":";
	my $unanswered = ":";
	my @resps = split(/&/, $SUBTEST_RESPONSES{$_[0]});
	for (1 .. $#resps) {
		($resp, $trash) = split(/:/, $resps[$_]);
		$resp =~ s/\?xxx//g;
		if ($resp =~ /\'/) {
			$marked .= "$_:";
		} 
		$resp =~ s/\'//g;
		if ($resp eq '') {
			$unanswered .= "$_:";
		}
	}
	if ($marked eq ":") { $marked = "" }
	if ($unanswered eq ":") { $unanswered = "" }
	return ($marked, $unanswered);
}

sub build_question_dropdown_list {
	my ($tsubtest, $marked, $unanswered) = @_;
	my $questionlist = "";
	my @questions=&get_question_list($TEST{'id'}, $SESSION{'clid'});
	my %qlist = {};
	for (1 .. $#questions) {
		my $qflds = $questions[$_];
		chop ($qflds);
		my @qdata = split(/&/, $qflds);
		my ($trash, $qsno) = split(/\./, $qdata[0]);
		$qlist{$qsno} = substr($qdata[4],0,20);
	}
	@qdata = ();
	my @tquestions = split(/\&/, $SUBTEST_QUESTIONS{$tsubtest});
	for (1 .. $#tquestions) {
		$qind1 = ($marked =~ /:$_:/) ? 'R' : "\&nbsp;\&nbsp;";
		$qind2 = ($unanswered =~ /:$_:/) ? 'U' : "\&nbsp;\&nbsp;";
		my ($trash, $qsno) = split(/\./, $tquestions[$_]);
		$listtext = sprintf("(%u) %20s", $_, $qlist{$qsno});
		if ($TEST{'qpv'} eq 'Y' || $qind1 eq 'R' || $qind2 eq 'U') {
			$questionlist = join('', $questionlist, "<OPTION VALUE=\"$_\">$qind1$qind2 $listtext</OPTION>\n");
		}
	}
	@questions = ();
	@tquestions = ();
	@qlist = ();
	return $questionlist;
}

sub get_question_id {
	@qids = split(/&/, $SUBTEST_QUESTIONS{$_[0]});
	$qid = $qids[$_[1]];
	@qids = ();
	return $qid;
}

sub prepare_test {
	my ($clid, $cndid, $authtests, $usetestform, $rmtests) = @_;
	my $retakeoptions="";

	&get_client_profile($clid);
	my $opts = { restrict_to_availability_window => 0 };
	if ($SESSION{'taclid'} eq '') {
		&get_candidate_profile( $clid, $cndid, $opts);
	} else {
		&get_tacl_profile();
	}
	&remove_inprogtest($clid, $cndid, $authtests);
        #&remove_pending_oldtests($clid, $cndid, $authtests);
	if ($rmtests ne '') {
		my @rmtests = split(/\;/, $rmtests);
		shift @rmtests;
		foreach (@rmtests) {
			my $pendfile = join($pathsep, $testpending, "$clid.$cndid.$_");
			if (-e $pendfile) { 
				unlink $pendfile; 
			}
		}
	}
	my @atests = &create_newtests_list($clid, $cndid, $authtests);
	my @testforms = split(/:/, $usetestform);
	$SYSTEM{'testprepmsg'}="";
	$SYSTEM{'testpreperror'}="";
	foreach $atest (@atests) {
		if ($atest ne '') {
			&get_test_profile($clid, $atest);
			$TEST_SESSION{'clid'} = $clid;
			$TEST_SESSION{'uid'} = $cndid;
			$TEST_SESSION{'tstid'} = $atest;
			$TEST_SESSION{'state'} = "0.0.0";
			$TEST_SESSION{'dscl'} = $TEST{'dscl'};
			$TEST_SESSION{'profb'} = $TEST{'profb'};
			$TEST_SESSION{'id'} = $TEST{'id'};
			$TEST_SESSION{'profa'} = $TEST{'profa'};
			$TEST_SESSION{'srvy'} = $TEST{'srvy'};
			$TEST_SESSION{'ntfy'} = $TEST{'ntfy'};
			$TEST_SESSION{'emlcnd'} = $TEST{'emlcnd'};

			@tseqs = ( $TEST{'dscl'}, $TEST{'profb'}, $TEST{'id'}, $TEST{'profa'}, $TEST{'srvy'} );

			for $isubtest (1 .. 4) {
				$SUBTEST_QUESTIONS{$isubtest} = "";
				$SUBTEST_ANSWERS{$isubtest} = "";
				$SUBTEST_RESPONSES{$isubtest} = "";
				$SUBTEST_SUMMARY{$isubtest} = "";
				if ($tseqs[$isubtest] ne '') {
# DBG &dbgprint("\t$isubtest:$tseqs[$isubtest]\n");
					&get_subtest_profile($clid, $tseqs[$isubtest]);
# sac - start addition for subject area percentage support
# (replaced)		$SUBTEST_QUESTIONS{$isubtest} = &build_questions( $clid, $tseqs[$isubtest], $SUBTEST{'noq'});
# (with)
					&IsTestSBA($clid,$tseqs[$isubtest]);
					$SYSTEM{'testpreperror'}="";
					# DED 6/9/04 handle uploaded test forms
					if ($isubtest == 2) {
						$testform = "";
						foreach $atestform (@testforms) {
							if ($atestform eq $tseqs[$isubtest]) {
								$testform = $atestform;
								break;
							}
						}
						$SUBTEST_QUESTIONS{$isubtest} = &build_questions( $clid, $tseqs[$isubtest], $SUBTEST{'noq'}, $testform);
					} else {
						$SUBTEST_QUESTIONS{$isubtest} = &build_questions( $clid, $tseqs[$isubtest], $SUBTEST{'noq'});
					}
					last if ($SYSTEM{'testpreperror'} ne "");
# sac - end addition for subject area percentage support
					$SUBTEST_ANSWERS{$isubtest} = &build_answers( $tseqs[$isubtest], $clid, $isubtest, $SUBTEST{'noq'});
					@rspflds = split(/&/, $SUBTEST_ANSWERS{$isubtest});
					$rspspc = "";
					foreach $rspfld (@rspflds) {
						$rspspc = join('&', $rspspc, "");
					}
					$SUBTEST_RESPONSES{$isubtest} = $rspspc;
					$rspspc = "";
					@rspflds = ();

# v sac support for retake options
					$retakeoptions=$SUBTEST{'slfregenab'};
					$retakeoptions=join('.',$retakeoptions,$SUBTEST{'retkcnt'});
					$retakeoptions=join('.',$retakeoptions,$SUBTEST{'retkcndtn'});
					$retakeoptions=join('.',$retakeoptions,$SUBTEST{'retkwt'});
					$retakeoptions=join('.',$retakeoptions,$SUBTEST{'retkwtdly'});
					$retakeoptions=join('.',$retakeoptions,$SUBTEST{'retkkeep'});
					$retakeoptions=join('.',$retakeoptions,$SUBTEST{'retkautorgstrenab'});
					$SUBTEST_QUESTIONS{$isubtest} = join('',$retakeoptions,$SUBTEST_QUESTIONS{$isubtest});
# ^ sac support for retake options

				}
			}
# sac - start addition for subject area percentage support
# (replaced)
#			&create_test_sequence($clid, $cndid ,$atest);
# (with)
			if ($SYSTEM{'testpreperror'} eq "") {
				&create_test_sequence($clid, $cndid ,$atest);
			} else {
				$SYSTEM{'testprepmsg'}=join('',$SYSTEM{'testprepmsg'},$SYSTEM{'testpreperror'});
				$SYSTEM{'testpreperror'}="";
			}
# sac - end addition for subject area percentage support
		}
	}
	@atests = ();
	@tseqs = ();
}

sub build_questions {

	if ($_[3] ne '') {
		# DED 6/9/04 use test form
		$qseq = &build_formqseq($_[1], $_[0]);
	} elsif (($SUBTEST{'seq'} eq 'std') || ($SUBTEST{'seq'} eq 'svy')) {
# sac - start addition for subject area percentage support
		if ($SUBTEST{'IsTestSBA'}) {
			$qseq = &build_rndqseq_sba($_[1], $_[0], $_[2]);
		} else {
# sac - end addition for subject area percentage support
			if ($SUBTEST{'rndq'} eq 'Y') {
				$qseq = &build_rndqseq($_[1], $_[0], $_[2]);
			} else {
				$qseq = &build_stdqseq($_[1], $_[0], $_[2]);
			}
# sac - start addition for subject area percentage support
		}
# sac - end addition for subject area percentage support

	} elsif ($SUBTEST{'seq'} eq 'dmg') {
		### DED 9/11/02 Adaptive Survey (dmg) support
		$qseq = &build_stdqseq($_[1], $_[0], $_[2]);
	}
	return $qseq;
}
### wac 072001 - expland labels to 25 from 15, put single quotes around alpha labels.
sub set_answer_labels {
	@albls = ();
	if ($_[0] eq 'a') {
		push @albls, ('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y');
	} elsif ($_[0] eq 'A') {
		push @albls, ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y');
	} elsif ($_[0] eq 'n') {
		push @albls, (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);
	} elsif ($_[0] eq 'r') {
		push @albls, (i,ii,iii,iv,v,vi,vii,viii,ix,x,xi,xii,xiii,xiv,xv,xvi,xvii,xviii,xix,xx,xxi,xxii,xxiii,xxiv,xxv);
	} elsif ($_[0] eq 'R') {
		push @albls, (I,II,III,IV,V,VI,VII,VIII,IX,X,XI,XII,XIII,XIV,XV,XVI,XVII,XVIII,XIX,XX,XXI,XXII,XXIII,XXIV,XXV);
	}
	return @albls;
}

sub get_label_index {
	@albls = ();
	if ($_[0] eq 'a') {
		push @albls, ('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y');
	} elsif ($_[0] eq 'A') {
		push @albls, ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y');
	} elsif ($_[0] eq 'n') {
		push @albls, (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);
	} elsif ($_[0] eq 'r') {
		push @albls, (i,ii,iii,iv,v,vi,vii,viii,ix,x,xi,xii,xiii,xiv,xv,xvi,xvii,xviii,xix,xx,xxi,xxii,xxiii,xxiv,xxv);
	} elsif ($_[0] eq 'R') {
		push @albls, (I,II,III,IV,V,VI,VII,VIII,IX,X,XI,XII,XIII,XIV,XV,XVI,XVII,XVIII,XIX,XX,XXI,XXII,XXIII,XXIV,XXV);
	}
	$retidx = -1;
	for (0 .. $#albls) {
		if ($albls[$_] eq $_[1]) {
			@albls = ();
			return $_;
		}
	}
	@albls = ();
	return $retidx;
}

sub build_answers {
	$ansrs="";
	@qids = split(/&/, $SUBTEST_QUESTIONS{$_[2]});
	for $iansno (1 .. $_[3]) {
		@ansl = ();
		$ansr="";
		$QUESTION{'id'}=$qids[$iansno];
		&get_question_definition($_[0], $_[1], $QUESTION{'id'});
		if ($QUESTION{'qtp'} eq 'mcm' || $QUESTION{'qtp'} eq 'mcs' || $QUESTION{'qtp'} eq 'mca' || $QUESTION{'qtp'} eq 'lik') {
			$forcetoend="";
			$forcetolast="";
			$anidx = 0;
			$ansmask="";
			if ($QUESTION{'qca'} ne '') {
				$qca = $QUESTION{'qca'};
				$qca =~ s/\r/\n/g;
				$qca =~ s/\n\n/\n/g;
				@qca = split(/\n/, $qca);
				foreach $qca (@qca) {
					if ($qca ne '') {
						if ($qca =~ /all of/i ) {
							$forcetoend="$anidx\=1";
						}
						if ($qca =~ /none of/i ) {
							$forcetolast="$anidx\=1";
						}
						push @ansl, "$anidx\=1";
						if ($ansmask eq '') {$ansmask = "<$anidx>";}
						else {$ansmask = join('', $ansmask, "<$anidx>");}
						$anidx++;
					}
				}
				@qca = ();
			}
			if ($QUESTION{'qia'} ne '') {
				$qia = $QUESTION{'qia'};
				$qia =~ s/\r/\n/g;
				$qia =~ s/\n\n/\n/g;
				@qia = split(/\n/, $qia);
				foreach $qia (@qia) {
					if ($qia ne '') {
						if ($qia =~ /all of/i ) {
							$forcetoend="$anidx\=0";
						}
						if ($qia =~ /none of/i ) {
							$forcetolast="$anidx\=0";
						}
						push @ansl, "$anidx\=0";
						if ($ansmask eq '') {$ansmask = "<$anidx>";}
						else {$ansmask = join('', $ansmask, "<$anidx>");}
						$anidx++;
					}
				}
				@qia = ();
			}
			$nans = $#ansl + 1;
			if ($SUBTEST{'rnda'} eq 'Y') {
				while ($ansmask ne '') {
					$aidx = int(rand($nans));
					if($ansmask =~ /<$aidx>/ && $aidx < $nans) {
						$ansr = join('?', $ansr, $ansl[$aidx]);
						$ansmask =~ s/<$aidx>//g;
					}
				}
			} else {
				for (0 .. $#ansl) {
					$ansr = join('?', $ansr, $ansl[$_]);
				}
			}
			if ($forcetoend ne '') {
				$ansr =~ s/\?$forcetoend//g;
				$ansr = join('?', $ansr, "$forcetoend");
			}
			if ($forcetolast ne '') {
				$ansr =~ s/\?$forcetolast//g;
				$ansr = join('?', $ansr, "$forcetolast");
			}
		} elsif ($QUESTION{'qtp'} eq 'mtx' || $QUESTION{'qtp'} eq 'mtr') {
			if ($QUESTION{'qca'} ne '') {
				$qca = $QUESTION{'qca'};
				$qca =~ s/\r/\n/g;
				$qca =~ s/\n\n/\n/g;
				@qca = split(/\n/, $qca);
				foreach $qca (@qca) {
					$ansr = join('?', $ansr, $qca);
				}
				@qca = ();
			}
		} elsif ($QUESTION{'qtp'} eq 'mch') {
			$anidx = 0;
			$ansmask="";
			if ($QUESTION{'qia'} ne '') {
				$qia = $QUESTION{'qia'};
				$qia =~ s/\r/\n/g;
				$qia =~ s/\n\n/\n/g;
				@qia = split(/\n/, $qia);
				foreach (0 .. $#qia) {
					$qia = $qia[$_];
					if ($qia ne '') {
						push @ansl, "$anidx";
						if ($anidx == 0) {$ansmask = "<$anidx>";}
						else {$ansmask = join('', $ansmask, "<$anidx>");}
						$anidx++;
					}
				}
				@qia = ();
			}
			$nans = $#ansl+1;
### ADT-01 9/02/2001 prevent right half of matching questions from scrambling
			if( $TEST{'rnda'} eq 'Y' )
			{
			### END ADT-01 change affects surveys only
			$ansr=$QUESTION{'qalb'};
			while ($ansmask ne '') {
				$aidx = int(rand($nans));
				if($ansmask =~ /<$aidx>/ && $aidx < $nans) {
					$ansr = join('.', $ansr, $ansl[$aidx]);
					$ansmask =~ s/<$aidx>//g;
				}
			}
			### ADT-02 9/02/2001
			}
			else
			{
				### DED-01 7/16/2002 Added line below to include
				### 	label in answer ("a","n", or "r")
				$ansr=$QUESTION{'qalb'};
				for( 0 .. $#ansl )
				{
					$ansr = join( '.', $ansr, $ansl[$_] );
				}
			}
			### END ADT-02 9/02/2001
		} elsif ($QUESTION{'qtp'} eq 'ord') {
			$anidx = 0;
			$ansmask="";
			if ($QUESTION{'qca'} ne '') {
				$qca = $QUESTION{'qca'};
				$qca =~ s/\r/\n/g;
				$qca =~ s/\n\n/\n/g;
				@qca = split(/\n/, $qca);
				foreach $qca (@qca) {
					if ($qca ne '') {
						push @ansl, "$anidx";
						if ($anidx == 0) {$ansmask = "<$anidx>";}
						else {$ansmask = join('', $ansmask, "<$anidx>");}
						$anidx++;
					}
				}
				@qca = ();
			}
			$nans = $#ansl+1;
###wac v
			if( $SUBTEST{'rnda'} eq 'Y' )
			{
###wac  ^
			### DED-02 7/16/2002 Replaced
			# $ansr="o";
			### with
			$ansr=$QUESTION{'qalb'};
			### 	to place label in answer ("a","n", or "r")
			while ($ansmask ne '') {
				$aidx = int(rand($nans));
				if($ansmask =~ /<$aidx>/ && $aidx < $nans) {
					$ansr = join('.', $ansr, $ansl[$aidx]);
					$ansmask =~ s/<$aidx>//g;
				}
			}
###wac v
			}
			else
			{
				### DED-03 7/16/2002 Added line below to include
				### 	label in answer ("a","n", or "r")
				$ansr=$QUESTION{'qalb'};
				for( 0 .. $#ansl )
				{
				$ansr = join( '.', $ansr, $ansl[$_] );
				}
			}
#			} 
###wac ^
		} elsif ($QUESTION{'qtp'} eq 'nrt') {
			$ansr = "";
### sac v multianswer esa support
		} elsif ($QUESTION{'qtp'} eq 'esa') {
			$ansr = $QUESTION{'qca'};
			$ansr =~ s/\r/\n/g;
			$ansr =~ s/\n\n/\n/g;
			$ansr =~ s/\n/\;/g;
### sac ^ multianswer esa support
		} else{
			$ansr = $QUESTION{'qca'};
		}
		$scwght = ($QUESTION{'wght'} eq '') ? '1' : $QUESTION{'wght'};
		$scpts = ($QUESTION{'pts'} eq '') ? '1' : $QUESTION{'pts'};
		$scded = ($QUESTION{'ded'} eq '') ? '0' : $QUESTION{'ded'};
		$scoring = join(':', $QUESTION{'subj'}, $scwght, $scpts, $scded);
		$ansr = join('::', $ansr, $scoring);
		$ansrs = join('&', $ansrs, $ansr);
	}
	@ansl = ();
	@qids = ();
	return $ansrs;
}

sub build_question_pool {
	@qtpool = ();
	@qcountrecs = &get_question_list($_[0],$_[1]);
	@qcountflds = split(/&/, $qcountrecs[0]);
	push @qtpool, $qcountrecs[0];
	for (1 .. $#qcountflds) {
		$qcountfldidx =  $_;
		last if($qcountflds[$_] eq 'qil');
	}
	for (1 .. $#qcountrecs) {
		@qcountflds = split(/&/, $qcountrecs[$_]);
		if ($qcountflds[$qcountfldidx] ne 'Y') {
			push @qtpool, $qcountrecs[$_];
		}
	}
	@qcountrecs = ();
	@qcountflds = ();
	return @qtpool;
}

sub build_rndqseq{
#print STDERR "RNDQSEQ\n";
	# randomize
	@qpool = &build_question_pool($_[0],$_[1]);
	$qrec="";
	$nqpool = $#qpool;
	$qlimit = ($nqpool > $_[2]) ? $_[2] : $nqpool;
	for $i (1 .. $qlimit) {
		$qrec = join('&', $qrec, "<$i>");
	}
	for $ibrs (1 .. $qlimit) {
		$qidx = int(rand($#qpool));
		$qidx++;
		($qid,$trash) = split(/&/, $qpool[$qidx]);
		$qrec =~ s/<$ibrs>/$qid/g;
		if ($qidx == $#qpool) { 
			pop(@qpool);
		} else {
			$qpool[$qidx] = pop(@qpool);
		}
	}
	@qpool = ();
	return $qrec;
}

sub build_stdqseq {
	@qpool = &build_question_pool($_[0],$_[1]);
	$qrec="";
	$nqpool = $#qpool;
	$qlimit = ($nqpool > $_[2]) ? $_[2] : $nqpool;
	for $ibrs (1 .. $qlimit) {
		($qid,$trash) = split(/&/, $qpool[$ibrs]);
		$qrec = join('&', $qrec, $qid);
	}
	@qpool = ();
	return $qrec;
}

sub build_formqseq {
	### DED 6/11/04 build test from form file
	### may later add formid as 3rd parameter to pick which form
	my ($test, $clid) = @_;
	open(FORMFILE, "<$questionroot/$test.$clid.form") or die "Can't open $questionroot/$test.$clid.form\n";
	my @forminfo = <FORMFILE>;
	close(FORMFILE);
	shift @forminfo;
	### DED 6/11/04 for now only use first form in file
	my ($formid, $quesnos) = split(/\&/, $forminfo[0]);
	my @quesnos = split(/,/,$quesnos);
	$qrec="";
	foreach $ques (@quesnos) {
		$qid = sprintf("%s.%03u", $test, $ques);
		$qrec = join('&', $qrec, $qid);
	}
	return $qrec;
}

sub admin_testresults {
		my $registrar = $_[1];
		my $adminbody = "";
		if ((!$registrar && $TEST{'emlesaopt'} eq 'Y' && $TEST{'emlesahtmlopt'} eq 'Y') || ($registrar && $TEST{'emlesaropt'} eq 'H')) {
			# Prepare HTML attachment
			$trtime = $mmtime;
			$trtime =~ s/ /_/g;
			my $html = `./testreport.pl $FORM{'tid'} $SESSION{'clid'} $SESSION{'uid'} $TEST{'id'} $trtime "$results[0]" $results[1] $TEST{'noq'} $results[2]`;
			$htmlfile = "$SESSION{'clid'}.$SESSION{'uid'}.$TEST{'id'}.htm";
			$adminbody = "${mm_encoded_html}\n" ;
			$adminbody .= encode_base64($html) ;
		} else {
			@testqs = &get_question_list($TEST{'id'}, $SESSION{'clid'});
			$mmflds = $testqs[0];
			chop($mmflds);
			$mmidx = 0;
			@mmflds = split(/&/, $mmflds);
			for (0 .. $#mmflds) {
				$mmidx = ($mmflds[$_] eq 'qtx') ? $_ : 0;
				last if ($mmidx != 0);
			}
			@mmflds = ();
			for (1 .. $#testqs) {
				$testqs = $testqs[$_];
				chop ($testqs);
				($mmqid, $trash) = split(/&/, $testqs);
				$MMQUESTION{$mmqid} = $testqs;
			}
			@testqs = ();
			@mmqs = split(/&/, $SUBTEST_QUESTIONS{$_[0]});
			@mmas = split(/&/, $SUBTEST_RESPONSES{$_[0]});
			$mmfullbody = "${mm_7bit_test}\n\nRESPONSES:\n\n";
			for ( 1.. $#mmas) {
				$testqs = $MMQUESTION{$mmqs[$_]};
				@mmflds = split(/&/, $testqs);
				$mmfullbody = join('', $mmfullbody, "$_:$mmqs[$_]\n");
				$mmfullbody = join('', $mmfullbody, "Q: $mmflds[$mmidx]\n");
				$qqans = $mmas[$_];
				$qqans = unmunge($qqans);
				$mmfullbody = join('', $mmfullbody, "R: $qqans\n\n");
			}
			@mmflds = ();
			@mmqs = ();
			@mmas = ();
			$mmfullbody =~ s/xxx/yyy/g;
			$adminbody = join('', $adminbody, $mmfullbody);
		}
		return $adminbody;
}

sub send_testresults {
	$logfile = "$SESSION{'clid'}.$SESSION{'uid'}";
	@loglines = get_log($logfile);
	@results = split(/&/, $SUBTEST_SUMMARY{$_[0]});
	@startlines = grep( /Test Start/,@loglines);
	($starttime, $startsession, $startnum, $startmsg) = split(/,/,@startlines[$#startlines]);
	if ($_[1]) {
		$mmtime = $_[1];
	} else {
		$mmtime = &format_date_time("dd-mmm-yyyy hh:nn:ss GMT", 1, "0");
	}
	if ($_[2]) {
		$mmdate = $_[2];
		$user_only = 1;
	} else {
		$mmdate = &format_date_time("dd-mmm-yyyy", 1, "0");
		$user_only = 0;
	}
	$mmfrom = $CLIENT{'email_from'};

	### Compute score
	if ($TEST{'scr'} eq '3') {
		$mmscore = "***** Not Scored *****\n\n";
	} 
	##wac v 01/03/02 change wording if scoring is by cummulative points
	elsif ($SUBTEST{'scr'} eq '2') {
		$minpass = ($SUBTEST{'minpass'} eq "") ? "Not Specified" :  $SUBTEST{'minpass'}." \points";
		$mmscore = "
Points from Correct Answers: $results[0]
Points deducted for Incorrect Answers: $results[1]
Total Number of Questions: $TEST{'noq'}

Cummulative Score: $results[2] \points
Passing Score: $minpass

";
	##wac v 01/08/02 change wording if scoring is by weighted percentage
	} elsif ($SUBTEST{'scr'} eq '1') {
		$minpass = ($SUBTEST{'minpass'} eq "") ? "Not Specified" :  $SUBTEST{'minpass'}." \%";
		$mmscore = "
Points (total) for Correct Answers: $results[0]
Points (total) for Incorrect Answers: $results[1]
Total Number of Questions: $TEST{'noq'}

Score: $results[2] \%
Passing Score: $minpass

";
	} else {
		$minpass = ($SUBTEST{'minpass'} eq "") ? "Not Specified" :  $SUBTEST{'minpass'}." \%";
		$mmscore = "
Correct Answers: $results[0]
Incorrect Answers: $results[1]
Total Number of Questions: $TEST{'noq'}

Score: $results[2] \%
Passing Score: $minpass

";
	}

# Compute the email boundary string used to divide multi-part 
#  email messages.

my $myrand ;
my $rand_str ;
my $boundary_str = "Acts-Corp-Boundary-" ;
foreach $i (1..5) {
  $myrand = rand ;
  $rand_str = sprintf "%12.12f", $myrand ;
  $rand_str =~ s/^0\.// ;
  $boundary_str .= $rand_str ;
}

$MIME_start = "MIME-version: 1.0\n" ;
$MIME_start .= "Content-Type: multipart/mixed; boundary=" ;
$MIME_start .= "\"${boundary_str}\"\n\n" ;

$mm_7bit_text = "\n--${boundary_str}\n" ;
$mm_7bit_text .= "Content-type: text/plain\n" ;
$mm_7bit_text .= "Content-transfer-encoding: 7bit\n" ;

$mm_encoded_html = "\n--${boundary_str}\n" ;
$mm_encoded_html .= "Content-type: text/html\n" ;
$mm_encoded_html .= "Content-transfer-encoding: base64\n" ;

if (!$user_only) {
	### Send results to admin notification list
	$mmto = $TEST{'ntfy'};
	$mmsubj = "Completed: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}";
	$mmnoreply = "DO NOT REPLY TO THIS MESSAGE";
	$mmheader = "

Date: $mmdate
Site: $TEST_SESSION{'clid'} 
Candidate: $SESSION{'uid'}
Name: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}
Description: $TEST{'desc'} - $TEST{'id'} 

Start Time: $starttime
Compl Time: $mmtime

";

	$mmbody = join('', ${MIME_start}, ${mm_7bit_text}, $mmnoreply, $mmheader, $mmscore);

	### Send notification to admin distribution list
	if ($mmto ne '') {
		my $adminbody = $mmbody;
		if ($TEST{'emlesaopt'} eq 'Y') {
			my $admin_testresults = &admin_testresults($_[0],0);
			$adminbody = join('', $adminbody, $admin_testresults);
			$mmorder = "\n$SUBTEST_ANSWERS{$_[0]}\n";
			$adminbody = join('', $adminbody, ${mm_7bit_text}, $mmorder);
		}
		&send_mail($mmfrom, $mmto, $mmsubj, $adminbody);
	}
	# HBI Defect - %CLIENT is not populated, So $CLIENT{'clid'} is empty.
	# HBI Defect - The code should call get_client_profile($TEST_SESSION{'clid'}) to populate %CLIENT.
	# HBI Defect - get_client_profile is in cybertestlib.pl.
	### Is there a registrar?
	if ($TEST{'emlesaropt'} ne 'N' && &get_a_key("cnd.$CLIENT{'clid'}", $CANDIDATE{'createdby'}, "registrar") eq 'Y') {
		### Does registrar have an e-mail address?
		$mmto = &get_a_key("cnd.$CLIENT{'clid'}", $CANDIDATE{'createdby'}, "eml");
		if ($mmto ne '') {
			my $notifbody = $mmbody;
			### Send notification to registrar
			if ($TEST{'emlesaropt'} eq 'H') {
				my $admin_testresults = &admin_testresults($_[0],1);
				$notifbody = join('', $MIME_start, $mm_7bit_text, $notifbody);
				$notifbody .= join('', $admin_testresults);
				$mmorder = "\n$SUBTEST_ANSWERS{$_[0]}\n";
				$notifbody .= join('', $mm_7bit_text, $mmorder);
			}

			&send_mail($mmfrom, $mmto, $mmsubj, $notifbody);
		}
	}

} # END if (!$user_only) 

	if ($TEST{'emlcndopt'} eq 'Y') {
		### Send results to candidate
		$mmto = $CANDIDATE{'eml'};
		$mmsubj = "Final results - $CANDIDATE{'nmf'} $CANDIDATE{'nml'}";
		$mmbody = "DO NOT REPLY TO THIS MESSAGE

Date: $mmdate
Site: $TEST_SESSION{'clid'} 
Candidate: $CANDIDATE{'uid'}
Name: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}
Description: $TEST{'desc'} - $TEST{'id'} 



The test administrator has been notified of your test scores as shown below.

Candidate completed the item above at $mmtime on the specified date with the following results.

$mmscore 
";
##wac 01/03/02 - added one line above - $mmscore. Idea is to pick up wording for results from above, should still be in $mmscore 
#Correct Answers: $results[0]
#Incorrect Answers: $results[1]
#Total Number of Questions: $TEST{'noq'}

#Score: $results[2] \%\n";
##wac ^
		if ($mmto ne '') {
			&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
		}
	}
}

sub send_start_notification {
	$mmdate = &format_date_time("dd-mmm-yyyy", "1", "0");
	$mmtime = &format_date_time("hh:nn:ss GMT", "1", "0");
	$mmfrom = $CLIENT{'email_from'};
	if ($_[0] ne '') {
		$mmto = $_[0];
	} else {
		$mmto = $TEST{'ntfy'};
	}
	$mmsubj = "Activity Initiated: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}";
	$mmbody = "DO NOT REPLY TO THIS MESSAGE

Date: $mmdate
Candidate: $SESSION{'uid'}
Site: $TEST_SESSION{'clid'} 
Name: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}
Description: $TEST{'desc'} - $TEST{'id'} 

Candidate has started the above item at $mmtime on this date.
";
	&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
}

sub send_resume_notification {
	$mmdate = &format_date_time("dd-mmm-yyyy", "1", "0");
	$mmtime = &format_date_time("hh:nn:ss GMT", "1", "0");
	$mmfrom = $CLIENT{'email_from'};
	if ($_[0] ne '') { 
		$mmto = $_[0];
	} else {
		$mmto = $TEST{'ntfy'};
	}
	$mmsubj = "Activity Resumed: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}";
	$mmbody = "DO NOT REPLY TO THIS MESSAGE

Date: $mmdate
Candidate: $SESSION{'uid'}
Site: $TEST_SESSION{'clid'} 
Name: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}
Description: $TEST{'desc'} - $TEST{'id'} 

Candidate has resumed the above item at $mmtime on this date.
";
	&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
}

sub send_pause_notification {
	$mmdate = &format_date_time("dd-mmm-yyyy", "1", "0");
	$mmtime = &format_date_time("hh:nn:ss GMT", "1", "0");
	$mmfrom = $CLIENT{'email_from'};
	if ($_[0] ne '') {
		$mmto = $_[0];
	} else {
		$mmto = $TEST{'ntfy'};
	}
	if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') {
		$itemdescription = "Survey";
	} else {
		$itemdescription = "Test";
	}
	$mmsubj = "$itemdescription Paused: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}";
	$mmbody = "DO NOT REPLY TO THIS MESSAGE

Date: $mmdate
Site: $TEST_SESSION{'clid'} 
Candidate: $SESSION{'uid'}
Name: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}
Description: $TEST{'desc'} - $TEST{'id'} 

Candidate Paused the above item at $mmtime on this date.
";
	&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
}

sub send_declined_notification {
	$mmdate = &format_date_time("dd-mmm-yyyy", "1", "0");
	$mmtime = &format_date_time("hh:nn:ss GMT", "1", "0");
	$mmfrom = $CLIENT{'email_from'};
	$mmto = $TEST{'ntfy'};
	$mmsubj = "CONFIDENTIALITY DECLINED: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}";
	$mmbody = "DO NOT REPLY TO THIS MESSAGE

Date: $mmdate
Site: $TEST_SESSION{'clid'} 
Candidate: $SESSION{'uid'}
Name: $CANDIDATE{'nmf'} $CANDIDATE{'nml'}
Description: $TEST{'desc'} - $TEST{'id'} 

Candidate declined the confidentality agreement at $mmtime on this date.
The item above was terminated and unregistered.
";
# The following email has all text, and should not need multipart lines.
	&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
}

#
# &show_test_worksheets($TEST_SESSION{'clid'}, $TEST_SESSION{'id'})
#
sub show_test_worksheets {
	@pagenos = split(/\./, $TEST{'Ins'});
	$pagecount = $#pagenos + 1;
	# show test instructions
	$jvars = "";
	$jscript = "i=1\;\nimax=$pagecount\;\n\n";
	$buttons = "";
	$jointer="";
	for (0 .. $#pagenos) {
		$x = int($_) + 1;
		$fpath = join($pathsep,$questionroot,"Ins","$TEST{'id'}.$SESSION{'clid'}.$pagenos[$_]");
		$wsURL = "$cgiroot/twsprint.pl?tid=$SESSION{'tid'}\&fn=$fpath";
		$jvars = join($jointer, $jvars, "wdw$x,sWorksheet$x");
		$jscript = join('', $jscript, "sWorksheet$x=\"$wsURL\"\;\n");
		$tmptitle = &get_test_worksheet($TEST{'id'},$SESSION{'clid'},$pagenos[$_]);
		@tmphtml = split(/<TITLE>/, $tmptitle);
		$tmptitle = $tmphtml[1];
		@tmphtml = split(/<\/TITLE>/, $tmptitle);
		$tmptitle = ($tmphtml[0] eq '') ? "Worksheet $x" : "$tmphtml[0]";
		if ($SESSION{'browserapp'} eq 'MSIE') {
			$buttons = join('', $buttons, "<INPUT TYPE=BUTTON VALUE=\"Reprint $tmptitle\" onClick=\"return Reprintpage($x)\"><BR>\n");
		} else {
			$buttons = join('', $buttons, "<INPUT TYPE=BUTTON VALUE=\"Print $tmptitle\" onClick=\"return Reprintpage($x)\"><BR>\n");
		}
		$jointer=",";
	}
	$FORM{'jscript'} = join('', "var $jvars\;\n", $jscript);
	$FORM{'buttons'} = $buttons;
	&show_template("qins");
}
# sac - start addition for subject area percentage support
sub IsTestSBA {
	my ($clid, $tstid) = @_;
	my $said;
	my $skid;
	my $saskcount;
	my $fn = join( $pathsep, $questionroot, "$tstid.$clid.sba.mtx");
	my $bOK=0;

	$SUBTEST{'IsTestSBA'}=0;
	if (open(TMPFILE, "<$fn")) {
		my @sbarecs = <TMPFILE>;
		close TMPFILE;
		if ($#sbarecs == 2) {
			chop $sbarecs[0];
			chop $sbarecs[1];
			chop $sbarecs[2];
			my @samtxrecs=split(/\,/,$sbarecs[2]);
			if ($#samtxrecs != -1) {
				($said,$skid,$saskcount) = split(/\:/,$samtxrecs[0]);
				if (($said ne '') && ($skid ne '') && ($saskcount ne '')) {
					$SUBTEST{'IsTestSBA'} = -1;
					$SUBTEST{'sbausesubj'} = $sbarecs[0];
					$SUBTEST{'sbauseskill'} = $sbarecs[1];
					$SUBTEST{'sbamtx'} = $sbarecs[2];
					$bOK=-1;
				}
			}
		}
	}
	return $bOK;
}
sub build_rndqseq_sba {
#print STDERR "RNDQSEQ_SBA\n";
	my ($tstid, $clid, $tnoq) = @_;
	# randomize
	my $i;
	my $j;
	my $qrec="";
	my $qrecall="";
	my $nqpool=0;
	my $qlimit=0;
	my @flds;
	my $ibrs;
	my $qidx;
	my $trash;
	my $sasksubj;
	my $saskskill;
	my $saskcount;
	my $saskqtotal=0;
	my @qpool = ();
	my $sgrepfor="";
	my $nm;
	my $pct;
	my $rnd;
	my $fixord;
	my %sarnds;
	my %safxos;
	my %sapools;

# Debug ANALYSIS
#if ($SUBTEST{'rndq'} eq "Y") { print STDERR "on\n"; } else { print STDERR "off\n";}

	# reset the error indicator
	$SYSTEM{'testpreperror'}="";

	# get the question list excluding obsolete questions
	my @qpoolmaster = &build_question_pool($tstid,$clid);
	@flds = split(/&/, $qpoolmaster[0]);
	for $i (0 ..$#flds) {
		if ($flds[$i] eq 'subj') {
			$j=$i;
			$qpoolmaster[0] = join('&', $flds[0], "$flds[$j]");
		}
	}
	for $i (1 ..$#qpoolmaster) {
		@flds = split(/&/, $qpoolmaster[$i]);
		if ($flds[$j] =~ /\./ ) {
			$qpoolmaster[$i] = join('&', $flds[0], "$flds[$j]");
		} else {
			$qpoolmaster[$i] = join('&', $flds[0], "$flds[$j].0");
		}
	}

	#
	# build subject area parameters array
	#	%sarnds		randomization flags
	#	%safxos		fixed orders
	#	%sapools	accumulated questions for all subj skill levels
	#	
	my @saparms=split(/\,/,$SUBTEST{'sbausesubj'});
	for $i (0 .. $#saparms) {
		if ($saparms[$i] ne '') {
			($nm,$pct,$rnd,$fixord) = split(/:/, $saparms[$i]);
			$sarnds{$nm}=int($rnd);		
			$safxos{$nm}=int($fixord);
			$sapools{$nm}="";
		}
	}
	@saparms=();

	# build subject skill array from $SUBTEST{'sbamtx'}
	my @sasks = split(/\,/, $SUBTEST{'sbamtx'});
$j=$#sasks+1;

	# for subject area create the question pools
	# and name the index in qspool array
	my @qspool;
	$j=-1;
	for $i (0 .. $#sasks) {
		($sasksubj,$saskskill,$saskcount) = split(/\:/,$sasks[$i]);
		if (($sasksubj eq '') || ($saskskill eq '') || ($saskcount eq '')) {
			# file format error
			$SYSTEM{'testpreperror'}="Unable to prepare $tstid: subject area skill level matrix format error.";
		} else {
			# 	prepare the question pool for the subject area
			my $sklvlid=($saskskill eq 'BASIC') ? "0" : "";
			$sklvlid=($saskskill eq 'INTERMEDIATE') ? "1" : $sklvlid;
			$sklvlid=($saskskill eq 'ADVANCED') ? "2" : $sklvlid;

			#
			$sgrepfor=join('.',"\&$sasksubj","$sklvlid");
			@qpool = grep( /$sgrepfor/,@qpoolmaster);

			#
			# prepare the sequential or randomized question list
			# and merge all skill levels for each subject area
			#
			$qrec="";
			unshift @qpool,$qrec;
			$nqpool = $#qpool;
			if ($nqpool >= $saskcount) {
				if (($sarnds{$sasksubj} == 1) || ($SUBTEST{'rndq'} eq 'Y')) {
					$qrec=&randomize_qpool($saskcount,@qpool);
				} else {
					$qrec=&sequential_qpool($saskcount,@qpool);
				}
				$sapools{$sasksubj}=join('', $sapools{$sasksubj}, $qrec);
				if (($qspool[$j] ne $sasksubj) || ($j == -1)) {
					$j++;
					$qspool[$j]=$sasksubj;
				}
			} else {
				# Insufficient question count to meet required distribution
				$SYSTEM{'testpreperror'}="Unable to prepare $tstid:<br>Insufficient number of $sasksubj.$saskskill questions in the pool.<br>$saskcount required : $nqpool defined and active.<br>";
			}
			@qpool = ();
		}
	}
	@sasks=();
	@qpoolmaster=();
	if ($SYSTEM{'testpreperror'} eq '') {
		#
		# if there were no errors
		#
		if ($SUBTEST{'rndq'} eq 'Y') {
			#
			# if globally randomized combine the pools and randomize
			#
			$qrec="";
			for $i (0 .. $#qspool) {
				$sasksubj=$qspool[$i];
				$qrec=join('',$qrec,$sapools{$sasksubj});
			}
			@qpool=split(/&/,$qrec);
			$saskcount=$#qpool;
			$qrecall=&randomize_qpool($saskcount,@qpool);
			@qpool=();
		} else {
			#
			#	keep subject area together and randomization within
			#
			for $i (0 .. $#qspool) {
				$sasksubj=$qspool[$i];
				if ($sarnds{$sasksubj} == 0) {
					@qpool=split(/&/,$sapools{$sasksubj});
					$saskcount=$#qpool;
					@qpool=();
				} else {
					@qpool=split(/&/,$sapools{$sasksubj});
					$saskcount=$#qpool;
					$sapools{$sasksubj}=&randomize_qpool($saskcount,@qpool);
					@qpool=();
				}
			}
			#
			#	check for fixed order and randomize the others
			#
			my @sbjfixed=();
			my @sbjrndmz=();
			for $i (0 .. $#qspool) {
				$sasksubj=$qspool[$i];
				if ($safxos{$sasksubj} == 0) {
					push @sbjrndmz, $sasksubj;
				} else {
					$qrec="$safxos{$sasksubj}.$sasksubj";
					push @sbjfixed,$qrec;
				}
			}
			if ($#sbjrndmz != -1) {
				$qrec="";
				unshift @sbjrndmz, $qrec;
				$saskcount=$#sbjrndmz;
				$qrec=&randomize_qpool($saskcount,@sbjrndmz);
				@sbjrndmz=split(/&/,$qrec);
				$qrec=shift @sbjrndmz;
			}
			if ($#sbjfixed != -1) {
				@qpool = sort @sbjfixed;
				@sbjfixed = @qpool;
				@qpool = ();
			}
#for $i (0 .. $#sbjrndmz) {
#}
#for $i (0 .. $#sbjfixed) {
#}
			@qspool=();
			if (($#sbjrndmz != -1) && ($#sbjfixed != -1)) {
				$saskcount=$#sbjrndmz + $#sbjfixed + 2;
				$qrec=shift @sbjfixed;
				($j,$sasksubj) = split(/\./,$qrec);
				for $i ( 1 .. $saskcount) {
					if( $i == $j) {
						push @qspool, $sasksubj;
						if ($#sbjfixed == -1) {
							$sasksubj="";
							$j=0;
						} else {
							$qrec=shift @sbjfixed;
							($j,$sasksubj) = split(/\./,$qrec);
						}
					} else {
						if ($#sbjrndmz != -1) {
							$qrec=shift @sbjrndmz;
							push @qspool, $qrec;
						}
					}
				}
				if ($sasksubj ne '') {
					push @qspool, $sasksubj;
					$j=1000;
					while (($#sbjfixed != -1) && ($j > 0)) {
						$qrec=shift @sbjfixed;
						($j,$sasksubj) = split(/\./,$qrec);
						push @qspool, $sasksubj;
						$j--;
					}
				}
#for $i (0 .. $#qspool) {
#}
			} else {
				### DED 11/02/2002 Changed
				#if ($#sbjfixed != -1) {
				### to
				if ($#sbjrndmz != -1) {
					@qspool = @sbjrndmz;
				} else {
					@qspool = @sbjfixed;
				}
			}
			@sbjfixed=();
			@sbjrndmz=();
			$qrecall="";
			for $i (0 .. $#qspool) {
				$sasksubj = $qspool[$i];
				$qrecall=join('',$qrecall,$sapools{$sasksubj});
			}
		}
	}
	@qspool=();
	%sarnds={};
	%safxos={};
	%sapools={};

# ANALYSIS
#@qpool=split(/&/,$qrecall);
#@qpool=();

	return $qrecall;
}

sub randomize_qpool {
	my ($qlmt,@qp) = @_;
	my $i;
	my $j;
	my $nqp;
	my $qid;
	my $trash;
	my $ibrs;
	my $qidx;
	my $qrec="";

	for $i (1 .. $qlmt) {
		$qrec = join('&', $qrec, "<$i>");
	}
	for $ibrs (1 .. $qlmt) {
		$qidx = int(rand($#qp));
		$qidx++;
		($qid,$trash) = split(/&/, $qp[$qidx]);
		$qrec =~ s/<$ibrs>/$qid/g;
		if ($qidx == $#qp) { 
			pop(@qp);
		} else {
			$qp[$qidx] = pop(@qp);
		}
	}
	return $qrec;
}

sub sequential_qpool {
	my ($qlmt,@qp) = @_;
	my $i;
	my $qid;
	my $trash;
	my $qrec="";

	for $i (1 .. $qlmt) {
		($qid,$trash) = split(/&/, $qp[$i]);
		$qrec = join('&', $qrec, $qid);
	}
	return $qrec;
}
# sac - end addition for subject area percentage support

# v sac anonymous submission support
sub make_anonymous {
	# test completed, terminated, or time expired
	# split off the anonymous parts if permitted and requested
	&get_test_sequence( $SESSION{'clid'}, $SESSION{'uid'}, $FORM{'tstid'}, $testcomplete);
	my $cnt = unlink "$testcomplete/".$SESSION{'clid'}.".".$SESSION{'uid'}.".".$FORM{'tstid'};
	my @anonymityFlags = split(/\;/,$SESSION{'anonymity'});
	my $anonflag;
	my $subtstno;
	my $subtstnm;
	my $subtstanon;
	my $tstfile;
	my $tsthistfile;
	my $historyopen=0;
	my $flsep="\<\<\>\>";
	my $clid=$TEST_SESSION{'clid'};

	my @tests=();
	$tests[1]=$TEST_SESSION{'profb'};
	$tests[2]=$TEST_SESSION{'id'};
	$tests[3]=$TEST_SESSION{'profa'};
	$tests[4]=$TEST_SESSION{'srvy'};

	my @flags=split(/\,/,",N,N,N,N");
	foreach $anonflag (@anonymityFlags) {
		($subtstno,$subtstnm,$subtstanon) = split(/\./,$anonflag);
		$flags[$subtstno]=$subtstanon;
	}
	my $ident;
	my $uid;
	my $chmodOK;
	my $dscl=$TEST_SESSION{'dscl'};
	for $i (1 .. 4) {
		if ($tests[$i] ne "") {
			if ($flags[$i] eq 'Y') {
				$uid=&get_anon_seqno($clid,$tests[$i]);
			} else {
				$uid=$TEST_SESSION{'uid'};
			}
			$tstfile=join($pathsep, $testcomplete, "$clid.$uid.$tests[$i]");
			$ident=$clid;
			$ident=join('&',$ident,$uid);
			$ident=join('&',$ident,$tests[$i]);
			$ident=join('&',$ident,$TEST_SESSION{'state'});
			if ($i == 2) {
				$ident=join('&',$ident,$dscl);
			} else {
				$ident=join('&',$ident,"");
			}
			$ident=join('&',$ident,"");
			$ident=join('&',$ident,$tests[$i]);
			$ident=join('&',$ident,"");
			$ident=join('&',$ident,"");
			$ident=join('&',$ident,$TEST_SESSION{'ntfy'});
			$ident=join('&',$ident,$TEST_SESSION{'emlcnd'});

			if (open(TOFILE, ">$tstfile")) {
				print TOFILE "$ident\n";
				print TOFILE "\n\n\n\n";
				print TOFILE "$SUBTEST_QUESTIONS{$i}\n";
				print TOFILE "$SUBTEST_ANSWERS{$i}\n";
				print TOFILE "$SUBTEST_RESPONSES{$i}\n";
				print TOFILE "$SUBTEST_SUMMARY{$i}\n";
				print TOFILE "\n\n\n\n";
				print TOFILE "\n\n\n\n";
				close TOFILE;
				$chmodOK = chmod 0666,$tstfile;
			}

			$logfile = "$SESSION{'clid'}.$SESSION{'uid'}";
			# DED 1/03/04 no longer puting starttime in history file
			#@loglines = get_log($logfile);
			#@startlines = grep( /Test Start/,@loglines);
			#($starttime, $startsession, $startnum, $startmsg) = split(/,/,@startlines[$#startlines]);
			$tsthistfile=join($pathsep, $testcomplete, "$clid.$tests[$i].history");
			if (open(TOFILE, ">>$tsthistfile")) {
				$historyopen=1;
			} else {
				if (open(TOFILE, ">$tsthistfile")) {
					$historyopen=1;
				} else {
					$historyopen=0;
				}
			}
			if ($historyopen) {
				print TOFILE "$endtime$flsep";
				print TOFILE "$ident$flsep";
				print TOFILE "$SUBTEST_QUESTIONS{$i}$flsep";
				print TOFILE "$SUBTEST_ANSWERS{$i}$flsep";
				print TOFILE "$SUBTEST_RESPONSES{$i}$flsep";
				print TOFILE "$SUBTEST_SUMMARY{$i}\n";
			}
			close TOFILE;
			$chmodOK = chmod 0666,$tsthistfile;
		}
	}
}

sub get_anon_seqno {
	my ($clid,$testid) = @_;
	my $sgrepfor;
	my $entry;
	my $cnt;
	my $iter;
	my $uid;
        my @dots=();
        my @dots2=();
	my @entries=();
	my @segs=();
	my $nxtid="anon";
	my @clsegs=split(/\./,$clid);
	my $tstclid="";

	opendir(DIR, $testcomplete);
        @dots = readdir(DIR);
        closedir DIR;
	opendir(DIR, $testinprog);
        @dots2 = readdir(DIR);
        closedir DIR;
	push @dots, @dots2;
	$cnt=0;
	if ($#dots != -1) {
		$sgrepfor=join('.',"$clid","anon","\*","$testid");
		@entries = grep( /$sgrepfor/,@dots);
		@dots = ();
		$cnt=0;
		foreach $entry (@entries) {
			@segs=split(/\./, $entry);
			$tstclid="";
			for (0 .. $#clsegs) {
				$tstclid=join('.',$tstclid,$segs[$_]);
			}
			### DED 3/23/04 Must trim leading "." from tstclid
			$tstclid=substr($tstclid,1);
			if (($tstclid eq $clid) && ($segs[$#segs] eq $testid)) {
				if ($cnt < $segs[2]) {
					$cnt = $segs[2];
				}
			}
		}
	}
	$cnt++;
	$nxtid=join('.','anon',"$cnt");
	return $nxtid;
}
# ^ sac anonymous submission support

sub get_test_sequence_for_reports {
# Called with $CLIENT{'clid'},$FORM{'cndid'}, $FORM{'tstid'}
# The pupose of this routine is to populate the global associative
#     arrays: TEST_SESSION SUBTEST_QUESTIONS SUBTEST_ANSWERS SUBTEST_RESPONSES SUBTEST_SUMMARY
    &get_test_profile($_[0], $_[2]);
# populates the Assoc. array %TEST with the characteristics of the test (but not the questions or answers).
    $trash3 = join($pathsep, $testcomplete, "$_[0].$_[1].$_[2]");
    $msg = "";
    if ( ! open(TESTFILE,"<$trash3") ) {
	&logger::logerr("Unable to open $trash3: $!");
	$msg="failed";
	print "<!-- open failure\n$trash3\n$!\n-->\n";
	$msg = "";
	# Clear the hashs.  Otherwise the calling code will process the current contents.
	%TEST_SESSION = () ;
  %SUBTEST_QUESTIONS = () ;
  %SUBTEST_ANSWERS = () ;
  %SUBTEST_RESPONSES = () ;
  %SUBTEST_SUMMARY = () ;
    } else {
	@seqlines = <TESTFILE>;
	close TESTFILE;
	$isubtest = 1; $iidx = 0; $iaryidx = 1;
	foreach $seqline (@seqlines) {
	    chop ($seqline);
	    if ($iidx eq 0) {
    # Process the first line of the Candidates test.
		@status = split(/&/, $seqline);
		$ifld = 0;
		$TEST_SESSION{'clid'} = $status[$ifld++]; # Client ID, like sandbox.
		$TEST_SESSION{'uid'} = $status[$ifld++]; # Candidate ID, like hank1
		$TEST_SESSION{'tstid'} = $status[$ifld++]; # Test ID, like linux01
		$TEST_SESSION{'state'} = $status[$ifld++]; # State, like 6.0.0 (for ???)
		$TEST_SESSION{'dscl'} = $status[$ifld++];
		$TEST_SESSION{'profb'} = $status[$ifld++];
		$TEST_SESSION{'id'} = $status[$ifld++]; # Test ID, like linux01
		$TEST_SESSION{'profa'} = $status[$ifld++];
		$TEST_SESSION{'srvy'} = $status[$ifld++];
		$TEST_SESSION{'ntfy'} = $status[$ifld++];
		$TEST_SESSION{'emlcnd'} = $status[$ifld++]; # Email address of candidate
# Warning: The last two fields do not match the sample I looked at.
		@status = ();
		$iidx++;
	    } else {
		if ($iaryidx eq 1) {
		    $SUBTEST_QUESTIONS{$isubtest} = $seqline;
		} elsif ($iaryidx eq 2) {
		    $SUBTEST_ANSWERS{$isubtest} = $seqline;
		} elsif ($iaryidx eq 3) {
		    $seqline =~ s/\%0D\%0A/<br>/g;
		    $SUBTEST_RESPONSES{$isubtest} = unmunge($seqline);
		} elsif ($iaryidx eq 4) {
		    $SUBTEST_SUMMARY{$isubtest} = $seqline;
		}
# The second and successive lines are treated as groups of four lines; 2-5, 6-9, etc.
		$iaryidx++;
		if ($iaryidx eq 5) {
		    $iaryidx = 1;
		    $isubtest++;
		}
	    }
	}
    }
    @seqlines = ();
    return;
}

sub getPrograms {
    my ($client) = @_;
    my @programs = &get_data("programs.$client");
    if (not @programs) {
	# no programs defined
	return undef;
    }
    chomp $programs[0];
    my @fields = split(/&/,shift @programs);
    my $programs={};
    foreach (@programs) {
	chomp $_;
	my $tmp = {};
	@{$tmp}{@fields} = split(/&/,$_);
	$tmp->{'prglist'} = [split(/,/,$tmp->{'prglist'})];
	$programs->{$tmp->{'prgid'}} = $tmp;
	$tmp = {};
    }
    return $programs;
}

sub getGroups {
# Parameters
# $client - character string of the Client ID.
# Returned value.
# $groups is a reference to an un-named hash.
#   The keys of the hash are the group (Department) ids.
#   The values of the hash are other un-named hashs.
#     These other un-named hashs contain data for the group (Department).
#     The keys of the other hashs are the field ids in the groups file.
#     The values of the other hashs are the data, as a string, for the group.
#     But the value for the 'grplist' key is not a string.
#     The value for the 'grplist' key is a reference to an array.
  my ($client) = @_;
  my @groups = &get_data("groups.$client");
  if (not @groups) {
		# no groups defined
		return undef;
  }
  chomp $groups[0];
  my @fields = split(/&/,shift @groups);
  my $groups={};
  foreach (@groups) {
		chomp $_;
		my $tmp = {};
		@{$tmp}{@fields} = split(/&/,$_);
		# @fields is the list of field ids, and the keys to the anon. hash reffed by $tmp.
		my %user_ids = () ;
		foreach my $user_id (split(/,/,$tmp->{'grplist'})) {
			$user_ids{$user_id} = 1 ;
		}
		# Any user id will be listed only once.
		$tmp->{'grplist'} = [ sort keys %user_ids] ;
		$groups->{$tmp->{'grpid'}} = $tmp;
		$tmp = {};
  }
  return $groups;
}

sub setGroups {
    my ($client,$groups) = @_;
    my @groups;
    my $grpfile = join($pathsep, $dataroot, "groups.$client");
    if (not &file_exists($grpfile)) {
	my $grpheader = join($pathsep, $dataroot, "groups.std");
	unless (&make_file( $grpfile, $grpheader, 1)) {
	    &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "FC Error: $grpfile $grpheader");
	    return 0;
	}
    }
    @groups = &get_data("groups.$client");
    chomp $groups[0];
    my @fields = split(/&/,$groups[0]);
    @groups = ($groups[0]."\n");
    foreach (values %$groups)  {
	my @line = ();
	foreach my $fld (@fields) {
	    if ($fld eq 'grplist') {
		push @line, join(',',@{$_->{'grplist'}});
	    } else {
		push @line, $_->{$fld};
	    }
	}
	push @groups, join('&',@line)."\n";
    }
    open(TMPGRP, ">".join($pathsep, $dataroot, "groups.$client")) or return 0;
    print TMPGRP @groups;
    close TMPGRP;
    return 1;
}

sub getIdlist {
# Parameters
# $client - Client id as a string.
# $grplist - string with comma separated group ids.
# Returned value
# $idlist is an un-named hash.
#   The keys of the hash are the candidates in the groups.
#   The values of the hash are 1.
    my ($client,$grplist) = @_;
    my $idlist;
    my $groups = &getGroups($client);
    foreach my $grp (split(/,/,$grplist)) {
	foreach my $cnd (@{$groups->{$grp}->{'grplist'}}) {
	    $idlist->{$cnd} = 1;
	}
    }
    return $idlist;
}    

sub getGroupMemberships {
    my ($client) = @_;
    my $groups =  &getGroups($client);
    my $canidates = {};
    foreach my $group (keys %$groups) {
	foreach my $canidate (@{$groups->{$group}->{'grplist'}}) {
	    push @{$canidates->{$canidate}}, $group;
	}
    }
    return $canidates;
}

sub get_cnd_test_from_history {
    my ($dir,$clid,$cndid,$tstid,$testdate) = @_;
    my $testseconds = (defined $testdate ? toGMSeconds($testdate) : undef);
    my @seqlines = ();
    my $test_data;

    &get_test_profile($clid, $tstid);
    my $trash = join($pathsep, $dir, "$clid.$tstid.history");
    $msg = "";
    open(TESTFILE, "<$trash") or $msg="failed to open history file";
    if ($msg eq "failed") {
	$msg = "";
	return undef;
    } else {
	@seqlines = <TESTFILE>;
	my $entry;
	foreach (reverse @seqlines) {
	    my @lines = split(/\<\<\>\>/, $_);
	    my $timestamp = toGMSeconds($lines[0]);
	    my %test_data;
	    if (defined $testseconds and (abs($testseconds-$timestamp) > 5)) {next;}
	    @test_data{'clid','uid','tstid','state','dscl','profb','id','profa','srvy','ntfy','emlcnd'} =
		split(/&/, $lines[1]);
	    if ($test_data{'uid'} ne $cndid) {undef %test_data; next;}
	    $test_data{'end'} = $test_data{'start'} = $timestamp;
	    $test_data{'SUBTEST_QUESTIONS'} = $lines[2];
	    $test_data{'SUBTEST_ANSWERS'} = $lines[3];
	    $test_data{'SUBTEST_RESPONSES'} = $lines[4];
	    $test_data{'SUBTEST_SUMMARY'} = $lines[5];
	    $test_data = \%test_data;
	    last;
	}
    }
    close TESTFILE;
    return $test_data;
}

sub get_cnd_test_cnt_from_history {
# Get the number of times the candidate has taken the test.
# The parameters are:
#   $dir - directory that contains the history files.
#   $clid - Client id.
#   $cndid - Candidate id.
#   $tstid - Test id.
    my ($dir,$clid,$cndid,$tstid) = @_;
    my @seqlines = ();
    my $test_count = 0;

    my $trash = join($pathsep, $dir, "$clid.$tstid.history");
    $msg = "";
    open(TESTFILE, "<$trash") or $msg="failed to open history file";
    if ($msg eq "failed") {
			$msg = "";
			return undef;
    }
		@seqlines = <TESTFILE>;
    close TESTFILE;
		my $entry;
		foreach (@seqlines) {
	    my @lines = split(/\<\<\>\>/, $_);
	    my %test_data;
	    @test_data{'clid','uid','tstid','state','dscl','profb','id','profa','srvy','ntfy','emlcnd'} =
				split(/&/, $lines[1]);
	    if ($test_data{'uid'} eq $cndid) {$test_count++;}
		}
    return $test_count;
}

sub get_users {
    my ($client,$test) = @_;
    my @users = &get_data("cnd.$client");
    chomp ($users[0]);
    my @keys = split(/&/,shift(@users));
    my %userdata;
    foreach my $user (@users) {
        chomp $user;
        $userdata{substr($user,0,index($user,"&"))} = $user;
    }
    if (defined $test) {
        my %tmp;
        my @filelist = &get_test_result_files($testcomplete, $client, $test);
        foreach my $file (@filelist) {
            my $user = $file;
            $user =~ s/.$test$//;
            $user =~ s/^$client.//;
            if (exists $userdata{$user}) {
                $tmp{$user} = $userdata{$user};
            }
        }
        return (\%tmp);
    } else {
        return (\%userdata);
    }
}

sub build_number_select_list {
	my ($min, $max, $step) = @_;
	my $option_list = "";
	if ($step eq "") {
		$step = 1;
	}
	if ($step eq "spread") {
		foreach my $i (1,5,10,20,25,50,100,250,500) {
			$option_list .= "<OPTION value=$i>$i</OPTION>\n";
		}
	} else {
		for (my $i=$min;$i<=$max;$i += $step) {
			$option_list .= "<OPTION value=$i>$i</OPTION>\n";
		}
	}
	return $option_list;
}

sub single_form_test_done {
	&put_several_questions();
	my $passfailflag=&summarize_test($tsubtest);
	&put_test_sequence($testinprog, $TEST_SESSION{'clid'}, $TEST_SESSION{'uid'}, $TEST_SESSION{'id'});
	&get_test_profile( $TEST_SESSION{'clid'}, $TEST_SESSION{'subtest'});
	$TEST{'customexit'}=&check_for_custom_exit_file($passfailflag);
	$tstate = $TEST_STATES{'_COMPLETED'};
	$tsubtest=0; $tqno=0;
	$TEST_SESSION{'state'} = "$tstate.$tsubtest.$tqno";
	&put_test_sequence($testinprog, $TEST_SESSION{'clid'}, $TEST_SESSION{'uid'}, $TEST_SESSION{'id'});
	&promote_test_sequence($testinprog, $testcomplete, $TEST_STATES{'_COMPLETED'});
	if ($TEST{'ntfy'} ne '') {
		&get_test_profile( $TEST_SESSION{'clid'}, $TEST_SESSION{'id'});
		&send_testresults("2","$endtime");
	}
        &send_custom_exit_email($passfailflag);

	$TEST_SESSION{'navbuttons'}="<INPUT TYPE=SUBMIT NAME=\"submit\" VALUE=\"$xlatphrase[769]\" onClick=\"cancel_test()\">";
	&show_template($tetmplt);
}

sub put_several_questions {
	# multiple questions on same page
	my $tmpkey;
	&get_subtest_profile( $TEST_SESSION{'clid'}, $TEST_SESSION{'subtest'});
	$TEST_SESSION{'noq'}=$SUBTEST{'noq'};
	if ($_[0]) {
		$hitqno=$_[0];
	} else {
		$hitqno=0;
	}
	for (keys %FORM) {
		if ($_ =~ /q[0-9]/ ) {
			($tqno, $tqidx) = split(/\-/, $_);
			$tmpkey="$tqno-qcucmt";
			$tqno =~ s/q//g;
			if ($tqno > $hitqno) {
				$hitqno = $tqno;
			}
			$tqidx =~ s/([0-9])//g;
			if ($tqidx eq 'qrs') {
				# setup qrs and qcucmt for putting
				$FORM{'qrs'} = $FORM{$_};
				$FORM{'qcucmt'} = $FORM{$tmpkey};
			#} elsif ($tqidx eq 'qcucmt') {
				## setup qcucmt and qrs for putting
			## haven't we already done this?
			### Yup, we have. DED 9/21/04
				#$FORM{'qcucmt'} = $FORM{$_};
				#if ($FORM{'qcucmt'} ne '') {
					#$tmpkey =~ s/qcucmt/qrs/g;
					#$FORM{'qrs'} = $FORM{$tmpkey};
				#} else {
					#next;
				#} 
			} else {
				$tqidx =~ s/qrs//g;
				next;
			}
			$QUESTION{'id'} = &get_question_id($tsubtest, $tqno);
			&get_question_definition($TEST{'id'}, $CLIENT{'clid'}, $QUESTION{'id'});
			&put_question_response($tsubtest, $tqno);
		}
	}
	$tqno=$hitqno;
}

sub check_for_custom_exit_file {
	my ($passfailflag) = @_;
	my $rec;
	my $customexitfile=join($pathsep,$questionroot,"$TEST_SESSION{'subtest'}.$SESSION{'clid'}.cx$passfailflag");
	if (file_exists($customexitfile)) {
		if (open(TMPFILE,"<$customexitfile")) {
			my @cstextrecs=<TMPFILE>;
			close TMPFILE;
			my $customexistmsg="";
			foreach $rec (@cstextrecs) {
				$customexistmsg=join('',$customexistmsg,$rec);
			}
			$TEST{'customexitmsg'}="$customexistmsg";
			@cstextrecs=();
			return "Y";
		}
	}
	return "N";
}

sub send_custom_exit_email {
	my ($passfailflag) = @_;
	my $rec;
	my $customemailfile=join($pathsep,$questionroot,"$TEST_SESSION{'subtest'}.$SESSION{'clid'}.ce$passfailflag");
	if (file_exists($customemailfile)) {
		if (open(TMPFILE,"<$customemailfile")) {
			my @cstemlrecs=<TMPFILE>;
			close TMPFILE;

			$mmfrom = $CLIENT{'email_from'};
			$mmto = $CANDIDATE{'eml'};
			$mmsubj = $TEST{'desc'}." Completion Certificate";

			my $customemailmsg="";
			foreach $rec (@cstemlrecs) {
				$rec = &xlatline($rec, '', 0, 1);
				$customemailmsg=join('',$customemailmsg,$rec);
			}
			@cstemlrecs=();

			$mmbody = "";
			$htmlfile = "$SESSION{'clid'}.$SESSION{'uid'}.$TEST{'id'}.htm";

			$mmbody = "MIME-version: 1.0\n" ;
			$mmbody .= "Content-type: text/html\n" ;
			$mmbody .= "Content-transfer-encoding: base64\n" ;
			$mmbody .= "Content-Disposition: attachment; filename=" ;
			$mmbody .= "\"${htmlfile}\"\n\n" ;  # The second \n is required.
			$mmbody .= encode_base64($customemailmsg) ;

			# open(ATTACHFILE, "> /tmp/$htmlfile");
			# print ATTACHFILE $customemailmsg;
			# close(ATTACHFILE);
			# `/usr/bin/uuencode /tmp/$htmlfile $htmlfile > /tmp/$htmlfile.uu`;
			# open(UUFILE, "/tmp/$htmlfile.uu");
			# while (<UUFILE>) {
				# $mmbody = join('', $mmbody,$_);
			# }
			# close(UUFILE);
			# unlink("/tmp/$htmlfile");
			# unlink("/tmp/$htmlfile.uu");

			&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
		}
	}
}

sub resend_exit_emails {
		my ($clid, $cndid, $testid) = @_;
		&get_candidate_profile($clid, $cndid);
		$TEST_SESSION{'subtest'} = $testid;
		&get_test_sequence_for_reports( $clid, $cndid, $testid);
		&get_subtest_profile( $clid, $testid);
		my $passfailflag=&summarize_test(2);
		my $mtime = (stat($testcomplete.$pathsep.$clid.".".$cndid.".".$testid))[9];
		$endtime = &format_date_time("h:nn:ss", "2", "-10000", $mtime);
		$enddate = &format_date_time("dd-mmm-yyyy", "2", "-10000", $mtime);
		&send_testresults("2", $endtime, $enddate);
		&send_custom_exit_email($passfailflag);
}

sub redirect {
	my $location = $_[0];
	my %vars = %{$_[1]};
	my $vars = "";
	if (scalar keys %vars != 0) {
		foreach (keys %vars) {
			$vars .= "&".$_."=".$vars{$_};
		}
		$vars =~ s/^&/\?/;
	}
	if ($ENV{'HTTPS'} eq "on") {
		$url = "https://";
	} else {
		$url = "http://";
	}
	$url .= $ENV{'HTTP_HOST'};
	$url .= "/cgi-bin/".$location.".pl$vars";

	warn "ReDirect to $url ." if ($HBI_Debug_redirect) ;
	print "Location: $url\n\n";
}

# end with True because this is a require file
1