survey-manager/survey-nginx/cgi-bin/likert_wall_105.pl.bu20150310

#!/usr/bin/perl

# Source File: likert_wall_105.pl

# Get config
use strict;
use diagnostics ;
use FileHandle;
use Time::Local;
use Data::Dumper;
use IntegroLib;
require 'sitecfg.pl';
require 'testlib.pl';
require 'tstatlib.pl';
require 'questionslib.pl';
# require 'LikertData.pl' ;
# require 'grepa.pm' ;
use bargraph_multi ;

use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
	    %SUBTEST_RESPONSES @xlatphrase);
use vars qw($testcomplete $cgiroot $pathsep $dataroot @rptparams );
use vars qw($testinprog $testpending) ;
use vars qw($QUESTIONS_AG) ;

# &app_initialize;
if (exists $FORM{"idlist"} and $FORM{"idlist"}) {
	$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
}

# Turn on the debugging flags only when we are going to generate a report.
use vars qw($HBI_Debug_idlist $HBI_Debug_grouping  $HBI_Debug_FORM $HBI_Debug_Report $HBI_Debug) ;
$HBI_Debug_idlist= $HBI_Debug_grouping = $HBI_Debug_FORM= $HBI_Debug_Report= 0 ;
$HBI_Debug = 0 ;
if (exists $FORM{'reportname'} and $FORM{'reportname'} and $FORM{'reportname'} =~ m/LikertWQ/) {
	$HBI_Debug_idlist = 0 ;
	$HBI_Debug_grouping = 0 ;
	$HBI_Debug_FORM = 0 ;
	$HBI_Debug_Report = 0 ;
}
$HBI_Debug = $HBI_Debug_idlist || $HBI_Debug_grouping  || $HBI_Debug_FORM || $HBI_Debug_Report ;

if ($HBI_Debug_idlist) {
	warn "INFO: FORM idlist " . $FORM{"idlist"} . " X\n" ;
}

# Make sure we have a valid session, and exit if we don't
if ($FORM{'tid'}) {
	if (not &get_session($FORM{'tid'})) {
		die "ERROR: " . __FILE__ . " started without a valid FORM Session ID.\n" ;
	}
} else {
	die "ERROR: " . __FILE__ . " started without a FORM Session ID.\n" ;
}

&LanguageSupportInit();
# print STDERR Dumper(\%FORM);
if ($SESSION{'clid'}) {
	&get_client_profile($SESSION{'clid'});
} else {
	die "ERROR: " . __FILE__ . " started without a SESSION Client ID.\n" ;
}

# If a report has not been choosen, then run reportChooser.
# else Prep for a report and run the report.

if ((! exists $FORM{'reportname'}) or $FORM{'reportname'} !~ m/\w/) {
	&ReportChooser();
	exit 0 ;
}

if ($FORM{'tstid'}) {
	&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
} else {
	die "ERROR: " . __FILE__ . " started without a FORM Test ID.\n" ;
}

# Get the group filters, if any
my ($idlist,$groups);
use vars qw(@Report_Groups) ;
if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
    #my @tmp = split(/,/,$FORM{'idlist'});
    @Report_Groups = param('idlist');
    $FORM{'idlist'} = join(',', @Report_Groups);
		if ($HBI_Debug_idlist) {
			warn "INFO: Second FORM idlist " . $FORM{"idlist"} . " X\n" ;
		}
    @{$groups}{@Report_Groups} = @Report_Groups;
    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
		# $idlist is a ref to a hash.  The keys are the candidate ids in the groups.
		#    The values are all 1.
		if ($HBI_Debug_idlist) {
			warn "INFO: Third idlist " . Dumper(\$idlist) . " X\n" ;
		}
}

# Get the time stamp style
my $timestamp;
if ($FORM{'timestamp'} eq 'currenttime') {
    $timestamp = scalar(localtime(time));
} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
    $timestamp = $FORM{'customtime'};
} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
    my $fh = new FileHandle;
    if ($fh->open($file)) {
	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
	# print "<pre>".Dumper(\@history)."</pre>";
	if (defined $idlist) {
	    foreach (reverse @history) {
		if (exists $idlist->{$_->[2]}) {
		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
		    last;
		}
	    }
	} else {
	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
	}
    } else {
	print STDERR "Could not open $file in " . __FILE__ . "\n";
    }
}
if (defined $timestamp) {
    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
} else {
    $timestamp = "<br>\n";
}

# Generate the reports
# if ($FORM{'reportname'} eq 'LikertWQ') {
#    &LikertWQ($idlist, $groups, $timestamp);
# The LikertWQ subroutine is in Likert_Gen_Groups.pl and teststats-tgwall101.pl
if ($FORM{'reportname'} eq 'LikertWQG') {
	&LikertWQG($idlist, $groups, $timestamp);
} else {
  die "ERROR: " . __FILE__ . " run without a valid report name. " .
		"Client ID $CLIENT{'clid'}, Test ID $FORM{'tstid'}, " .
		"Report Name $FORM{'reportname'}\n" ;
}

# There should only be function definitions beyond this point.
exit(0);

sub HTMLHeader {
	my $title = "" ; my $ret_str = "" ;
	my $JAVA_script = "" ;
	($title, $JAVA_script) = @_ ;
	$ret_str .= "<html>\n<head>\n<title>${title}</title>\n" ;
	$ret_str .= "<!-- " .  __FILE__ . " -->\n" ;
	$ret_str .= "<script language=\"JavaScript\">\n<!-- \n${JAVA_script}\n -->\n</script>\n</head>\n" ;
	$ret_str .= "<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"" ;
	$ret_str .= " TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"" ;
	$ret_str .= " VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n" ;
	return $ret_str ;
}

sub HTMLHeaderPlain {
    return "<html>\n<head>\n<title>$_[0]</title>\n".
	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
	"<BODY>\n";
}

sub HTMLFooter {
    my $year = `date +%Y`;
    my $ionline = "" ;
    return "<br><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline</font></body>\n</html>\n";
}

sub ReportChooser {
    # Links w/javascript for chosing report
    # Radio button to choose between all and select group(s)
    # Menu box to chose one or more groups
    my $groups = &getGroups($CLIENT{'clid'});
    my $js = "function parmsIntegro(oform,rpt) {\n\t".
	"oform.reportname.value=rpt;\n\t".
	"oform.action='/cgi-bin/creports.pl';\n\t".
	"oform.submit();\n};\n";
    # $js .= "\nfunction commIntegro(oform) {\n\t".  "oform.rptid.value='ACT-C-004';\n\t".  "oform.rptdesc.value='Test Statistics by Test'\n\t".  "oform.action='/cgi-bin/IntegroTS.pl';\n\t".  "oform.submit();\n};\n";
    my $organizationname = $CLIENT{'clnmc'};
    my $uberheader = "" ;
		my $TESTS = get_data_hash ("tests.$CLIENT{'clid'}") ;
		# print STDERR Dumper($TESTS) ;
		my %TESTS = %$TESTS ;
    my @test_list = () ;
		my $ids ;
		for $ids (keys %TESTS) {
			# warn "ID $ids DATADESC $TESTS{$ids}->{'desc'} X" ;
			push @test_list, [$TESTS{$ids}->{'desc'}, $ids] ;
		}
		# warn "test_list count $#test_list X\n" ;
  	# print STDERR Dumper(\@test_list) ;
		my ($js1, $test_choice_html) = ret_test_chooser_mod(@test_list) ;

    #print STDERR get_data("tests.$CLIENT{'clid'}");
    #print STDERR "Test ID = $tstid\n"; 
    print HTMLHeader("TG Wall Custom Reports",$js . $js1);
    print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
    # For development purposes we hardcode the survey id.
    # Fix this before production
    # print "<input type=hidden name=\"tstid\" value=\"\">\n"; # HBI This had a value of $tstid
    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
    print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
    print "<input type=hidden name=\"CustomFormat\" value=\"Yes\">\n";
    
    print "<center>\n<table border>\n<caption>TG Wall Custom Reports</Caption>\n".
	"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked>All Groups</td>\n".
	"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\">Choose Groups<br>\n".
        "<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
    foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
	print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
    }
    print "</select>\n";
    #print "<tr><td colspan=\"2\">$xlatphrase[797] $xlatphrase[279]: <input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
    print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
    print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
    print "<tr><td colspan=\"2\">Time Stamp:<ul style=\"list-style: none\">".
	"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
	# "<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
	# "<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
	# "<input type=\"text\" name=\"customtime\"></li>
			"</tr></td>";
    print "</table></center>\n";
		print $test_choice_html ;
    print "<p>Likert Scale Report" ;
		print "<ul style=\"list-style: none\">" ;
		# print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQ');\">Likert Scale</a> - No Response is ignored, Question Numbers listed.</li>\n" ;
		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQG');\">Automated Organizational Trust Report</a> No Response is ignored, Detail by Groups.</li>\n" ;
		print "</ul></p>\n" ;
    print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
    print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
    print "</form>";
    print HTMLFooter();
}

