#!/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 "
".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 (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 '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 "\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". "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 "

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\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" ; print "

\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(); } # 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 KindsOfPeopleReport { 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 "$xlatphrase[802]
    \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 ""; 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 "\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 "\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 %%11%
    Compliant%.1f %%27%
    Self-Directed%.1f %%62%
    \n"; } else { print "

    No valid Data

    \n"; } #print "
    ".Dumper($data)."
    \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 "
    Strategic Alignment Survey
    Section 1 - Kinds of People Summary

    \n"; print "$xlatphrase[802]
    \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'}->{'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%.1f %%%.1f %%%.1f %%
    Group Breakdown
    GroupRebelliousCompliantSelf-Directed
    $groups->{$grp}->{'grpnme'}%.1f %%%.1f %%%.1f %%
     RebelliousCompliantSelf-Directed
    International Average11%27%62%
    \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 "
    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 <=60; $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(); } # 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 "
    " ; print "Strategic Alignment Survey
    " ; # print "The percentage of employees at each level of Improvement at Ausco

    \n"; print "" ; print "Positive Changes at Ausco

    \n"; # print "    \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 (@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 "

    \n" ; print "" ; print "

    \n" ; print ""; # 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 "\n"; # Do the Description. print "\n" ; # Do the percentage. print "\n" ; # Start a row. print "\n"; # Do the Description. print "\n" ; # Do the percentage. print "\n" ; print "\n"; # Start a row. print "\n"; # Do the Description. print "\n" ; # Do the percentage. print "\n" ; print "\n"; # Start a row. print "\n"; # Do the Description. print "\n" ; # Do the percentage. print "\n" ; print "\n"; # Finish the Table and the page. print "
    Disagree\n" ; print " there have been positive changes at Ausco in the last year.\n"; print "\n" ; printf " %.1f", $values[0] ; print " %" ; print "
    Somewhat disagree\n" ; print " there have been positive changes at Ausco in the last year.\n" ; print "\n" ; printf " %.1f", $values[1] ; print " %" ; print "
    Somewhat agree\n" ; print " there have been positive changes at Ausco in the last year.\n" ; print "\n" ; printf " %.1f", $values[2] ; print " %" ; print "
    Agree\n" ; print " there have been positive changes at Ausco in the last year.\n" ; print "\n" ; printf " %.1f", $values[3] ; print " %" ; print "
    \n"; print "

    \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 "
    " ; print "Strategic Alignment Survey
    " ; print "Positive Changes at Ausco Summary

    \n"; # print "Improvement as Perceived by Employees
    \n"; # print "$FORM{'orgname'}
    \n"; if ($FORM{'uberheader'} ne "") { print "".$FORM{'uberheader'}."
    \n"; } elsif (defined $idlist) { print "Summary for Groups: " .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
    \n"; } else { print "$xlatphrase[798] $xlatphrase[799]
    \n"; } print $timestamp; print "" ; # Print HTML for heading. print "\n"; # Print First Row, Some elements span 2 rows. print "" ; print "" ; print "" ; print "" ; print "\n" ; # Print Second Row of headers. print "" ; my $i ; for ($i = 1; $i <= 6; $i ++) { print "" ; } print "\n" ; # print ""; print keys %{$sumdata} ; print "\n" ; # print ""; print keys %{$sumdata->{'Improvement'}} ; print "\n" ; # print ""; print keys %{$sumdata->{'Improvement'}->{'ScoreCount'}} ; print "\n" ; # Print row for overall values. my $total = $sumdata->{'Improvement'}->{'NoResponses'}+$sumdata->{'Improvement'}->{'Responses'} ; print ""; 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 "", $total ; # Total test takers. print "\n" ; # loop for groups. my $group ; foreach $group (sort keys %{$groups}) { $total = $grpdata->{$group}->{'Improvement'}->{'NoResponses'}+$grpdata->{$group}->{'Improvement'}->{'Responses'} ; # Total test takers. print ""; 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 "", $grpdata->{$group}->{'Improvement'}->{'NoResponses'}+$grpdata->{$group}->{'Improvement'}->{'Responses'} ; # Total test takers. print "\n" ; } print "
    GroupDisagreeSomewhat DisagreeSomewhat AgreeAgreeNo ResponseNot Here Last YearTotal
    CountPercent
    Overall%4i
    $group%4i
    \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 = "" ; my ($percent, $percent_str, $count_str) ; $count_str = sprintf("%4i", $count) ; if ($total == 0) { # total is 0, percent is undefined. $percent_str = "-   - %" ; } else { $percent = 100.0 * $count / $total ; $percent_str = sprintf("%5.1f %%", $percent) ; } # $html_str .= sprintf("%4i", $count) ; # $html_str .= "" ; # $html_str .= "" ; $html_str .= "" ; # $html_str .= "
    $html_str .= "$count_str" ; $html_str .= "$percent_str
    " ; # $html_str .= "\n" ; return $html_str ; }