You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1016 lines
48 KiB

#!/usr/bin/perl
#
# $Id: Integro3.pl,v 1.4 2006/05/04 20:55:48 ddoughty Exp $
#
# Source File: Integro.pl
# Get config
use FileHandle;
use Time::Local;
use Data::Dumper;
use IntegroLib1; # The code is almost like IntegroLib.pm
require 'sitecfg.pl';
require 'testlib.pl';
require 'tstatlib.pl';
require 'LikertData.pl' ;
require 'grepa.pm' ;
use strict;
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 );
&app_initialize;
$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma. HBI
&LanguageSupportInit();
#print STDERR Dumper(\%SESSION);
&get_client_profile($SESSION{'clid'});
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
# Make sure we have a valid session, and exit if we don't
if (not &get_session($FORM{'tid'})) {
exit(0);
}
# Get the group filters, if any
my ($idlist,$groups);
if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
#my @tmp = split(/,/,$FORM{'idlist'});
my @tmp = param('idlist');
$FORM{'idlist'} = join(',', @tmp);
@{$groups}{@tmp} = @tmp;
$idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
}
# 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 Integro.pl\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 'commeffect') {
&CommEffectReport($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'commeffectsummary') {
&CommEffectSummary($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'trustlevel') {
&TrustLevelReport($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'trustlevelsummary') {
&TrustLevelSummary($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'values') {
&ValuesReport($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'valuessummary') {
&ValuesSummary($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'comments') {
&CommentsReport($idlist, $timestamp, 0);
} elsif ($FORM{'reportname'} eq 'comments2') {
&CommentsReport($idlist, $timestamp, 1);
} elsif ($FORM{'reportname'} eq 'people') {
&KindsOfPeopleReport($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'peoplesummary') {
&KindsOfPeopleSummary($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'improvepie') { # Section 5 - Improvement Pie Chart
undef $idlist ; undef $groups ;
&ImprovementPieChart($idlist, $groups, $timestamp);
} elsif ($FORM{'reportname'} eq 'improvesummary') { # Section 5 - Improvement Summary
undef $idlist ; undef $groups ;
&ImprovementSummary($idlist, $groups, $timestamp);
} else {
&ReportChooser();
}
# There should only be function definitions beyond this point.
exit(0);
sub HTMLHeader {
return "<html>\n<head>\n<title>$_[0]</title>\n".
"<!--Integro3.pl-->\n".
"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
}
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;
if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
$ionline = " - Copyright (c) $year, Integro Learning Company";
}
return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, Integro Leadership Institute$ionline<center></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 $test;
if ($rptparams[0]) {
$test = $rptparams[0];
} else {
$test = "SAS01b";
}
my ($tstid) = grep((/($test\S*)&/ && ($_=$1)),get_data("tests.$CLIENT{'clid'}"));
if (not $tstid) {
print HTMLHeader("Error! No Strategic Alignment Survey Found.");
print "<h1>Error! No Strategic Alignment Survey Found.</h1>\n";
print HTMLFooter();
}
#print STDERR get_data("tests.$CLIENT{'clid'}");
#print STDERR "Test ID = $tstid\n";
print HTMLHeader("Integro Learning Custom Reports",$js);
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=\"$tstid\">\n";
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 "<center>\n<table border>\n<caption>Integro Learning 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 "<hr>\n";
#print "<input type=\"checkbox\" name=\"pdf\">Display reports as PDF\n";
print "<p>Section 1<ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'people');\">Kinds of People Report</a></li>".
"<li><a href=\"javascript:parmsIntegro(document.integrorpt,'peoplesummary');\">Kinds of People Summary</a></li></ul></p>\n";
print "<p>Section 2<ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'trustlevel');\">Group Trust Level Report</a></li>".
"<li><a href=\"javascript:parmsIntegro(document.integrorpt,'trustlevelsummary');\">Group Trust Level Summary</a></li></ul></p>\n";
print "<p>Section 3<ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'values');\">Values That Build Trust Report</a></li>".
"<li><a href=\"javascript:parmsIntegro(document.integrorpt,'valuessummary');\">Values That Build Trust Summary</a></li></ul></p>\n";
print "<p>Section 4<ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'commeffect');\">Group Alignment Report</a></li>".
"<li><a href=\"javascript:parmsIntegro(document.integrorpt,'commeffectsummary');\">Group Alignment Summary</a></li></ul></p>\n";
print "<p>Section 5" ;
print "<ul style=\"list-style: none\">" ;
print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'improvepie');\">Improvement Pie Chart</a> - No Groups" ;
print "</li><li><a href=\"javascript:parmsIntegro(document.integrorpt,'improvesummary');\">Improvement Summary</a> - All Groups</li></ul></p>\n";
print "<p>General Reports<ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'comments');\">Comments</a></li>";
print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'comments2');\">Comments by Category</a></li>";
print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
#my $commurl = "/cgi-bin/teststats.pl?tstid=$tstid".
# "&tid=$FORM{'tid'}&rptid=ACT-C-004&rptdesc=Test%20Statistics%20by%20Test".
# "&testsummary=composite&showcmts=donot";
print "<li><a href=\"javascript:commIntegro(document.integrorpt);\">Question Statistics</a></li></p>\n";
print "</form>";
print HTMLFooter();
}
# Also known as the Group Alignment report
sub CommEffectReport {
my ($idlist,$groups,$timestamp) = @_;
my $data = &CommEffectData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
my $claritysum = $data->{'organization'}->{'claritysum'};
my $approvalsum = $data->{'organization'}->{'approvalsum'};
my $histograms = $data->{'organization'}->{'histogram'};
my %intlc;
my %intla;
$intlc{'Purpose'} = "86";
$intla{'Purpose'} = "88";
$intlc{'Values'} = "77";
$intla{'Values'} = "86";
$intlc{'Vision'} = "72";
$intla{'Vision'} = "78";
$intlc{'Goals'} = "79";
$intla{'Goals'} = "85";
$intlc{'Procedures'} = "78";
$intla{'Procedures'} = "71";
$intlc{'Roles'} = "84";
$intla{'Roles'} = "70";
print HTMLHeaderPlain("Section 4 - Group Alignment Report");
print "<Center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 4 - Group Alignment Report</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The Degree to which Group Members are in Alignment</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border><tr><th>&nbsp;&nbsp;&nbsp;&nbsp;</th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Very Unclear</b></font></th><th>&nbsp;&nbsp;&nbsp;&nbsp;</th>".
"<th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Moderately Unclear</b></font></th><th>&nbsp;&nbsp;&nbsp;&nbsp;</th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Moderately Clear</b></font></th>".
"<th>&nbsp;&nbsp;&nbsp;&nbsp;</th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Very Clear</b></font></th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Group Clarity</b></font></th>".
"<th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Group Approval</b></font></th>".
"<th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Int'l Clarity</b></font></th>".
"<th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Int'l Approval</b></font></th></tr>\n";
# fill in the rows
my $overall = {'clarity' => 0, 'approval' => 0};
foreach my $row (qw(Purpose Values Vision Goals Procedures Roles)) {
print "<tr><th>$row</th>";
for my $i (0..6) {
print "<td align=\"center\">";
if ($histograms->{$row}->{'Clarity'}->[$i]) {
if ($histograms->{$row}->{'Approval'}->[$i]->[2]) {
print "<img src=\"/graphic/face-smile.gif\">".
"<sub>$histograms->{$row}->{'Approval'}->[$i]->[2]</sub><br>";
}
if ($histograms->{$row}->{'Approval'}->[$i]->[1]) {
print "<img src=\"/graphic/face-red.gif\">".
"<sub>$histograms->{$row}->{'Approval'}->[$i]->[1]</sub><br>";
}
if ($histograms->{$row}->{'Approval'}->[$i]->[0]) {
print "<img src=\"/graphic/face-blue.gif\">".
"<sub>$histograms->{$row}->{'Approval'}->[$i]->[0]</sub>";
}
} else {
print "&nbsp;";
}
print "</td>";
}
printf "<td align=\"center\">%.1f %%</td>\n", $claritysum->{$row}->{'value'};
printf "<td align=\"center\">%.1f %%</td>\n", $approvalsum->{$row}->{'value'};
printf "<td align=\"center\">%.1f %%</td>\n", $intlc{$row};
printf "<td align=\"center\">%.1f %%</td>\n", $intla{$row};
print "</tr>\n";
}
print "</table>\n<p>Position = Group Clarity</p>\n<p>Countenance = Personal Approval</p>\n";
print HTMLFooter();
}
sub CommEffectSummary {
my ($idlist,$groups,$timestamp) = @_;
my $data = &CommEffectData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
my @cols = ("Purpose","Values","Vision","Goals","Procedures","Roles");
$groups = getGroups($CLIENT{'clid'});
print HTMLHeaderPlain("Section 4 - Group Alignment Summary");
print "<Center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 4 - Group Alignment Summary</i></b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The Degree to which Group Members are in Alignment</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>\n";
print "<tr>\n<th>&nbsp</th>\n";
foreach my $col (@cols) {
print "<th colspan=2>$col</th>";
}
print "</tr>\n";
print "<tr>\n<td>&nbsp</td>\n";
foreach my $col (@cols) {
print "<td align=center><font size=-1><b>Clarity</b></font></td><td><font size=-1><b>Approval</b></font></td>";
}
print "</tr>\n";
print "<tr><td>Overall</td>";
foreach my $col (@cols) {
printf "<td align=center>%.1f %%</td>", $data->{'organization'}->{'claritysum'}->{$col}->{'value'};
printf "<td align=center>%.1f %%</td>", $data->{'organization'}->{'approvalsum'}->{$col}->{'value'};
}
if (exists $data->{'groups'}) {
print "<tr><th colspan=13 align=\"left\">Group Breakdown</th></tr>\n";
print "<tr><th>Group</th>";
foreach my $col (@cols) {
print "<th colspan=2>$col</th>";
}
print "</tr>\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "<tr><td>$groups->{$grp}->{'grpnme'}</td>";
foreach my $col (@cols) {
printf "<td align=center>%.1f %%</td>", $data->{'groups'}->{$grp}->{'claritysum'}->{$col}->{'value'};
printf "<td align=center>%.1f %%</td>", $data->{'groups'}->{$grp}->{'approvalsum'}->{$col}->{'value'};
}
print "</tr>\n";
}
}
print "<tr>\n<td rowspan=2><b>International<br>Average</b></td>\n";
foreach my $col (@cols) {
print "<th colspan=2>$col</th>";
}
print "</tr>\n";
print "<tr>";
print "<td align=center>86%</td>";
print "<td align=center>88%</td>";
print "<td align=center>77%</td>";
print "<td align=center>86%</td>";
print "<td align=center>72%</td>";
print "<td align=center>78%</td>";
print "<td align=center>79%</td>";
print "<td align=center>85%</td>";
print "<td align=center>78%</td>";
print "<td align=center>71%</td>";
print "<td align=center>84%</td>";
print "<td align=center>70%</td>";
print "</tr>\n";
print "</table></b></font>\n";
print HTMLFooter();
}
sub TrustLevelReport {
my ($idlist,$groups,$timestamp) = @_;
my $data = TrustLevelData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
my $histograms = $data->{'organization'}->{'histogram'};
my $trust = $data->{'organization'}->{'trust'};
print HTMLHeaderPlain("Section 2 - Group Trust Level Report");
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 2 - Group Trust Level Report</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>$xlatphrase[801]</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border><tr><th>&nbsp;</th><th>&nbsp;</th><th>Group Trust Level</th><th>Int'l Average</th></tr>\n";
my $baseurl = "/cgi-bin/bargraph.pl?labels=Low::::Medium::::High&title=Trust%20Level&ylabel=Respondents";
$baseurl .= "&xdim=400&ydim=100";
my %intl;
$intl{'Congruence'} = "66";
$intl{'Openness'} = "69";
$intl{'Acceptance'} = "73";
$intl{'Reliability'} = "79";
foreach my $row (qw(Congruence Openness Acceptance Reliability)) {
print "<tr><th>$row</th>";
print "<td><img src=\"$baseurl&values=".join(":",@{$histograms->{$row}})."\"></td>";
printf "<td align=\"center\">%.1f%% </td>\n", $trust->{$row}->{'value'};
printf "<td align=\"center\">%.1f%% </td></tr>\n", $intl{$row};
}
print "</table></b></font>\n";
#printf "<P><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"2\"><b>Overall Group Trust Level</b></font> = %.1f %%.</p>\n",$data->{'organization'}->{'overalltrust'};
print HTMLFooter();
}
sub TrustLevelSummary {
my ($idlist,$groups,$timestamp) = @_;
my $data = TrustLevelData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
my @cols = ("Congruence","Openness","Acceptance","Reliability");
$groups = getGroups($CLIENT{'clid'});
print HTMLHeaderPlain("Section 2 - Group Trust Level Summary");
print "<Center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 2 - Group Trust Level Summary</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>$xlatphrase[801]</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[800]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>\n";
print "<tr><td>&nbsp;</th>";
foreach my $col (@cols) {
print "<th align=center>$col</th>";
}
print "</tr>\n";
print "<tr><td>Overall</td>";
foreach my $col (@cols) {
printf "<td align=center>%.1f %%</td>", $data->{'organization'}->{'trust'}->{$col}->{'value'};
}
print "</tr>\n";
if (exists $data->{'groups'}) {
print "<tr><th colspan=5 align=\"left\">Group Breakdown</th></tr>\n";
print "<tr><th>Group</th>";
foreach my $col (@cols) {
print "<th>$col</th>";
}
print "</tr>\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "<tr><td align=left>$groups->{$grp}->{'grpnme'}</td>";
foreach my $col (@cols) {
printf "<td align=center>%.1f %%</td>", $data->{'groups'}->{$grp}->{'trust'}->{$col}->{'value'};
}
}
print "</tr>\n";
}
print "<tr>\n<td rowspan=2><b>International<br>Average</b></td>\n";
foreach my $col (@cols) {
print "<th align=center>$col</th>";
}
print "</tr>\n";
print "<tr>";
print "<td align=center>66%</td>";
print "<td align=center>69%</td>";
print "<td align=center>73%</td>";
print "<td align=center>79%</td>";
print "</tr>\n";
print "</table></b></font>\n";
print HTMLFooter();
}
# Aka Gap Analysis
sub ValuesReport {
my ($idlist,$groups,$timestamp) = @_;
my $data = &ValuesData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
print HTMLHeaderPlain("Section 3 - Values That Build Trust");
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 3 - Values That Build Trust</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The gap between Employee Expectation and the degree to <br>which the $xlatphrase[797] operates by these Values</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
$timestamp;
printf "<table border><tr><td>Your Trust Values Gap Score is %.1f",$data->{'organization'}->{'gap'};
#print "<br>World Class Standard ?<br>International Benchmark ?<br>";
print "</td></tr></table>\n";
print "<p><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">The graphs below show the Personal Importance and Perceptions of Work Performance".
" for each of the eight values.</font>";
print "<tr><td>&nbsp;</td><th>Gap</th><th>Int'l<br>Avg</th></tr>\n";
my $baseurl = "/cgi-bin/bargraph.pl?labels=Personal%20Importance:Work%20Performance".
"&xdim=500&ydim=60&hbar=1&ymax=11&ymin=0&yticknum=11";
my %intl;
$intl{'Straightforwardness'} = "2.0";
$intl{'Honesty'} = "1.7";
$intl{'Receptivity'} = "1.6";
$intl{'Disclosure'} = "1.8";
$intl{'Respect'} = "1.8";
$intl{'Recognition'} = "2.2";
$intl{'Seeks Excellence'} = "1.5";
$intl{'Keeps Commitments'} = "1.9";
foreach ('Straightforwardness', 'Honesty', 'Receptivity', 'Disclosure', 'Respect',
'Recognition', 'Seeks Excellence', 'Keeps Commitments') {
my $url;
my $pinum = (int(10*$data->{'organization'}->{$_}->{'Personal Importance'}+0.5)/10);
my $wpnum = (int(10*$data->{'organization'}->{$_}->{'Work Performance'}+0.5)/10);
my $diff = $pinum - $wpnum;
$diff = sprintf("%1.1f", $diff);
$url = $baseurl."&values=".$pinum.":";
$url = $url."&values2=:".$wpnum;
print "<tr><th colspan=\"3\" align=\"left\">$_</th></tr>\n";
print "<tr><td><img src=\"$url\"></td><td align=\"center\">$diff</td><td align=\"center\">$intl{$_}</td></tr>\n";
}
print "<tr><th>Total Trust Values Gap</th>";
printf "<td align=center>%.1f</td>", $data->{'organization'}->{'gap'};
print "<td align=center>13.8</td></tr>\n";
print "</table></b></font>\n";
print HTMLFooter();
}
sub ValuesSummary {
my ($idlist,$groups,$timestamp) = @_;
my $data = &ValuesData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
$groups = getGroups($CLIENT{'clid'});
print HTMLHeaderPlain("Section 3 - Values That Build Trust Summary");
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 3 - Values That Build Trust Summary</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The gap between Employee Expectation and the degree to <br>which the $xlatphrase[797] operates by these Values</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>\n";
print "<tr><td>&nbsp;</th><th>Total Importance</th><th>Total Performance</th><th>Trust Values Gap</th></tr>\n";
print "<tr><td>Overall</td>";
printf "<td align=center>%.1f</td>", $data->{'organization'}->{'Personal Importance'};
printf "<td align=center>%.1f</td>", $data->{'organization'}->{'Work Performance'};
printf "<td align=center>%.1f</td></tr>\n", $data->{'organization'}->{'gap'};
if (exists $data->{'groups'}) {
print "<tr><th colspan=4 align=\"left\">Group Breakdown</th></tr>\n";
print "<tr><th>Group</th><th>Total Importance</th><th>Total Performance</th><th>Trust Values Gap</th></tr>\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "<tr><td>$groups->{$grp}->{'grpnme'}</td>";
printf "<td align=center>%.1f</td>", $data->{'groups'}->{$grp}->{'Personal Importance'};
printf "<td align=center>%.1f</td>", $data->{'groups'}->{$grp}->{'Work Performance'};
printf "<td align=center>%.1f</td></tr>\n", $data->{'groups'}->{$grp}->{'gap'};
}
}
print "<tr><td>&nbsp;</th><th>Total Importance</th><th>Total Performance</th><th>Trust Values Gap</th></tr>\n";
print "<tr><td><b>International Average</b></td>";
printf "<td align=center>%.1f</td>", 74.6;
printf "<td align=center>%.1f</td>", 60.8;
printf "<td align=center>%.1f</td></tr>\n", 13.8;
print "</table></b></font>\n";
print HTMLFooter();
}
sub KindsOfPeopleReport {
my ($idlist,$groups,$timestamp) = @_;
my $data = KindsOfPeopleData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
print HTMLHeaderPlain("Section 1 - Kinds of People");
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 1 - Kinds of People</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>$xlatphrase[802]</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>";
my $url;
#if (exists $data->{'self'}) {
if (0) {
my @self = @{$data->{'self'}}{'Rebellious','Compliant','Self-Directed'};
$url = "/cgi-bin/piechart.pl?title=Self%20Perception&values=".
join(':',map(int($_+0.5),@self)).
"&labels=Rebellious:Compliant:Self-Directed";
print "<tr><td><img src=\"$url\"></td></tr>\n";
}
if (exists $data->{'organization'}) {
my @other = @{$data->{'organization'}}{'Rebellious','Compliant','Self-Directed'};
$url = "/cgi-bin/piechart.pl?title=Perception%20of%20Others&values=".
join(':',map(int(10*$_+0.5)/10,@other)).
"&labels=Rebellious:Compliant:Self-Directed";
print "<tr><td><img src=\"$url\"></td></tr>\n";
print "</table>\n";
print "<p><table border>\n";
print "<tr><td colspan=2><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Overall Group Values</b></font></td><td><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Int'l Average</b></font></td></tr>\n";
printf "<tr><th>Rebellious</th><td>%.1f %%</td><td align=center>11%</td></tr>\n", $data->{'organization'}->{'Rebellious'};
printf "<tr><th>Compliant</th><td>%.1f %%</td><td align=center>27%</td></tr>\n", $data->{'organization'}->{'Compliant'};
printf "<tr><th>Self-Directed</th><td>%.1f %%</td><td align=center>62%</td></tr>\n", $data->{'organization'}->{'Self-Directed'};
print "</table></b></font>\n";
} else {
print "<h1>No valid Data</h1>\n";
}
#print "<pre>".Dumper($data)."</pre>\n";
print HTMLFooter();
}
sub KindsOfPeopleSummary {
my ($idlist,$groups,$timestamp) = @_;
my $data = KindsOfPeopleData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
$groups = getGroups($CLIENT{'clid'});
print HTMLHeaderPlain("Section 1 - Kinds of People Summary");
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Section 1 - Kinds of People Summary</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>$xlatphrase[802]</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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>\n";
print "<tr><td>&nbsp;</th><th>Rebellious</th><th>Compliant</th><th>Self-Directed</th></tr>\n";
print "<tr><td>Overall</td>";
printf "<td align=\"center\">%.1f %%</td>", $data->{'organization'}->{'Rebellious'};
printf "<td align=\"center\">%.1f %%</td>", $data->{'organization'}->{'Compliant'};
printf "<td align=\"center\">%.1f %%</td></tr>\n", $data->{'organization'}->{'Self-Directed'};
if (exists $data->{'groups'}) {
print "<tr><th colspan=4 align=\"left\">Group Breakdown</th></tr>\n";
print "<tr><th>Group</th><th>Rebellious</th><th>Compliant</th><th>Self-Directed</th></tr>\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "<tr><td>$groups->{$grp}->{'grpnme'}</td>";
printf "<td align=\"center\">%.1f %%</td>\n", $data->{'groups'}->{$grp}->{'Rebellious'};
printf "<td align=\"center\">%.1f %%</td>\n", $data->{'groups'}->{$grp}->{'Compliant'};
printf "<td align=\"center\">%.1f %%</td></tr>\n", $data->{'groups'}->{$grp}->{'Self-Directed'};
}
}
print "<tr><td>&nbsp;</th><th>Rebellious</th><th>Compliant</th><th>Self-Directed</th></tr>\n";
print "<tr><td><b>International Average</b></td><td align=center>11%</td><td align=center>27%</td><td align=center>62%</td></tr>\n";
print "</table></b></font>\n";
print HTMLFooter();
}
sub CommentsReport {
my ($idlist, $timestamp, $bycat) = @_;
my @filelist = &get_test_result_files($testcomplete, $CLIENT{'clid'},$TEST{'id'});
my @comments;
for (my $i=0; $i<=60; $i++) {$comments[$i] = [];}
my @questions = map([split(/&/,$_)],&get_question_list($TEST{'id'},$CLIENT{'clid'}));
foreach (@questions) {$_->[4] =~ s/:::.*$//;}
foreach my $file (@filelist) {
my $user = $file;
$user =~ s/.$TEST{'id'}$//;
$user =~ s/^$CLIENT{'clid'}.//;
if (defined $idlist and not $idlist->{$user}) {
next;
}
my ($answers,$usercomm) = &get_survey_results( $CLIENT{'clid'}, $user, $TEST{'id'});
for (my $i=1; $i<=58; $i++) {
if ($usercomm->[$i] == -1) {
$comments[$i] = -1;
} elsif ($usercomm->[$i]) {
push @{$comments[$i]},$usercomm->[$i];
}
}
if ($usercomm->[59] ) {
push @{$comments[59]},$usercomm->[59];
}
# if ($usercomm->[59]) {
# push @{$comments[59]},"Comments 59 test\n", $usercomm->[59];
# }
if ($answers->[60]) {
push @{$comments[60]}, $answers->[60];
}
if ($usercomm->[60]) {
push @{$comments[60]}, $usercomm->[60];
}
}
print HTMLHeaderPlain("Comments Report");
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Strategic Alignment Survey<br>Comments Report</b></font><br><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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "</center>\n";
print "<blockquote>\n";
my @outary = ();
for (my $i=1; $i <=60; $i++) {
if ($comments[$i] == -1) {
# inactive question
next;
}
$outary[$i] = "<hr width=\"100%\"><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"2\"><b>\n";
$outary[$i] .= "$questions[$i]->[0] - $questions[$i]->[4]</b><p>\n";
if (@{$comments[$i]}) {
$outary[$i] .= "<ul>\n";
foreach (@{$comments[$i]}) {
$outary[$i] .= "<li>$_</li>\n";
}
$outary[$i] .= "</ul>\n";
} else {
$outary[$i] .= "<ul><li><small><i>No Comments</i></small></li></ul>\n";
}
$outary[$i] .= "</font>\n";
}
# Read in .rgo file which defines question presentation order
my $out;
my $lookupfile = join($pathsep,$dataroot,"IntegroSAS.rgo");
if ($bycat && -e $lookupfile) {
my $fh = new FileHandle;
if ($fh->open($lookupfile)) {
$out = "";
my @lines = <$fh>;
$fh->close();
shift @lines;
foreach (@lines) {
chomp;
my @line = split(/\&/,$_);
my $section = shift @line;
if ($section ne "") {
$out .= "<tr><td colspan=6><hr width=\"100\%\"></td></tr>\n";
$out .= "<tr><td colspan=6><font size=+1><b>$section</b></font></td></tr>\n";
}
foreach my $sub (@line) {
my ($subheader, $quess) = split(/:/,$sub);
if ($subheader ne "") {
$out .= "<hr width=100%><tr><td colspan=6><b>$subheader:</b></td></tr>\n";
}
my @ques = split(/\,/,$quess);
foreach my $quesid (@ques) {
$out .= $outary[$quesid];
}
}
}
print $out;
}
} else {
for (1 .. $#outary) {
print $outary[$_];
}
}
print "<hr width=\"100%\">\n";
print "</blockquote>\n";
#print "<pre>".Dumper(\@questions,\@comments)."</pre>\n";
print "<center>".HTMLFooter();
}
# The original request was for a pie chart of all
# of the answers on the last question. I wrote the survey,
# so the question is a Likert Scale question that uses a value of
# "Improvement" for its super category. This function generates the
# report on the Improvement super category regardless of the
# question number.
# This version of the subroutine will have one 3-D piechart with a legend.
# It will have a table with three columns for each
# type: Name, Description, and Percentage.
sub ImprovementPieChart {
my ($idlist,$groups,$timestamp) = @_;
# warn "idlist $idlist .\n" ;
# warn "idlist keys " . join (" ",keys (%$idlist)) . ".\n" ;
# warn "groups $groups .\n" ;
# warn "groups keys " . join (" ",keys (%$groups)) . ".\n" ;
# warn "timestamp $timestamp .\n" ;
# warn "Client $CLIENT{'clid'} .\n" ;
# warn "Test Id $TEST{'id'} .\n" ;
# warn "Form Test Id $FORM{'tstid'} .\n" ;
my $data ;
my $data = &GetLikertData($CLIENT{'clid'},$TEST{'id'},$idlist);
my %Categories = () ; my $resp ;
# Client said he wanted to ignore the data for non-responding candidates, and "Not here last year" Candidates.
# $Categories{'NoResponse'} = $$data{'Improvement'}->{'NoResponses'} ;
# The Scores, and meanings.
# 2 - Disagree
# 3 - Somewhat Disagree
# 4 - Somewhat Agree
# 5 - Agree
# 1 - Unable to answer since I was not at ausco last year.
my $mystery = $data->{'Improvement'}->{'ScoreCount'} ; # Should be a reference to a hash.
# warn "Mystery Keys " . join(" ", keys %$mystery) . " . " ;
foreach $resp ( keys %$mystery ) {
# each response score.
$Categories{$resp} = $data->{'Improvement'}->{'ScoreCount'}->{$resp} ;
}
# print HTMLHeaderPlain("Section 5 - Improvement Piechart");
print HTMLHeaderPlain("Strategic Alignment Survey");
print "<Center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>" ;
print "Strategic Alignment Survey<br></font>" ;
# print "<font size=\"4\">The percentage of employees at each level of Improvement at Ausco</b></font><br><br>\n";
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
print "Positive Changes at Ausco</b></font><br><br>\n";
# print "</font></b>\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";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
my (@values , @Labels , $url, $mykey, @scores, $total) ;
$total = 0 ;
# @Labels = sort keys %Categories ;
@Labels = ("Disagree", "Somewhat Disagree",
"Somewhat Agree", "Agree") ;
foreach $mykey (sort keys %Categories) {
unless($mykey==1) { # We will not count the "Not here last year" response.
push @scores,$Categories{$mykey} ;
$total += $Categories{$mykey} ;
}
}
if ($total) {
@values = map ((100 * $_ / $total),@scores ) ;
} else {
# $total is zero. (Do not divide by zero.)
@values = @scores ;
}
$url = "/cgi-bin/piechart4.pl?values=" .
join(':',map(int($_+0.5),grepa(\@values,\@values))) .
# "&labels=" .
"&xdim=800&ydim=200" .
"&labels=" . join(":",grepa(\@values,\@Labels)) ;
# "&xdim=200&ydim=100&nolegend=1" ;
print "<br><br>\n" ;
print "<img src=\"${url}&colors=" ;
print join(":", grepa(\@values, ["lred", "lorange", "lyellow", "lgreen", "decentblue"])) ;
print "\">" ;
print "<br><br>\n" ;
print "<table border>";
# I just need to add the colors to each graph.
# The selected colors are "lred", "lorange", "lyellow", "lgreen", "lblue"
# The deselected colors are "dred", "dbrown", "dyellow", "dgreen", "dblue"
# Start a row.
print "<tr>\n";
# Do the Description.
print "<td><b>Disagree</b>\n" ;
print " there have been positive changes at Ausco in the last year.\n";
print "</td>\n" ;
# Do the percentage.
print "<td><b>\n" ;
printf "&nbsp;%.1f", $values[0] ;
print "&nbsp;%" ;
print "</b></td>\n" ;
# Start a row.
print "<tr>\n";
# Do the Description.
print "<td><b>Somewhat disagree</b>\n" ;
print " there have been positive changes at Ausco in the last year.\n" ;
print "</td>\n" ;
# Do the percentage.
print "<td><b>\n" ;
printf "&nbsp;%.1f", $values[1] ;
print "&nbsp;%" ;
print "</b></td>\n" ;
print "</tr>\n";
# Start a row.
print "<tr>\n";
# Do the Description.
print "<td><b>Somewhat agree</b>\n" ;
print " there have been positive changes at Ausco in the last year.\n" ;
print "</td>\n" ;
# Do the percentage.
print "<td><b>\n" ;
printf "&nbsp;%.1f", $values[2] ;
print "&nbsp;%" ;
print "</b></td>\n" ;
print "</tr>\n";
# Start a row.
print "<tr>\n";
# Do the Description.
print "<td><b>Agree</b>\n" ;
print " there have been positive changes at Ausco in the last year.\n" ;
print "</td>\n" ;
# Do the percentage.
print "<td><b>\n" ;
printf "&nbsp;%.1f", $values[3] ;
print "&nbsp;%" ;
print "</b></td>\n" ;
print "</tr>\n";
# Finish the Table and the page.
print "</table>\n";
print "<br><br>\n";
print HTMLFooter();
} # End ImprovementPieChart
sub ImprovementSummary {
# This does the Summary on the Improvement Likert Scale,
# for everybody, and all of the Groups.
my ($idlist,$groups,$timestamp) = @_;
$groups = getGroups($CLIENT{'clid'}) ;
my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$groups) ;
# print HTMLHeaderPlain("Section 5 - Improvement Summary");
print HTMLHeaderPlain("Strategic Alignment Survey");
print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
print "<b>Strategic Alignment Survey<br>" ;
print "Positive Changes at Ausco Summary</b></font><br><br>\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";
} elsif (defined $idlist) {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
} else {
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
}
print $timestamp;
print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
# Print HTML for heading.
print "<b><table border>\n";
# Print First Row, Some elements span 2 rows.
print "<tr>" ;
print "<th rowspan=\"2\">Group</th><th colspan=\"2\">Disagree</th><th colspan=\"2\">Somewhat Disagree</th>" ;
print "<th colspan=\"2\">Somewhat Agree</th><th colspan=\"2\">Agree</th><th colspan=\"2\">No Response</th>" ;
print "<th colspan=\"2\">Not Here Last Year</th><th rowspan=\"2\">Total</th>" ;
print "</tr>\n" ;
# Print Second Row of headers.
print "<tr>" ;
my $i ;
for ($i = 1; $i <= 6; $i ++) { print "<th>Count</th><th>Percent</th>" ; }
print "</tr>\n" ;
# print "<tr>"; print keys %{$sumdata} ; print "</tr>\n" ;
# print "<tr>"; print keys %{$sumdata->{'Improvement'}} ; print "</tr>\n" ;
# print "<tr>"; print keys %{$sumdata->{'Improvement'}->{'ScoreCount'}} ; print "</tr>\n" ;
# Print row for overall values.
my $total = $sumdata->{'Improvement'}->{'NoResponses'}+$sumdata->{'Improvement'}->{'Responses'} ;
print "<tr><th>Overall</th>";
print &rep_cell_str($sumdata->{'Improvement'}->{'ScoreCount'}->{2} , $total) ; # Disagree
print &rep_cell_str($sumdata->{'Improvement'}->{'ScoreCount'}->{3} , $total) ; # Somewhat Disagree
print &rep_cell_str($sumdata->{'Improvement'}->{'ScoreCount'}->{4} , $total) ; # Somewhat Agree
print &rep_cell_str($sumdata->{'Improvement'}->{'ScoreCount'}->{5} , $total) ; # Agree
print &rep_cell_str($sumdata->{'Improvement'}->{'NoResponses'} , $total) ; # No Response
print &rep_cell_str($sumdata->{'Improvement'}->{'ScoreCount'}->{1} , $total) ; # Not Here Last Year.
printf "<td align=\"center\">%4i</td>", $total ; # Total test takers.
print "</tr>\n" ;
# loop for groups.
my $group ;
foreach $group (sort keys %{$groups}) {
$total = $grpdata->{$group}->{'Improvement'}->{'NoResponses'}+$grpdata->{$group}->{'Improvement'}->{'Responses'} ; # Total test takers.
print "<tr><th>$group</th>";
print &rep_cell_str($grpdata->{$group}->{'Improvement'}->{'ScoreCount'}->{2} , $total) ; # Disagree
print &rep_cell_str($grpdata->{$group}->{'Improvement'}->{'ScoreCount'}->{3} , $total) ; # Somewhat Disagree
print &rep_cell_str($grpdata->{$group}->{'Improvement'}->{'ScoreCount'}->{4} , $total) ; # Somewhat Agree
print &rep_cell_str($grpdata->{$group}->{'Improvement'}->{'ScoreCount'}->{5} , $total) ; # Agree
print &rep_cell_str($grpdata->{$group}->{'Improvement'}->{'NoResponses'} , $total) ; # No Response
print &rep_cell_str($grpdata->{$group}->{'Improvement'}->{'ScoreCount'}->{1} , $total) ; # Not Here Last Year.
printf "<td align=\"center\">%4i</td>", $grpdata->{$group}->{'Improvement'}->{'NoResponses'}+$grpdata->{$group}->{'Improvement'}->{'Responses'} ; # Total test takers.
print "</tr>\n" ;
}
print "</table>\n" ;
print HTMLFooter();
}
sub rep_cell_str {
# Parameters
# $count - required, number for the cell, integer.
# $total - dividend for the percent, integer.
# Returned Value
# $html_str - html string to print for the cell.
my ($count, $total) = @_ ;
my $html_str = "<td align=\"center\">" ;
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 .= sprintf("%4i", $count) ;
# $html_str .= "<table border>" ;
# $html_str .= "<td>
$html_str .= "$count_str</td>" ;
$html_str .= "<td align=\"right\">" ;
$html_str .= "$percent_str</td>" ;
# $html_str .= "</table>" ;
# $html_str .= "</td>\n" ;
return $html_str ;
}