sub LikertWQG {
	# This does the Summary on the Likert Scale questions,
	#   for everybody, or just groups, and lists group results.
	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
	# $FORM{'grouping'} is "all" when the report should cover everybody.
	use vars qw($QUESTIONS_AG) ;
  my ($idlist,$groups,$timestamp) = @_;
  my $ResponseRequired = 1 ; # Do not count questions if there was no response.
  my $client = $SESSION{'clid'} ;
  my $testid2 = $FORM{'tstid'} ;
  my $all_groups = getGroups($client) ;
	my $group_membership_required ;
	if ($groups) {
		$group_membership_required = 1 ;
		my $group_p ;
		for $group_p (keys %{$all_groups}) {
			unless ($groups->{$group_p}) {
				undef $all_groups->{$group_p} ;
			}
		}
	} else {
		$group_membership_required = 0 ;
	}

  $SYSTEM{'FeedBackDate'} = "Date UNK" ;
	use vars qw($FeedBackDateTime) ;
	use vars qw($FULL_HISTORY) ;
  $FeedBackDateTime = 0 ;
	use vars qw($full_history_OK) ;
  $full_history_OK = &get_full_history($testcomplete, $client, $testid2) ;
  my $HBI_Debug_FeedBack = 0 ;

	my ($sumdata, $grpdata) = &GetTGWallLikertGrpData($client, $testid2,
					$all_groups, $group_membership_required, $ResponseRequired) ;
	my $last_index = $#{$QUESTIONS_AG} ;
	if ($HBI_Debug_Report ) {
		warn "sumdata" ;
		warn &Dumper(\$sumdata) ;
  	warn "grpdata" ;
		warn &Dumper(\$grpdata) ;
	}
  my $MasterGroupHash = &get_group_hash($client) ;
  my $grplist = {} ;
  my $groupid ; my $HBI_Debug_Groups_800 = 0 ;
  warn "INFO: grplist reference " . (ref $grplist) . "\n" if ($HBI_Debug_Groups_800) ;
	use vars qw(@Report_Groups) ;
  foreach $groupid (@Report_Groups) {
		if (exists $MasterGroupHash->{$groupid}->{'GroupMembersA'}) {
    	$grplist->{$groupid} = $MasterGroupHash->{$groupid}->{'GroupMembersA'} ;
		} else {
			$grplist->{$groupid} = () ;
		}
    warn "INFO: Group ID $groupid \n" if ($HBI_Debug_Groups_800) ;
    warn "INFO: Group members : " . join (" ", @{$grplist->{$groupid}}) . "\n" if ($HBI_Debug_Groups_800) ;
  }

  # Get the current year for the copyright.
	my $date_ascii = localtime ;
	chomp $date_ascii ;
	my @date_parts = split (/ +/, $date_ascii) ;
	$SYSTEM{'CopyRightYear'} = $date_parts[4] ;

	# Get the consolidated comments from all the likert questions.
  my @CommSuperCats = sort keys %{$sumdata} ;
  my @SuperCatQuestions ;
  my $CommSuperCategory ; my $SuperCatQuestion ; 
  foreach $CommSuperCategory (@CommSuperCats) {
    @SuperCatQuestions = keys %{$sumdata->{$CommSuperCategory}->{'Questions'}} ;
    $SYSTEM{'ALL_Comments'} .= "\\par \\par CATEGORY - $CommSuperCategory\n" ;
    # $SYSTEM{'ALL_Comments'} .= "\\par \n" ;
    my @SortedQuestions = sort {$a <=> $b} @SuperCatQuestions ;
    foreach $SuperCatQuestion (@SortedQuestions) {
      $SYSTEM{'ALL_Comments'} .= "\\par \\par Question " ; 
      # $SYSTEM{'ALL_Comments'} .= "\\par Question " . ($SuperCatQuestion + 1) . " - " ; 
      $SYSTEM{'ALL_Comments'} .= ${$QUESTIONS_AG}[$SuperCatQuestion]->{'qtx'} . "\\par \n" ;
      my $qComm = ${$QUESTIONS_AG}[$SuperCatQuestion]->{'comments'} ;
      if ($qComm) {
        $SYSTEM{'ALL_Comments'} .= $qComm ;
      } else {
        $SYSTEM{'ALL_Comments'} .= "\\par NO Comments.\n" ;
      }
    }
  }

	$SYSTEM{'orgname_Show'} = &RTFize($FORM{'orgname'}) ;

	if ($HBI_Debug_Report ) {
		print "Content-Type: text/html\n\n";
  	print HTMLHeaderPlain("Likert Scale Group Results");
  	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
		print "<b>Likert Scale Group Results<br>" ;
		print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
		print "<P ALIGN=Left>\n" ;
  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
  	if ($FORM{'uberheader'} ne "") {
    	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
  	} 
		if (defined $idlist) {
			print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
	    	.join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
  	}
			# print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
  	print "<P>Timestamp ", $timestamp, "</p>\n" ;
  	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
	# Print HTML for heading.
		my $key ;
    print "\<br\>\n" ;

  	if ($HBI_Debug_FeedBack) {
    	my $FBClient; my $FBtest; my $FBcand ;
    	print "<P>", "INFO: FB Clients " . (join(" ", keys %{$FULL_HISTORY})) . "\n" ;
    	foreach $FBClient (keys %{$FULL_HISTORY}) {
      	print "</P><P>" . "INFO: FB client $FBClient tests " . (join(" ", keys %{$FULL_HISTORY->{$FBClient}})) . "\n" ;
      	foreach $FBtest (keys %{$FULL_HISTORY->{$FBClient}}) {
        	print "</P><P>" . "INFO: FB client $FBClient test $FBtest candidates " .
          	(join(" ", keys %{$FULL_HISTORY->{$FBClient}->{$FBtest}})) . "\n" ;
        	foreach $FBcand (keys %{$FULL_HISTORY->{$FBClient}->{$FBtest}}) {
          	print "</P><P>" . "INFO: FB times $FBClient test $FBtest candidate $FBcand " .
            	(join(" ", keys %{$FULL_HISTORY->{$FBClient}->{$FBtest}->{$FBcand}})) . "\n" ;
        	}
      	}
    	}
			print "</P>\n" ;
  	}

    print "\<br\>\<br\>SESSION HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%SESSION)) {
      print "KEY $key VAL $SESSION{$key}\<br\>\n" ;
    }
    print "\<br\>\<br\>FORM HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%FORM)) {
      print "KEY $key VAL $FORM{$key}\<br\>\n" ;
    }
		# use vars qw(@Report_Groups) ;
    print "\<br\>\<br\>idlist ARRAY \@Report_Groups\<br\>\n" ;
    print "Length of \@Report_Groups is " . ($#Report_Groups + 1) . "\<br\>\n" ;
    foreach $key (@Report_Groups) {
      print "Array element $key \<br\>\n" ;
    }
    print "\<br\>Dumper of \$FORM\{idlist\} " ;
    print Dumper($FORM{'idlist'}) ;
    print "\<br\>\<br\>\n" ;

    print "\<br\>\<br\>CLIENT HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%CLIENT)) {
      # print "KEY $key VAL $CLIENT{$key}\<br\>\n" ;
			print ("KEY $key VAL ", &HTML_Maybe_Hash_Key_value(\%CLIENT, $key) , "\<br\>\n") ;
		}
    print "\<br\>\<br\>SYSTEM HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%SYSTEM)) {
      print "KEY $key VAL $SYSTEM{$key}\<br\>\n" ;
    }
    print "\<br\>\<br\>TEST HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%TEST)) {
      # print "KEY $key VAL $TEST{$key}\<br\>\n" ;
			print ("KEY $key VAL ", &HTML_Maybe_Hash_Key_value(\%TEST, $key) , "\<br\>\n") ;
    }
    print "\<br\>\<br\>TEST_SESSION HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%TEST_SESSION)) {
      print "KEY $key VAL $TEST_SESSION{$key}\<br\>\n" ;
    }
    print "\<br\>\<br\>SUBTEST_QUESTIONS HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%SUBTEST_QUESTIONS)) {
      print "KEY $key VAL $SUBTEST_QUESTIONS{$key}\<br\>\n" ;
    }
    print "\<br\>\<br\>SUBTEST_ANSWERS HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%SUBTEST_ANSWERS)) {
      print "KEY $key VAL $SUBTEST_ANSWERS{$key}\<br\>\n" ;
    }
    print "\<br\>\<br\>SUBTEST_RESPONSES HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%SUBTEST_RESPONSES)) {
      print "KEY $key VAL $SUBTEST_RESPONSES{$key}\<br\>\n" ;
    }
    print "\<br\>\<br\>SUBTEST_SUMMARY XXX HASH ARRAY\<br\>\n" ;
    foreach $key (sort keys (%SUBTEST_SUMMARY)) {
      print "KEY $key VAL $SUBTEST_SUMMARY{$key}\<br\>\n" ;
    }
	}

	print "<b><table border>\n" if ($HBI_Debug_Report ) ;

	# Set up Hashs for the data.
	my $OverAll = {} ; # Hash Reference.  Keys are categories/Trust Components.
	my $ByGroup = {} ; # Hash Ref. keys {Group}->{Category}, value rounded percent.
	my $ByGroupTot = {} ; # Hash Ref. keys {Group} value PerCent all Cat.
	my $ByTotTot = 0 ; # Scalar percent of all groups and categories.
	my @supercats = sort keys %{$sumdata} ;
	my $cat_count = $#supercats + 1 ; # Number of categories.
	# 

	# Print first row.
	print "<tr>"  if ($HBI_Debug_Report ) ;
	print "<th ></th>"  if ($HBI_Debug_Report ) ;
  my $supercat ;
	foreach $supercat (@supercats) {
		print "<th >$supercat</th>\n"  if ($HBI_Debug_Report ) ;
	}
	print "<th >Total</th>"  if ($HBI_Debug_Report ) ;
	print "</tr>\n"  if ($HBI_Debug_Report ) ;

	# Print second row. Heading for each column.
	# Loop for Categories.
	my $tot_poss = 0 ; my $tot_earned = 0 ;
	print "<tr>"  if ($HBI_Debug_Report ) ;
	print "<td >Overall</td >\n"  if ($HBI_Debug_Report ) ;
	for $supercat (@supercats) {
		# my $questions = "" ;
		my $possible = 0 ;
		my $earned = 0 ;
		# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
		$tot_poss += $possible ;
		$tot_earned += $earned ;
		$OverAll->{$supercat} = &Round_Per_Cent($earned, $possible) ;
		print &rep_cell_str($earned, $possible, 1)  if ($HBI_Debug_Report ) ;
	}
	$ByTotTot = &Round_Per_Cent($tot_earned, $tot_poss) ;
	print &rep_cell_str($tot_earned, $tot_poss, 1)  if ($HBI_Debug_Report ) ;
	print "</tr>\n"  if ($HBI_Debug_Report ) ;

	# Print heading for Groups.
	my $col_count = $cat_count + 2 ;
	print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n"  if ($HBI_Debug_Report ) ;

	print "<tr><th >Supervisor</th >"  if ($HBI_Debug_Report ) ;
	for $supercat (@supercats) {
		print "<th >$supercat</th >"  if ($HBI_Debug_Report ) ;
	}
	print "<th >Total</th ></tr >\n"  if ($HBI_Debug_Report ) ;

	unless ($grpdata) {
		print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n"  if ($HBI_Debug_Report ) ;
	} else {
		my $group ;
		foreach $group (sort keys %{$grpdata}) {
			if ($group) {
				print "<tr >"  if ($HBI_Debug_Report ) ;
				print "<td >"  if ($HBI_Debug_Report ) ;
				# print "$group "  if ($HBI_Debug_Report ) ;
				print $all_groups->{$group}->{'grpnme'}  if ($HBI_Debug_Report ) ;
				print "</td >"  if ($HBI_Debug_Report ) ;
				my $tot_poss = 0 ; my $tot_earned = 0 ;
				for $supercat (@supercats) {
					my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
					my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
					$tot_poss += $possible ;
					$tot_earned += $earned ;
					$ByGroup->{$group}->{$supercat} = &Round_Per_Cent($earned, $possible) ;
					print &rep_cell_str($earned, $possible, 1)  if ($HBI_Debug_Report ) ;
				}
				$ByGroupTot->{$group} = &Round_Per_Cent($tot_earned, $tot_poss) ;
				print &rep_cell_str($tot_earned, $tot_poss, 1)  if ($HBI_Debug_Report ) ;
				print "</tr>\n"  if ($HBI_Debug_Report ) ;
			}
		}
	}
	print "</table>\n"  if ($HBI_Debug_Report ) ;
	if ($HBI_Debug_Report ) {
		print "<br>sumdata<br>" ;
		print &Dumper(\$sumdata) ;
  	print "<br>grpdata<br>" ;
		print &Dumper(\$grpdata) ;
	}
	my ($key, $index) ;
  if ($HBI_Debug) {
    if ($last_index == -1) {
      print "\<br\>\n" ;
      print "\<br\>\<br\>QUESTIONS_AG HASH ARRAY is empty.\<br\>\n" ;
      print "\<br\>\n" ;
    } else {
      foreach $index (0 .. $last_index) {
        print "\<br\>\n" ; # HBI 
        print "\<br\>\<br\>QUESTIONS_AG HASH ARRAY Element $index \<br\>\n" ;
        foreach $key (sort keys (%{${$QUESTIONS_AG}[$index]})) {
          print "KEY $key VAL " ;
          # print "${$QUESTIONS_AG}[$index]->{$key}" ;
					print &HTML_Maybe_Array_Hash_Key_value($QUESTIONS_AG, $index, $key) ;
          print "\<br\>\n" ;
        }  # end foreach $key
      }  # end foreach $index
    }   # end of if $last_index
  }  # end of if $HBI_Debug

	# Lets go compute the stuff we need for the bar charts.
	my $Data1 = [] ; # The data for the chart.
	my $Category_ARef = [] ;
	my $category ;
	my $Legend1 = [ "Overall Organization" ] ; # The legends for the chart.
	my @All_Groups = sort keys %{$grpdata} ;
	my @Master_Color_Scheme_Array = 
			qw(red blue lgreen yellow gray dgreen pink lbrown lred purple 
	 		dblue lpurple green white gold dyellow marine dred cyan lblue orange lgray dbrown lyellow 
	 		black dpink dgray lorange dpurple ) ;

	# Create the graph for the Overall Graph first.
	push @{$Category_ARef}, @supercats ;
	push @{$Category_ARef}, "Total" ;
	push @{$Data1}, $Category_ARef ;
	my $Category_ARef2 ;
	foreach $supercat (@supercats) {
		push @{$Category_ARef2}, $OverAll->{$supercat} ;
	}
	push @{$Category_ARef2}, $ByTotTot ;
	push @{$Data1}, $Category_ARef2 ;
	my $Opts = {} ;
	$Opts->{'width'} = ( 6 * 72 ) ;
	$Opts->{'height'} = ( 3 * 72 ) ;
	$Opts->{'title'} = "" ;
	$Opts->{'hbar'} = 1 ;
	$Opts->{'x_label'} = "" ;
	$Opts->{'y_label'} = "" ;
	$Opts->{'y_max_value'} = 100 ;
	$Opts->{'y_min_value'} = 0 ;
	$Opts->{'y_tick_number'} = 10 ;
	$Opts->{'t_margin'} = 20 ;
	$Opts->{'b_margin'} = 10 ;
	$Opts->{'l_margin'} = 10 ;
	$Opts->{'r_margin'} = 30 ;
	my $Consolidated_Color_index = $#Report_Groups + 1 ;
	$Opts->{'colorscheme'} = $Master_Color_Scheme_Array[$Consolidated_Color_index] ;
	# Get the last color.
	$Opts->{'bar_spacing'} = 0 ;
	$Opts->{'bargroup_spacing'} = 2 ;
	$Opts->{'show_values'} = 1 ;
	$Opts->{'transparent'} = 0 ;
	$Opts->{'x_label_position'} = 0.5 ;
	$Opts->{'overwrite'} = 0 ;
	$Opts->{'boxclr'} = "lgray" ;
	$Opts->{'legend_placement'} = "BC" ;
	$Opts->{'Graphic_Mode'} = "png" ;

	# $Legend1 = [ "a", "b", "c" ] ;
	# my $array_row ;
	# $array_row = [ "H", "I", "J", "K", "L", "Tot" ] ;
	# $Data1 = [ $array_row ] ;
	# $array_row = [ 11, 12, 13, 14, 15, 16 ] ;
	# push (@$Data1 , $array_row) ;
	# $array_row = [ 21, 22, 23, 24, 25, 26 ] ;
	# push (@$Data1 , $array_row) ;
	# $array_row = [ 31, 32, 33, 34, 35, 36 ] ;
	# push (@$Data1 , $array_row) ;

	my ($Graph1_obj, $Graph1_str) = &Build_Labeled_X_Axis_Graph_Str_opts($Data1, $Legend1, $Opts) ;
	my $Eol = "\r\n" ; my $lCurly = "\x7b" ; my $rCurly = "\x7d" ;
  # $lCurly, and $rCurly are used as curly braces, so vim is not confused
  #   about matching perl code curly braces.
  my $RTF_PNG_Begin = $lCurly . '\\*\\shppict' ;
  $RTF_PNG_Begin .= $lCurly . '\\pict\\pngblip' ; # $Opts->{'xdim'}
  $RTF_PNG_Begin .= "\\picw" . ($Opts->{'width'} + 0) . " " ; # Width in pixels
  $RTF_PNG_Begin .= "\\pich" . ($Opts->{'height'} + 0) . " " ; # Height in pixels
  $RTF_PNG_Begin .= "\\picwgoal" . ($Opts->{'width'}*20) ; # width on the page in twips
  $RTF_PNG_Begin .= "\\pichgoal" . ($Opts->{'height'}*20) ; # Height on the page in twips.
  $RTF_PNG_Begin .= $Eol ;
  # I am using a pixel in a point.  A point is 1/72 inches.
  #  A twip is 1/20 of a point.
  $RTF_PNG_Begin .= "\\bliptag20000" ; # Unique identifier for the image.
  $RTF_PNG_Begin .= $lCurly . '\\*\\blipuid ' ;
  $RTF_PNG_Begin .= "00000000000000000000000000022710" ; # 32 numeric digits
  $RTF_PNG_Begin .= $rCurly . $Eol ; # Ends blipuid.
  my $RTF_PNG_Close = $rCurly . $rCurly ; # Ends pict and shppict commands.
  $RTF_PNG_Close .= $Eol ;

  my $HBI_Debug_msg_str = "" ;
  my $offset = 0 ;
  my $length_line = 40 ;
  my $len_left ;
  my $part_data = "" ;
  my $Hex_image ;
  my $All_data_len = length $Graph1_str ;

	if ($HBI_Debug_Report ) {
    print "\<br\>Graphical Data Info.\<br\>\n" ; # HBI 
		print "Graph1_str length is $All_data_len \<br\>\n" ;
		if (defined $Graph1_obj) {
			print "Graph1_obj defined.\<br\>\n" ;
			print "Graph1_obj reference X", (ref $Graph1_obj), "X\<br\>\n" ;
			print "Graph1_obj X", $Graph1_obj, "X\<br\>\n" ;
		} else {
			print "Graph1_obj NOT defined.\<br\>\n" ;
		}
    print "\<br\>END SYSTEM Graph1_obj and string.\<br\>\<br\>\n" ; # HBI 
	}

  do {
    $len_left = $All_data_len - $offset ;
    if ($len_left < $length_line) {$length_line = $len_left;}
    $part_data .= unpack ("H*", substr($Graph1_str, $offset, $length_line)) ;
    $part_data .= $Eol ;
    $offset += $length_line ;
  } while ($offset < $All_data_len ) ;

  $SYSTEM{'Barchart_org'} = $RTF_PNG_Begin . $part_data . $RTF_PNG_Close ;

	# Lets go compute the stuff we need for the Group bar charts.
	my $Chart_Group ; my $Chart_Group_cnt = 0 ; my $Chart_Group_Desc ;
	my @Group_Chart_Array = () ;
	foreach $Chart_Group (@Report_Groups) {
		$Data1 = [] ; # The data for the chart.
		$Category_ARef = [] ;
		my $Group_Name = $MasterGroupHash->{$Chart_Group}->{'grpnme'} ;
		$Legend1 = [ $Group_Name ] ; # The legends for the chart.
		# Create the graph for the Group
		push @{$Category_ARef}, @supercats ;
		push @{$Category_ARef}, "Total" ;
		push @{$Data1}, $Category_ARef ;
		# $Category_ARef2 ;
		$Category_ARef2 = [] ;
		foreach $supercat (@supercats) {
			push @{$Category_ARef2}, $ByGroup->{$Chart_Group}->{$supercat} ;
		}
		push @{$Category_ARef2}, $ByGroupTot->{$Chart_Group} ;
		push @{$Data1}, $Category_ARef2 ;
		# $Opts = {} ;
		# $Opts->{'width'} = ( 6 * 72 ) ;
		# $Opts->{'height'} = ( 5 * 72 ) ;
		# $Opts->{'title'} = "" ;
		# $Opts->{'hbar'} = 1 ;
		# $Opts->{'x_label'} = "" ;
		# $Opts->{'y_label'} = "" ;
		# $Opts->{'y_max_value'} = 100 ;
		# $Opts->{'y_min_value'} = 0 ;
		# $Opts->{'y_tick_number'} = 10 ;
		# $Opts->{'t_margin'} = 20 ;
		# $Opts->{'b_margin'} = 10 ;
		# $Opts->{'l_margin'} = 10 ;
		# $Opts->{'r_margin'} = 10 ;
		$Opts->{'colorscheme'} = $Master_Color_Scheme_Array[$Chart_Group_cnt] ;
		# Get the group color.
		# $Opts->{'bar_spacing'} = 0 ;
		# $Opts->{'bargroup_spacing'} = 2 ;
		# $Opts->{'show_values'} = 1 ;
		# $Opts->{'transparent'} = 0 ;
		# $Opts->{'x_label_position'} = 0.5 ;
		# $Opts->{'overwrite'} = 0 ;
		# $Opts->{'boxclr'} = "lgray" ;
		# $Opts->{'legend_placement'} = "BC" ;
		# $Opts->{'Graphic_Mode'} = "png" ;

		($Graph1_obj, $Graph1_str) = &Build_Labeled_X_Axis_Graph_Str_opts($Data1, $Legend1, $Opts) ;
		# my $Eol = "\r\n" ; my $lCurly = "\x7b" ; my $rCurly = "\x7d" ;
  # $lCurly, and $rCurly are used as curly braces, so vim is not confused
  #   about matching perl code curly braces.
  	$RTF_PNG_Begin = $lCurly . '\\*\\shppict' ;
  	$RTF_PNG_Begin .= $lCurly . '\\pict\\pngblip' ; # $Opts->{'xdim'}
  	$RTF_PNG_Begin .= "\\picw" . ($Opts->{'width'} + 0) . " " ; # Width in pixels
  	$RTF_PNG_Begin .= "\\pich" . ($Opts->{'height'} + 0) . " " ; # Height in pixels
  	$RTF_PNG_Begin .= "\\picwgoal" . ($Opts->{'width'}*20) ; # width on the page in twips
  	$RTF_PNG_Begin .= "\\pichgoal" . ($Opts->{'height'}*20) ; # Height on the page in twips.
  	$RTF_PNG_Begin .= $Eol ;
  # I am using a pixel in a point.  A point is 1/72 inches.
  #  A twip is 1/20 of a point.
		my $bliptag_id = 20000 + 1 + $Chart_Group_cnt ;
  	$RTF_PNG_Begin .= "\\bliptag" ; # Unique identifier for the image.
		$RTF_PNG_Begin .= $bliptag_id ;
  	$RTF_PNG_Begin .= $lCurly . '\\*\\blipuid ' ;
  	$RTF_PNG_Begin .= "000000000000000000000000000" ; # 32 numeric digits
		$RTF_PNG_Begin .= $bliptag_id ;
  	$RTF_PNG_Begin .= $rCurly . $Eol ; # Ends blipuid.
  	$RTF_PNG_Close = $rCurly . $rCurly ; # Ends pict and shppict commands.
  	$RTF_PNG_Close .= $Eol ;

  	$HBI_Debug_msg_str = "" ;
  	$offset = 0 ;
  	$length_line = 40 ;
  	$part_data = "" ;
  	$All_data_len = length $Graph1_str ;

		if ($HBI_Debug_Report ) {
    	print "\<br\>Graphical Data Info - Group $Chart_Group.\<br\>\n" ; # HBI 
			print "Graph1_str length is $All_data_len \<br\>\n" ;
			if (defined $Graph1_obj) {
				print "Graph1_obj defined.\<br\>\n" ;
				print "Graph1_obj reference X", (ref $Graph1_obj), "X\<br\>\n" ;
				print "Graph1_obj X", $Graph1_obj, "X\<br\>\n" ;
			} else {
				print "Graph1_obj NOT defined.\<br\>\n" ;
			}
    	print "\<br\>END SYSTEM Graph1_obj and string.\<br\>\<br\>\n" ; # HBI 
		}

  	do {
    	$len_left = $All_data_len - $offset ;
    	if ($len_left < $length_line) {$length_line = $len_left;}
    	$part_data .= unpack ("H*", substr($Graph1_str, $offset, $length_line)) ;
    	$part_data .= $Eol ;
    	$offset += $length_line ;
  	} while ($offset < $All_data_len ) ;
		push @Group_Chart_Array , ($RTF_PNG_Begin . $part_data . $RTF_PNG_Close) ;
		$Chart_Group_cnt ++ ;
	}
  $SYSTEM{'Barchart_groups'} = join ("\n\\par \n" , @Group_Chart_Array ) ;

	# Lets go compute the stuff we need for the Consolidated bar charts.
	# my $Chart_Group ; my $Chart_Group_cnt = 0 ; my $Chart_Group_Desc ;
	my @All_Chart_Array = () ;
	$Data1 = [] ; # The data for the chart.
	$Legend1 = [ ] ; # The legends for the chart.
	$Category_ARef = [] ;
	push @{$Category_ARef}, @supercats ;
	push @{$Category_ARef}, "Total" ;
	push @{$Data1}, $Category_ARef ;
	foreach $Chart_Group (@All_Groups) {
		# Create the graph for the Group
		# $Category_ARef2 ;
		$Category_ARef2 = [] ;
		foreach $supercat (@supercats) {
			push @{$Category_ARef2}, $ByGroup->{$Chart_Group}->{$supercat} ;
		}
		push @{$Category_ARef2}, $ByGroupTot->{$Chart_Group} ;
		push @{$Data1}, $Category_ARef2 ;
		push @{$Legend1}, $MasterGroupHash->{$Chart_Group}->{'grpnme'} ;
	}
	$Category_ARef2 = [] ;
	foreach $supercat (@supercats) {
		push @{$Category_ARef2}, $OverAll->{$supercat} ;
	}
	push @{$Category_ARef2}, $ByTotTot ;
	push @{$Data1}, $Category_ARef2 ;
	push @{$Legend1}, "Overall" ;
		# $Opts = {} ;
		# $Opts->{'width'} = ( 6 * 72 ) ;
	$Opts->{'height'} = ( 9 * 72 ) ;
		# $Opts->{'title'} = "" ;
		# $Opts->{'hbar'} = 1 ;
		# $Opts->{'x_label'} = "" ;
		# $Opts->{'y_label'} = "" ;
		# $Opts->{'y_max_value'} = 100 ;
		# $Opts->{'y_min_value'} = 0 ;
		# $Opts->{'y_tick_number'} = 10 ;
		# $Opts->{'t_margin'} = 20 ;
		# $Opts->{'b_margin'} = 10 ;
		# $Opts->{'l_margin'} = 10 ;
		# $Opts->{'r_margin'} = 10 ;
		$Opts->{'colorscheme'} = join (":", @Master_Color_Scheme_Array ) ;
		# Get the group color.
		# $Opts->{'bar_spacing'} = 0 ;
		# $Opts->{'bargroup_spacing'} = 2 ;
		# $Opts->{'show_values'} = 1 ;
		# $Opts->{'transparent'} = 0 ;
		# $Opts->{'x_label_position'} = 0.5 ;
		# $Opts->{'overwrite'} = 0 ;
		# $Opts->{'boxclr'} = "lgray" ;
		# $Opts->{'legend_placement'} = "BC" ;
		# $Opts->{'Graphic_Mode'} = "png" ;

		($Graph1_obj, $Graph1_str) = &Build_Labeled_X_Axis_Graph_Str_opts($Data1, $Legend1, $Opts) ;
		# my $Eol = "\r\n" ; my $lCurly = "\x7b" ; my $rCurly = "\x7d" ;
  # $lCurly, and $rCurly are used as curly braces, so vim is not confused
  #   about matching perl code curly braces.
  	$RTF_PNG_Begin = $lCurly . '\\*\\shppict' ;
  	$RTF_PNG_Begin .= $lCurly . '\\pict\\pngblip' ; # $Opts->{'xdim'}
  	$RTF_PNG_Begin .= "\\picw" . ($Opts->{'width'} + 0) . " " ; # Width in pixels
  	$RTF_PNG_Begin .= "\\pich" . ($Opts->{'height'} + 0) . " " ; # Height in pixels
  	$RTF_PNG_Begin .= "\\picwgoal" . ($Opts->{'width'}*20) ; # width on the page in twips
  	$RTF_PNG_Begin .= "\\pichgoal" . ($Opts->{'height'}*20) ; # Height on the page in twips.
  	$RTF_PNG_Begin .= $Eol ;
  # I am using a pixel in a point.  A point is 1/72 inches.
  #  A twip is 1/20 of a point.
		my $bliptag_id = 20000 + 1 + $Chart_Group_cnt + 1 ;
  	$RTF_PNG_Begin .= "\\bliptag" ; # Unique identifier for the image.
		$RTF_PNG_Begin .= $bliptag_id ;
  	$RTF_PNG_Begin .= $lCurly . '\\*\\blipuid ' ;
  	$RTF_PNG_Begin .= "000000000000000000000000000" ; # 32 numeric digits
		$RTF_PNG_Begin .= $bliptag_id ;
  	$RTF_PNG_Begin .= $rCurly . $Eol ; # Ends blipuid.
  	$RTF_PNG_Close = $rCurly . $rCurly ; # Ends pict and shppict commands.
  	$RTF_PNG_Close .= $Eol ;

  	$HBI_Debug_msg_str = "" ;
  	$offset = 0 ;
  	$length_line = 40 ;
  	$part_data = "" ;
  	$All_data_len = length $Graph1_str ;

		if ($HBI_Debug_Report ) {
    	print "\<br\>Graphical Data Info - Consolidated Report.\<br\>\n" ; # HBI 
			print "Graph1_str length is $All_data_len \<br\>\n" ;
			if (defined $Graph1_obj) {
				print "Graph1_obj defined.\<br\>\n" ;
				print "Graph1_obj reference X", (ref $Graph1_obj), "X\<br\>\n" ;
				print "Graph1_obj X", $Graph1_obj, "X\<br\>\n" ;
			} else {
				print "Graph1_obj NOT defined.\<br\>\n" ;
			}
    	print "\<br\>END SYSTEM Graph1_obj and string.\<br\>\<br\>\n" ; # HBI 
		}

  	do {
    	$len_left = $All_data_len - $offset ;
    	if ($len_left < $length_line) {$length_line = $len_left;}
    	$part_data .= unpack ("H*", substr($Graph1_str, $offset, $length_line)) ;
    	$part_data .= $Eol ;
    	$offset += $length_line ;
  	} while ($offset < $All_data_len ) ;

  $SYSTEM{'Barchart_consolidated'} = $RTF_PNG_Begin . $part_data . $RTF_PNG_Close ;

	# Compute the last date of the test taken.  $FeedBackDateTime
	my %Month_Full =
	  ("Jan" => "January", "Feb" => "February", "Mar" => "March",
		"Apr" => "April", "May" => "May", "Jun" => "June", 
		"Jul" => "July", "Aug" => "August", "Sep" => "September",
		"Oct" => "October", "Nov" => "November", "Dec" => "December") ;
	my @Month_Full_A =
	  ("January", "February", "March", "April", "May", "June", "July", 
			"August", "September", "October", "November", "December") ;
  my ($day_month, $month_str, $cent_year) ;
	if ($FeedBackDateTime > 0 ) {
		my (@Time_array) = gmtime ($FeedBackDateTime) ;
		$day_month = $Time_array[3] ;
		$month_str = $Month_Full_A[($Time_array[4])] ;
		$cent_year = $Time_array[5] + 1900 ;
    $SYSTEM{'FeedBackDate'} = &RTFize("$month_str $day_month, $cent_year") ;
  } else {
		warn "ERROR: FeedBackDateTime is Unknown.\n" ;
	}
	my $index1 ;
	# Compute the RTF format of the Collected Replies for a non-Likert question.
	for ($index1 = 0; $index1 <= $last_index ; $index1 ++) {
		${$QUESTIONS_AG}[$index1]->{'Collected_RTF_Replies'} = "" ;
		next if (${$QUESTIONS_AG}[$index1]->{'qtp'} eq "lik") ;
		my $Reply_Array_ref = ${$QUESTIONS_AG}[$index1]->{'Collected_Replies'} ;
		my $first_array_ref ; my @Consolidated = () ; my $second_array_ref ;
		my $prefix = "" ; my $suffix = "" ;
		foreach $first_array_ref (@{$Reply_Array_ref}) {
			my ($Rep_Arr_Ref, $Comment_Arr_Ref) = @{$first_array_ref} ;
			$prefix = "\\keep \\widctlpar " . $lCurly . "\\keepn " ;
			push @Consolidated, $prefix ;
			if (defined $Rep_Arr_Ref) {
				foreach $second_array_ref (@$Rep_Arr_Ref) {
					push @Consolidated, $second_array_ref . "\\par " ;
				}
			} else {
				push @Consolidated, $lCurly . "\bNo Answer.\\par " . $rCurly ;
			}
			if (defined $Comment_Arr_Ref) {
				foreach $second_array_ref (@$Comment_Arr_Ref) {
					push @Consolidated, $second_array_ref . "\\par " ;
				}
			} else {
				push @Consolidated, $lCurly . "\bNo Comment.\\par " . $rCurly ;
			}
			my ($last_str) ;
			$last_str = pop @Consolidated ;
			push @Consolidated, $rCurly, $last_str ;
		}
		${$QUESTIONS_AG}[$index1]->{'responses_and_comments'} =
			join ($Eol, @Consolidated) ;
	}

	if ($HBI_Debug_Report ) {
    print "\<br\>\n" ;
    print "FeedBack Date\<br\>\n" ;
    print $SYSTEM{'FeedBackDate'} ;
    print "\<br\>\n" ;
    print "\<br\>SYSTEM Barchart_org\<br\>\n" ; # HBI 
		my $debug_line ;
		foreach $debug_line (split /\n/, $SYSTEM{'Barchart_org'}) {
			print ($debug_line, "\<br\>\n") ;
		}
    print "\<br\>END SYSTEM Barchart_groups\<br\>\<br\>\n" ; # HBI 
    print "\<br\>SYSTEM Barchart_groups\<br\>\n" ; # HBI 
		foreach $debug_line (split /\n/, $SYSTEM{'Barchart_groups'}) {
			print ($debug_line, "\<br\>\n") ;
		}
    print "\<br\>END SYSTEM Barchart_groups\<br\>\<br\>\n" ; # HBI 
    print "\<br\>SYSTEM Barchart_consolidated\<br\>\n" ; # HBI 
		foreach $debug_line (split /\n/, $SYSTEM{'Barchart_consolidated'}) {
			print ($debug_line, "\<br\>\n") ;
		}
    print "\<br\>END SYSTEM Barchart_consolidated\<br\>\<br\>\n" ; # HBI 
	}

  print HTMLFooter() if ($HBI_Debug_Report ) ;
	exit 0 if ($HBI_Debug_Report ) ;
	use vars qw($OUTPUT_Format) ;
  $OUTPUT_Format = "RTF" ; 
  print "Content-Type: text/rtf\n";
  my $FName = ($FORM{'orgname'}) ? $FORM{'orgname'} : "Org-Name" ;
  $FName =~ s/\W/_/g ;
  # print "Content-Disposition: attachment;filename=report.rtf\n\n";
  print "Content-Disposition: attachment;filename=${FName}_OTS_report.rtf\n\n";
  &show_template("TGWALL_Org_Trust_Blank_Report.rtf") ;
  $OUTPUT_Format = "HTML" ;
}

