#!/usr/bin/perl # # $Id: IntegroTeam.pl,v 1.13 2006/04/12 19:18:47 ddoughty Exp $ # # Source File: Integro.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); use vars qw($testcomplete $testinprog $testcomplete $testpending $cgiroot $pathsep $dataroot @rptparams); &app_initialize; $FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma. HBI &LanguageSupportInit(); &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 =~ "^TAQ") {push @tmptrecs, join('&', "$desc", "$id");} } @trecs = sort @tmptrecs; if ($#trecs > 0) { # show test chooser &print_test_chooser(@trecs); } } # 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"; } # Is this report for a specific canidate? my $cndid; #print STDERR "$FORM{'specificuser'} $FORM{'cndid'}\n"; if ($FORM{'specificuser'} and (not $idlist or $idlist->{$FORM{'cndid'}})) { $cndid = $FORM{'cndid'}; } # Generate the reports if ($FORM{'reportname'} eq 'commeffect') { &CommEffectReport($idlist, $groups, $timestamp, $cndid); } elsif ($FORM{'reportname'} eq 'commeffectsummary') { &CommEffectSummary($idlist, $groups, $timestamp); } elsif ($FORM{'reportname'} eq 'trustlevel') { &TrustLevelReport($idlist, $groups, $timestamp, $cndid); } elsif ($FORM{'reportname'} eq 'trustlevelsummary') { &TrustLevelSummary($idlist, $groups, $timestamp); } elsif ($FORM{'reportname'} eq 'comments') { &CommentsReport($idlist, $timestamp, 0); } elsif ($FORM{'reportname'} eq 'comments2') { &CommentsReport($idlist, $timestamp, 1); } else { &ReportChooser(); } # There should only be function definitions beyond this point. exit(0); sub HTMLHeader { return "\n\n$_[0]\n". "\n". "\n". "\n"; } sub HTMLHeaderPlain { return "\n\n$_[0]\n". "\n\n". "\n"; } sub HTMLFooter { my $year = `date +%Y`; return "
Copyright (c) 2004-$year, Integro Leadership Institute\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 $orgname = $CLIENT{'clnmc'}; my $uberheader; my $test; if ($FORM{'tstid'}) { $test = $FORM{'tstid'}; } elsif ($rptparams[0]) { $test = $rptparams[0]; } else { $test = "TAQ01"; } my ($tstid) = grep((/^($test\w*)&/ && ($_=$1)),get_data("tests.$CLIENT{'clid'}")); if (not $tstid) { print HTMLHeader("Error! No Team Alignment Questionnaire Found."); print "

Error! No Team Alignment Questionnaire Found.

\n"; print HTMLFooter(); } my $grplist = getGroups($CLIENT{'clid'}); my @grplist = keys(%$grplist); my $grplistlen = $#grplist + 2; $js .= "var groups = new Array($grplistlen)\;\n"; foreach my $grp (@grplist) { my $gidlist = getIdlist($CLIENT{'clid'}, $grp); my @gidklist = keys(%$gidlist); $js .= "groups[\"$grp\"] = ["; foreach my $cnd (@gidklist) { $js .= "\"$cnd\", "; } if ($#gidklist > -1) { $js = substr($js,0,-2); } $js .= "]\;\n"; $js .= "groups[\"$grp\"] = groups[\"$grp\"].sort()\;\n"; } $js .= "groups[\"all\"] = ["; my $users = get_users($CLIENT{'clid'},"$tstid"); my @users = keys(%$users); foreach my $cnd (@users) { $js .= "\"$cnd\", "; } if ($#users + 1) { $js = substr($js,0,-2); } $js .= "]\;\n"; $js .= "groups[\"all\"] = groups[\"all\"].sort()\;\n"; $js .= "function removeOptions(optionMenu) { \ var oml = optionMenu.options.length; \ for (var i=0; i < oml; i++) { \ optionMenu.remove(0); \ } \ } \ \ function addOptions(optionList, optionMenu) { \ var oml = optionMenu.options.length; \ for (var i=0; i < optionList.length; i++) { \ optionMenu[oml+i] = new Option(optionList[i], optionList[i]); \ } \ } "; $js .= "function buildGroupList(optionListArray, optionListMenu, optionMenu) {\n\t". " removeOptions(optionMenu);". " for (var i=0; i\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 "

Team Alignment Reports

All Groups

Choose Groups
\n". "

Specific User
"; print "

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

Team Trust Level Report

\n"; print "

Team Alignment Report

\n"; print "

General Reports

Comments
Comments by Category

Question Statistics

	Very Unclear		Moderately Unclear		Moderately Clear		Very Clear	Team Clarity	Team Approval
$row	"; if ($histograms->{$row}->{'Clarity'}->[$i]) { if ($histograms->{$row}->{'Approval'}->[$i]->[2]) { my $img = "/graphic/face-smile.gif"; if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[2]) { $img = "/graphic/face-smile-green.gif"; } print "_{$histograms->{$row}->{'Approval'}->[$i]->[2]} "; } if ($histograms->{$row}->{'Approval'}->[$i]->[1]) { my $img = "/graphic/face-red.gif"; if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[1]) { $img = "/graphic/face-red-green.gif"; } print "_{$histograms->{$row}->{'Approval'}->[$i]->[1]} "; } if ($histograms->{$row}->{'Approval'}->[$i]->[0]) { my $img = "/graphic/face-blue.gif"; if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[0]) { $img = "/graphic/face-blue-green.gif"; } print "_{$histograms->{$row}->{'Approval'}->[$i]->[0]}"; } } else { print " "; } print "	%.1f %%	%.1f %%

**Overall Team Alignment**
Clarity	%.1f %%
Approval	%.1f %%

	Clarity	Approval
Overall	%.1f %%	%.1f %%
Group Breakdown
Group	Clarity	Approval
$groups->{$grp}->{'grpnme'}	%.1f %%	%.1f %%

		Team Trust Level
$row		%.1f%%

Team Alignment Questionnaire
Team Alignment Report
$CANDIDATE{'sal'} $CANDIDATE{'nmf'} $CANDIDATE{'nmm'} $CANDIDATE{'nml'}
\n"; print "The Degree to which Team 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 "Organization-wide Report
\n"; print "
\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'}; print "\n"; } print "
Very Unclear Moderately Unclear Moderately Clear Very Clear Team Clarity Team Approval
$row "; if ($histograms->{$row}->{'Clarity'}->[$i]) { if ($histograms->{$row}->{'Approval'}->[$i]->[2]) { my $img = "/graphic/face-smile.gif"; if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[2]) { $img = "/graphic/face-smile-green.gif"; } print "_{$histograms->{$row}->{'Approval'}->[$i]->[2]}
"; } if ($histograms->{$row}->{'Approval'}->[$i]->[1]) { my $img = "/graphic/face-red.gif"; if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[1]) { $img = "/graphic/face-red-green.gif"; } print "_{$histograms->{$row}->{'Approval'}->[$i]->[1]}
"; } if ($histograms->{$row}->{'Approval'}->[$i]->[0]) { my $img = "/graphic/face-blue.gif"; if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[0]) { $img = "/graphic/face-blue-green.gif"; } print "_{$histograms->{$row}->{'Approval'}->[$i]->[0]}"; } } else { print " "; } print " %.1f %% %.1f %%
\n
Position = Team Clarity
\n
Countenance = Personal Approval
\n"; #print "\n"; #printf "\n", $data->{'organization'}->{'overallclarity'}; #printf "\n", $data->{'organization'}->{'overallapproval'}; #print "
Overall Team Alignment
Clarity %.1f %%
Approval %.1f %%
\n"; print HTMLFooter(); } sub CommEffectSummary { my ($idlist,$groups,$timestamp) = @_; my $data = &CommEffectData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups); $groups = getGroups($CLIENT{'clid'}); print HTMLHeaderPlain("Team Alignment Summary"); print "Team Alignment Questionnaire
Team Alignment Summary

\n"; print "The degree to which Employees are Aligned with the Organization
\n"; print "$FORM{'orgname'}
\n"; if (defined $idlist) { my $groups = getGroups($CLIENT{'clid'}); print "Summary for Groups: " .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n"; } else { #print "Organization-wide Report
\n"; print "
\n"; } print $timestamp; print "\n"; print "\n"; print ""; printf "",$data->{'organization'}->{'overallclarity'}; printf "\n", $data->{'organization'}->{'overallapproval'}; if (exists $data->{'groups'}) { print "\n"; print "\n"; foreach my $grp (sort keys %{$data->{'groups'}}) { print ""; printf "", $data->{'groups'}->{$grp}->{'overallclarity'}; printf "\n", $data->{'groups'}->{$grp}->{'overallapproval'}; } } print "
Clarity Approval
Overall %.1f %% %.1f %%
Group Breakdown
Group Clarity Approval
$groups->{$grp}->{'grpnme'} %.1f %% %.1f %%
\n"; print HTMLFooter(); } sub TrustLevelReport { my ($idlist,$groups,$timestamp,$cndid) = @_; my $data = &TrustLevelData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups); my $user; if ($cndid) {$user = &TrustLevelData($CLIENT{'clid'},$TEST{'id'},{$cndid => 1},$groups);&get_candidate_profile($CLIENT{'clid'},$cndid);} my $histograms = $data->{'organization'}->{'histogram'}; my $trust = $data->{'organization'}->{'trust'}; print HTMLHeaderPlain("Team Trust Level Report"); print "Team Alignment Questionnaire
Team Trust Level Report
$CANDIDATE{'sal'} $CANDIDATE{'nmf'} $CANDIDATE{'nmm'} $CANDIDATE{'nml'}
\n"; print "The level of Trust Building behaviors
\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 "Organization-wide Report
\n"; print "
\n"; } print $timestamp; print "\n"; my $baseurl; if (defined($ENV{'SSL_PROTOCOL'})) { $baseurl = "https://"; } else { $baseurl = "http://"; } $baseurl .= $ENV{'HTTP_HOST'}; $baseurl .= "/cgi-bin/bargraph.pl?labels=Low::::Medium::::High&title=Trust%20Level&ylabel=Respondents"; $baseurl .= "&xdim=500&ydim=150"; foreach my $row (qw(Congruence Openness Acceptance Reliability)) { my $url; if (not $user) { $url = "$baseurl&values=".join(":",@{$histograms->{$row}}); } else { my (@values,@values2); for (my $i=0; $i < @{$histograms->{$row}}; $i++) { if ($user->{'organization'}->{'histogram'}->{$row}->[$i]) { push @values ,''; push @values2 , $histograms->{$row}->[$i]; } else { push @values2 ,''; push @values , $histograms->{$row}->[$i]; } } $url = "$baseurl&values=".join(":",@values)."&values2=".join(":",@values2); } print ""; print ""; printf "\n", $trust->{$row}->{'value'}; } print "
Team Trust Level
$row %.1f%%
\n"; #printf "

Overall Team Level of Trust = %.1f %%.

	Team Trust Level
Overall	%.1f %%
Group Breakdown
Group	Team Trust Level
$groups->{$grp}->{'grpnme'}	%.1f %%

\n",$data->{'organization'}->{'overalltrust'}; print HTMLFooter(); } sub TrustLevelSummary { my ($idlist,$groups,$timestamp) = @_; my $data = TrustLevelData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups); $groups = getGroups($CLIENT{'clid'}); print HTMLHeaderPlain("Team Trust Level Summary"); print "Team Alignment Questionnaire
Team Trust Level Summary

\n"; print "The level of Trust Building behaviors
\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 "Organization-wide Summary
\n"; print "
\n"; } print $timestamp; print "\n"; print "\n"; print ""; printf "\n", $data->{'organization'}->{'overalltrust'}; if (exists $data->{'groups'}) { print "\n"; print "\n"; foreach my $grp (sort keys %{$data->{'groups'}}) { print ""; printf "\n", $data->{'groups'}->{$grp}->{'overalltrust'}; } } print "
Team Trust Level
Overall %.1f %%
Group Breakdown
Group Team Trust Level
$groups->{$grp}->{'grpnme'} %.1f %%
\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<=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 "Team Alignment Questionnaire
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 "Organization-wide Report
\n"; print "
\n"; } print $timestamp; print "\n"; print "

\n"; my @outary = (); for (my $i=1; $i <=40; $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,"IntegroTAQ.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(); }