#!/usr/bin/perl
#
# Source File: Integro3.5.pl
# Get config
use FileHandle;
use Time::Local;
use Data::Dumper;
use IntegroLib;
require 'sitecfg.pl';
require 'testlib.pl';
require 'tstatlib.pl';
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 $testpending $testinprog $testcomplete);
&app_initialize;
$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma. HBI
# Make sure we have a valid session, and exit if we don't
if (not &get_session($FORM{'tid'})) {
exit(0);
}
&LanguageSupportInit();
#print STDERR Dumper(\%SESSION);
&get_client_profile($SESSION{'clid'});
if ($FORM{'tstid'}) {
&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
} elsif (!$rptparams[0]) {
# Check for multiple tests
my @trecs = &get_test_list($CLIENT{'clid'}); #tests in an array
my @tmptrecs = ();
for (1 .. $#trecs) {
my ($id, $desc) = split(/&/, $trecs[$_]); #id=testid, descr=test description
if ($id =~ "^SAS") {push @tmptrecs, join('&', "$desc", "$id");}
}
@trecs = sort @tmptrecs;
if ($#trecs > 0) {
# show test chooser
&print_test_chooser(@trecs);
}
}
# 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 "
".Dumper(\@history)."
";
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 (substr($FORM{'reportname'},-3) ne 'csv') {
if (defined $timestamp) {
$timestamp = "$timestamp
\n";
} else {
$timestamp = "
\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 'trustlevelcsv') {
&TrustLevelCSV($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 'valuescsv') {
&ValuesCSV($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 'peoplecsv') {
&KindsOfPeopleCSV($idlist, $groups, $timestamp);
} else {
&ReportChooser();
}
# There should only be function definitions beyond this point.
exit(0);
sub HTMLHeader {
return "\n\n$_[0]\n".
"\n".
"\n\n".
"\n";
}
sub HTMLHeaderPlain {
return "\n\n$_[0]\n".
"\n\n".
"\n";
}
sub HTMLFooter {
my $year = `date +%Y`;
my $ionline;
if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
$ionline = " - Copyright (c) $year, Integro Learning Company";
}
return "
Copyright (c) $year, Integro Leadership Institute$ionline\n\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".
"if (rpt.indexOf('csv') > 0) { oform.csv.value=1; } else{ oform.csv.value=0; }\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 ($FORM{'tstid'}) {
$test = $FORM{'tstid'};
} elsif ($rptparams[0]) {
$test = $rptparams[0];
} else {
$test = "SAS01";
}
my ($tstid) = grep((/($test\s*)&/ && ($_=$1)),get_data("tests.$CLIENT{'clid'}"));
if (not $tstid) {
print HTMLHeader("Error! No Strategic Alignment Survey Found.");
print "Error! No Strategic Alignment Survey Found.
\n";
print HTMLFooter();
}
#print STDERR get_data("tests.$CLIENT{'clid'}");
#print STDERR "Test ID = $tstid\n";
print HTMLHeader("Integro Learning Custom Reports",$js);
print "";
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 "Strategic Alignment Survey
Section 4 - Group Alignment Report
\n";
print "The Degree to which Group Members are in Alignment
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
print $timestamp;
print " | Very Unclear | | ".
"Moderately Unclear | | Moderately Clear | ".
" | Very Clear | Group Clarity | ".
"Group Approval | ".
"Int'l Clarity | ".
"Int'l Approval |
\n";
# fill in the rows
my $overall = {'clarity' => 0, 'approval' => 0};
foreach my $row (qw(Purpose Values Vision Goals Procedures Roles)) {
print "$row | ";
for my $i (0..6) {
print "";
if ($histograms->{$row}->{'Clarity'}->[$i]) {
if ($histograms->{$row}->{'Approval'}->[$i]->[2]) {
print "".
"$histograms->{$row}->{'Approval'}->[$i]->[2] ";
}
if ($histograms->{$row}->{'Approval'}->[$i]->[1]) {
print "".
"$histograms->{$row}->{'Approval'}->[$i]->[1] ";
}
if ($histograms->{$row}->{'Approval'}->[$i]->[0]) {
print "".
"$histograms->{$row}->{'Approval'}->[$i]->[0]";
}
} else {
print " ";
}
print " | ";
}
printf "%.1f %% | \n", $claritysum->{$row}->{'value'};
printf "%.1f %% | \n", $approvalsum->{$row}->{'value'};
printf "%.1f %% | \n", $intlc{$row};
printf "%.1f %% | \n", $intla{$row};
print "
\n";
}
print "
\nPosition = Group Clarity
\nCountenance = Personal Approval
\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 "Strategic Alignment Survey
Section 4 - Group Alignment Summary
\n";
print "The Degree to which Group Members are in Alignment
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
print $timestamp;
print "\n";
print "\n  | \n";
foreach my $col (@cols) {
print "$col | ";
}
print "
\n";
print "\n  | \n";
foreach my $col (@cols) {
print "Clarity | Approval | ";
}
print "
\n";
print "Overall | ";
foreach my $col (@cols) {
printf "%.1f %% | ", $data->{'organization'}->{'claritysum'}->{$col}->{'value'};
printf "%.1f %% | ", $data->{'organization'}->{'approvalsum'}->{$col}->{'value'};
}
if (exists $data->{'groups'}) {
print "
Group Breakdown |
\n";
print "Group | ";
foreach my $col (@cols) {
print "$col | ";
}
print "
\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "$groups->{$grp}->{'grpnme'} | ";
foreach my $col (@cols) {
printf "%.1f %% | ", $data->{'groups'}->{$grp}->{'claritysum'}->{$col}->{'value'};
printf "%.1f %% | ", $data->{'groups'}->{$grp}->{'approvalsum'}->{$col}->{'value'};
}
print "
\n";
}
}
print "\nInternational Average | \n";
foreach my $col (@cols) {
print "$col | ";
}
print "
\n";
print "";
print "86% | ";
print "88% | ";
print "77% | ";
print "86% | ";
print "72% | ";
print "78% | ";
print "79% | ";
print "85% | ";
print "78% | ";
print "71% | ";
print "84% | ";
print "70% | ";
print "
\n";
print "
\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 "Strategic Alignment Survey
Section 2 - Group Trust Level Report
\n";
print "$xlatphrase[801]
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
print $timestamp;
print " | | Group Trust Level | Int'l Average |
\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 "$row | ";
print "{$row}})."\"> | ";
printf "%.1f%% | \n", $trust->{$row}->{'value'};
printf "%.1f%% |
\n", $intl{$row};
}
print "
\n";
#printf "Overall Group Trust Level = %.1f %%.
\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 "Strategic Alignment Survey
Section 2 - Group Trust Level Summary
\n";
print "$xlatphrase[801]
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[800]
\n";
}
print $timestamp;
print "\n";
print " ";
foreach my $col (@cols) {
print " | $col | ";
}
print "
\n";
print "Overall | ";
foreach my $col (@cols) {
printf "%.1f %% | ", $data->{'organization'}->{'trust'}->{$col}->{'value'};
}
print "
\n";
if (exists $data->{'groups'}) {
print "Group Breakdown |
\n";
print "Group | ";
foreach my $col (@cols) {
print "$col | ";
}
print "
\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "$groups->{$grp}->{'grpnme'} | ";
foreach my $col (@cols) {
printf "%.1f %% | ", $data->{'groups'}->{$grp}->{'trust'}->{$col}->{'value'};
}
}
print "
\n";
}
print "\nInternational Average | \n";
foreach my $col (@cols) {
print "$col | ";
}
print "
\n";
print "";
print "66% | ";
print "69% | ";
print "73% | ";
print "79% | ";
print "
\n";
print "
\n";
print HTMLFooter();
}
sub TrustLevelCSV {
my ($idlist,$groups,$timestamp) = @_;
my $data = TrustLevelData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
my @cols = ("Congruence","Openness","Acceptance","Reliability");
$groups = getGroups($CLIENT{'clid'});
print "Content-Disposition: attachment; filename=TrustLevel.csv\n\n";
print "Strategic Alignment Survey,Section 2 - Group Trust Level Summary,";
print "$xlatphrase[801],";
print "$FORM{'orgname'},";
if ($FORM{'uberheader'} ne "") {
print $FORM{'uberheader'};
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Summary for Groups:,"
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})));
} else {
print "$xlatphrase[798] $xlatphrase[800]";
}
print ",".$timestamp."\n";
print "Group";
foreach my $col (@cols) {
print ",$col";
}
print "\n";
print "Overall";
foreach my $col (@cols) {
printf ",%.1f %%", $data->{'organization'}->{'trust'}->{$col}->{'value'};
}
print "\n";
if (exists $data->{'groups'}) {
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "$groups->{$grp}->{'grpnme'}";
foreach my $col (@cols) {
printf ",%.1f %%", $data->{'groups'}->{$grp}->{'trust'}->{$col}->{'value'};
}
print "\n";
}
}
}
# 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 "Strategic Alignment Survey
Section 3 - Values That Build Trust
\n";
print "The gap between Employee Expectation and the degree to
which the $xlatphrase[797] operates by these Values
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
$timestamp;
printf "Your Trust Values Gap Score is %.1f",$data->{'organization'}->{'gap'};
#print " World Class Standard ? International Benchmark ? ";
print " |
\n";
print "\n";
print "The graphs below show the Personal Importance and Perceptions of Work Performance".
" for each of the eight values.";
print " | Gap | Int'l Avg |
\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 "$_ |
\n";
print " | $diff | $intl{$_} |
\n";
}
print "Total Trust Values Gap | ";
printf "%.1f | ", $data->{'organization'}->{'gap'};
print "13.8 |
\n";
print "
\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 "
Strategic Alignment Survey
Section 3 - Values That Build Trust Summary
\n";
print "The gap between Employee Expectation and the degree to
which the $xlatphrase[797] operates by these Values
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
print $timestamp;
print "\n";
print " | Total Importance | Total Performance | Trust Values Gap |
\n";
print "Overall | ";
printf "%.1f | ", $data->{'organization'}->{'Personal Importance'};
printf "%.1f | ", $data->{'organization'}->{'Work Performance'};
printf "%.1f |
\n", $data->{'organization'}->{'gap'};
if (exists $data->{'groups'}) {
print "Group Breakdown |
\n";
print "Group | Total Importance | Total Performance | Trust Values Gap |
\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "$groups->{$grp}->{'grpnme'} | ";
printf "%.1f | ", $data->{'groups'}->{$grp}->{'Personal Importance'};
printf "%.1f | ", $data->{'groups'}->{$grp}->{'Work Performance'};
printf "%.1f |
\n", $data->{'groups'}->{$grp}->{'gap'};
}
}
print " | Total Importance | Total Performance | Trust Values Gap |
\n";
print "International Average | ";
printf "%.1f | ", 74.6;
printf "%.1f | ", 60.8;
printf "%.1f |
\n", 13.8;
print "
\n";
print HTMLFooter();
}
sub ValuesCSV {
my ($idlist,$groups,$timestamp) = @_;
my $data = &ValuesData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
$groups = getGroups($CLIENT{'clid'});
print "Content-Disposition: attachment; filename=ValuesThatBuildTrust.csv\n\n";
print "Strategic Alignment Survey,Section 3 - Values That Build Trust Summary,";
print "The gap between Employee Expectation and the degree to which the $xlatphrase[797] operates by these Values,";
print "$FORM{'orgname'},";
if ($FORM{'uberheader'} ne "") {
print $FORM{'uberheader'};
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Summary for Groups:,"
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})));
} else {
print "$xlatphrase[798] $xlatphrase[799]";
}
print ",".$timestamp."\n";
print "Group,Total Importance,Total Performance,Trust Values Gap\n";
print "Overall,";
printf "%.1f,", $data->{'organization'}->{'Personal Importance'};
printf "%.1f,", $data->{'organization'}->{'Work Performance'};
printf "%.1f\n", $data->{'organization'}->{'gap'};
if (exists $data->{'groups'}) {
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "$groups->{$grp}->{'grpnme'},";
printf "%.1f,", $data->{'groups'}->{$grp}->{'Personal Importance'};
printf "%.1f,", $data->{'groups'}->{$grp}->{'Work Performance'};
printf "%.1f\n", $data->{'groups'}->{$grp}->{'gap'};
}
}
}
sub KindsOfPeopleReport {
my $intl_reb_group;
my $intl_comp_group;
my $intl_dir_group;
my $intl_reb_self;
my $intl_comp_self;
my $intl_dir_self;
my $intl_reb_diff;
my $intl_comp_diff;
my $intl_dir_diff;
my ($idlist,$groups,$timestamp) = @_;
my $data = KindsOfPeopleData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
print HTMLHeaderPlain("Section 1 - Kinds of People");
print "Strategic Alignment Survey
Section 1 - Kinds of People
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
print $timestamp;
my $url;
if (exists $data->{'self'} && $data->{'self'} != {}) {
print "$xlatphrase[943]
\n";
print "";
my @self = @{$data->{'self'}}{'Rebellious','Compliant','Self-Directed'};
$url = "/cgi-bin/piechart3.5.pl?values=".
join(':',map(int($_+0.5),@self)).
"&labels=Rebellious:Compliant:Self-Directed";
print " |
\n";
print "
\n";
print "
\n";
}
if (exists $data->{'organization'}) {
print "$xlatphrase[802]
\n";
print "";
my @other = @{$data->{'organization'}}{'Rebellious','Compliant','Self-Directed'};
$url = "/cgi-bin/piechart3.5.pl?values=".
join(':',map(int(10*$_+0.5)/10,@other)).
"&labels=Rebellious:Compliant:Self-Directed";
$intl_reb_group = 11;
$intl_comp_group = 27;
$intl_dir_group = 62;
$intl_reb_self = 0;
$intl_comp_self = 6.1;
$intl_dir_self = 93.9;
$intl_reb_diff = $intl_reb_self - $intl_reb_group;
$intl_comp_diff = $intl_comp_self - $intl_comp_group;
$intl_dir_diff = $intl_dir_self - $intl_dir_group;
print " |
\n";
print "
\n";
print "
\n";
}
if (exists $data->{'self'}) {
print "\n";
print "";
print "\n";
print "Overall Self Values | Int'l Average | \n";
printf "Rebellious | %.1f %% | $intl_reb_self% | \n", $data->{'self'}->{'Rebellious'};
#printf "Rebellious | %.1f %% | - | \n", $data->{'self'}->{'Rebellious'};
printf "Compliant | %.1f %% | $intl_comp_self% | \n", $data->{'self'}->{'Compliant'};
#printf "Compliant | %.1f %% | - | \n", $data->{'self'}->{'Compliant'};
printf "Self-Directed | %.1f %% | $intl_dir_self% | \n", $data->{'self'}->{'Self-Directed'};
#printf "Self-Directed | %.1f %% | - | \n", $data->{'self'}->{'Self-Directed'};
print " \n";
print " | \n";
}
print "\n";
print "Overall Group Values | Int'l Average | \n";
printf "Rebellious | %.1f %% | $intl_reb_group% | \n", $data->{'organization'}->{'Rebellious'};
printf "Compliant | %.1f %% | $intl_comp_group% | \n", $data->{'organization'}->{'Compliant'};
printf "Self-Directed | %.1f %% | $intl_dir_group% | \n", $data->{'organization'}->{'Self-Directed'};
print " \n";
if (exists $data->{'self'}) {
print " | \n";
print "\n";
print "Self - Group Values | Int'l Average | \n";
printf "Rebellious | %.1f %% | $intl_reb_diff% | \n", $data->{'self'}->{'Rebellious'} - $data->{'organization'}->{'Rebellious'};
#printf "Rebellious | %.1f %% | - | \n", $data->{'self'}->{'Rebellious'} - $data->{'organization'}->{'Rebellious'};
printf "Compliant | %.1f %% | $intl_comp_diff% | \n", $data->{'self'}->{'Compliant'} - $data->{'organization'}->{'Compliant'};
#printf "Compliant | %.1f %% | - | \n", $data->{'self'}->{'Compliant'} - $data->{'organization'}->{'Compliant'};
printf "Self-Directed | %.1f %% | $intl_dir_diff% | \n", $data->{'self'}->{'Self-Directed'} - $data->{'organization'}->{'Self-Directed'};
#printf "Self-Directed | %.1f %% | - | \n", $data->{'self'}->{'Self-Directed'} - $data->{'organization'}->{'Self-Directed'};
print " \n";
print " |
\n";
}
if (!(exists $data->{'self'}) && !(exists $data->{'organization'})) {
print "No valid Data
\n";
}
#print "".Dumper($data)."
\n";
print HTMLFooter();
}
sub KindsOfPeopleSummary {
my $intl_reb_group = 11;
my $intl_comp_group = 27;
my $intl_dir_group = 62;
my $intl_reb_self = 0;
my $intl_comp_self = 6.1;
my $intl_dir_self = 93.9;
my $intl_reb_diff = $intl_reb_self - $intl_reb_group;
my $intl_comp_diff = $intl_comp_self - $intl_comp_group;
my $intl_dir_diff = $intl_dir_self - $intl_dir_group;
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 "Strategic Alignment Survey
Section 1 - Kinds of People Summary
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Summary for Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
print "$timestamp
";
if (exists $data->{'self'} && $data->{'self'} != {}) {
print "$xlatphrase[943]
\n";
print "\n";
print " | Rebellious | Compliant | Self-Directed |
\n";
print "Overall Self Values | ";
printf "%.1f %% | ", $data->{'self'}->{'Rebellious'};
printf "%.1f %% | ", $data->{'self'}->{'Compliant'};
printf "%.1f %% |
\n", $data->{'self'}->{'Self-Directed'};
print "International Average | $intl_reb_self% | $intl_comp_self% | $intl_dir_self% |
\n";
print "
\n";
}
print "$xlatphrase[802]
\n";
print "\n";
print " | Rebellious | Compliant | Self-Directed |
\n";
print "Overall Group Values | ";
printf "%.1f %% | ", $data->{'organization'}->{'Rebellious'};
printf "%.1f %% | ", $data->{'organization'}->{'Compliant'};
printf "%.1f %% |
\n", $data->{'organization'}->{'Self-Directed'};
if (exists $data->{'groups'}) {
print "Group Breakdown |
\n";
print "Group | Rebellious | Compliant | Self-Directed |
\n";
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "$groups->{$grp}->{'grpnme'} | ";
printf "%.1f %% | \n", $data->{'groups'}->{$grp}->{'Rebellious'};
printf "%.1f %% | \n", $data->{'groups'}->{$grp}->{'Compliant'};
printf "%.1f %% |
\n", $data->{'groups'}->{$grp}->{'Self-Directed'};
}
}
print " | Rebellious | Compliant | Self-Directed |
\n";
print "International Average | $intl_reb_group% | $intl_comp_group% | $intl_dir_group% |
\n";
print "
\n";
if (exists $data->{'self'} && $data->{'self'} != {}) {
print "
Perception Differences
\n";
print "\n";
print " | Rebellious | Compliant | Self-Directed |
\n";
print "Self - Group Values | ";
printf "%.1f %% | ", $data->{'self'}->{'Rebellious'} - $data->{'organization'}->{'Rebellious'};
printf "%.1f %% | ", $data->{'self'}->{'Compliant'} - $data->{'organization'}->{'Compliant'};
printf "%.1f %% |
\n", $data->{'self'}->{'Self-Directed'} - $data->{'organization'}->{'Self-Directed'};
print "International Average | $intl_reb_diff% | $intl_comp_diff% | $intl_dir_diff% |
\n";
print "
\n";
}
print HTMLFooter();
}
sub KindsOfPeopleCSV {
my ($idlist,$groups,$timestamp) = @_;
my $data = KindsOfPeopleData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
$groups = getGroups($CLIENT{'clid'});
print "Content-Disposition: attachment; filename=KindsOfPeople.csv\n\n";
print "Strategic Alignment Survey,Section 1 - Kinds of People Summary,$xlatphrase[802],$FORM{'orgname'},";
if ($FORM{'uberheader'} ne "") {
print $FORM{'uberheader'};
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Summary for Groups:,"
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})));
} else {
print "$xlatphrase[798] $xlatphrase[799]";
}
print ",".$timestamp."\n";
print "Group,Rebellious,Compliant,Self-Directed\n";
print "Overall,";
printf "%.1f %%,", $data->{'organization'}->{'Rebellious'};
printf "%.1f %%,", $data->{'organization'}->{'Compliant'};
printf "%.1f %%\n", $data->{'organization'}->{'Self-Directed'};
if (exists $data->{'groups'}) {
foreach my $grp (sort keys %{$data->{'groups'}}) {
print "$groups->{$grp}->{'grpnme'},";
printf "%.1f %%,", $data->{'groups'}->{$grp}->{'Rebellious'};
printf "%.1f %%,", $data->{'groups'}->{$grp}->{'Compliant'};
printf "%.1f %%\n", $data->{'groups'}->{$grp}->{'Self-Directed'};
}
}
}
sub CommentsReport {
my ($idlist, $timestamp, $bycat) = @_;
my @filelist = &get_test_result_files($testcomplete, $CLIENT{'clid'},$TEST{'id'});
my @comments;
for (my $i=0; $i<=59; $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 ($answers->[59]) {
push @{$comments[59]},$answers->[59];
}
}
print HTMLHeaderPlain("Comments Report");
print "Strategic Alignment Survey
Comments Report
\n";
print "$FORM{'orgname'}
\n";
if ($FORM{'uberheader'} ne "") {
print "".$FORM{'uberheader'}."
\n";
} elsif (defined $idlist) {
my $groups = getGroups($CLIENT{'clid'});
print "Groups: "
.join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n";
} else {
print "$xlatphrase[798] $xlatphrase[799]
\n";
}
print $timestamp;
print "\n";
print "\n";
my @outary = ();
for (my $i=1; $i <=59; $i++) {
if ($comments[$i] == -1) {
# inactive question
next;
}
$outary[$i] = "
\n";
$outary[$i] .= "$questions[$i]->[0] - $questions[$i]->[4]\n";
if (@{$comments[$i]}) {
$outary[$i] .= "
\n";
foreach (@{$comments[$i]}) {
$outary[$i] .= "- $_
\n";
}
$outary[$i] .= "
\n";
} else {
$outary[$i] .= "\n";
}
$outary[$i] .= "\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 .= "
|
\n";
$out .= "$section |
\n";
}
foreach my $sub (@line) {
my ($subheader, $quess) = split(/:/,$sub);
if ($subheader ne "") {
$out .= "
$subheader: |
\n";
}
my @ques = split(/\,/,$quess);
foreach my $quesid (@ques) {
$out .= $outary[$quesid];
}
}
}
print $out;
}
} else {
for (1 .. $#outary) {
print $outary[$_];
}
}
print "
\n";
print "
\n";
#print "".Dumper(\@questions,\@comments)."
\n";
print "".HTMLFooter();
}
sub print_test_chooser {
my @trecs = @_;
my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
my $js = "function setTest(oform,test) {\n\t".
"oform.tstid.value=test;\n\t".
"oform.submit();\n};\n";
for (0 .. $#trecs) {
my ($desc,$id) = split(/&/, $trecs[$_]);
$testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
$testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
$testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
$href="javascript:setTest(document.testform1,\'$id\')\;";
$tstoption ="
$id |
$desc |
$testscompleted |
$testsinprogress |
$testspending |
\n";
$tstoptions = join('', $tstoptions, $tstoption);
}
print HTMLHeader("Integro Learning Custom Reports", $js);
print "Please choose the survey for which you would like reports:
|
Test ID |
Description |
Cmp |
InP |
Pnd |
|
$tstoptions
|
";
print HTMLFooter();
exit();
}