sub rep_cell_str {
	# Parameters
	# $count - required, number for the cell, integer.
	# $total - dividend for the percent, integer.
	# $skip_tot - Optional, default false.
	#			If true, do not print total.
	# Returned Value
	# $html_str - html string to print for the cell.
	my ($count, $total, $skip_tot) = @_ ;
	my $html_str ;
	$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
	my ($percent, $percent_str, $count_str) ;
	$count_str = sprintf("%4i", $count) ;
	if ($total == 0) {
		# total is 0, percent is undefined.
		$percent_str = "-&nbsp;&nbsp;&nbsp;-&nbsp;%" ;
	} else {
		$percent = 100.0 * $count / $total ;
		$percent_str = sprintf("%5.1f&nbsp;%%", $percent) ;
	}
	$html_str .= "$count_str</td>" unless ($skip_tot) ;
	$html_str .= "<td align=\"right\">" ;
	$html_str .= "$percent_str</td>" ;
	return $html_str ;
}

sub Round_Per_Cent {
	# Parameters
	# $count - required, number for the cell, integer.
	# $total - dividend for the percent, integer.
	# Returned Value
	# $PerCent - as an integer 0 to 100.
	my ($count, $total) = @_ ;
	my $PerCent ;
	if ($total == 0) {
		# total is 0, percent is undefined.
		return 0 ;
	} else {
		$PerCent = ( int(((100.0 * $count) / $total) + 0.5 )) ;
	}
	return $PerCent ;
}

