#!/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'}); # Populate $CLIENT{} if ($FORM{'tstid'}) { &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); # Populate $TEST{} } 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 'diversity') { &diversityReport($idlist, $groups, $timestamp); } elsif ($FORM{'reportname'} eq 'diversitysummary') { &diversitySummary($idlist, $groups, $timestamp); } elsif ($FORM{'reportname'} eq 'diversitycsv') { &diversityCSV($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 "
\n"; print "\n"; # For development purposes we hardcode the survey id. # Fix this before production print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n\n\n". "\n". "\n"; print "\n"; print ""; print "
Integro Learning Custom Reports
All GroupsChoose Groups
\n". "\n"; #print "
$xlatphrase[797] $xlatphrase[279]:
\n"; print "
Organization Name:
Header Override:
Time Stamp:
    ". "
  • Most Recent Survey Taken
    • ". "
  • Current Time
    • ". "
  • Custom Value: ". "
\n"; print "
\n"; #print "Display reports as PDF\n"; print "

Section 1

\n"; print "

Section 2

\n"; print "

Section 3

\n"; print "

Section 4

\n"; print "

Section 5

\n"; print "

General Reports

  • Comments
    • "; print "
  • Comments by Category
    • "; print "\n"; print "\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 "
  • Question Statistics

    • \n"; 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 "". "". "". "". "". "\n"; # fill in the rows my $overall = {'clarity' => 0, 'approval' => 0}; foreach my $row (qw(Purpose Values Vision Goals Procedures Roles)) { print ""; for my $i (0..6) { print ""; } printf "\n", $claritysum->{$row}->{'value'}; printf "\n", $approvalsum->{$row}->{'value'}; printf "\n", $intlc{$row}; printf "\n", $intla{$row}; print "\n"; } print "
        Very Unclear    Moderately Unclear    Moderately Clear    Very ClearGroup ClarityGroup ApprovalInt'l ClarityInt'l Approval
    $row"; 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 "    		%.1f %%%.1f %%%.1f %%%.1f %%
    \n

    Position = Group Clarity

    \n

    Countenance = 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 ""; } print "\n"; print "\n\n"; foreach my $col (@cols) { print ""; } print "\n"; print ""; foreach my $col (@cols) { printf "", $data->{'organization'}->{'claritysum'}->{$col}->{'value'}; printf "", $data->{'organization'}->{'approvalsum'}->{$col}->{'value'}; } if (exists $data->{'groups'}) { print "\n"; print ""; foreach my $col (@cols) { print ""; } print "\n"; foreach my $grp (sort keys %{$data->{'groups'}}) { print ""; foreach my $col (@cols) { printf "", $data->{'groups'}->{$grp}->{'claritysum'}->{$col}->{'value'}; printf "", $data->{'groups'}->{$grp}->{'approvalsum'}->{$col}->{'value'}; } print "\n"; } } print "\n\n"; foreach my $col (@cols) { print ""; } print "\n"; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print "\n"; print "
     $col
     ClarityApproval
    Overall%.1f %%%.1f %%
    Group Breakdown
    Group$col
    $groups->{$grp}->{'grpnme'}%.1f %%%.1f %%
    International
    Average    		$col
    86%88%77%86%72%78%79%85%78%71%84%70%
    \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 "\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 ""; print ""; printf "\n", $trust->{$row}->{'value'}; printf "\n", $intl{$row}; } print "
      Group Trust LevelInt'l Average
    $row{$row}})."\">%.1f%% %.1f%%
    \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 ""; } print "\n"; print ""; foreach my $col (@cols) { printf "", $data->{'organization'}->{'trust'}->{$col}->{'value'}; } print "\n"; if (exists $data->{'groups'}) { print "\n"; print ""; foreach my $col (@cols) { print ""; } print "\n"; foreach my $grp (sort keys %{$data->{'groups'}}) { print ""; foreach my $col (@cols) { printf "", $data->{'groups'}->{$grp}->{'trust'}->{$col}->{'value'}; } } print "\n"; } print "\n\n"; foreach my $col (@cols) { print ""; } print "\n"; print ""; print ""; print ""; print ""; print ""; print "\n"; print "
     "; foreach my $col (@cols) { print "$col
    Overall%.1f %%
    Group Breakdown
    Group$col
    $groups->{$grp}->{'grpnme'}%.1f %%
    International
    Average    		$col
    66%69%73%79%
    \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 "\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 "\n"; } print ""; printf "", $data->{'organization'}->{'gap'}; print "\n"; print "
     GapInt'l
    Avg
    $_
    $diff$intl{$_}
    Total Trust Values Gap%.1f13.8
    \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 "\n"; print ""; printf "", $data->{'organization'}->{'Personal Importance'}; printf "", $data->{'organization'}->{'Work Performance'}; printf "\n", $data->{'organization'}->{'gap'}; if (exists $data->{'groups'}) { print "\n"; print "\n"; foreach my $grp (sort keys %{$data->{'groups'}}) { print ""; printf "", $data->{'groups'}->{$grp}->{'Personal Importance'}; printf "", $data->{'groups'}->{$grp}->{'Work Performance'}; printf "\n", $data->{'groups'}->{$grp}->{'gap'}; } } print "\n"; print ""; printf "", 74.6; printf "", 60.8; printf "\n", 13.8; print "
     Total ImportanceTotal PerformanceTrust Values Gap
    Overall%.1f%.1f%.1f
    Group Breakdown
    GroupTotal ImportanceTotal PerformanceTrust Values Gap
    $groups->{$grp}->{'grpnme'}%.1f%.1f%.1f
     Total ImportanceTotal PerformanceTrust Values Gap
    International Average%.1f%.1f%.1f
    \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'}; } } } # HBIHBI # Aka Gap Analysis sub diversityReport { my ($idlist,$groups,$timestamp) = @_; my $data = &diversityData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups); print HTMLHeaderPlain("Section 5 - Values for Diversity"); print "
    Strategic Alignment Survey
    Section 5 - Values for Diversity

    \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 five values."; print "\n"; my $baseurl = "/cgi-bin/bargraph.pl?labels=Personal%20Importance:Work%20Performance". "&xdim=500&ydim=60&hbar=1&ymax=11&ymin=0&yticknum=11&colorscheme=1"; my %intl; $intl{'Respectfulness'} = "Undef"; $intl{'Speaking Up'} = "Undef"; $intl{'Divergent Thinking'} = "Undef"; $intl{'Freedom from Harassment'} = "Undef"; $intl{'Fairness of Decisions'} = "Undef"; foreach ('Respectfulness', 'Speaking Up', 'Divergent Thinking', 'Freedom from Harassment', 'Fairness of Decisions') { 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 "\n"; } print ""; printf "", $data->{'organization'}->{'gap'}; print "\n"; print "
     GapInt'l
    Avg
    $_
    $diff$intl{$_}
    Total Trust Values Gap%.1f13.8
    \n"; print HTMLFooter(); } sub diversitySummary { my ($idlist,$groups,$timestamp) = @_; my $data = &diversityData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups); $groups = getGroups($CLIENT{'clid'}); print HTMLHeaderPlain("Section 5 - Values for Diversity"); print "

    Strategic Alignment Survey
    Section 5 - Values for Diversity

    \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 "\n"; print ""; printf "", $data->{'organization'}->{'Personal Importance'}; printf "", $data->{'organization'}->{'Work Performance'}; printf "\n", $data->{'organization'}->{'gap'}; if (exists $data->{'groups'}) { print "\n"; print "\n"; foreach my $grp (sort keys %{$data->{'groups'}}) { print ""; printf "", $data->{'groups'}->{$grp}->{'Personal Importance'}; printf "", $data->{'groups'}->{$grp}->{'Work Performance'}; printf "\n", $data->{'groups'}->{$grp}->{'gap'}; } } print "\n"; print ""; printf "", 74.6; printf "", 60.8; printf "\n", 13.8; print "
     Total ImportanceTotal PerformanceTrust Values Gap
    Overall%.1f%.1f%.1f
    Group Breakdown
    GroupTotal ImportanceTotal PerformanceTrust Values Gap
    $groups->{$grp}->{'grpnme'}%.1f%.1f%.1f
     Total ImportanceTotal PerformanceTrust Values Gap
    International Average%.1f%.1f%.1f
    \n"; print HTMLFooter(); } sub diversityCSV { my ($idlist,$groups,$timestamp) = @_; my $data = &diversityData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups); $groups = getGroups($CLIENT{'clid'}); print "Content-Disposition: attachment; filename=ValuesThatBuildTrust.csv\n\n"; print "Strategic Alignment Survey,Section 5 - Values for Diversity,"; 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 "\n"; printf "\n", $data->{'self'}->{'Rebellious'}; #printf "\n", $data->{'self'}->{'Rebellious'}; printf "\n", $data->{'self'}->{'Compliant'}; #printf "\n", $data->{'self'}->{'Compliant'}; printf "\n", $data->{'self'}->{'Self-Directed'}; #printf "\n", $data->{'self'}->{'Self-Directed'}; print "
    Overall Self ValuesInt'l Average
    Rebellious%.1f %%$intl_reb_self%
    Rebellious%.1f %%-
    Compliant%.1f %%$intl_comp_self%
    Compliant%.1f %%-
    Self-Directed%.1f %%$intl_dir_self%
    Self-Directed%.1f %%-
    \n"; print "    		\n"; } print "\n"; print "\n"; printf "\n", $data->{'organization'}->{'Rebellious'}; printf "\n", $data->{'organization'}->{'Compliant'}; printf "\n", $data->{'organization'}->{'Self-Directed'}; print "
    Overall Group ValuesInt'l Average
    Rebellious%.1f %%$intl_reb_group%
    Compliant%.1f %%$intl_comp_group%
    Self-Directed%.1f %%$intl_dir_group%
    \n"; if (exists $data->{'self'}) { print "    		\n"; print "\n"; print "\n"; printf "\n", $data->{'self'}->{'Rebellious'} - $data->{'organization'}->{'Rebellious'}; #printf "\n", $data->{'self'}->{'Rebellious'} - $data->{'organization'}->{'Rebellious'}; printf "\n", $data->{'self'}->{'Compliant'} - $data->{'organization'}->{'Compliant'}; #printf "\n", $data->{'self'}->{'Compliant'} - $data->{'organization'}->{'Compliant'}; printf "\n", $data->{'self'}->{'Self-Directed'} - $data->{'organization'}->{'Self-Directed'}; #printf "\n", $data->{'self'}->{'Self-Directed'} - $data->{'organization'}->{'Self-Directed'}; print "
    Self - Group ValuesInt'l Average
    Rebellious%.1f %%$intl_reb_diff%
    Rebellious%.1f %%-
    Compliant%.1f %%$intl_comp_diff%
    Compliant%.1f %%-
    Self-Directed%.1f %%$intl_dir_diff%
    Self-Directed%.1f %%-
    \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 "\n"; print ""; printf "", $data->{'self'}->{'Rebellious'}; printf "", $data->{'self'}->{'Compliant'}; printf "\n", $data->{'self'}->{'Self-Directed'}; print "\n"; print "
     RebelliousCompliantSelf-Directed
    Overall Self Values%.1f %%%.1f %%%.1f %%
    International Average$intl_reb_self%$intl_comp_self%$intl_dir_self%


    \n"; } print "$xlatphrase[802]
    \n"; print "\n"; print "\n"; print ""; printf "", $data->{'organization'}->{'Rebellious'}; printf "", $data->{'organization'}->{'Compliant'}; printf "\n", $data->{'organization'}->{'Self-Directed'}; if (exists $data->{'groups'}) { print "\n"; print "\n"; foreach my $grp (sort keys %{$data->{'groups'}}) { print ""; printf "\n", $data->{'groups'}->{$grp}->{'Rebellious'}; printf "\n", $data->{'groups'}->{$grp}->{'Compliant'}; printf "\n", $data->{'groups'}->{$grp}->{'Self-Directed'}; } } print "\n"; print "\n"; print "
     RebelliousCompliantSelf-Directed
    Overall Group Values%.1f %%%.1f %%%.1f %%
    Group Breakdown
    GroupRebelliousCompliantSelf-Directed
    $groups->{$grp}->{'grpnme'}%.1f %%%.1f %%%.1f %%
     RebelliousCompliantSelf-Directed
    International Average$intl_reb_group%$intl_comp_group%$intl_dir_group%
    \n"; if (exists $data->{'self'} && $data->{'self'} != {}) { print "

    Perception Differences
    \n"; print "\n"; print "\n"; print ""; printf "", $data->{'self'}->{'Rebellious'} - $data->{'organization'}->{'Rebellious'}; printf "", $data->{'self'}->{'Compliant'} - $data->{'organization'}->{'Compliant'}; printf "\n", $data->{'self'}->{'Self-Directed'} - $data->{'organization'}->{'Self-Directed'}; print "\n"; print "
     RebelliousCompliantSelf-Directed
    Self - Group Values%.1f %%%.1f %%%.1f %%
    International Average$intl_reb_diff%$intl_comp_diff%$intl_dir_diff%


    \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] .= "
    • No Comments
    \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:
    $tstoptions
    Test ID Description Cmp InP Pnd
    "; print HTMLFooter(); exit(); }