sub ret_test_chooser_mod {
# Return strings of html to pick a survey.
# The parameter is an array of arrays with test descriptions and ids.
# The returned value is an array with two strings.
#   The first string is JavaScript for the test chooser.
#   The second string is html for the tables to drive the test chooser.
  my @trecs = @_;
  # print STDERR Dumper(\@trecs) ;
  my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
	$tstoptions = "" ;
	my $html_str = "" ;
  my $js = "function setTest(oform,test) {\n\t".
    "oform.tstid.value=test;\n\t".
    "oform.submit();\n};\n";
  for (0 .. $#trecs) {
    my ($desc,$id) ;
		$desc = $trecs[$_][0] ;
		$id = $trecs[$_][1] ;
		# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
    $testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
    $testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
    $testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
    $href="javascript:setTest(document.testform1,\'$id\')\;";
		my $radio_tst_button ;
		$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
			'" > ' . $id ;
    $tstoption = " <TR>" .
    # "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
    "<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
    "<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
    "<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
    "<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
    "<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
    # $tstoptions = join('', $tstoptions, $tstoption);
    $tstoptions .= $tstoption ;
  }
  $html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
  # "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
  # "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
  # "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
  # "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
  # "</form>" .
"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
  "<TR>" .
    "<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
    "<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
    "<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
    "<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
    "<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
  "</TR>" .
  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
  $tstoptions .
  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
	"</TABLE> " ;
  return ($js, $html_str) ;
}

sub get_full_history {
	# Parameters
	# $dir
	# $clientID
	# $testID
	# Side Effect
	#  All of the data is placed into the global variable %FULL_HISTORY
	# Returned Value
	# $ret - 0 implies failure, 1 implies success.
	# %FULL_HISTORY format.
	# Key is the Client ID.
	# value is an anon. hash.
	#   Its key is the Test ID.
	#   value is an anon. hash.
	#     Its key is the Candidate ID.
	#     value is an anon. hash.
	#       Its key is the time of the test in seconds for the GMT time zone.
	#       value is the raw character string of the data.
	# To access a single test's data:
	#  $FULL_HISTORY->{$clientID}->{$testID}->{$candidateID}->{$GMTsec}
	use vars qw($FULL_HISTORY) ;
	my ($dir,$clientID,$testID) = @_;
	my $trash = join($pathsep, $dir, "$clientID.$testID.history");
	my $HBI_Debug_get_full_history = 0 ;
	my $Open_state = 1 ; 
	open(TESTFILE, "<$trash") or $Open_state = 0 ;
	unless ($Open_state) {
		# The open failed.
		warn "ERROR: Failed to open $trash " ;
		return 0 ;
	}
	# The open succeeded.
	my @seqlines = ();
	@seqlines = <TESTFILE>;
	close TESTFILE;
	if ($HBI_Debug_get_full_history) {
		warn "INFO: History file $clientID.$testID.history line count is " . 
			($#seqlines + 1) . " \n" ;
	}
	my $testline ; my $Line_cnt = 0 ;
	foreach $testline (@seqlines) {
		my $match_state ; $Line_cnt ++ ;
		if ($testline =~ m/^([^\<]+)\<\<\>\>([^\&]+)&([^\&]+)&([^\&]+)&/) {
			my $time_ascii = $1 ;
			my $Client_id_str = $2 ;
			my $candidateID = $3 ;
			my $Test_id_str = $4 ;
			if ($Client_id_str ne $clientID) {
				warn "ERROR: Bad test history file data ${clientID}.${testID}.history " . 
					"line $Line_cnt has mismatched client id.\n" ;
			}
			if ($Test_id_str ne $testID) {
				warn "ERROR: Bad test history file data ${clientID}.${testID}.history " . 
					"line $Line_cnt has mismatched test id.\n" ;
			}
			my $timestamp = &toGMSeconds($time_ascii) ;
			unless ($timestamp) {
				warn "ERROR: Bad test history file data ${clientID}.${testID}.history " .
					"line $Line_cnt has bad time stamp.\n" ;
				$timestamp = "UNK $Line_cnt" ; # Unique value for the file.
			}
			if ($HBI_Debug_get_full_history and ($Line_cnt <= 4 )) {
				warn "INFO: History file $clientID.$testID.history time_ascii $time_ascii timestamp $timestamp\n" ;
			}
			$FULL_HISTORY->{$clientID}->{$testID}->{$candidateID}->{$timestamp} = $testline ;
		} else {
			warn "ERROR: get_full_history failed to match a valid format in a test history file.\n" ;
			warn "ERROR: get_full_history file ${clientID}.${testID}.history line $Line_cnt \n" ;
			next ;
		}
	}
	if ($HBI_Debug_get_full_history) {
		warn "INFO: History file $clientID.$testID.history RETURN 1, line_cnt $Line_cnt \n" ;
	}
	return 1 ;
}

sub get_group_hash {
	# Parameters
	# $client - Client ID string.
	# Returned value.
	# $Group_hash - A scalar reference to an anonymous hash.
	#		The keys of the hash are the group ids.
	#		The values are another hash of data for the group.
	#			The keys are the field ids: grpowner, grpid, grpnme, grplist, validfrom, validto
	#			and GroupMembersA.
	#				The value of GroupMembersA is an anon array of the candidate ids of the members.
	#				The other values are the raw data of the fields in the group file.
	my ($clientID) = @_ ;
	my $HBI_Debug_get_group_hash = 0 ;
	my @GroupData = &get_client_groups($clientID);
	use vars qw(%GRPFIELD) ; # Global variable set by get_client_groups.
	my $GroupID_HREF = {} ;
	my $idxid = $GRPFIELD{'grpid'};
	my @GroupFieldIDs = keys %GRPFIELD ;
	warn "INFO: idxid $idxid Field IDS " . (join(" ", @GroupFieldIDs)) . "\n" if ($HBI_Debug_get_group_hash) ;
	my ($FieldID, $GroupID ) ;
	my $orig_data ; my @split_orig_data ; my $raw_data ; my $candidates ;
	foreach $orig_data (@GroupData) {
		chomp $orig_data ;
		@split_orig_data = split(/&/, $orig_data) ;
		$GroupID = $split_orig_data[$idxid] ;
		warn "INFO: Simple group ID $GroupID raw data $raw_data\n" if ($HBI_Debug_get_group_hash) ;
		# Populate the raw data.
		foreach $FieldID (@GroupFieldIDs) {
			$GroupID_HREF->{$GroupID}->{$FieldID} = $split_orig_data[$GRPFIELD{$FieldID}] ;
			warn "INFO: group ID $GroupID FieldID $FieldID " .
					"Value " . $GroupID_HREF->{$GroupID}->{$FieldID} . "\n" if ($HBI_Debug_get_group_hash) ;
		}
		$candidates = $GroupID_HREF->{$GroupID}->{'grplist'} ;
		chomp $candidates ;
		$GroupID_HREF->{$GroupID}->{'GroupMembersA'} = [ split (/\,/, $candidates) ] ;
		warn "INFO: group ID $GroupID Candidates "
					. join (" ", $GroupID_HREF->{$GroupID}->{'GroupMembersA'} )
					. "\n" if ($HBI_Debug_get_group_hash) ;
	}
	return $GroupID_HREF ;
}

sub RTFHexEscape {
	# Return the RTF Hex Escape of the first character in $_.
	my $oldstr = shift(@_) ;
	my $retstr = unpack ("H*", substr($oldstr, 0, 1)) ;
	if ($retstr) {
		return "\\\'" . $retstr ;
	} else {
		return "" ;
	}
}

sub RTFize {
	# Parameter
	# $textStr - An ASCII text string, not to be modified.
	# Returned value
	# $retStr - the $textStr with all special characters converted to special RTF sequences.
	# Control Characters 0-31, or 0x00 to 0x1F
	# tab, 0x09, becomes "\tab ".
	# carriage returns, 0x0D; and line feeds, 0x0A; are left alone.
	# Other control characters are deleted.
	# Left Curly Brace becomes \'7b.
	# Right Curly Brace becomes \'7d.
	# Back slash becomes \'5c.
	# Characters 128 to 255 become the hex escaped equivalent.
	my ($retStr) = @_ ;
	# Delete special control characters.
	$retStr =~ s/[\x00-\x08\x0B\x0C\x0E-\x1F]//g ;
	# Convert the back slash.
	$retStr =~ s/\\/\\\'5C/g ;
	# Convert tab.
	$retStr =~ s/\x09/\\tab /g ;
	# Convert characters that become the hex escaped value.
	$retStr =~ s/([\x7b\x7d\x80-\xFF])/&RTFHexEscape($1)/ge ;
	return $retStr ;
}

sub GetTGWallLikertGrpData {
# Parameters
# $client - required String, client id.
# VOID $testid1 - required String, test id.
# VOID $candidate1 - required String, candidate id, testid1 is candidate1's self evaluation.
# $testid2 - required String, test id of the evaluation of candidate1 by others; the members of the
#            groups in grplist.
# $grplist - required Hash reference, keys are group ids, values are like getGroups function.
#            The values contain the candidate ids in the group.
#            if undef. then only one returned value.
# $respRequired - optional boolean, default is false.  If true then do not count unanswered questions 
# 	as points available.

# Returned values - $ret_all, $ret_grp, $ret_err
# $ret_all - reference to a Hash of a Hash.  The keys of the first hash are the supercategories
#   of the likert questions in the test.  The keys of the second hash are 'PointsAvail', 
#   'Responses', 'NoResponses', 'PointsEarned', 'ScoreCount', and 'Questions'.  The values of the first 
#   four keys are numeric counts, or score totals.  The value of the 'ScoreCount' is 
#   another hash.  Its keys are the scores, and the values are the counts of the number
#   of times each score was a response.  Values for candidates will be counted here regardless of 
#   group membership.  The value of 'Questions' is an un-named hash.  The keys of the un-named 
#   hash are the question numbers for the supercategory.  The value is always 1.
# $ret_grp - reference to a Hash of a Hash of a Hash.  The keys of the first hash are
#   the group ids.  The values are structured like $ret_all.  This is not returned if
#   the parameter $grplist is not provided, or undef.
# $ret_all, and $ret_grp contain results and scores for $testid2 taken by members of $grplist.
# $ret_err - string. - It is either an empty string or text about likert categoies not matching,
#   or question counts not matching.
# Populate $QUESTION_AG with questions, responses, and comments for $testid2 and $grplist.

  my ($client, $testid2, $grplist, $respRequired) = @_ ;
	my $HBI_Debug_Groups = 0 ;
  warn "INFO: GetTGWallLikertGrpData parms client $client, testid2 $testid2, respRequired $respRequired \n" if ($HBI_Debug_Groups) ;
  warn "INFO: grplist\n" if ($HBI_Debug_Groups) ;
  warn &Dumper(\$grplist) if ($HBI_Debug_Groups) ;
	my $grp_req = 1 ;
  warn "grp_req $grp_req X\n" ;
  my $ret_all = {} ; my $ret_grp = {} ; my $ret_one = {} ; my $ret_err = "" ;
  my %Group_Xref = () ; # List of groups that each member belongs to.
  # The hash key is a member id, the value is an array of the groups he is in.
  # Build the cross reference.
	my %Group_XrefP = () ; # Hash of groups that each member belongs to.
	#  It is a hash of a hash.
  my $Group = "" ; my $Member = "" ;
  warn "INFO: grplist SIMPLE.\n" if ($HBI_Debug_Groups) ;
  foreach $Group (keys %{$grplist}) {
		warn "INFO: Processing group $Group\n" if ($HBI_Debug_Groups) ;
    foreach $Member (@{${$grplist}{$Group}{'grplist'}}) {
			warn "INFO: $Member is a member of group $Group\n" if ($HBI_Debug_Groups) ;
      push @{$Group_Xref{$Member}} , $Group ;
			$Group_XrefP{$Member}->{$Group} = 1 ;
    }
  }
  # warn Dumper(\%Group_Xref) ;
  my %supercat_foundg = () ; 
	# hash of categories found and initialized in the hash of hashes for groups.
	# PROCESS GROUPS and testid2

  my %supercat_found_in_G = () ; 
	# hash of categories found and initialized in the hash of hashes in test2 for groups.
  &get_test_profile($client, $testid2) ; # Populates %TEST
  $QUESTIONS_AG = &get_question_definitions ($client, $testid2) ;
  # Populates an array of hashs that contains all of the questions and the answers.
  #   $QUESTIONS_AG is a reference to the arrays of hashs.
  my $last_index_g = $#{$QUESTIONS_AG} ; # Last index of the Array of Hashs of the Q&A.
  my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid2);
  # warn "INFO: QUESTIONS_AG\n" if ($HBI_Debug_Groups) ;
  # warn &Dumper(\$QUESTIONS_AG) if ($HBI_Debug_Groups) ;
  warn "INFO: filelist\n" if ($HBI_Debug_Groups) ;
  warn &Dumper(\@filelist) if ($HBI_Debug_Groups) ;
	my $file ;
	my @HBI_Debug_Feedback = (0, 0, 0, 0, 0) ;
	warn "INFO: Group Required flag is $grp_req.\n" if ($HBI_Debug_Feedback[0]) ;
  foreach $file (@filelist) {
    my $user = $file;
		# warn "length file is " . (length $file) . "\n" ;
		$user =~ s/\s+$// ;
    $user =~ s/\.$testid2$//;  # Strip the test id off the end of the file name.
    $user =~ s/^$client\.//;  # Strip the client id off the start of the file name.
		warn "file is $file user is $user testid2 is $testid2 client is $client \n" 
				if ($HBI_Debug_Feedback[1]) ;
    my $user_grp = undef ;
    my $inact_ques = 0; # Count of the inactive questions found.
    # Do not process this user if group membership is required and not a member.
    if ($grp_req and not $Group_Xref{$user}) { 
      warn "Skipped User $user X" if ($HBI_Debug_Feedback[1]) ;
      next ; 
    }
		# Update the FeedBack date if this user has taken the test later
		#   than the recorded time.

		use vars qw($full_history_OK $FeedBackDateTime) ;
		if ($full_history_OK) {
			my @FeedBack_test_times ;
			my $FeedBack_Test_Time ;
			@FeedBack_test_times = keys %{$FULL_HISTORY->{$client}->{$testid2}->{$user}} ;
			warn "INFO: There are " . ($#FeedBack_test_times + 1) . " History times.\n";
			foreach $FeedBack_Test_Time (@FeedBack_test_times) {
				warn "FULL_HISTORY Error $FeedBack_Test_Time is not all numeric.\n" if ($FeedBack_Test_Time =~ m/\D/) ;
				$FeedBackDateTime = $FeedBack_Test_Time if ($FeedBack_Test_Time > $FeedBackDateTime) ;
			}
		} else {
			warn "FULL_HISTORY Error full_history_OK is false.\n" ;
		}
    # Process this desired candidate's test answers.
    # warn "Process User $user X" ;
    &get_test_sequence_for_reports($client, $user, $testid2) ;
    # populates the Assoc. arrays %TEST_SESSION, %SUBTEST_QUESTIONS, 
    #	%SUBTEST_ANSWERS, %SUBTEST_RESPONSES, and %SUBTEST_SUMMARY.
		my ($responses , @responses, $index1) ;
    $responses = $SUBTEST_RESPONSES{2} ;
    @responses = split (/\&/, $responses) ;
    shift @responses ; # Drop the empty element in front of the list.
    foreach $index1 (0 .. $last_index_g) {
			my ($response_g, $comment_g) ;
			my $group ; my ($points, $weight, $ques_type, $scores, @Response_parts) ;
      # Skip the question if it is inactive.
      if (${$QUESTIONS_AG}[$index1]->{'qil'} eq "Y") {$inact_ques++ ; next ;}
      # Get the data for a single question.
      $points = ${$QUESTIONS_AG}[$index1]->{'pts'} ;
      $weight = ${$QUESTIONS_AG}[$index1]->{'wght'} ;
      $ques_type = ${$QUESTIONS_AG}[$index1]->{'qtp'} ;
      $scores = ${$QUESTIONS_AG}[$index1]->{'scores'} ;
			@Response_parts = split ('::', $responses[$index1], 2) ;
			$response_g = $Response_parts[0] ;
			$comment_g = $Response_parts[1] ;
			chomp $response_g ; chomp $comment_g ;
			$response_g = &RTFize($response_g) ;
			$comment_g = &RTFize($comment_g) ;
			my @Response_array ; my $Response_array_ref ;
			my @Comment_array ; my $Comment_array_ref ;
			my @Collected ; my $Collected_ref ;
			if ($response_g =~ /^\s*$/) {
				# Only White space.
				@Response_array = () ;
			} else {
				# text for response.
				@Response_array = split (/\<br\>/, $response_g) ;
			}

			if ($comment_g =~ /^\s*$/) {
				# Only White space.
				@Comment_array = () ;
			} else {
				# text for response.
				@Comment_array = split (/\<br\>/, $comment_g) ;
			}

			$response_g =~ s/\s*(\<br\>)+\s*/\\par /isg ;
			$comment_g =~ s/\s*(\<br\>)+\s*/\\par /isg ;
			${$QUESTIONS_AG}[$index1]->{'responses'} .= $response_g . "\n" if ($response_g) ;
			${$QUESTIONS_AG}[$index1]->{'comments'} .= $comment_g . "\n" if ($comment_g) ;
			unless (${$QUESTIONS_AG}[$index1]->{'QTX_Processed'}) {
				my $testid2_qtx = ${$QUESTIONS_AG}[$index1]->{'qtx'} ;
				chomp $testid2_qtx ;
				$testid2_qtx = &RTFize($testid2_qtx) ;
				$testid2_qtx =~ s/\s*(\<br\>)+\s*/\\par /isg ;
				${$QUESTIONS_AG}[$index1]->{'qtx'} = $testid2_qtx ;
				${$QUESTIONS_AG}[$index1]->{'QTX_Processed'} = 1 ;
			}
			my @scores ; my @Collected ;
    	if ($ques_type eq "lik") {
				# Likert style question.
				my ($supercat) ;
      	@scores = split (/\,/ , $scores) ;
      	$supercat = ${$QUESTIONS_AG}[$index1]->{'supercat'} ;
      	unless ($supercat_foundg{$supercat}) {
					# Initialize counters.
					warn "Init all Cat $supercat\n" if ($HBI_Debug_Feedback[2]) ;
					$ret_all->{$supercat}->{'PointsAvail'} = 0 ;
					$ret_all->{$supercat}->{'NoResponses'} = 0 ;
					$ret_all->{$supercat}->{'Responses'} = 0 ;
					$ret_all->{$supercat}->{'PointsEarned'} = 0 ;
					$ret_all->{$supercat}->{'ScoreCount'} = {} ;
					$supercat_foundg{$supercat} = 1 ;
      	}
      	$ret_all->{$supercat}->{'Questions'}->{$index1-$inact_ques} = 1 ;
      	my @Groups = @{$Group_Xref{$user}} ;
				warn "INFO: Groups cnt " . ($#Groups + 1) . "\n" if ($HBI_Debug_Feedback[2]) ;
      	foreach $group (@Groups) {
       		unless (defined $ret_grp->{$group}->{$supercat}) {
	  				warn "Init all Cat $supercat Group $group user $user.\n" if ($HBI_Debug_Feedback[2]) ;
	  				$ret_grp->{$group}->{$supercat}->{'PointsAvail'} = 0 ;
	  				$ret_grp->{$group}->{$supercat}->{'NoResponses'} = 0 ;
	  				$ret_grp->{$group}->{$supercat}->{'Responses'} = 0 ;
	  				$ret_grp->{$group}->{$supercat}->{'PointsEarned'} = 0 ;
	  				$ret_grp->{$group}->{$supercat}->{'ScoreCount'} = {} ;
					}
      	} # foreach $group
				my @Ans_Comment = split ('::', $responses[$index1-$inact_ques], 2) ;
      	$responses = $Ans_Comment[0] ;
				my @individ ;
      	@individ = split(/\?/, $responses) ;
      	shift @individ ;
      	my $no_response = 1 ;
      	$ret_all->{$supercat}->{'PointsAvail'} += $points ;
      	foreach $group (@Groups) {
					$ret_grp->{$group}->{$supercat}->{'PointsAvail'} += $points ;
      	}
				my $index2 ;
      	foreach $index2 (0 .. $#scores) {
					# Add the key for the score count to the hash.
					unless (exists $ret_all->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
	  				$ret_all->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
					}
      		foreach $group (@Groups) {
						unless (exists $ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
	  					$ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
						}
      		}
      	}
      	# warn "CHECKING CAT $supercat USER $user GRP @group RESP $responses \n" if $supercat eq "Improvement" ;
      	foreach $index2 (0 .. $#scores) {
					if ($individ[$index2] ne "xxx" and $individ[$index2] ne "" and $individ[$index2] == $index2) {
	  				# Answered this question.
	  				warn "Scored CAT $supercat POINTS $scores[$index2] USER $user \n"
								if ($HBI_Debug_Feedback[3]) ;
	  				$ret_all->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
	  				$ret_all->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
	  				foreach $group (@Groups) {
	  					warn "Scored CAT $supercat POINTS $scores[$index2] USER $user GRP $group \n"
								if ($HBI_Debug_Feedback[3]) ;
	    				$ret_grp->{$group}->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
	    				$ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
	  				}
	  				$no_response = 0 ;
					} # If answered.
      	} # foreach $index2
      	if ($no_response) {
      		# Add to the no response count.
      		$ret_all->{$supercat}->{'NoResponses'} ++ ;
					foreach $group (@Groups) {
	  				$ret_grp->{$group}->{$supercat}->{'NoResponses'} ++ ;
					}
					if ($respRequired) {
	  				# Reduce the points avail if a response is required to count.
          	$ret_all->{$supercat}->{'PointsAvail'} -= $points ;
          	foreach $group (@Groups) {
	    				$ret_grp->{$group}->{$supercat}->{'PointsAvail'} -= $points ;
          	}
					}
      	} else {
					# Add to the response count.
					$ret_all->{$supercat}->{'Responses'} ++ ;
					foreach $group (@Groups) {
	  				$ret_grp->{$group}->{$supercat}->{'Responses'} ++ ;
					}
      	}
				# Add comment to Collected_Replies.
				if ($#Comment_array == -1) {
					@Collected = () ;
				} else {
					push @Collected, undef ;
					push @Collected, \@Comment_array ;
				}
			} else {
				# Non-likert question.
				@Collected = () ;
				if ($#Response_array == -1) {
					push @Collected, undef ;
				} else {
					push @Collected, \@Response_array ;
				}
				if ($#Comment_array == -1) {
					push @Collected, undef ;
				} else {
					push @Collected, \@Comment_array ;
				}
				@Collected = () if (($#Response_array == -1) and ($#Comment_array == -1)) ;
			}
			# Save the collected references for all questions.
			if ($#Collected > -1) {
				$Collected_ref = \@Collected ;
				push @{${$QUESTIONS_AG}[$index1]->{'Collected_Replies'}}, $Collected_ref ;
			}
		} # foreach question.
  } # foreach file (i.e. candidate)
  return ($ret_all, $ret_grp, $ret_err) ; # Return reference.
} # End of GetTGWallLikertGrpData

sub HTML_Maybe_Hash_Key_value {
	# Return an HTML formatted string for a hash key value that may not exist.
	# Parameters
	# $HashRef - A Reference to a hash array.
	# $key_str - The key value.
	# Return a string in HTML format that describes the issues or value.
	my ($HashRef, $key_str, $ret_str) ;
	($HashRef, $key_str) = @_ ;
	my $Bold_str = "<B>" ;
	my $End_Bold_str = "</B>" ;
	# Validate the hash reference.
	unless (defined $HashRef) {
		$ret_str = $Bold_str . "Hash Reference is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
	my $HashRefP = ref $HashRef ;
	if ($HashRefP) {
		unless ($HashRefP eq "HASH") {
			$ret_str = $Bold_str . "Hash Reference is a reference to a $HashRefP." . $End_Bold_str ;
			return $ret_str ;
		}
	} else {
		$ret_str = $Bold_str . "Hash Reference is not a reference." . $End_Bold_str ;
		return $ret_str ;
	}
	# The Hash reference is good.
	# validate the key.
	unless (defined $key_str) {
		$ret_str = $Bold_str . "Key is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
	unless (exists $HashRef->{$key_str}) {
		$ret_str = $Bold_str . "Key is not in the Hash." . $End_Bold_str ;
		return $ret_str ;
	}
	my $Hash_value = $HashRef->{$key_str} ;
	if (defined $Hash_value) {
		$ret_str = $Hash_value ;
		return $ret_str ;
	} else {
		$ret_str = $Bold_str . "Value of the Key in the Hash is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
}

sub HTML_Maybe_Array_Hash_Key_value {
	# Return an HTML formatted string for an array of hash key value that may not exist.
	# Parameters
	# $ArrayRef - A reference to an array of references to a hash.
	# $ArrayIndex - Numeric index to the array.
	# $key_str - The key value.
	# Return a string in HTML format that describes the issues or value.
	my ($ArrayRef, $ArrayIndex, $key_str) ;
	my ($HashRef, $ret_str) ;
	($ArrayRef, $ArrayIndex, $key_str) = @_ ;
	my $Bold_str = "<B>" ;
	my $End_Bold_str = "</B>" ;
	# Validate the Array Reference.
	unless (defined $ArrayRef) {
		$ret_str = $Bold_str . "Array Reference is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
	my $ArrayRefP = ref $ArrayRef ;
	if ($ArrayRefP) {
		unless ($ArrayRefP eq "ARRAY") {
			$ret_str = $Bold_str . "Array Reference is a reference to a $ArrayRefP." . $End_Bold_str ;
			return $ret_str ;
		}
	} else {
		$ret_str = $Bold_str . "Array Reference is not a reference." . $End_Bold_str ;
		return $ret_str ;
	}
	# The Array reference is good.
	# Validate the index. $ArrayIndex
	unless (defined $ArrayIndex) {
		$ret_str = $Bold_str . "Array Index is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
	if (ref $ArrayIndex) {
		$ret_str = $Bold_str . "Array Index is a reference." . $End_Bold_str ;
		return $ret_str ;
	} elsif ($ArrayIndex !~ m/^\d+$/) {
		$ret_str = $Bold_str . "Array Index is non-numeric." . $End_Bold_str ;
		return $ret_str ;
	}
	# The $ArrayIndex is a numeric scalar.
	# Validate the range.
	unless (($ArrayIndex >= 0) and ($ArrayIndex <= $#{$ArrayRef})) {
		$ret_str = $Bold_str . "Array Index is out of range." . $End_Bold_str ;
		return $ret_str ;
	}
	$HashRef = ${$ArrayRef}[$ArrayIndex] ;
	# Validate the hash reference.
	unless (defined $HashRef) {
		$ret_str = $Bold_str . "Hash Reference is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
	my $HashRefP = ref $HashRef ;
	if ($HashRefP) {
		unless ($HashRefP eq "HASH") {
			$ret_str = $Bold_str . "Hash Reference is a reference to a $HashRefP." . $End_Bold_str ;
			return $ret_str ;
		}
	} else {
		$ret_str = $Bold_str . "Hash Reference is not a reference." . $End_Bold_str ;
		return $ret_str ;
	}
	# The Hash reference is good.
	# validate the key.
	unless (defined $key_str) {
		$ret_str = $Bold_str . "Key to the Hash is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
	unless (exists $HashRef->{$key_str}) {
		$ret_str = $Bold_str . "Key to the Hash does not exist." . $End_Bold_str ;
		return $ret_str ;
	}
	my $Hash_value = $HashRef->{$key_str} ;
	if (defined $Hash_value) {
		$ret_str = $Hash_value ;
		return $ret_str ;
	} else {
		$ret_str = $Bold_str . "Value of the Key in the Hash is undefined." . $End_Bold_str ;
		return $ret_str ;
	}
}