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 "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 | |||
|---|---|---|---|---|---|---|---|---|---|---|---|
| $row | "; - for my $i (0..6) { - print "";
- if ($histograms->{$row}->{'Clarity'}->[$i]) {
- if ($histograms->{$row}->{'Approval'}->[$i]->[2]) {
- print "![](\"/graphic/face-smile.gif\") ".
- "$histograms->{$row}->{'Approval'}->[$i]->[2]"; - } - if ($histograms->{$row}->{'Approval'}->[$i]->[1]) { - print " ![](\"/graphic/face-red.gif\") ".
- "$histograms->{$row}->{'Approval'}->[$i]->[1]"; - } - if ($histograms->{$row}->{'Approval'}->[$i]->[0]) { - print " ![](\"/graphic/face-blue.gif\") ".
- "$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 "
Position = 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 "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"; - foreach my $col (@cols) { - print " | $col | "; - } - print "|||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| \n"; - foreach my $col (@cols) { - print " | Clarity | Approval | "; - } - 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 | ||||||||||||
| Group | "; - foreach my $col (@cols) { - print "$col | "; - } - 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 "||||||||||
| International Average | \n";
- foreach my $col (@cols) {
- print "$col | "; - } - 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 "|
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 | ||
|---|---|---|---|
| $row | "; - print "%.1f%% | \n", $trust->{$row}->{'value'}; - printf "%.1f%% |
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 "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 "
| "; - foreach my $col (@cols) { - print " | $col | "; - } - print "|||
|---|---|---|---|---|
| Overall | "; - foreach my $col (@cols) { - printf "%.1f %% | ", $data->{'organization'}->{'trust'}->{$col}->{'value'}; - } - print "|||
| Group Breakdown | ||||
| Group | "; - foreach my $col (@cols) { - print "$col | "; - } - print "|||
| $groups->{$grp}->{'grpnme'} | "; - foreach my $col (@cols) { - printf "%.1f %% | ", $data->{'groups'}->{$grp}->{'trust'}->{$col}->{'value'}; - } - } - print "|||
| International Average | \n";
- foreach my $col (@cols) {
- print "$col | "; - } - print "|||
| 66% | "; - print "69% | "; - print "73% | "; - print "79% | "; - print "|
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 "The graphs below show the Personal Importance and Perceptions of Work Performance".
- " for each of the eight values.";
- 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 " Gap Int'l
Avg$_ $diff $intl{$_} Total Trust Values Gap ";
- printf "%.1f ", $data->{'organization'}->{'gap'};
- print "13.8
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 "
| Total Importance | Total Performance | Trust Values Gap | |
|---|---|---|---|
| Overall | "; - printf "%.1f | ", $data->{'organization'}->{'Personal Importance'}; - printf "%.1f | ", $data->{'organization'}->{'Work Performance'}; - printf "%.1f |
| Group Breakdown | |||
| Group | Total Importance | Total Performance | Trust Values Gap |
| $groups->{$grp}->{'grpnme'} | "; - printf "%.1f | ", $data->{'groups'}->{$grp}->{'Personal Importance'}; - printf "%.1f | ", $data->{'groups'}->{$grp}->{'Work Performance'}; - printf "%.1f |
| Total Importance | Total Performance | Trust Values Gap | |
| International Average | "; - printf "%.1f | ", 74.6; - printf "%.1f | ", 60.8; - printf "%.1f |
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 "
| Overall Group Values | Int'l Average | |
| Rebellious | %.1f %% | 11% |
|---|---|---|
| Compliant | %.1f %% | 27% |
| Self-Directed | %.1f %% | 62% |
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 "
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 "
| Rebellious | Compliant | Self-Directed | |
|---|---|---|---|
| Overall | "; - printf "%.1f %% | ", $data->{'organization'}->{'Rebellious'}; - printf "%.1f %% | ", $data->{'organization'}->{'Compliant'}; - printf "%.1f %% |
| Group Breakdown | |||
| Group | Rebellious | Compliant | Self-Directed |
| $groups->{$grp}->{'grpnme'} | "; - printf "%.1f %% | \n", $data->{'groups'}->{$grp}->{'Rebellious'}; - printf "%.1f %% | \n", $data->{'groups'}->{$grp}->{'Compliant'}; - printf "%.1f %% |
| Rebellious | Compliant | Self-Directed | |
| International Average | 11% | 27% | 62% |
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"; - - my @outary = (); - for (my $i=1; $i <=60; $i++) { - if ($comments[$i] == -1) { - # inactive question - next; - } - $outary[$i] = "\n"; - #print "
\n"; - $outary[$i] .= "$questions[$i]->[0] - $questions[$i]->[4]\n"; - if (@{$comments[$i]}) { - $outary[$i] .= "
\n"; - foreach (@{$comments[$i]}) { - $outary[$i] .= "
\n"; - } else { - $outary[$i] .= "- $_
\n"; - } - $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 .= "
- No Comments
\n"; - $out .= " \n"; - } - foreach my $sub (@line) { - my ($subheader, $quess) = split(/:/,$sub); - if ($subheader ne "") { - $out .= " $section \n"; - } - my @ques = split(/\,/,$quess); - foreach my $quesid (@ques) { - $out .= $outary[$quesid]; - } - } - } - print $out; - } - } else { - for (1 .. $#outary) { - print $outary[$_]; - } - } - - print " $subheader:
\n"; - print "
".Dumper(\@questions,\@comments)."\n"; - print "
" ; - # 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 "
\n" ; - print "
| Disagree\n" ; - print " there have been positive changes at Ausco in the last year.\n"; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[0] ; - print " %" ; - print " | \n" ; - # Start a row. - print "
| Somewhat disagree\n" ; - print " there have been positive changes at Ausco in the last year.\n" ; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[1] ; - print " %" ; - print " | \n" ; - print "
| Somewhat agree\n" ; - print " there have been positive changes at Ausco in the last year.\n" ; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[2] ; - print " %" ; - print " | \n" ; - print "
| Agree\n" ; - print " there have been positive changes at Ausco in the last year.\n" ; - print " | \n" ; - # Do the percentage. - 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 "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 "
| Group | Disagree | Somewhat Disagree | " ; - print "Somewhat Agree | Agree | No Response | " ; - print "Not Here Last Year | Total | " ; - print "
|---|---|---|---|---|---|---|---|
| Count | Percent | " ; } - print "||||||
| Overall | "; - 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 "%4i | ", $total ; # Total test takers. - print "||||||
| $group | "; - 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 "%4i | ", $grpdata->{$group}->{'Improvement'}->{'NoResponses'}+$grpdata->{$group}->{'Improvement'}->{'Responses'} ; # Total test takers. - print "
| - $html_str .= "$count_str | " ; - $html_str .= "" ; - $html_str .= "$percent_str | " ; - # $html_str .= "
".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 'PassionPeopleGroups') { # Section 1 - &PassionPeopleGroups($idlist, $groups, $timestamp); -} elsif ($FORM{'reportname'} eq 'PassionPeopleSummary') { # Section 1 - &PassionPeopleSummary($timestamp); -} elsif ($FORM{'reportname'} eq 'PassionIndexGroups') { # Section 2 - &PassionIndexGroups($idlist, $groups, $timestamp); -# } elsif ($FORM{'reportname'} eq 'PassionVertGroups') { # Section 2 -# &PassionVertGroups($idlist, $groups, $timestamp); -} elsif ($FORM{'reportname'} eq 'PassionIndexSummary') { # Section 2 - &PassionIndexSummary($timestamp); -} elsif ($FORM{'reportname'} eq 'values') { # Section 3 - &ValuesReport($idlist, $groups, $timestamp); -} elsif ($FORM{'reportname'} eq 'valuessummary') { # Section 3 - &ValuesSummary($idlist, $groups, $timestamp); -} elsif ($FORM{'reportname'} eq 'valuescsv') { # Section 3 - &ValuesCSV($idlist, $groups, $timestamp); -} elsif ($FORM{'reportname'} eq 'comments') { # General Reports - &CommentsReport($idlist, $timestamp, 0); -# Disable because there are comments on only one question. -# } elsif ($FORM{'reportname'} eq 'comments2') { # General Reports -# &CommentsReport($idlist, $timestamp, 1); -} else { - &ReportChooser(); -} - -# There should only be function definitions beyond this point. -exit(0); - - -sub grepa { - # Parms - # (\@boola, \@data) - # Returned value. - # Array of the @data array with a cooresponding value of @boola that is true. - my (@reta, $bool, $data, $index) ; - ($bool, $data) = @_ ; - for ($index=0; $index<=$#$data ; $index++) { - push @reta, $$data[$index] if ($$bool[$index]) ; - } - return @reta ; -} - -sub HTMLHeader { - return "\n\n
Error! No Employee Passion 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(); -} - -# The original request was for a pie chart of all -# of the answers on the last question, number 37. I wrote the survey, -# so question 37 is a Likert Scale question that uses a value of -# "Employee Passion" for its super category. This function generates the -# report on the Employee Passion 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 PassionPeopleGroups { - 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" ; - my $data ; - my $data = &GetLikertData($CLIENT{'clid'},$TEST{'id'},$idlist); - my %Categories = () ; my $resp ; - # Keith said he wanted to ignore the data for non-responding candidates. - # $Categories{'NoResponse'} = $$data{'Employee Passion'}->{'NoResponses'} ; - my $mystery = $data->{'Employee Passion'}->{'ScoreCount'} ; # Should be a reference to a hash. - # warn "Mystery Keys " . join(" ", keys %$mystery) . " . " ; - foreach $resp ( keys %$mystery ) { - # each response score. - $Categories{$resp} = $data->{'Employee Passion'}->{'ScoreCount'}->{$resp} ; - } - print HTMLHeaderPlain("Section 1 - Employee Passion"); - print "" ; - print "The percentage of employees at each level of Passion
\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"; - } - - my (@values , @Labels , $url, $mykey, @scores, $total) ; - $total = 0 ; - # @Labels = sort keys %Categories ; - @Labels = ("Level 5 - Job and Org", "Level 4 - Job", "Level 3 - Org", - "Level 2 - Conscientious", "Level 1 - Disconnected") ; - foreach $mykey (sort keys %Categories) { - 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=700&ydim=200" . - "&labels=" . join(":",@Labels) ; - # "&xdim=200&ydim=100&nolegend=1" ; - print "
\n" ; - print "
\n" ; - print "
| Level 5 - Passionate about the job and the organization:\n" ; - print " Employees at level 5 are passionate about their work and the organization they work for.\n"; - print " They feel valued and respected and know that what they do makes a real difference." ; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[0] ; - print " %" ; - print " | \n" ; - # Start a row. - print "
| Level 4 - Passionate only about the job:\n" ; - print " Level 4 employees are passionate about their work " ; - print "and get great satisfaction from knowing they make a difference.\n"; - print " However they feel somewhat disengaged from the organization - " ; - print "they don't feel their contribution is valued." ; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[1] ; - print " %" ; - print " | \n" ; - print "
| Level 3 - Passionate only about the organization:\n" ; - print " Employees at this level are passionate about the organization " ; - print "and believe it delivers real value.\n " ; - print " But they find their work unrewarding - it's just a job." ; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[2] ; - print " %" ; - print " | \n" ; - print "
| Level 2 - Not Passionate, but still conscientious:\n" ; - print " Employees at level 2 are not passionate about the work " ; - print "they do, but are still conscientious about doing a good job. " ; - print "However they feel disconnected from the organization " ; - print "and what it stands for." ; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[3] ; - print " %" ; - print " | \n" ; - print "
| Level 1 - Disconnected from the job and the organization:\n" ; - print " Level 1 employees feel really disconnected from both the work they do " ; - print "and their organization. If they could find another job, " ; - print "they would take it." ; - print " | \n" ; - # Do the percentage. - print "\n" ; - printf " %.1f", $values[4] ; - print " %" ; - print " | \n" ; - print "
\n"; - print HTMLFooter(); -} - -# The request is for a pie chart on the People Passion question, -# on the Employee Passion Survey (id passion). The original request was for a pie chart of all -# of the answers on the last question, number 37. I wrote the survey, -# so question 37 is a Likert Scale question that uses a value of -# "Employee Passion" for its super category. This function generates the -# report on the Employee Passion super category regardless of the -# question number. -sub PassionPeopleSummary { - my ($timestamp) = @_; - # warn "timestamp $timestamp .\n" ; - # warn "Client $CLIENT{'clid'} .\n" ; - # warn "Test Id $TEST{'id'} .\n" ; - my $grp_data = getGroups($CLIENT{'clid'}) ; - my %id_grp = () ; # Hash of candidate ids, and groups. - # warn "Do GROUPS" ; - foreach my $grp_id (sort keys %{$grp_data}) { - # warn "Do grp_id $grp_id" ; - my $can_ids = $grp_data->{$grp_id}->{'grplist'} ; - foreach my $id (@$can_ids) { - if ($id_grp{$id}) { - # Candidate id already has a group id. - warn "Candidate id $id is in two groups $id_grp{$id} and $grp_id" ; - } else { - # Candidate id can be assigned. - $id_grp{$id} = $grp_id ; - # warn "GRP MEMBER $id GRP $grp_id" ; - } - } - } - my $data ; my $data_grp ; - ($data, $data_grp) = &GetLikertGrpData($CLIENT{'clid'},$TEST{'id'}, \%id_grp); - my %Categories = () ; my $resp ; - $Categories{'NoResponse'} = $$data{'Employee Passion'}->{'NoResponses'} ; - my $mystery = $data->{'Employee Passion'}->{'ScoreCount'} ; # Should be a reference to a hash. - # warn "Mystery Keys " . join(" ", keys %$mystery) . " . " ; - foreach $resp ( keys %$mystery ) { - # each response score. - $Categories{$resp} = $data->{'Employee Passion'}->{'ScoreCount'}->{$resp} ; - } - print HTMLHeaderPlain("Section 1 - Employee Passion Summary"); - print "
\n"; - print "The percentage of employees at each level of passion.
\n"; - print "Integro Leadership Institute
\n"; - # print "$FORM{'orgname'}
\n"; - print "
\n" ; - print "
| " ; - print " | Level 5 | " ; - print "Level 4 | " ; - print "Level 3 | " ; - print "Level 2 | " ; - print "Level 1 | " ; - print "
|---|---|---|---|---|---|
| Overall | " ; - my $total = 0 ; my $percent ; - foreach $mykey (@Labels) { - $total += $Categories{$mykey} ; - } - foreach $mykey (@Labels) { - if ($total) { - # Compute percent - $percent = 100 * $Categories{$mykey} / $total ; - } else { - # $total is zero. Use 0% for all values. - $percent = 0 ; - } - printf "%.1f % | ", $percent ; - } - print "||||
| Group Breakdown | |||||
| Group | " ; - print "Level 5 | " ; - print "Level 4 | " ; - print "Level 3 | " ; - print "Level 2 | " ; - print "Level 1 | " ; - print "
| $group_name | " ; - foreach $mykey (@Labels) { - if ($total) { - # Compute percent - $percent = 100 * $data_grp->{$grp_id}->{'Employee Passion'}->{'ScoreCount'}->{$mykey} / $total ; - } else { - # $total is zero. Use 0% for all values. - $percent = 0 ; - } - printf "%.1f % | ", $percent ; - } - print "
\n"; - print HTMLFooter(); -} - -# The request is for a bar chart on the Passion index, -# on the Employee Passion Survey (id passion). -# They want bar charts comparing the desire of the -# employees for a goal, vs. the Organizations ability -# to deliver that goal, and a summary gap number. -sub OldPassionIndexGroups { - my ($idlist,$groups,$timestamp) = @_; - my @Goals = ("Need to be Respected" , "Learn and Grow" , "Need to be an Insider" , - "Need for Meaning" , "Winning Team" ) ; - my @GoalSuffixes = ("Me" , "Org.") ; - my $data ; - $data = &GetLikertData($CLIENT{'clid'},$TEST{'id'},$idlist); - # Compute the Summary gap number. - # It is the average of the gaps for each Goal. - my $url; - my $Gap = 0 ; - my $goal ; - foreach $goal (@Goals) { - my $pigoal = $goal . " " . $GoalSuffixes[0] ; - my $wpgoal = $goal . " " . $GoalSuffixes[1] ; - my $piavail = $data->{$pigoal}->{'PointsAvail'} ; - my $piscore = $data->{$pigoal}->{'PointsEarned'} ; - my $piaver = $piavail ? ($piscore/$piavail) : 0 ; - my $pinum = (int(100*$piaver + 0.5))/10 ; - my $wpavail = $data->{$wpgoal}->{'PointsAvail'} ; - my $wpscore = $data->{$wpgoal}->{'PointsEarned'} ; - my $wpaver = $wpavail ? ($wpscore/$wpavail) : 0 ; - my $wpnum = (int(100*$wpaver + 0.5))/10 ; - my $diff = $pinum - $wpnum; - $Gap += $diff ; - } - print HTMLHeaderPlain("Section 2 - Values That Build Passion"); - print "
Section 2 - Values That Build Passion
\n"; - print "The gap between Employee Passion 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",$Gap ; - print " |
\n";
- print "The graphs below show the Personal Importance and Perceptions of Work Passion".
- " for each of the values.";
- print "
\n";
- print HTMLFooter();
-}
-
-# The request is for a summary of the Passion index,
-# on the Employee Passion Survey (id passion).
-sub PassionIndexSummary {
- my ($timestamp) = @_;
- my @Goals = ("Need to be Respected" , "Learn and Grow" , "Need to be an Insider" ,
- "Need for Meaning" , "Winning Team" ) ;
- my @GoalPrefixes = ("Man", "Org") ;
- my @GoalSuffixes = ("Me" , "Org.") ;
-
- # Get Groups Data
- my $grp_data = getGroups($CLIENT{'clid'}) ;
- my %id_grp = () ; # Hash of candidate ids, and groups.
- foreach my $grp_id (sort keys %{$grp_data}) {
- my $can_ids = $grp_data->{$grp_id}->{'grplist'} ;
- foreach my $id (@$can_ids) {
- if ($id_grp{$id}) {
- # Candidate id already has a group id.
- warn "Candidate id $id is in two groups $id_grp{$id} and $grp_id" ;
- } else {
- # Candidate id can be assigned.
- $id_grp{$id} = $grp_id ;
- }
- }
- }
-
- my ($data, $data_grp) = &GetLikertGrpData($CLIENT{'clid'},$TEST{'id'}, \%id_grp);
- my $goal ; my $Gap = 0 ; my $pre_goal ; my %Summ= () ;
- my $TotalImp = 0 ; my $TotalSat = 0 ; my $TotalGap = 0 ;
- my $ImpAvail = 0 ; my $SatAvail = 0 ;
- my $ImpScore = 0 ; my $SatScore = 0 ;
- my $piaver ;
- my $pinum ;
- my $wpaver ;
- my $wpnum ;
- foreach $pre_goal(@GoalPrefixes) {
- foreach $goal (@Goals) {
- $ImpAvail = 0 ; $SatAvail = 0 ;
- $ImpScore = 0 ; $SatScore = 0 ;
- my $pigoal = join(" ", $pre_goal, $goal, $GoalSuffixes[0]) ;
- my $wpgoal = join(" ", $pre_goal, $goal, $GoalSuffixes[1]) ;
- $ImpAvail = $data->{$pigoal}->{'PointsAvail'} ;
- $ImpScore = $data->{$pigoal}->{'PointsEarned'} ;
- $SatAvail = $data->{$wpgoal}->{'PointsAvail'} ;
- $SatScore = $data->{$wpgoal}->{'PointsEarned'} ;
- $piaver = $ImpAvail ? ($ImpScore/$ImpAvail) : 0 ;
- $pinum = (int(100*$piaver + 0.5))/10 ;
- $wpaver = $SatAvail ? ($SatScore/$SatAvail) : 0 ;
- $wpnum = (int(100*$wpaver + 0.5))/10 ;
- $Gap = $pinum - $wpnum;
- $TotalImp += $pinum ;
- $TotalSat += $wpnum ;
- $TotalGap += $Gap ;
- # warn "SUMM pigoal $pigoal wpgoal $wpgoal $TotalImpAvail $TotalImpScore $TotalSatAvail $TotalSatScore" ;
- }
- }
- # $piaver = $TotalImpAvail ? ($TotalImpScore/$TotalImpAvail) : 0 ;
- # $pinum = (int(100*$piaver + 0.5))/10 ;
- # $wpaver = $TotalSatAvail ? ($TotalSatScore/$TotalSatAvail) : 0 ;
- # $wpnum = (int(100*$wpaver + 0.5))/10 ;
- # $Gap = $pinum - $wpnum;
-
- print HTMLHeaderPlain("Section 2 - The Passion Index Summary");
- print " Gap $goal $diff Total Trust Values Gap ";
- printf "%.1f ", $Gap;
- # print "13.8 \n" ; # International Average
- print "
\n"; - print "The gap between Employee Needs and the degree to which the Needs are being satisfied
\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; - print "
\n" ; - print "
| " ; - print " | Total Importance | " ; - print "Total Satisfaction | " ; - print "Passion Gap | " ; - print "
|---|---|---|---|
| Overall | " ; - printf "%.1f | ", $TotalImp ; - printf "%.1f | ", $TotalSat ; - printf "%.1f | ", $TotalGap ; - print "
| Group Breakdown | " ; - print "|||
| Group | " ; - print "Total Importance | " ; - print "Total Satisfaction | " ; - print "Passion Gap | " ; - print "
| $group_name | " ; - printf "%.1f | ", $TotalImp ; - printf "%.1f | ", $TotalSat ; - printf "%.1f | ", $TotalGap ; - print "
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"; - foreach my $col (@cols) { - print " | $col | "; - } - print "|||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| \n"; - foreach my $col (@cols) { - print " | Clarity | Approval | "; - } - 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 | ||||||||||||
| Group | "; - foreach my $col (@cols) { - print "$col | "; - } - 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 "||||||||||
| International Average | \n";
- foreach my $col (@cols) {
- print "$col | "; - } - 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 "|
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 | ||
|---|---|---|---|
| $row | "; - print "%.1f%% | \n", $trust->{$row}->{'value'}; - printf "%.1f%% |
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 "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 "
| "; - foreach my $col (@cols) { - print " | $col | "; - } - print "|||
|---|---|---|---|---|
| Overall | "; - foreach my $col (@cols) { - printf "%.1f %% | ", $data->{'organization'}->{'trust'}->{$col}->{'value'}; - } - print "|||
| Group Breakdown | ||||
| Group | "; - foreach my $col (@cols) { - print "$col | "; - } - print "|||
| $groups->{$grp}->{'grpnme'} | "; - foreach my $col (@cols) { - printf "%.1f %% | ", $data->{'groups'}->{$grp}->{'trust'}->{$col}->{'value'}; - } - } - print "|||
| International Average | \n";
- foreach my $col (@cols) {
- print "$col | "; - } - print "|||
| 66% | "; - print "69% | "; - print "73% | "; - print "79% | "; - print "|
\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 "The graphs below show the Personal Importance and Perceptions of Work Performance".
- " for each of the eight values.";
- 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 " Gap " ;
- # print "Int'l " ;
- print "
Avg$_ $diff " ;
- # print "$intl{$_} " ;
- print "Total Trust Values Gap ";
- printf "%.1f ", $data->{'organization'}->{'gap'};
- # print "13.8
\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 "
| Total Importance | Total Performance | Trust Values Gap | |
|---|---|---|---|
| Overall | "; - printf "%.1f | ", $data->{'organization'}->{'Personal Importance'}; - printf "%.1f | ", $data->{'organization'}->{'Work Performance'}; - printf "%.1f |
| Group Breakdown | |||
| Group | Total Importance | Total Performance | Trust Values Gap |
| $groups->{$grp}->{'grpnme'} | "; - printf "%.1f | ", $data->{'groups'}->{$grp}->{'Personal Importance'}; - printf "%.1f | ", $data->{'groups'}->{$grp}->{'Work Performance'}; - printf "%.1f |
| Total Importance | Total Performance | Trust Values Gap | |
| International Average | "; # International Average - # printf "%.1f | ", 74.6; # International Average - # printf "%.1f | ", 60.8; # International Average - # printf "%.1f | \n", 13.8; # International Average - # print "
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"; - - my @outary = (); - for (my $i=37 ; $i <=37 ; $i++) { - if ($comments[$i] == -1) { - # inactive question - next; - } - $outary[$i] = "\n"; - #print "
\n"; - $outary[$i] .= "$questions[$i]->[0] - $questions[$i]->[4]\n"; - if (@{$comments[$i]}) { - $outary[$i] .= "
\n"; - foreach (@{$comments[$i]}) { - $outary[$i] .= "
\n"; - } else { - $outary[$i] .= "- $_
\n"; - } - $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 .= "
- No Comments
\n"; - $out .= " \n"; - } - foreach my $sub (@line) { - my ($subheader, $quess) = split(/:/,$sub); - if ($subheader ne "") { - $out .= " $section \n"; - } - my @ques = split(/\,/,$quess); - foreach my $quesid (@ques) { - $out .= $outary[$quesid] ; - } - } - } - print $out; - } - } else { - for (1 .. $#outary) { - print $outary[$_]; - } - } - - print " $subheader:
\n"; - # print "
".Dumper(\@questions,\@comments)."\n"; - print "
- -
| Test ID | -Description | -Cmp | -InP | -Pnd | -
\n"; - print "" ; - print "Employee Needs That Ignite Passion" ; - 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"; - } - $timestamp; - # printf "
| Your Employee Passion Gap Score is %.1f",$Gap ; - # print " |
| Gap | " ; - # print "Intl | " ; - print "|
|---|---|---|
| 1. The Need To Be Respected | " ; - print "" ; - print " | 1a. My immediate manager or supervisor trusts me and treats me with respect. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Need to be Respected Me", "Man Need to be Respected Org.") ; - print " | 1b. My organization's policies and practices regarding compensation, work/life balance, and valuing diversity demonstrate respect for all employees. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Need to be Respected Me", "Org Need to be Respected Org.") ; - -# Print one Category. - print " |
| 2. " ; - print "The Need to Learn and Grow | " ; - print "" ; - print " | 2a. I have the opportunity to increase my knowledge and develop new skills in my job. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Learn and Grow Me", "Man Learn and Grow Org.") ; - print " | 2b. My organization invests in developing the potential of all employees. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Learn and Grow Me", "Org Learn and Grow Org.") ; - -# Close the table, set up a page break for printing, and restart the table. - # print " |
\n" ;
- # Works for ???, but not IE.
- # print "\n" ;
- # Works for ???, but not IE.
- # print "\n" ;
- # Works for ???, but not IE.
- # print "\n" ;
- # print "\n" ;
- # print "\n" ;
-
-# Print one Category.
- print "
\n";
- print "\n";
- print HTMLFooter();
-}
-
-# The request is for a bar chart on the Passion index,
-# on the Employee Passion Survey (id passion).
-# They want bar charts comparing the desire of the
-# employees for a goal, vs. the Organizations ability
-# to deliver that goal, and a summary gap number.
-sub NewOldPassionIndexGroups {
- my ($idlist,$groups,$timestamp) = @_;
- my @Goals = ("Need to be Respected" , "Learn and Grow" , "Need to be an Insider" ,
- "Need for Meaning" , "Winning Team" ) ;
- # The Goals are the general passion ignitors.
- my @GoalSuffixes = ("Me" , "Org.") ;
- # The suffix is "Me" for its importance to the Candidate.
- # The suffix is "Org." for its delivery by the company.
- my @GoalPrefixes = ("Man", "Org") ;
- # The prefix is "Man" for the manager's delivery of the ignitor,
- # or the delivery to the Candidate.
- # The prefix is "Org" for the organization's delivery of the ignitor,
- # or the delivery to the other employees.
-
- my $data ;
- $data = &GetLikertData($CLIENT{'clid'},$TEST{'id'},$idlist);
- # Compute the Summary gap number.
- # It is the average of the gaps for each Goal.
- my $url;
- my $Gap = 0 ;
- my $goal ; my $gen_goal ; my $pre_goal ;
- foreach $pre_goal(@GoalPrefixes) {
- foreach $goal (@Goals) {
- my $pigoal = join(" ", $pre_goal, $goal, $GoalSuffixes[0]) ;
- my $wpgoal = join(" ", $pre_goal, $goal, $GoalSuffixes[1]) ;
- my $piavail = $data->{$pigoal}->{'PointsAvail'} ;
- my $piscore = $data->{$pigoal}->{'PointsEarned'} ;
- my $piaver = $piavail ? ($piscore/$piavail) : 0 ;
- my $pinum = (int(100*$piaver + 0.5))/10 ;
- # warn "pigoal $pigoal piavail $piavail piscore $piscore piaver $piaver pinum $pinum X" ;
- my $wpavail = $data->{$wpgoal}->{'PointsAvail'} ;
- my $wpscore = $data->{$wpgoal}->{'PointsEarned'} ;
- my $wpaver = $wpavail ? ($wpscore/$wpavail) : 0 ;
- my $wpnum = (int(100*$wpaver + 0.5))/10 ;
- # warn "wpgoal $wpgoal wpavail $wpavail wpscore $wpscore wpaver $wpaver wpnum $wpnum X" ;
- my $diff = $pinum - $wpnum;
- # warn "diff $diff X" ;
- $Gap += $diff ;
- }
- }
-
- print HTMLHeaderPlain("Section 2 - Values That Build Passion");
- print "Employee Passion Survey
Section 2 - Values That Build Passion
\n"; - print "The gap between Employee Passion 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 "
\n";
- print "" ;
- print "Section 1 - Employee Passion Report
" ; - print "The percentage of employees at each level of Passion
\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 "";
- my (@values , @Labels , $url, $mykey, @scores, $total) ;
- $total = 0 ;
- @Labels = sort keys %Categories ;
- foreach $mykey (@Labels) {
- 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=150&ydim=150&nolegend=1¬3d=1" ;
- # "&labels=" . join(":",@Labels) .
- # "&xdim=200&ydim=100&nolegend=1" ;
- # 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";
- print "
\n"; - print HTMLFooter(); -} - -# The request is for a bar chart on the Passion index, -# on the Employee Passion Survey (id passion). -# This was an attempt to use a different style chart -# to get the data displayed on one page. -# It was abandoned. -sub PassionVertGroups { - my ($idlist,$groups,$timestamp) = @_; - my @Goals = ("Need to be Respected" , "Learn and Grow" , "Need to be an Insider" , - "Need for Meaning" , "Winning Team" ) ; - # The Goals are the general passion ignitors. - my @GoalSuffixes = ("Me" , "Org.") ; - # The suffix is "Me" for its importance to the Candidate. - # The suffix is "Org." for its delivery by the company. - my @GoalPrefixes = ("Man", "Org") ; - # The prefix is "Man" for the manager's delivery of the ignitor, - # or the delivery to the Candidate. - # The prefix is "Org" for the organization's delivery of the ignitor, - # or the delivery to the other employees. - - my $data ; - $data = &GetLikertData($CLIENT{'clid'},$TEST{'id'},$idlist); - # Compute the Summary gap number. - # It is the average of the gaps for each Goal. - my $url; - my $Gap = 0 ; - my $goal ; my $gen_goal ; my $pre_goal ; - foreach $pre_goal(@GoalPrefixes) { - foreach $goal (@Goals) { - my $pigoal = join(" ", $pre_goal, $goal, $GoalSuffixes[0]) ; - my $wpgoal = join(" ", $pre_goal, $goal, $GoalSuffixes[1]) ; - my $piavail = $data->{$pigoal}->{'PointsAvail'} ; - my $piscore = $data->{$pigoal}->{'PointsEarned'} ; - my $piaver = $piavail ? ($piscore/$piavail) : 0 ; - my $pinum = (int(100*$piaver + 0.5))/10 ; - # warn "pigoal $pigoal piavail $piavail piscore $piscore piaver $piaver pinum $pinum X" ; - my $wpavail = $data->{$wpgoal}->{'PointsAvail'} ; - my $wpscore = $data->{$wpgoal}->{'PointsEarned'} ; - my $wpaver = $wpavail ? ($wpscore/$wpavail) : 0 ; - my $wpnum = (int(100*$wpaver + 0.5))/10 ; - # warn "wpgoal $wpgoal wpavail $wpavail wpscore $wpscore wpaver $wpaver wpnum $wpnum X" ; - my $diff = $pinum - $wpnum; - # warn "diff $diff X" ; - $Gap += $diff ; - } - } - - my $style_with_page = "" ; - $style_with_page .= "\n" ; - $style_with_page .= "\n" ; - $style_with_page .= "\n" ; -# The following is an enheritable class. - $style_with_page .= "\n" ; - print HTMLHeaderPlain("Section 2 - The Passion Index", - "", $style_with_page ); - # print "\n" ;
- print "" ;
- print "Section 2 - The Passion Index
\n"; - print "" ; - print "Employee Needs That Ignite Passion" ; - 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"; - } - $timestamp; - # printf "
\n";
- print "
\n";
- print "" ;
- print "The graphs below show employees' perceptions of the importance of these needs " ;
- print "and the level of \"satisfaction\" being experienced.\n" ;
- print "";
- $url = "/cgi-bin/linegraph.pl?values=B:C::1:6::2:4" .
- "&labels=J:K:L&y_label=Scale&x_label=letter" .
- "&xdim=700&ydim=200" .
- "&xdim=200&ydim=100" ;
- print "" ;
- print "
\n";
- # Works for Firefox 8 on Linux, but not IE.
- # print "\n" ;
- # print "
\n";
- print HTMLFooter();
-}
-
diff --git a/survey-nginx/cgi-bin/IntegroStats.pl.bu20131217 b/survey-nginx/cgi-bin/IntegroStats.pl.bu20131217
deleted file mode 100755
index 20dd13e97..000000000
--- a/survey-nginx/cgi-bin/IntegroStats.pl.bu20131217
+++ /dev/null
@@ -1,2180 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: IntegroStats.pl,v 1.2 2005/10/31 17:03:34 ddoughty Exp $
-#
-# Source File: IntegroStats.pl
-
-# Get config
-# use strict;
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'ui.pl';
-
-#use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
- %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot );
-
-&app_initialize;
-&LanguageSupportInit();
-&get_session($FORM{'tid'});
-#&get_client_profile($SESSION{'clid'});
-my @sortbys = qw(Name LoginID Date);
-my ($bExport,$idlist);
-#print STDERR Dumper(\%FORM,\%CLIENT,\%SESSION);
-#if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
- #$idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
-#}
-
-if ($FORM{'export'}) {
- print "Content-Type: application/doc\n\n";
- $bExport=1;
-} elsif ($FORM{'csv'}) {
- print "Content-Type: text/x-csv\n\n";
-} else {
- print "Content-Type: text/html\n\n";
- $bExport=0;
-}
-#print STDERR Dumper(\%FORM,$idlist);
-if (&get_session($FORM{'tid'})) {
- if ($FORM{'testsummary'} eq 'composite') {
- &show_test_composite($idlist);
- } elsif ($FORM{'testsummary'} eq 'bycnd') {
- &show_test_resultsbycnd($idlist);
- } else {
- &extract_test_data();
- }
-}
-if ($bExport) {
- exit(0);
-}
-
-sub extract_test_data() {
- &LanguageSupportInit();
- &get_client_profile($SESSION{'clid'});
- &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
- my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
- my @colhdrs=();
- push @colhdrs,"";
- if ($FORM{'cndnme'}) {
- push @colhdrs,"left:Last Name";
- push @colhdrs,"left:First Name";
- push @colhdrs,"left:MI";
- }
- push @colhdrs,"left:User ID";
- if ($FORM{'cndeml'}) {
- push @colhdrs,"left:Email Address";
- }
- if ($FORM{'cnd1'}) {
- push @colhdrs,"left:$CLIENT{'clcnd1'}";
- }
- if ($FORM{'cnd2'}) {
- push @colhdrs,"left:$CLIENT{'clcnd2'}";
- }
- if ($FORM{'cnd3'}) {
- push @colhdrs,"left:$CLIENT{'clcnd3'}";
- }
- if ($FORM{'cnd4'}) {
- push @colhdrs,"left:$CLIENT{'clcnd4'}";
- }
- if ($FORM{'cndscr'}) {
- push @colhdrs,"center:Correct";
- push @colhdrs,"center:Incorrect";
- push @colhdrs,"right:Score";
- }
- my @dataflds=();
- my @unsorted=();
- my $row="";
- my @qsumry=();
- my $user="";
- my $joint="\&";
- my $colhdr;
- my $colalgn;
- my $fidx;
- for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
- $user = $filelist[$fidx];
- $user =~ s/.$TEST{'id'}$//;
- $user =~ s/^$CLIENT{'clid'}.//;
- my $excuser="inc$user";
- if ($FORM{$excuser}) {
- next;
- }
- &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
- @qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
- &get_candidate_profile($CLIENT{'clid'},$user);
- if ($FORM{'cndnme'}) {
- $row=join($joint,$row,"$CANDIDATE{'nml'}");
- $row=join($joint,$row,"$CANDIDATE{'nmf'}");
- $row=join($joint,$row,"$CANDIDATE{'nmm'}");
- }
- $row=join($joint,$row,"$user");
- if ($FORM{'cndeml'}) {
- $row=join($joint,$row,"$CANDIDATE{'eml'}");
- }
- if ($FORM{'cnd1'}) {
- $row=join($joint,$row,"$CANDIDATE{'cnd1'}");
- }
- if ($FORM{'cnd2'}) {
- $row=join($joint,$row,"$CANDIDATE{'cnd2'}");
- }
- if ($FORM{'cnd3'}) {
- $row=join($joint,$row,"$CANDIDATE{'cnd3'}");
- }
- if ($FORM{'cnd4'}) {
- $row=join($joint,$row,"$CANDIDATE{'cnd4'}");
- }
- if ($FORM{'cndscr'}) {
- $row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]);
- }
- push @unsorted, $row;
- $row="";
- }
- my @sorted=sort @unsorted;
- @unsorted=();
- my $rowcount=$#filelist+1;
- &print_report_dataextract_header($rowcount,@colhdrs,@colalign);
- my ($i);
- for $i (0 .. $#sorted) {
- @dataflds=split($joint, $sorted[$i]);
- if ($bExport) {
- for $i (1 .. $#dataflds) {
- print "$dataflds[$i]";
- if ($i == $#dataflds) {
- print "\n";
- } else {
- print "\t";
- }
- }
- } else {
- print "\n";
- for $i (1 .. $#dataflds) {
- ($colalgn,$colhdr) = split(/:/,$colhdrs[$i]);
- print "\t\t$dataflds[$i] \n";
- }
- print " \n";
- }
- }
- &print_report_bycnd_footer();
- @sorted=();
-}
-
-sub print_report_dataextract_header {
- my ($ncount,@cols)= @_;
- my $colhdr;
- my $colalgn;
- my $i;
- if ($bExport) {
- print "$TEST{'desc'} ($TEST{'id'})\n";
- print "Raw Data Extraction\n";
- print "$ncount Completed Responses\n";
- for $i (1 .. $#cols) {
- ($colalgn,$colhdr) = split(/:/,$cols[$i]);
- print "$colhdr";
- if ($i == $#cols) {
- print "\n";
- } else {
- print "\t";
- }
- }
- } else {
- print "\n";
- print "\n";
- print "\tTest Data Extraction \n";
- print "\t\n";
- print "\n";
- print "\n";
- print "\n";
- print "$TEST{'desc'} ($TEST{'id'})
\n"; - print "Raw Data Extraction
\n"; - print "$ncount Completed Responses\n"; - print "\n";
- print "\t
\n" ; - # print "
\n" ;
- # print "
" ;
- # print "
" ;
- # print "
" ;
- # print "
" ;
- # print "
" ;
- # print "
| 3. " ; - print "The Need to Be an Insider | " ; - print "" ; - print " | 3a. My immediate manager or supervisor values my contribution and cares about my well-being. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Need to be an Insider Me", "Man Need to be an Insider Org.") ; - print " | 3b. My organization is open with employees about information and organizational performance to help us understand the decisions that are being made. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Need to be an Insider Me", "Org Need to be an Insider Org.") ; - -# Print one Category. - print " |
| 4. " ; - print "The Need for Meaning | " ; - print "" ; - print " | 4a. The mission or purpose of my organization makes me feel proud to work here. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Need for Meaning Me", "Man Need for Meaning Org.") ; - print " | 4b. The work I do is meaningful because it helps my organization fulfill our mission. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Need for Meaning Me", "Org Need for Meaning Org.") ; - -# Print one Category. - print " |
| 5. " ; - print "The Need to Be Part of a Winning Team | " ; - print "" ; - print " | 5a. My team is making a significant contribution to our organization. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Winning Team Me", "Man Winning Team Org.") ; - print " | 5b. My team is focused on continually improving our performance. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Winning Team Me", "Org Winning Team Org.") ; - -# Closing values. - print " |
| Total Employee Passion Gap | "; - printf "%.1f | ", $Gap; - # print "13.8 | \n" ; # International Average - print "
|---|
Section 2 - Values That Build Passion
\n"; - print "The gap between Employee Passion 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",$Gap ; - print " |
\n";
- print "The graphs below show the Personal Importance and Perceptions of Work Passion".
- " for each of the values.";
- print "
\n";
- print HTMLFooter();
-}
-
-# The original request was for a pie chart of all
-# of the answers on the last question, number 37. I wrote the survey,
-# so question 37 is a Likert Scale question that uses a value of
-# "Employee Passion" for its super category. This function generates the
-# report on the Employee Passion super category regardless of the
-# question number.
-# This version creates a table with 2 columns and 5 rows.
-# One row for each type of enthusiasm.
-# one column has the description for a type.
-# The second column has a 2-D piechart with colors,
-# and the color is lighter for the described type.
-sub PassionPeopleGroups_obsolete {
- 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" ;
- my $data ;
- my $data = &GetLikertData($CLIENT{'clid'},$TEST{'id'},$idlist);
- my %Categories = () ; my $resp ;
- # Keith said he wanted to ignore the data for non-responding candidates.
- # $Categories{'NoResponse'} = $$data{'Employee Passion'}->{'NoResponses'} ;
- my $mystery = $data->{'Employee Passion'}->{'ScoreCount'} ; # Should be a reference to a hash.
- # warn "Mystery Keys " . join(" ", keys %$mystery) . " . " ;
- foreach $resp ( keys %$mystery ) {
- # each response score.
- $Categories{$resp} = $data->{'Employee Passion'}->{'ScoreCount'}->{$resp} ;
- }
- print HTMLHeaderPlain("Section 1 - Employee Passion");
- print " Gap $goal $localteam $diff Total Trust Values Gap ";
- printf "%.1f ", $Gap;
- # print "13.8 \n" ; # International Average
- print "
" ; - print "The percentage of employees at each level of Passion
\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 "
| Level 5 - Passionate about the job and the organization:\n" ; - print " Employees at level 5 are passionate about the work and the organization they work for.\n"; - print " They feel valued and respected and know that what they do makes a real difference." ; - print " | \n" ; - # Do the pie chart. - print "\n" ;
- print " |
| Level 4 - Passionate only about the job:\n" ; - print " Level 4 employees are passionate about their work " ; - print "and get great satisfaction from knowing they make a difference.\n"; - print " However they feel somewhat disengaged from the organization - " ; - print "they don't feel their contribution is valued." ; - print " | \n" ; - # Do the pie chart. - print "\n" ;
- print " |
| Level 3 - Passionate only about the organization:\n" ; - print " Employees at this level are passionate about the organization " ; - print "and believe it delivers real value.\n " ; - print " But they find their work unrewarding - it's just a job." ; - print " | \n" ; - # Do the pie chart. - print "\n" ;
- print " |
| Level 2 - Not Passionate, but still conscientious:\n" ; - print " Employees at level 2 are not passionate about the work " ; - print "they do, but are still conscientious about doing a good job. " ; - print "However they feel disconnected from the organization " ; - print "and what it stands for." ; - print " | \n" ; - # Do the pie chart. - print "\n" ;
- print " |
| Level 1 - Disconnected from the job and the organization:\n" ; - print " Level 1 employees feel really disconnected from both the work they do " ; - print "and the organization. If they could find another job, " ; - print "would take it." ; - print " | \n" ; - # Do the pie chart. - print "\n" ;
- print " |
\n"; - print HTMLFooter(); -} - -# The request is for a bar chart on the Passion index, -# on the Employee Passion Survey (id passion). -# This was an attempt to use a different style chart -# to get the data displayed on one page. -# It was abandoned. -sub PassionVertGroups { - my ($idlist,$groups,$timestamp) = @_; - my @Goals = ("Need to be Respected" , "Learn and Grow" , "Need to be an Insider" , - "Need for Meaning" , "Winning Team" ) ; - # The Goals are the general passion ignitors. - my @GoalSuffixes = ("Me" , "Org.") ; - # The suffix is "Me" for its importance to the Candidate. - # The suffix is "Org." for its delivery by the company. - my @GoalPrefixes = ("Man", "Org") ; - # The prefix is "Man" for the manager's delivery of the ignitor, - # or the delivery to the Candidate. - # The prefix is "Org" for the organization's delivery of the ignitor, - # or the delivery to the other employees. - - my $data ; - $data = &GetLikertData($CLIENT{'clid'},$TEST{'id'},$idlist); - # Compute the Summary gap number. - # It is the average of the gaps for each Goal. - my $url; - my $Gap = 0 ; - my $goal ; my $gen_goal ; my $pre_goal ; - foreach $pre_goal(@GoalPrefixes) { - foreach $goal (@Goals) { - my $pigoal = join(" ", $pre_goal, $goal, $GoalSuffixes[0]) ; - my $wpgoal = join(" ", $pre_goal, $goal, $GoalSuffixes[1]) ; - my $piavail = $data->{$pigoal}->{'PointsAvail'} ; - my $piscore = $data->{$pigoal}->{'PointsEarned'} ; - my $piaver = $piavail ? ($piscore/$piavail) : 0 ; - my $pinum = (int(100*$piaver + 0.5))/10 ; - # warn "pigoal $pigoal piavail $piavail piscore $piscore piaver $piaver pinum $pinum X" ; - my $wpavail = $data->{$wpgoal}->{'PointsAvail'} ; - my $wpscore = $data->{$wpgoal}->{'PointsEarned'} ; - my $wpaver = $wpavail ? ($wpscore/$wpavail) : 0 ; - my $wpnum = (int(100*$wpaver + 0.5))/10 ; - # warn "wpgoal $wpgoal wpavail $wpavail wpscore $wpscore wpaver $wpaver wpnum $wpnum X" ; - my $diff = $pinum - $wpnum; - # warn "diff $diff X" ; - $Gap += $diff ; - } - } - - my $style_with_page = "" ; - $style_with_page .= "\n" ; - $style_with_page .= "\n" ; - $style_with_page .= "\n" ; -# The following is an enheritable class. - $style_with_page .= "\n" ; - print HTMLHeaderPlain("Section 2 - The Passion Index", - "", $style_with_page ); - # print "
\n"; - print "" ; - print "Employee Needs That Ignite Passion" ; - 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"; - } - $timestamp; - # printf "
| Your Employee Passion Gap Score is %.1f",$Gap ; - # print " |
| Gap | " ; - # print "Intl | " ; - print "|
|---|---|---|
| 1. The Need To Be Respected | " ; - print "" ; - print " | 1a. My immediate manager or supervisor trusts me and treats me with respect. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Need to be Respected Me", "Man Need to be Respected Org.") ; - print " | 1b. My organization's policies and practices regarding compensation, work/life balance, and valuing diversity demonstrate respect for all employees. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Need to be Respected Me", "Org Need to be Respected Org.") ; - -# Print one Category. - print " |
| 2. " ; - print "The Need to Learn and Grow | " ; - print "" ; - print " | 2a. I have the opportunity to increase my knowledge and develop new skills in my job. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Learn and Grow Me", "Man Learn and Grow Org.") ; - print " | 2b. My organization invests in developing the potential of all employees. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Learn and Grow Me", "Org Learn and Grow Org.") ; - -# Close the table, set up a page break for printing, and restart the table. - print " |
\n" ;
- # Works for ???, but not IE.
- # print "\n" ;
- # Works for ???, but not IE.
- # print "\n" ;
- # Works for ???, but not IE.
- # print "\n" ;
- # print "\n" ;
- print "\n" ;
-
-# Print one Category.
- print "
\n";
- print "
\n" ; - print "
\n" ;
- print "
" ;
- print "
" ;
- print "
" ;
- print "
" ;
- print "
" ;
- print "
| 3. " ; - print "The Need to Be an Insider | " ; - print "" ; - print " | 3a. My immediate manager or supervisor values my contribution and cares about my well-being. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Need to be an Insider Me", "Man Need to be an Insider Org.") ; - print " | 3b. My organization is open with employees about information and organizational performance to help us understand the decisions that are being made. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Need to be an Insider Me", "Org Need to be an Insider Org.") ; - -# Print one Category. - print " |
| 4. " ; - print "The Need for Meaning | " ; - print "" ; - print " | 4a. The mission or purpose of my organization makes me feel proud to work here. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Need for Meaning Me", "Man Need for Meaning Org.") ; - print " | 4b. The work I do is meaningful because it helps my organization fulfill our mission. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Need for Meaning Me", "Org Need for Meaning Org.") ; - -# Print one Category. - print " |
| 5. " ; - print "The Need to Be Part of a Winning Team | " ; - print "" ; - print " | 5a. My team is making a significant contribution to our organization. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Man Winning Team Me", "Man Winning Team Org.") ; - print " | 5b. My team is focused on continually improving our performance. | " ; - print "" ; - print "\n" ; - &TwoBarCharts($data, "Org Winning Team Me", "Org Winning Team Org.") ; - -# Closing values. - print " |
| Total Employee Passion Gap | "; - printf "%.1f | ", $Gap; - # print "13.8 | \n" ; # International Average - print "
|---|
\n"; - print "Raw Data Extraction
\n"; - print "$ncount Completed Responses\n"; - print "
| $colhdr | \n"; - } - print "\t<\TR>\n"; - } -} - -sub date_out_of_range { - my ($completedat,$datefm,$dateto) = @_; - my @unsorted=(); - push @unsorted, $completedat; - push @unsorted, $datefm; - push @unsorted, $dateto; - my @sorted = sort @unsorted; - my $bretyes = ($sorted[1] eq $unsorted[0]) ? 0 : 1; - @unsorted=(); - @sorted=(); - return $bretyes; -} - -$^W=1; -sub sort_test_results { - my ($sortby,@rows) = @_; - if ($sortby eq 'Name') { - #print STDERR "by Name\n"; - return sort {$a->{'columns'}->[0] cmp $b->{'columns'}->[0];} @rows; - } elsif ($sortby eq 'LoginID') { - #print STDERR "by LoginID\n"; - return sort {$a->{'columns'}->[1] cmp $b->{'columns'}->[1];} @rows; - } elsif ($sortby eq 'Date') { - #print STDERR "by Date\n"; - return sort {$a->{'end'} <=> $b->{'end'};} @rows; - } else { - #print STDERR "by Nothing\n"; - return @rows; - } -} - -sub show_test_resultsbycnd { - &LanguageSupportInit(); - &get_client_profile($SESSION{'clid'}); - &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); - my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}"); - my ($url) = ("$cgiroot/IntegroStats.pl?"); - if (not $FORM{'sortby'}) {$FORM{'sortby'}=$sortbys[0];} - if (not $FORM{'reverse'}) {$FORM{'reverse'}=0;} - foreach (keys %FORM) { - if (($_ ne 'sortby') and ($_ ne 'reverse') and ($FORM{$_} !~ /\s+/)) { - #print STDERR "$_=$FORM{$_}\n"; - $url .= "&$_=$FORM{$_}"; - } else { - #print STDERR "NOT $_=$FORM{$_}\n"; - } - } - my $csvurl = $url."&csv=1&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); - my $reverseurl = $url."&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); - my %sorturls; - foreach my $sorter (@sortbys) { - $sorturls{$sorter} = $url."&sortby=$sorter"; - } - my @sorted=(); - my @unsorted=(); - my $user; - my $test; - my $qidx; - my $trash; - my $subjskl; - my $subj; - my $sklvl; - my $subjlist=","; - my @qids=(); - my @qsumry=(); - my @corincs=(); - my $bysubjflag = ($FORM{'statsbysubj'} ne '') ? 1 : 0; - my @subjects=(); - my @subjcnts=(); - my @subjtot=(); - my @subjmean=(); - my @subjmedian=(); - my @meanscore=split('\,',"0,0,0,0,100,0,0"); - my @medianscore=(); - my $i=0; - my $j=0; - my $fidx; - my @rows=(); - my $row={}; - my @answ=(); - my $qid; - my $usrnm; - my $nresultcount=$#filelist+1; - my $mtime; - my $completedat; - my $displaydate; - if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";} - if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";} - if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";} - if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";} - my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}"; - my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}"; - for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$CLIENT{'clid'}.//; - my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'}); - if (not defined $history) { - $history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'}); - } - if (not defined $history) { - # no log file entry for this test - #print STDERR "$testcomplete.$pathsep.$filelist[$fidx]\n"; - my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9]; - $history->{'end'} = $mtime; - $history->{'start'} = $history->{'end'}; - #print STDERR Dumper($history); - } - #$trash=join($pathsep,$testcomplete,$filelist[$fidx]); - #open (TMPFILE, "<$trash"); - #$mtime = (stat(TMPFILE))[9]; - #close TMPFILE; - $completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'}); - $displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'}); - #print STDERR "$completedat $displaydate $datefm $dateto\n"; - if (&date_out_of_range($completedat,$datefm,$dateto)) { - $nresultcount--; - next; - } - my $excuser="inc$user"; - if ($FORM{$excuser}) { - $nresultcount--; - next; - } - &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); - @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); - @answ=split(/\&/,$SUBTEST_ANSWERS{2}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - @corincs = split(/\//, $qsumry[$#qsumry]); - for $i (0 .. $#subjects) { - $subjcnts[$i][0]=0; - $subjcnts[$i][1]=0; - $subjcnts[$i][2]=0; - $subjcnts[$i][3]=0; - } - &get_candidate_profile($CLIENT{'clid'},$user); - $usrnm="$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}"; - $row={'columns' => [$usrnm,$user,$displaydate]}; - $row->{'start'} = $history->{'start'}; - $row->{'end'} = $history->{'end'}; - #print STDERR "Survey = $TEST_SESSION{'srvy'}\n"; - if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { - for $qid (1 .. $#qids) { - ($test,$qidx) = split(/\./, $qids[$qid]); - ($trash,$subjskl) = split(/::/, $answ[$qid]); - ($subj,$sklvl,$trash)=split(/\.|\:/,$subjskl); - unless ($subjlist =~ /\,$subj\,/i) { - $subjlist = join('',$subjlist,"$subj\,"); - push @subjects,"$subj"; - $i=$#subjects; - $subjcnts[$i][0]=0; # questions in subject area - $subjcnts[$i][1]=0; # correct answers - $subjcnts[$i][2]=0; # incorrect answers - $subjcnts[$i][3]=0; # pct correct - $subjtot[$i][0]=0; - $subjtot[$i][1]=0; - $subjtot[$i][2]=0; - $subjtot[$i][3]=0; - $subjmean[$i][0]=0; # population count - $subjmean[$i][1]=0; # population value summation - $subjmean[$i][2]=0; # population mean - $subjmean[$i][3]=0; # population standard deviation - $subjmean[$i][4]=100; # population range-low - $subjmean[$i][5]=0; # population range-high - } - for $i (0 .. $#subjects) { - if ($subj eq $subjects[$i]) { - $subjcnts[$i][0]++; - $subjtot[$i][0]++; - if (substr($corincs[$qid],0,1) eq '1') { - $subjcnts[$i][1]++; - $subjtot[$i][1]++; - } else { - $subjcnts[$i][2]++; - $subjtot[$i][2]++; - } - $subjcnts[$i][3]=int((($subjcnts[$i][1]/$subjcnts[$i][0])*100)); - $subjtot[$i][3]=int((($subjtot[$i][1]/$subjtot[$i][0])*100)); - last; - } - } - } - if ($bysubjflag) { - for $i (0 .. $#subjects) { - push @{$row->{'columns'}},$subjcnts[$i][0],$subjcnts[$i][1],$subjcnts[$i][2],$subjcnts[$i][3]; - $subjmean[$i][0]++; - $subjmean[$i][1]+=$subjcnts[$i][3]; - $subjmean[$i][2]=int(($subjmean[$i][1]/$subjmean[$i][0])); - #$subjmean[$i][4]=(($subjcnts[$i][3] < $subjmean[$i][4]) || ($subjmean[$i][4] == 0)) ? $subjcnts[$i][3] : $subjmean[$i][4]; - $subjmean[$i][4]=($subjcnts[$i][3] < $subjmean[$i][4]) ? $subjcnts[$i][3] : $subjmean[$i][4]; - $subjmean[$i][5]=($subjcnts[$i][3] > $subjmean[$i][5]) ? $subjcnts[$i][3] : $subjmean[$i][5]; - $subjmedian[$i][$fidx]=$subjcnts[$i][3]; - $subjcnts[$i][0]=0; - $subjcnts[$i][1]=0; - $subjcnts[$i][2]=0; - $subjcnts[$i][3]=0; - } - } - $meanscore[0]++; # data count - $meanscore[1]+=$qsumry[2]; # sum of values - $meanscore[2]=int(($meanscore[1]/$meanscore[0])); # unbiased population mean - $meanscore[4]=($qsumry[2] < $meanscore[4]) ? $qsumry[2] : $meanscore[4]; - $meanscore[5]=($qsumry[2] > $meanscore[5]) ? $qsumry[2] : $meanscore[5]; - $medianscore[$fidx]=$qsumry[2]; - } - push @{$row->{'columns'}},$qsumry[0],$qsumry[1],$qsumry[2]; - push @rows, $row; - } - @sorted=sort {$a <=> $b} @medianscore; - $j=$#sorted/2; - $i=$sorted[$j]; - if (($#sorted % 2) == 0) { - @medianscore=(); - $medianscore[0]=$i; - } else { - $j++; - $i+=$sorted[$j]; - @medianscore=(); - $medianscore[0]=int(($i/2)); - } - my @scores=(); - for $i (0 .. $#subjects) { - for $j (0 .. $#filelist) { - $scores[$j]=$subjmedian[$i][$j]; - } - @sorted=sort {$a <=> $b} @scores; - @scores=(); - $j=$#sorted/2; - $qid=$sorted[$j]; - if (($#sorted % 2) == 0) { - $subjmedian[$i][0]=$qid; - } else { - $j++; - $qid+=$sorted[$j]; - $subjmedian[$i][0]=int(($qid/2)); - } - } - # The sorting block - if ($FORM{'reverse'}) { - @sorted = reverse &sort_test_results($FORM{'sortby'},@rows); - } else { - @sorted = &sort_test_results($FORM{'sortby'},@rows); - } - # end of the sorting block - @rows=(); - if ($FORM{'csv'}) { - &print_report_bycnd_csv(@sorted); - return; - } - my $colspan=&print_report_bycnd_header($nresultcount,$bysubjflag,\%sorturls,$FORM{'sortby'}, - $csvurl,$reverseurl,@subjects); - @unsorted=(); - @subjcnts=(); - my $symbol=""; - my @cols=(); - my @rowhdrs=('Questions','Correct','Incorrect','Pct Correct'); - my $rowspan=($bysubjflag) ? ($#rowhdrs+1) : 1; - foreach my $row (@sorted) { - @cols=@{$row->{'columns'}}; - my ($start,$end,$duration,$datestamp,$total); - if ($bExport) { - print "$cols[0]\t$cols[1]\t$cols[2]\t"; - if ($bysubjflag) { print "\n";} - } else { - #($start,$end,$duration) = get_teststartend($CLIENT{'clid'},$cols[1],$FORM{'tstid'}); - $start = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'start'}))[0..2])); - $end = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'end'}))[0..2])); - $duration = &fmtDuration($row->{'end'} - $row->{'start'}); - if ($end == "Unknown" ) { - $datestamp = ""; - } else { - my $gmend = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'end'}))[0..2])); - $datestamp = "$cols[2] $gmend GMT"; - $datestamp =~ s/ /_/g; - } - $total = $cols[3] + $cols[4]; - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| $cols[0] | \n"; - print "\t\t$cols[1] | \n"; - print "\t\t$cols[2] | \n"; - } - if ($bysubjflag) { - for $j (0 .. $#rowhdrs) { - $symbol=($j==3) ? "\%" : ""; - if ($j > 0) { - if ($bExport == 0) { - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| $rowhdrs[$j] | \n"; - } - for $fidx (0 .. $#subjects) { - $qid=($fidx*4)+$j+3; - if ($bExport) { - print "$cols[$qid]\t"; - } else { - print "\t\t$cols[$qid]$symbol | \n"; - } - if ($j==3) { - $subjmean[$fidx][3]+=(($subjmean[$fidx][2]-$cols[$qid])*($subjmean[$fidx][2]-$cols[$qid])); - } - } - if ($j == 0) { - $fidx=$#cols-2; - if ($bExport) { - print "$cols[$fidx++]\t"; - print "$cols[$fidx++]\t"; - print "$cols[$fidx]\t"; - } else { - print "\t\t$cols[$fidx++] | \n"; - print "\t\t$cols[$fidx++] | \n"; - print "\t\t$cols[$fidx]\% | \n"; - } - } - if ($bExport) { - print "\n"; - } else { - print "\t$start | \n"; - print "\t\t$end | \n"; - print "\t\t$duration | \n"; - if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { - print "\t\t$cols[$j++] | \n"; - print "\t\t$cols[$j++] | \n"; - print "\t\t$cols[$j]\% | \n"; - } else { - print "\t\tNot Scored by Definition | \n"; - } - print "\t\n"; - } - } - if ($bysubjflag) { - if ($bExport==0) { - print "\t|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Composite | \n"; - } - } else { - if ($bExport) { - print "\t\t"; - } - } - if ($bExport) { - print "$rowhdrs[$j]\t"; - } else { - print "\t\t$rowhdrs[$j] | \n"; - } - if ($j < 4) { - $symbol=($j==3) ? "\%" : ""; - for $fidx (0 .. $#subjects) { - if ($bExport) { - print "$subjtot[$fidx][$j]\t"; - } else { - print "\t\t$subjtot[$fidx][$j]$symbol | \n"; - } - } - if ($j == 0) { - if ($bExport) { - print "\t\t"; - } else { - print "\t\t\ \; | \n";
- }
- } elsif ($j == 3) {
- if ($bExport) {
- print "\tOverall\t";
- } else {
- print "\t\tOverall | \n"; - } - } - } else { - $symbol="\%"; - $i=$j-2; - for $fidx (0 .. $#subjects) { - if ($i == 6) { - if ($bExport) { - print "$subjmedian[$fidx][0]\t"; - } else { - print "\t\t$subjmedian[$fidx][0]$symbol | \n"; - } - } else { - if ($i==3) { - $subjmean[$fidx][3]=int((sqrt(($subjmean[$fidx][3]/$subjmean[$fidx][0])))); - if ($bExport) { - print "$subjmean[$fidx][$i]\t"; - } else { - print "\t\t\&\#177$subjmean[$fidx][$i]$symbol | \n"; - } - } else { - if ($bExport) { - print "$subjmean[$fidx][$i]\t"; - } else { - print "\t\t$subjmean[$fidx][$i]$symbol | \n"; - } - } - } - } - $i=$j-2; - if ($i==3) { - if ($bExport) { - print "\t$meanscore[$i]\t"; - } else { - print "\t\t\&\#177$meanscore[$i]$symbol | \n"; - } - } elsif ($i==6) { - if ($bExport) { - print "\t$medianscore[0]\t"; - } else { - print "\t\t$medianscore[0]$symbol | \n"; - } - } else { - if ($bExport) { - print "\t$meanscore[$i]\t"; - } else { - print "\t\t$meanscore[$i]$symbol | \n"; - } - } - } - if ($bExport) { - print "\n"; - } else { - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Composite | \n"; - } - } - if ($bExport) { - print "\t$rowhdrs[$j]\t"; - } else { - print "\t\t$rowhdrs[$j] | \n"; - } - if ($j==1) { - if ($bExport) { - print "\t\t$meanscore[$i]"; - } else { - print "\t\t\&\#177$meanscore[$i]$symbol | \n"; - } - } elsif ($j==4) { - if ($bExport) { - print "\t\t$medianscore[0]"; - } else { - print "\t\t$medianscore[0]$symbol | \n"; - } - } else { - if ($bExport) { - print "\t\t$meanscore[$i]"; - } else { - print "\t\t$meanscore[$i]$symbol | \n"; - } - } - if ($bExport) { - print "\n"; - } else { - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| \n";
- foreach (@sortbys) {
- if ($_ ne $sortby) {
- print "\t\t\t{$_}\">Sort by $_ \n"; - } else { - print "\t\t\tSorted by $_ \n"; - } - } - print "\t\t\t | ";
- print "CSV Report\n\t\t\t "; - print "Change to ".($FORM{'reverse'}?'ascending':'descending')."\n\t\t | \n";
- print "\t||||||||
| Candidate | \n"; - print "\t\tLoginID | \n"; - print "\t\tDate | \n"; - if ($bysubj) { - print "\t\tSubject Areas | \n"; - } else { - print "\t\tStart | \n"; - print "\t\tEnd | \n"; - print "\t\tDuration | \n"; - } - print "\t\tOverall | \n"; - print "\t||
| \ \; | \n"; - for $i (0 .. $nsubjects) { - print "\t\t$subjects[$i] | \n"; - } - }; - print "\t\tCorrect | \n"; - print "\t\tIncorrect | \n"; - print "\t\tScore | \n"; - print "\t|||||
/g; - #$qtx = $qtx; - ($test,$qid) = split(/\./, $id); - $qstatsid[$qid] = $id; - $qstatsqc[$qid] = 0; # occurrences of question - $qstatsqp[$qid] = 0; # percent occurrences of question - $qstatsqt[$qid] = $qtx; # question text - if ($qil eq 'Y') { - $qstatsqf[$qid] = "obs"; # question type - } else { - $qstatsqf[$qid] = $qtp; # question type - $qallans = ""; - if ($qtp eq 'tf') { - $qallans = "$qca\;$qia\;$xlatphrase[670]"; #670=No Response - } elsif ($qtp eq 'mcs' || $qtp eq 'mca') { - if ($qca eq '') { - $qallans = "$qia\;$xlatphrase[670]"; - } else { - $qallans = "$qca\;$qia\;$xlatphrase[670]"; - } - } elsif ($qtp eq 'mtx' || $qtp eq 'mtr') { - # DED When qca is saved correctly in tdef, - # put this back and delte rest: - # $qallans = "$qca"; - ($qiar, $qiac) = split("RC", $qia); - @qiar = split("\;", $qiar); - @qiac = split("\;", $qiac); - $qallans = ""; - foreach $qiarow (@qiar) - { - foreach $qiacol (@qiac) - { - $qallans .= "xxx\;"; - } - } - } elsif ($qtp eq 'mcm') { - if ($qca eq '') { - $qallans = "$qia"; - } else { - $qallans = "$qca\;$qia"; - } - } elsif ($qtp eq 'esa') { - if ($qca eq '') { - $qallans = ""; - } else { - $qallans = "$qca"; - } - } elsif ($qtp eq 'nrt') { - if ($qca eq '') { - $qallans = "Other\;$xlatphrase[670]"; - } else { - $qallans = "$qca\;Other\;$xlatphrase[670]"; - } - } elsif ($qtp eq 'mch') { - @qcans = split(/\;/, $qca); - @qians = split(/\;/, $qia); - for (my $i = 0; $i <= $#qcans; $i++ ) { - $qallans = join('', $qallans, "$qcans[$i]===$qians[$i]
"); - } - } elsif ($qtp eq 'ord') { - $qallans = "$qca"; - } - $qallans =~ s/\;\;/\;/g; - $qstatsqr[$qid] = $qallans; # response options - $fqstatsqr[$qid] = $qallans; ### DED for FBQ - $qstatsqw[$qid] = (); - if (($qtp eq 'mch') || ($qtp eq 'ord')) { - if ($qtp eq 'mch') { - @qstato = split(/
/, $qallans); - } else { - @qstato = split(/\;/, $qallans); - } - $ncount = $#qstato + 1; - $ncount = int(($ncount * ($ncount + 1)) + 3); - for (my $i = 0; $i <= $ncount; $i++ ) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } elsif ($qtp eq 'mcm' || $qtp eq 'esa' || $qtp eq 'mtx' || $qtp eq 'mtr') { - @qstato = split(/\;/, $qallans); - if ($qtp eq 'mtr') - { - # Have to allow for [1..5] in - # each answer, so make it big! - $ncount = (($#qstato + 1) * 5) + 3; - } - else - { - $ncount = $#qstato + 3; - } - for (my $i = 0; $i <= $ncount; $i++ ) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } else { - @qstato = split(/\;/, $qallans); - foreach $qstat (@qstato) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } - } - @qstato = (); - } - $ncount = $#filelist + 1; - @qucmts=(); - $nresponses=$#filelist+1; - for (my $fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $tmpclientID = $filelist[$fidx]; - $tmpclientID =~ s/^([\w]+).//; - $clientID = $1; - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$clientID.//; - #print STDERR "----> ClientID: $clientID User: $user\n"; - if (defined $idlist and not $idlist->{$user}) { - $nresponses--; - next; - } - my $excuser="inc$user"; - if ($FORM{$excuser}) { - $nresponses--; - next; - } - &get_test_sequence_for_reports( $clientID, $user, $TEST{'id'}); - @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); - @qrsp = split(/\&/, $SUBTEST_RESPONSES{2}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - @corincs = split(/\//, $qsumry[5]); - @qsumry = (); - @qsumry = split(/\&/, $SUBTEST_ANSWERS{2}); - @qansseq = (); - $fqid=""; - $fqididx=""; - for (1 .. $#qids) { - ($test,$qidx) = split(/\./, $qids[$_]); - ($qansord,$trash) = split(/::/, $qsumry[$_]); - $qansord =~ s/\=([0-1])//g; - $qansseq[$_] = $qansord; - - ($qresp,$qucmt) = split(/::/, $qrsp[$_]); - $qresp=~ tr/+/ /; - $qresp=~ tr/'//d; - $qrsp[$_]=$qresp; - - ##### v ADT - 7/03/2002 ################################################ - # Added code to print NRT answers in the form of the comments - ######################################################################## - push @qresponses, "$qidx\&$user\&$qresp"; - ##### ^ ADT - 7/03/2002 ################################################ - - if ($qucmt ne '') { - $qucmt =~ tr/+/ /; - $qucmt =~ tr/'//d; - push @qucmts, "$qidx\&$user\&$qucmt"; - } - ### DED 10/28/2002 Support for filter-by-question (FBQ) - if ($FORM{'question'} eq $qids[$_]) { - $fqididx=$_; - ($trash,$fqid)=split(/\./,$qids[$_]); - } - } - ### DED 10/28/2002 Support for filter-by-question (fbq) - #print "
FormQues= $FORM{'question'} Ans= $FORM{'answer'} Qansseq= $qansseq[$fqididx]
\n"; - if ($fqid ne "" && $FORM{'answer'} ne "") { - $fmatch=0; - if ($qstatsqf[$fqid] eq 'mcs' || $qstatsqf[$fqid] eq 'mca') { - @fqansseq=split(/\?/,$qansseq[$fqididx]); - shift @fqansseq; - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - foreach $fans (@fans) { - @ffresp=(); - $fresp=""; - for (0 .. $#fqansseq) { - $fqseqans[$fqansseq[$_]]=$_; - $ffresp[$_]="xxx"; - } - if ($fans ne "No+Response") { - $ffresp[$fqseqans[$fans]]=$fqseqans[$fans]; - } - if ($ffresp[0] eq "") { - $fresp=""; - } else { - foreach (@ffresp) { - $fresp=join('?',$fresp,$_); - } - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { - $fmatch=1; - } - @ffresp=(); - if ($fmatch == 1) { break; } - } - @fqansseq=(); - @fans=(); - } elsif ($qstatsqf[$fqid] eq 'mcm') { - @fqansseq=split(/\?/,$qansseq[$fqididx]); - shift @fqansseq; - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - @ffresp=(); - $fresp=""; - for (0 .. $#fqansseq) { - $fqseqans[$fqansseq[$_]]=$_; - $ffresp[$_]="xxx"; - } - if ($fans[0] ne "No+Response") { - foreach (@fans) { - $ffresp[$fqseqans[$_]]=$fqseqans[$_]; - } - } - if ($ffresp[0] eq "") { - $fresp=""; - } else { - foreach (@ffresp) { - $fresp=join('?',$fresp,$_); - } - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { - $fmatch=1; - } - @fqansseq=(); - @fans=(); - @ffresp=(); - } elsif ($qstatsqf[$fqid] eq 'tf') { - if ($FORM{'answer'} eq "\&0" ) { - $fresp=$qansseq[$fqididx]; - } elsif ($FORM{'answer'} eq "\&1" ) { - SWITCH: for ($qansseq[$fqididx]) { - $fresp = /TRUE/ && "FALSE" - || /FALSE/ && "TRUE" - || /YES/ && "NO" - || /NO/ && "YES" - || "bad"; - } - } elsif ($FORM{'answer'} eq "\&No+Response") { - $fresp=""; - } else { - $fresp="bad"; - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "bad") { - $fmatch=1; - } - } elsif ($qstatsqf[$fqid] eq 'esa') { - ($fqstatsqr,$trash)=split(/;Other/,$fqstatsqr[$fqid]); - @fqr=split(/\;/,$fqstatsqr); - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - if ($fans[0] eq "No+Response") { - $fqr=""; - if ($fqr eq $qrsp[$fqididx]) { - $fmatch=1; - } - } else { - foreach (@fans) { - $fqr=lc($fqr[$_]); - $fqrsp=lc($qrsp[$fqididx]); - if ($fqr eq $fqrsp && $fqr ne "") { - $fmatch=1; - last; - } - } - } - @fqr=(); - @fans=(); - } - #print "
FQid= $fqid Qtp= $qstatsqf[$fqid] Qstatsid= $qstatsid[$fqid] Fresp= $fresp Qrsp=$qrsp[$fqididx]
\n";
- if ($fmatch == 0) {
- ### Don't count this one
- #print "...Skipping...";
- $nresponses--;
- next;
- }
- $fresp="";
- }
- ### DED End fbq support
- @qsumry=();
- for (1 .. $#qids) {
- ($test,$qidx) = split(/\./, $qids[$_]);
- if ($qstatsqf[$qidx] ne 'obs') {
- $qstatsqc[$qidx]++;
- $qstatsqp[$qidx] = format_percent(($qstatsqc[$qidx] / $ncount),
- { fmt => "%.0f" } );
- @qstatc = split(/\;/, $qstatsqrc[$qidx]);
- @qstatp = split(/\;/, $qstatsqrp[$qidx]);
- if ($qstatsqf[$qidx] eq 'tf') {
- @qstato = split(/\;/, $qstatsqr[$qidx]);
- if ($qrsp[$_] eq $qstato[0]) {
- $qstatc[0]++;
- } elsif ($qrsp[$_] eq $qstato[1]) {
- $qstatc[1]++;
- } else {
- $qstatc[2]++;
- }
- }elsif ($qstatsqf[$qidx] eq 'esa'){
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/\+/ /g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 1) {
- @qansord = split(/\;/, $qansseq[$_]);
- for $q (0 .. $#qansord) {
- if ($qansord[$q] eq $qresp) {
- $qstatc[$q]++;
- last;
- }
- }
- } else { # incorrect
- $found=0;
- @qstatw=split(/\;/,$qstatsqw[$qidx]);
- shift(@qstatw);
- for $q (0 .. $#qstatw) {
- if ($qstatw[$q] eq $qresp) {
- $qstatsqwc[$q]++;
- $found=1;
- last;
- }
- }
- if ($found != 1) {
- $qstatsqwc[$#qstatw+1]=1;
- $qstatsqw[$qidx]=join(';',$qstatsqw[$qidx],$qresp);
- }
- @qstatq=();
- }
- } else {
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- }elsif ($qstatsqf[$qidx] eq 'nrt'){
- if ($qrsp[$_] ne '') {
- $qstatc[1]++;
- $qrsp[$_] =~ s/\;/\:/g;
- $qrsp[$_] =~ s/\r//g;
- $qrsp[$_] =~ s/\n/\\n/g;
-
- $qstatsqr[$qidx] = join('
',$qstatsqr[$qidx],$qrsp[$_]);
- } else {
- $qstatc[2]++;
- }
- } elsif ($qstatsqf[$qidx] eq 'mcs' || $qstatsqf[$qidx] eq 'mca') {
- ### DED Filter out "?" and "xxx" in qrsp so will match
- $qrsp[$_] =~ s/\?//g;
- $qrsp[$_] =~ s/xxx//g;
- @qansord = split(/\?/, $qansseq[$_]);
- shift @qansord;
- $found = 0;
- ### DED 10/09/02 Changed to allow for
- ### randomized answers
- #for (my $i = 0; $i <= $#qansord; $i++ ) {
- #if (("$qansord[$i]" eq "$qrsp[$_]") && ($qrsp[$_] ne '')) {
- if ($qrsp[$_] ne '') {
- $qstatc[$qansord[$qrsp[$_]]]++;
- $found = 1;
- }
- #}
- unless ($found) {
- # increment "No Response"
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- } elsif ($qstatsqf[$qidx] eq 'mtx') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
- ($qiar, $qiac) = split("RC", $qia);
- @qiar = split("\;", $qiar);
- @qiac = split("\;", $qiac);
-
- # skipping answer sequence part (no rand answ)
- $holding3 = $_;
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- $i=0;
- foreach $qiarow (@qiar)
- {
- foreach $qiacol (@qiac)
- {
- if ($qresps[$i] ne "xxx") {
- $qstatc[$i]++;
- }
- $i++;
- }
- }
- }
- } else {
- # increment No Response counter
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mtr') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
- ($qiar, $qiac) = split("RC", $qia);
- @qiar = split("\;", $qiar);
- @qiac = split("\;", $qiac);
-
- # skipping answer sequence part (no rand answ)
- $holding3 = $_;
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- $iqresps=0;
- $iqstatc=0;
- foreach $qiarow (@qiar)
- {
- foreach $qiacol (@qiac)
- {
- if ($qresps[$iqresps] ne "xxx")
- {
- # $qresps[$iqresps] will be [1..5], so adjust index accordingly
- $irank = $iqstatc + $qresps[$iqresps] - 1;
- $qstatc[$irank]++;
- }
- $iqresps++;
- $iqstatc += 5;
- }
- }
- }
- } else {
- # increment No Response counter
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mcm') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- @qansord = split(/\?/, $qansseq[$_]);
- shift @qansord;
- $holding3 = $_;
- #$found = 0;
- ### DED 10/18/02 Changed to allow for
- ### randomized answers & new format
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- foreach $qresp (@qresps) {
- if ($qresp ne "xxx") {
- $qstatc[$qansord[$qresp]]++;
- }
- }
- }
- } else {
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mch') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
- ### DED 10/18/02 Changed for
- ### random answers and new format
-
- #
- # Count occurrence of each match
-
- # $qansseq[$qidx] [Wrong! DED]
- # $qansseq[$_]
- # &a.3.2.0.6.5.8.4.7.1::MATCH.0:1:1:0
- # $qrsp[$_]
- # &dgihbfcea [Old format]
- # &?d?g?i?h?b?f?c?e?a [New]
-
- #$qansseq[$qidx] =~ s/\&//g;
- $qansseq[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/ //g;
- #@corord = split(/\./, $qansseq[$qidx]);
- @corord = split(/\./, $qansseq[$_]);
- #@selord = split(//,$qrsp[$_]);
- @selord = split(/\?/,$qrsp[$_]);
- shift @selord;
- $corhold = $_;
- if ($corinc == 0) {
- for (0 .. $#selord) {
- if ($selord[$_] ne 'xxx') {
- ($x = &get_label_index($corord[0],$selord[$_]))++;
- $y = $corord[$x];
-
- #$ncountidx = int($_ * $#corord + $y);
- $ncountidx = int($y * $#corord + $_);
- } else {
- $ncountidx = int(($#corord * $#corord ) + $_);
- }
- $qstatc[$ncountidx]++;
- }
- }
- $_ = $corhold;
- @selord = ();
- @corord = ();
- } else {
- $qstatc[$#qstatc]++;
- }
- } elsif ($qstatsqf[$qidx] eq 'ord') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- ### DED 10/18/02 Changed for
- ### random answers and new format
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- #
- # Count occurrence of each incorrect order
- # &o.2.3.4.1.0::ORDERED.0:1:1:0
- # &34521 [Old format]
- # &?3?4?5?2?1 [New]
- #
- #$qansseq[$qidx] =~ s/\&//g;
- $qansseq[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/\&//g;
- #@corord = split(/\./, $qansseq[$qidx]);
- @corord = split(/\./, $qansseq[$_]);
- #@selord = split(//,$qrsp[$_]);
- @selord = split(/\?/,$qrsp[$_]);
- shift @selord;
- $corhold = $_;
- if ($corinc == 0) {
- for (1 .. $#corord) {
- $ncountidx = int(($corord[$_]) * $#corord);
- $x = int($_ - 1);
- if ($selord[$x] ne 'xxx') {
- $ncountidx = $ncountidx + int($selord[$x]) - 1;
- } else {
- $ncountidx = int(($#corord * $#corord) + $_ - 1);
- }
- $qstatc[$ncountidx]++;
- }
- }
- $_ = $corhold;
- @selord = ();
- @corord = ();
- } else {
- $qstatc[$#qstatc]++;
- }
- }
- ### DED 8/20/2002 If checked, don't count
- ### "No Response" in statistics
- if ($FORM{'exnoresp'}) {
- if ($qstatsqc[$qidx] > $qstatc[$#qstatc]) {
- $denom = $qstatsqc[$qidx] - $qstatc[$#qstatc];
- } else {
- $denom = 1;
- }
- for (my $i = 0; $i <= $#qstatc-1; $i++ ) {
- $qstatp[$i] = format_percent($qstatc[$i] / $denom);
- }
- } else {
- for (my $i = 0; $i <= $#qstatc; $i++ ) {
- $qstatp[$i] = format_percent($qstatc[$i] / $qstatsqc[$qidx]);
- }
- }
-
- $qstatsqrc[$qidx] = "";
- foreach $qstat (@qstatc) {
- $qstatsqrc[$qidx] = join('', $qstatsqrc[$qidx], "$qstat\;");
- }
- $qstatsqrp[$qidx] = "";
- ### DED 8/22/2002 Exclude "No Response"
- ### from statistics
- if ($FORM{'exnoresp'}) {
- $count = $#qstatc-1;
- } else {
- $count = $#qstatp
- }
- for (0 .. $count) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstatp[$_]\;");
- }
- }
- if (($qstatsqf[$qidx] eq 'mcm') || ($qstatsqf[$qidx] eq 'mch') || ($qstatsqf[$qidx] eq 'ord') || ($qstatsqf[$qidx] eq 'mtx') || ($qstatsqf[$qidx] eq 'mtr')) {
- $npctidxend = $#qstatc - 3;
- $nincidx = $#qstatc - 1;
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $npctidxend; $i++ ) {
- if ($ntotinc == 0) {
- $qstatp[$i] = 0;
- } else {
- $qstatp[$i] = format_percent($qstatc[$i] / $ntotinc);
- }
- }
- $qstatsqrp[$qidx] = "";
- foreach $qstat (@qstatp) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
- }
- } elsif ($qstatsqf[$qidx] eq 'esa') {
- $npctidxend = $#qstatc - 3;
- $ncoridx = $#qstatc - 2;
- $nincidx = $#qstatc - 1;
- $ntotcor = $qstatc[$ncoridx];
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $npctidxend; $i++ ) {
- if ($ntotcor == 0) {
- $qstatp[$i] = 0;
- } else {
- $qstatp[$i] = format_percent($qstatc[$i] / $ntotcor);
- }
- }
- $qstatsqrp[$qidx] = "";
- foreach $qstat (@qstatp) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
- }
- $nincidx = $#qstatc - 1;
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $#qstatsqwc; $i++ ) {
- if ($ntotinc == 0) {
- $qstatsqwp[$i] = 0;
- } else {
- $qstatsqwp[$i] = format_percent($qstatsqwc[$i] / $ntotinc);
- }
- }
- }
- @qstato = ();
- @qstatc = ();
- @qstatp = ();
- }
-}
-
-if ($#qucmts != -1) {
- @qsumry=sort @qucmts;
- @qucmts=@qsumry;
- @qsumry=();
-}
-print "
-
-Question Response Statistics
"; -if (defined $idlist) { - print "Groups: ".join(", ",split(/,/,$FORM{'idlist'}))."
\n"; -} - -print "$nresponses Completed Responses -
| ID | -Occ | -Pct | -Question Text | -|||||||||||||||||
| Cnt | -Pct | -|||||||||||||||||||
| $qstatsid[$_] | -INACTIVE | -$qstatsqt[$qid] | -||||||||||||||||||
| $qstatsid[$_] | -$qstatsqc[$qid] | -$qstatsqp[$qid]\% | -$qstatsqt[$qid] | -|||||||||||||||||
| $qstatccor | -$qstatpcor\% | -$xlatphrase[137] | -||||||||||||||||||
| $qstatcinc | -$qstatpinc\% | -INCORRECT | -||||||||||||||||||
| $qstatcinc | -$qstatpinc\% | -RESPONSES | -||||||||||||||||||
| $qstatcnor | "; - if ($FORM{'exnoresp'}) { - print "\n"; - } else { - print " | $qstatpnor\% | \n"; - } - print "$xlatphrase[670] | -|||||||||||||||||
-
|
- ||||||||||||||||||||
-
|
- ||||||||||||||||||||
-
|
- ||||||||||||||||||||
-
"; - print " -
|
- ||||||||||||||||||||
$qstatc[1]"; - } else { - print"$qstatc[0] $qstatc[2] $qstatc[1]"; - } - print " |
- $qstatp[1]\%"; - } else { - print"$qstatp[0]\% $qstatp[1]\%"; - } - } else { - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - print"$qstatp[2]\% $qstatp[1]\%"; - } else { - print"$qstatp[0]\% $qstatp[2]\% $qstatp[1]\%"; - } - } - print " |
- $qstato[1]"; - } else { - print"$qstato[0] $qstato[2] $qstato[1]"; - } - print " |
- ||||||||||||||||||
";
- #print "\n\t\t\t
| \n\t||||||||||||||||||||
"; - $boldtag = ""; - $boldtagend = ""; - } - print " |
- "; - $boldtag = ""; - $boldtagend = ""; - } - print " |
- "; - $boldtag = ""; - $boldtagend = ""; - } - print " |
- ||||||||||||||||||
\n\t\t\t
|
- ||||||||||||||||||||
| Comments | ||||||||||||||||||||
\n";
- print "
| \n||||||||||||||||||||
".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"; -} - -if ($FORM{'export'}) { - print "Content-Type: application/doc\n\n"; - $bExport=1; -} elsif ($FORM{'csv'}) { - print "Content-Type: text/x-csv\n\n"; -} else { - print "Content-Type: text/html\n\n"; - $bExport=0; -} -#print STDERR Dumper(\%FORM,$idlist); -if (&get_session($FORM{'tid'})) { - if ($FORM{'testsummary'} eq 'composite') { - &show_test_composite($idlist); - } elsif ($FORM{'testsummary'} eq 'bycnd') { - &show_test_resultsbycnd($idlist); - } else { - &extract_test_data(); - } -} -if ($bExport) { - exit(0); -} - -sub extract_test_data() { - &LanguageSupportInit(); - &get_client_profile($SESSION{'clid'}); - &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); - my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}"); - my @colhdrs=(); - push @colhdrs,""; - if ($FORM{'cndnme'}) { - push @colhdrs,"left:Last Name"; - push @colhdrs,"left:First Name"; - push @colhdrs,"left:MI"; - } - push @colhdrs,"left:User ID"; - if ($FORM{'cndeml'}) { - push @colhdrs,"left:Email Address"; - } - if ($FORM{'cnd1'}) { - push @colhdrs,"left:$CLIENT{'clcnd1'}"; - } - if ($FORM{'cnd2'}) { - push @colhdrs,"left:$CLIENT{'clcnd2'}"; - } - if ($FORM{'cnd3'}) { - push @colhdrs,"left:$CLIENT{'clcnd3'}"; - } - if ($FORM{'cnd4'}) { - push @colhdrs,"left:$CLIENT{'clcnd4'}"; - } - if ($FORM{'cndscr'}) { - push @colhdrs,"center:Correct"; - push @colhdrs,"center:Incorrect"; - push @colhdrs,"right:Score"; - } - my @dataflds=(); - my @unsorted=(); - my $row=""; - my @qsumry=(); - my $user=""; - my $joint="\&"; - my $colhdr; - my $colalgn; - my $fidx; - for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$CLIENT{'clid'}.//; - my $excuser="inc$user"; - if ($FORM{$excuser}) { - next; - } - &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - &get_candidate_profile($CLIENT{'clid'},$user); - if ($FORM{'cndnme'}) { - $row=join($joint,$row,"$CANDIDATE{'nml'}"); - $row=join($joint,$row,"$CANDIDATE{'nmf'}"); - $row=join($joint,$row,"$CANDIDATE{'nmm'}"); - } - $row=join($joint,$row,"$user"); - if ($FORM{'cndeml'}) { - $row=join($joint,$row,"$CANDIDATE{'eml'}"); - } - if ($FORM{'cnd1'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd1'}"); - } - if ($FORM{'cnd2'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd2'}"); - } - if ($FORM{'cnd3'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd3'}"); - } - if ($FORM{'cnd4'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd4'}"); - } - if ($FORM{'cndscr'}) { - $row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]); - } - push @unsorted, $row; - $row=""; - } - my @sorted=sort @unsorted; - @unsorted=(); - my $rowcount=$#filelist+1; - &print_report_dataextract_header($rowcount,@colhdrs,@colalign); - my ($i); - for $i (0 .. $#sorted) { - @dataflds=split($joint, $sorted[$i]); - if ($bExport) { - for $i (1 .. $#dataflds) { - print "$dataflds[$i]"; - if ($i == $#dataflds) { - print "\n"; - } else { - print "\t"; - } - } - } else { - print "
\n"; - print "Raw Data Extraction
\n"; - print "$ncount Completed Responses\n"; - #print "
| $colhdr | \n"; - } - print "\t<\TR>\n"; - } -} - -sub date_out_of_range { - my ($completedat,$datefm,$dateto) = @_; - my @unsorted=(); - push @unsorted, $completedat; - push @unsorted, $datefm; - push @unsorted, $dateto; - my @sorted = sort @unsorted; - my $bretyes = ($sorted[1] eq $unsorted[0]) ? 0 : 1; - @unsorted=(); - @sorted=(); - return $bretyes; -} - -$^W=1; -sub sort_test_results { - my ($sortby,@rows) = @_; - if ($sortby eq 'Name') { - #print STDERR "by Name\n"; - return sort {$a->{'columns'}->[0] cmp $b->{'columns'}->[0];} @rows; - } elsif ($sortby eq 'LoginID') { - #print STDERR "by LoginID\n"; - return sort {$a->{'columns'}->[1] cmp $b->{'columns'}->[1];} @rows; - } elsif ($sortby eq 'Date') { - #print STDERR "by Date\n"; - return sort {$a->{'end'} <=> $b->{'end'};} @rows; - } else { - #print STDERR "by Nothing\n"; - return @rows; - } -} - -sub show_test_resultsbycnd { - &LanguageSupportInit(); - &get_client_profile($SESSION{'clid'}); - &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); - my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}"); - my ($url) = ("$cgiroot/teststats.pl?"); - if (not $FORM{'sortby'}) {$FORM{'sortby'}=$sortbys[0];} - if (not $FORM{'reverse'}) {$FORM{'reverse'}=0;} - foreach (keys %FORM) { - if (($_ ne 'sortby') and ($_ ne 'reverse') and ($FORM{$_} !~ /\s+/)) { - #print STDERR "$_=$FORM{$_}\n"; - $url .= "&$_=$FORM{$_}"; - } else { - #print STDERR "NOT $_=$FORM{$_}\n"; - } - } - my $csvurl = $url."&csv=1&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); - my $reverseurl = $url."&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); - my %sorturls; - foreach my $sorter (@sortbys) { - $sorturls{$sorter} = $url."&sortby=$sorter"; - } - my @sorted=(); - my @unsorted=(); - my $user; - my $test; - my $qidx; - my $trash; - my $subjskl; - my $subj; - my $sklvl; - my $subjlist=","; - my @qids=(); - my @qsumry=(); - my @corincs=(); - my $bysubjflag = ($FORM{'statsbysubj'} ne '') ? 1 : 0; - my @subjects=(); - my @subjcnts=(); - my @subjtot=(); - my @subjmean=(); - my @subjmedian=(); - my @meanscore=split('\,',"0,0,0,0,100,0,0"); - my @medianscore=(); - my $i=0; - my $j=0; - my $fidx; - my @rows=(); - my $row={}; - my @answ=(); - my $qid; - my $usrnm; - my $nresultcount=$#filelist+1; - my $mtime; - my $completedat; - my $displaydate; - if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";} - if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";} - if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";} - if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";} - my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}"; - my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}"; - for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$CLIENT{'clid'}.//; - my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'}); - if (not defined $history) { - #print STDERR "$user from history.\n"; - $history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'}); - } else { - #print STDERR "$user from log.\n"; - } - if (not defined $history) { - # no log file entry for this test - #print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n"; - my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9]; - $history->{'end'} = $mtime; - $history->{'start'} = $history->{'end'}; - #print STDERR Dumper($history); - } - #$trash=join($pathsep,$testcomplete,$filelist[$fidx]); - #open (TMPFILE, "<$trash"); - #$mtime = (stat(TMPFILE))[9]; - #close TMPFILE; - $completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'}); - $displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'}); - #print STDERR "$completedat $displaydate $datefm $dateto\n"; - if (&date_out_of_range($completedat,$datefm,$dateto)) { - $nresultcount--; - next; - } - my $excuser="inc$user"; - if ($FORM{$excuser}) { - $nresultcount--; - next; - } - &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); - @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); - @answ=split(/\&/,$SUBTEST_ANSWERS{2}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - @corincs = split(/\//, $qsumry[$#qsumry]); - for $i (0 .. $#subjects) { - $subjcnts[$i][0]=0; - $subjcnts[$i][1]=0; - $subjcnts[$i][2]=0; - $subjcnts[$i][3]=0; - } - &get_candidate_profile($CLIENT{'clid'},$user); - $usrnm="$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}"; - $row={'columns' => [$usrnm,$user,$displaydate]}; - $row->{'start'} = $history->{'start'}; - $row->{'end'} = $history->{'end'}; - #print STDERR "Survey = $TEST_SESSION{'srvy'}\n"; - if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { - for $qid (1 .. $#qids) { - ($test,$qidx) = split(/\./, $qids[$qid]); - ($trash,$subjskl) = split(/::/, $answ[$qid]); - ($subj,$sklvl,$trash)=split(/\.|\:/,$subjskl); - unless ($subjlist =~ /\,$subj\,/i) { - $subjlist = join('',$subjlist,"$subj\,"); - push @subjects,"$subj"; - $i=$#subjects; - $subjcnts[$i][0]=0; # questions in subject area - $subjcnts[$i][1]=0; # correct answers - $subjcnts[$i][2]=0; # incorrect answers - $subjcnts[$i][3]=0; # pct correct - $subjtot[$i][0]=0; - $subjtot[$i][1]=0; - $subjtot[$i][2]=0; - $subjtot[$i][3]=0; - $subjmean[$i][0]=0; # population count - $subjmean[$i][1]=0; # population value summation - $subjmean[$i][2]=0; # population mean - $subjmean[$i][3]=0; # population standard deviation - $subjmean[$i][4]=100; # population range-low - $subjmean[$i][5]=0; # population range-high - } - for $i (0 .. $#subjects) { - if ($subj eq $subjects[$i]) { - $subjcnts[$i][0]++; - $subjtot[$i][0]++; - if (substr($corincs[$qid],0,1) eq '1') { - $subjcnts[$i][1]++; - $subjtot[$i][1]++; - } else { - $subjcnts[$i][2]++; - $subjtot[$i][2]++; - } - $subjcnts[$i][3]=int((($subjcnts[$i][1]/$subjcnts[$i][0])*100)); - $subjtot[$i][3]=int((($subjtot[$i][1]/$subjtot[$i][0])*100)); - last; - } - } - } - if ($bysubjflag) { - for $i (0 .. $#subjects) { - push @{$row->{'columns'}},$subjcnts[$i][0],$subjcnts[$i][1],$subjcnts[$i][2],$subjcnts[$i][3]; - $subjmean[$i][0]++; - $subjmean[$i][1]+=$subjcnts[$i][3]; - $subjmean[$i][2]=int(($subjmean[$i][1]/$subjmean[$i][0])); - #$subjmean[$i][4]=(($subjcnts[$i][3] < $subjmean[$i][4]) || ($subjmean[$i][4] == 0)) ? $subjcnts[$i][3] : $subjmean[$i][4]; - $subjmean[$i][4]=($subjcnts[$i][3] < $subjmean[$i][4]) ? $subjcnts[$i][3] : $subjmean[$i][4]; - $subjmean[$i][5]=($subjcnts[$i][3] > $subjmean[$i][5]) ? $subjcnts[$i][3] : $subjmean[$i][5]; - $subjmedian[$i][$fidx]=$subjcnts[$i][3]; - $subjcnts[$i][0]=0; - $subjcnts[$i][1]=0; - $subjcnts[$i][2]=0; - $subjcnts[$i][3]=0; - } - } - $meanscore[0]++; # data count - $meanscore[1]+=$qsumry[2]; # sum of values - $meanscore[2]=int(($meanscore[1]/$meanscore[0])); # unbiased population mean - $meanscore[4]=($qsumry[2] < $meanscore[4]) ? $qsumry[2] : $meanscore[4]; - $meanscore[5]=($qsumry[2] > $meanscore[5]) ? $qsumry[2] : $meanscore[5]; - $medianscore[$fidx]=$qsumry[2]; - } - push @{$row->{'columns'}},$qsumry[0],$qsumry[1],$qsumry[2]; - push @rows, $row; - } - @sorted=sort {$a <=> $b} @medianscore; - $j=$#sorted/2; - $i=$sorted[$j]; - if (($#sorted % 2) == 0) { - @medianscore=(); - $medianscore[0]=$i; - } else { - $j++; - $i+=$sorted[$j]; - @medianscore=(); - $medianscore[0]=int(($i/2)); - } - my @scores=(); - for $i (0 .. $#subjects) { - for $j (0 .. $#filelist) { - $scores[$j]=$subjmedian[$i][$j]; - } - @sorted=sort {$a <=> $b} @scores; - @scores=(); - $j=$#sorted/2; - $qid=$sorted[$j]; - if (($#sorted % 2) == 0) { - $subjmedian[$i][0]=$qid; - } else { - $j++; - $qid+=$sorted[$j]; - $subjmedian[$i][0]=int(($qid/2)); - } - } - # The sorting block - if ($FORM{'reverse'}) { - @sorted = reverse &sort_test_results($FORM{'sortby'},@rows); - } else { - @sorted = &sort_test_results($FORM{'sortby'},@rows); - } - # end of the sorting block - @rows=(); - if ($FORM{'csv'}) { - &print_report_bycnd_csv(@sorted); - return; - } - my $colspan=&print_report_bycnd_header($nresultcount,$bysubjflag,\%sorturls,$FORM{'sortby'}, - $csvurl,$reverseurl,@subjects); - @unsorted=(); - @subjcnts=(); - my $symbol=""; - my @cols=(); - my @rowhdrs=('Questions','Correct','Incorrect','Pct Correct'); - my $rowspan=($bysubjflag) ? ($#rowhdrs+1) : 1; - foreach my $row (@sorted) { - @cols=@{$row->{'columns'}}; - my ($start,$end,$duration,$datestamp,$total); - if ($bExport) { - print "$cols[0]\t$cols[1]\t$cols[2]\t"; - if ($bysubjflag) { print "\n";} - } else { - #($start,$end,$duration) = get_teststartend($CLIENT{'clid'},$cols[1],$FORM{'tstid'}); - $start = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'start'}))[0..2])); - $end = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'end'}))[0..2])); - $duration = &fmtDuration($row->{'end'} - $row->{'start'}); - if ($end == "Unknown" ) { - $datestamp = ""; - } else { - my $gmend = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'end'}))[0..2])); - $datestamp = "$cols[2] $gmend GMT"; - $datestamp =~ s/ /_/g; - } - $total = $cols[-3] + $cols[-2]; - - my $params = "tid=$SESSION{'tid'}&clid=$CLIENT{'clid'}&cndid=". - uri_escape($cols[1]). - "&tstid=$FORM{'tstid'}&correct=$cols[-3]&incorrect=$cols[-2]&total=$total&percent=$cols[-1]"; - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| $cols[0] | \n"; - print "\t\t$cols[1] | \n"; - print "\t\t$cols[2] | \n"; - } - if ($bysubjflag) { - for $j (0 .. $#rowhdrs) { - $symbol=($j==3) ? "\%" : ""; - if ($j > 0) { - if ($bExport == 0) { - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| $rowhdrs[$j] | \n"; - } - for $fidx (0 .. $#subjects) { - $qid=($fidx*4)+$j+3; - if ($bExport) { - print "$cols[$qid]\t"; - } else { - print "\t\t$cols[$qid]$symbol | \n"; - } - if ($j==3) { - $subjmean[$fidx][3]+=(($subjmean[$fidx][2]-$cols[$qid])*($subjmean[$fidx][2]-$cols[$qid])); - } - } - if ($j == 0) { - $fidx=$#cols-2; - if ($bExport) { - print "$cols[$fidx++]\t"; - print "$cols[$fidx++]\t"; - print "$cols[$fidx]\t"; - } else { - print "\t\t$cols[$fidx++] | \n"; - print "\t\t$cols[$fidx++] | \n"; - print "\t\t$cols[$fidx]\% | \n"; - } - } - if ($bExport) { - print "\n"; - } else { - print "\t$start | \n"; - print "\t\t$end | \n"; - print "\t\t$duration | \n"; - if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { - print "\t\t$cols[$j++] | \n"; - print "\t\t$cols[$j++] | \n"; - print "\t\t$cols[$j]\% | \n"; - } else { - print "\t\tNot Scored by Definition | \n"; - } - print "\t\n"; - } - } - if ($bysubjflag) { - if ($bExport==0) { - print "\t|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Composite | \n"; - } - } else { - if ($bExport) { - print "\t\t"; - } - } - if ($bExport) { - print "$rowhdrs[$j]\t"; - } else { - print "\t\t$rowhdrs[$j] | \n"; - } - if ($j < 4) { - $symbol=($j==3) ? "\%" : ""; - for $fidx (0 .. $#subjects) { - if ($bExport) { - print "$subjtot[$fidx][$j]\t"; - } else { - print "\t\t$subjtot[$fidx][$j]$symbol | \n"; - } - } - if ($j == 0) { - if ($bExport) { - print "\t\t"; - } else { - print "\t\t\ \; | \n";
- }
- } elsif ($j == 3) {
- if ($bExport) {
- print "\tOverall\t";
- } else {
- print "\t\tOverall | \n"; - } - } - } else { - $symbol="\%"; - $i=$j-2; - for $fidx (0 .. $#subjects) { - if ($i == 6) { - if ($bExport) { - print "$subjmedian[$fidx][0]\t"; - } else { - print "\t\t$subjmedian[$fidx][0]$symbol | \n"; - } - } else { - if ($i==3) { - $subjmean[$fidx][3]=int((sqrt(($subjmean[$fidx][3]/$subjmean[$fidx][0])))); - if ($bExport) { - print "$subjmean[$fidx][$i]\t"; - } else { - print "\t\t\&\#177$subjmean[$fidx][$i]$symbol | \n"; - } - } else { - if ($bExport) { - print "$subjmean[$fidx][$i]\t"; - } else { - print "\t\t$subjmean[$fidx][$i]$symbol | \n"; - } - } - } - } - $i=$j-2; - if ($i==3) { - if ($bExport) { - print "\t$meanscore[$i]\t"; - } else { - print "\t\t\&\#177$meanscore[$i]$symbol | \n"; - } - } elsif ($i==6) { - if ($bExport) { - print "\t$medianscore[0]\t"; - } else { - print "\t\t$medianscore[0]$symbol | \n"; - } - } else { - if ($bExport) { - print "\t$meanscore[$i]\t"; - } else { - print "\t\t$meanscore[$i]$symbol | \n"; - } - } - } - if ($bExport) { - print "\n"; - } else { - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Composite | \n"; - } - } - if ($bExport) { - print "\t$rowhdrs[$j]\t"; - } else { - print "\t\t$rowhdrs[$j] | \n"; - } - if ($j==1) { - if ($bExport) { - print "\t\t$meanscore[$i]"; - } else { - print "\t\t\&\#177$meanscore[$i]$symbol | \n"; - } - } elsif ($j==4) { - if ($bExport) { - print "\t\t$medianscore[0]"; - } else { - print "\t\t$medianscore[0]$symbol | \n"; - } - } else { - if ($bExport) { - print "\t\t$meanscore[$i]"; - } else { - print "\t\t$meanscore[$i]$symbol | \n"; - } - } - if ($bExport) { - print "\n"; - } else { - print "\t||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| \n";
- foreach (@sortbys) {
- if ($_ ne $sortby) {
- print "\t\t\t{$_}\">Sort by $_ \n"; - } else { - print "\t\t\tSorted by $_ \n"; - } - } - print "\t\t\t | ";
- print "CSV Report\n\t\t\t "; - print "Change to ".($FORM{'reverse'}?'ascending':'descending')."\n\t\t | \n";
- print "\t||||||||
| Candidate | \n"; - print "\t\tLoginID | \n"; - print "\t\tDate | \n"; - if ($bysubj) { - print "\t\tSubject Areas | \n"; - } else { - print "\t\tStart | \n"; - print "\t\tEnd | \n"; - print "\t\tDuration | \n"; - } - print "\t\tOverall | \n"; - print "\t||
| \ \; | \n"; - for $i (0 .. $nsubjects) { - print "\t\t$subjects[$i] | \n"; - } - }; - print "\t\tCorrect | \n"; - print "\t\tIncorrect | \n"; - print "\t\tScore | \n"; - print "\t|||||
/g; - ($test,$qid) = split(/\./, $id); - $qstatsid[$qid] = $id; - $qstatsqc[$qid] = 0; # occurrences of question - $qstatsqp[$qid] = 0; # percent occurrences of question - $qstatsqt[$qid] = $qtx; # question text - if ($qil eq 'Y') { - $qstatsqf[$qid] = "obs"; # question type - } else { - $qstatsqf[$qid] = $qtp; # question type - $qallans = ""; - if ($qtp eq 'tf') { - $qallans = "$qca\;$qia\;$xlatphrase[670]"; #670=No Response - } elsif ($qtp eq 'mcs' || $qtp eq 'mca' || $qtp eq 'lik') { - if ($qca eq '') { - $qallans = "$qia\;$xlatphrase[670]"; - } else { - $qallans = "$qca\;$qia\;$xlatphrase[670]"; - } - } elsif ($qtp eq 'mtx' || $qtp eq 'mtr') { - # DED When qca is saved correctly in tdef, - # put this back and delte rest: - # $qallans = "$qca"; - ### DED 2/25/05 Assumes RC labels, not lblall - ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); - @qiar = split("\;", $qiar); - @qiac = split("\;", $qiac); - $qallans = ""; - foreach $qiarow (@qiar) - { - foreach $qiacol (@qiac) - { - $qallans .= "xxx\;"; - } - } - } elsif ($qtp eq 'mcm') { - if ($qca eq '') { - $qallans = "$qia"; - } else { - $qallans = "$qca\;$qia"; - } - } elsif ($qtp eq 'esa') { - if ($qca eq '') { - $qallans = ""; - } else { - $qallans = "$qca"; - } - } elsif ($qtp eq 'nrt') { - if ($qca eq 'N/A') { - $qallans = "Other\;$xlatphrase[670]\;"; - } else { - $qallans = "$qca\;Other\;$xlatphrase[670]\;"; - } - } elsif ($qtp eq 'mch') { - @qcans = split(/\;/, $qca); - @qians = split(/\;/, $qia); - for (my $i = 0; $i <= $#qcans; $i++ ) { - $qallans = join('', $qallans, "$qcans[$i]===$qians[$i]
"); - } - } elsif ($qtp eq 'ord') { - $qallans = "$qca"; - } - $qallans =~ s/\;\;/\;/g; - $qstatsqr[$qid] = $qallans; # response options - $fqstatsqr[$qid] = $qallans; ### DED for FBQ - $qstatsqw[$qid] = (); - if (($qtp eq 'mch') || ($qtp eq 'ord')) { - if ($qtp eq 'mch') { - @qstato = split(/
/, $qallans); - } else { - @qstato = split(/\;/, $qallans); - } - $ncount = $#qstato + 1; - $ncount = int(($ncount * ($ncount + 1)) + 3); - for (my $i = 0; $i <= $ncount; $i++ ) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } elsif ($qtp eq 'mcm' || $qtp eq 'esa' || $qtp eq 'mtx' || $qtp eq 'mtr') { - ### ASSUMES rank=1..10 - need to allow for other ranks - @qstato = split(/\;/, $qallans); - if ($qtp eq 'mtr') - { - # Have to allow for [1..10] in - # each answer, so make it big! - $ncount = (($#qstato + 1) * 10) + 3; - } - else - { - $ncount = $#qstato + 3; - } - for (my $i = 0; $i <= $ncount; $i++ ) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } else { - @qstato = split(/\;/, $qallans); - foreach $qstat (@qstato) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } - } - @qstato = (); - } - $ncount = $#filelist + 1; - @qucmts=(); - $nresponses=$#filelist+1; - for (my $fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$CLIENT{'clid'}.//; - if (defined $idlist and not $idlist->{$user}) { - $nresponses--; - next; - } - my $excuser="inc$user"; - if ($FORM{$excuser}) { - $nresponses--; - next; - } - &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); - @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); - @qrsp = split(/\&/, $SUBTEST_RESPONSES{2}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - @corincs = split(/\//, $qsumry[5]); - @qsumry = (); - @qsumry = split(/\&/, $SUBTEST_ANSWERS{2}); - @qansseq = (); - $fqid=""; - $fqididx=""; - for (1 .. $#qids) { - ($test,$qidx) = split(/\./, $qids[$_]); - ($qansord,$trash) = split(/::/, $qsumry[$_]); - $qansord =~ s/\=([0-1])//g; - $qansseq[$_] = $qansord; - - ($qresp,$qucmt) = split(/::/, $qrsp[$_]); - $qresp=~ tr/+/ /; - $qresp=~ tr/'//d; - $qrsp[$_]=$qresp; - - ##### v ADT - 7/03/2002 ################################### - # Added code to print NRT answers in the form of the comments - #push @qresponses, "$qidx\&$user\&$qresp"; - - if ($qucmt ne '') { - $qucmt =~ tr/+/ /; - $qucmt =~ tr/'//d; - push @qucmts, "$qidx\&$user\&$qucmt"; - } - ### DED 10/28/2002 Support for filter-by-question (FBQ) - if ($FORM{'question'} eq $qids[$_]) { - $fqididx=$_; - ($trash,$fqid)=split(/\./,$qids[$_]); - } - } - ### DED 10/28/2002 Support for filter-by-question (fbq) - #print "
FormQues= $FORM{'question'} Ans= $FORM{'answer'} Qansseq= $qansseq[$fqididx]
\n"; - if ($fqid ne "" && $FORM{'answer'} ne "") { - $fmatch=0; - if ($qstatsqf[$fqid] eq 'mcs' || $qstatsqf[$fqid] eq 'mca' || $qstatsqf[$fqid] eq 'lik') { - @fqansseq=split(/\?/,$qansseq[$fqididx]); - shift @fqansseq; - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - foreach $fans (@fans) { - @ffresp=(); - $fresp=""; - for (0 .. $#fqansseq) { - $fqseqans[$fqansseq[$_]]=$_; - $ffresp[$_]="xxx"; - } - if ($fans ne "No+Response") { - $ffresp[$fqseqans[$fans]]=$fqseqans[$fans]; - } - if ($ffresp[0] eq "") { - $fresp=""; - } else { - foreach (@ffresp) { - $fresp=join('?',$fresp,$_); - } - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { - $fmatch=1; - } - @ffresp=(); - if ($fmatch == 1) { break; } - } - @fqansseq=(); - @fans=(); - } elsif ($qstatsqf[$fqid] eq 'mcm') { - @fqansseq=split(/\?/,$qansseq[$fqididx]); - shift @fqansseq; - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - @ffresp=(); - $fresp=""; - for (0 .. $#fqansseq) { - $fqseqans[$fqansseq[$_]]=$_; - $ffresp[$_]="xxx"; - } - if ($fans[0] ne "No+Response") { - foreach (@fans) { - $ffresp[$fqseqans[$_]]=$fqseqans[$_]; - } - } - if ($ffresp[0] eq "") { - $fresp=""; - } else { - foreach (@ffresp) { - $fresp=join('?',$fresp,$_); - } - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { - $fmatch=1; - } - @fqansseq=(); - @fans=(); - @ffresp=(); - } elsif ($qstatsqf[$fqid] eq 'tf') { - if ($FORM{'answer'} eq "\&0" ) { - $fresp=$qansseq[$fqididx]; - } elsif ($FORM{'answer'} eq "\&1" ) { - SWITCH: for ($qansseq[$fqididx]) { - $fresp = /TRUE/ && "FALSE" - || /FALSE/ && "TRUE" - || /YES/ && "NO" - || /NO/ && "YES" - || "bad"; - } - } elsif ($FORM{'answer'} eq "\&No+Response") { - $fresp=""; - } else { - $fresp="bad"; - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "bad") { - $fmatch=1; - } - } elsif ($qstatsqf[$fqid] eq 'esa') { - ($fqstatsqr,$trash)=split(/;Other/,$fqstatsqr[$fqid]); - @fqr=split(/\;/,$fqstatsqr); - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - if ($fans[0] eq "No+Response") { - $fqr=""; - if ($fqr eq $qrsp[$fqididx]) { - $fmatch=1; - } - } else { - foreach (@fans) { - $fqr=lc($fqr[$_]); - $fqrsp=lc($qrsp[$fqididx]); - if ($fqr eq $fqrsp && $fqr ne "") { - $fmatch=1; - last; - } - } - } - @fqr=(); - @fans=(); - } - #print "
FQid= $fqid Qtp= $qstatsqf[$fqid] Qstatsid= $qstatsid[$fqid] Fresp= $fresp Qrsp=$qrsp[$fqididx]
\n";
- if ($fmatch == 0) {
- ### Don't count this one
- #print "...Skipping...";
- $nresponses--;
- @fqucmts = @qucmts;
- @qucmts = ();
- foreach (@fqucmts) {
- if (!($_ =~ /\&$user\&/)) {
- push @qucmts, "$_";
- }
- }
- next;
- }
- $fresp="";
- }
- ### DED End fbq support
- @qsumry=();
- for (1 .. $#qids) {
- ($test,$qidx) = split(/\./, $qids[$_]);
- if ($qstatsqf[$qidx] ne 'obs') {
- $qstatsqc[$qidx]++;
- $qstatsqp[$qidx] = format_percent(($qstatsqc[$qidx] / $ncount),
- { fmt => "%.0f" } );
- @qstatc = split(/\;/, $qstatsqrc[$qidx]);
- @qstatp = split(/\;/, $qstatsqrp[$qidx]);
- if ($qstatsqf[$qidx] eq 'tf') {
- @qstato = split(/\;/, $qstatsqr[$qidx]);
- if ($qrsp[$_] eq $qstato[0]) {
- $qstatc[0]++;
- } elsif ($qrsp[$_] eq $qstato[1]) {
- $qstatc[1]++;
- } else {
- $qstatc[2]++;
- }
- }elsif ($qstatsqf[$qidx] eq 'esa'){
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/\+/ /g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 1) {
- @qansord = split(/\;/, $qansseq[$_]);
- for $q (0 .. $#qansord) {
- if ($qansord[$q] eq $qresp) {
- $qstatc[$q]++;
- last;
- }
- }
- } else { # incorrect
- $found=0;
- @qstatw=split(/\;/,$qstatsqw[$qidx]);
- shift(@qstatw);
- for $q (0 .. $#qstatw) {
- if ($qstatw[$q] eq $qresp) {
- $qstatsqwc[$q]++;
- $found=1;
- last;
- }
- }
- if ($found != 1) {
- $qstatsqwc[$#qstatw+1]=1;
- $qstatsqw[$qidx]=join(';',$qstatsqw[$qidx],$qresp);
- }
- @qstatq=();
- }
- } else {
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- }elsif ($qstatsqf[$qidx] eq 'nrt'){
- if ($qrsp[$_] ne '') {
- $qstatc[1]++;
- $qrsp[$_] =~ s/\;/\:/g;
- $qrsp[$_] =~ s/\r//g;
- $qrsp[$_] =~ s/\n/\\n/g;
-
- $qstatsqr[$qidx] = join('
',$qstatsqr[$qidx],$qrsp[$_]);
- } else {
- $qstatc[2]++;
- }
- } elsif ($qstatsqf[$qidx] eq 'mcs' || $qstatsqf[$qidx] eq 'mca' || $qstatsqf[$qidx] eq 'lik') {
- ### DED Filter out "?" and "xxx" in qrsp so will match
- $qrsp[$_] =~ s/\?//g;
- $qrsp[$_] =~ s/xxx//g;
- @qansord = split(/\?/, $qansseq[$_]);
- shift @qansord;
- $found = 0;
- ### DED 10/09/02 Changed to allow for
- ### randomized answers
- #for (my $i = 0; $i <= $#qansord; $i++ ) {
- #if (("$qansord[$i]" eq "$qrsp[$_]") && ($qrsp[$_] ne '')) {
- if ($qrsp[$_] ne '') {
- $qstatc[$qansord[$qrsp[$_]]]++;
- $found = 1;
- }
- #}
- unless ($found) {
- # increment "No Response"
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- } elsif ($qstatsqf[$qidx] eq 'mtx') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
- ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
- @qiar = split("\;", $qiar);
- @qiac = split("\;", $qiac);
-
- # skipping answer sequence part (no rand answ)
- $holding3 = $_;
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- $i=0;
- foreach $qiarow (@qiar)
- {
- foreach $qiacol (@qiac)
- {
- if ($qresps[$i] ne "xxx") {
- $qstatc[$i]++;
- }
- $i++;
- }
- }
- }
- } else {
- # increment No Response counter
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mtr') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
- ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
- @qiar = split("\;", $qiar);
- @qiac = split("\;", $qiac);
-
- # skipping answer sequence part (no rand answ)
- $holding3 = $_;
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- $iqresps=0;
- $iqstatc=0;
- foreach $qiarow (@qiar)
- {
- foreach $qiacol (@qiac)
- {
- if ($qresps[$iqresps] ne "xxx")
- {
- # $qresps[$iqresps] will be [1..10], so adjust index accordingly
- $irank = $iqstatc + $qresps[$iqresps] - 1;
- $qstatc[$irank]++;
- }
- $iqresps++;
- $iqstatc += 10;
- }
- }
- }
- } else {
- # increment No Response counter
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mcm') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- @qansord = split(/\?/, $qansseq[$_]);
- shift @qansord;
- $holding3 = $_;
- #$found = 0;
- ### DED 10/18/02 Changed to allow for
- ### randomized answers & new format
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- foreach $qresp (@qresps) {
- if ($qresp ne "xxx") {
- $qstatc[$qansord[$qresp]]++;
- }
- }
- }
- } else {
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mch') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
- ### DED 10/18/02 Changed for
- ### random answers and new format
-
- #
- # Count occurrence of each match
-
- # $qansseq[$qidx] [Wrong! DED]
- # $qansseq[$_]
- # &a.3.2.0.6.5.8.4.7.1::MATCH.0:1:1:0
- # $qrsp[$_]
- # &dgihbfcea [Old format]
- # &?d?g?i?h?b?f?c?e?a [New]
-
- #$qansseq[$qidx] =~ s/\&//g;
- $qansseq[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/ //g;
- #@corord = split(/\./, $qansseq[$qidx]);
- @corord = split(/\./, $qansseq[$_]);
- #@selord = split(//,$qrsp[$_]);
- @selord = split(/\?/,$qrsp[$_]);
- shift @selord;
- $corhold = $_;
- if ($corinc == 0) {
- for (0 .. $#selord) {
- if ($selord[$_] ne 'xxx') {
- ($x = &get_label_index($corord[0],$selord[$_]))++;
- $y = $corord[$x];
-
- #$ncountidx = int($_ * $#corord + $y);
- $ncountidx = int($y * $#corord + $_);
- } else {
- $ncountidx = int(($#corord * $#corord ) + $_);
- }
- $qstatc[$ncountidx]++;
- }
- }
- $_ = $corhold;
- @selord = ();
- @corord = ();
- } else {
- $qstatc[$#qstatc]++;
- }
- } elsif ($qstatsqf[$qidx] eq 'ord') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- ### DED 10/18/02 Changed for
- ### random answers and new format
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- #
- # Count occurrence of each incorrect order
- # &o.2.3.4.1.0::ORDERED.0:1:1:0
- # &34521 [Old format]
- # &?3?4?5?2?1 [New]
- #
- #$qansseq[$qidx] =~ s/\&//g;
- $qansseq[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/\&//g;
- #@corord = split(/\./, $qansseq[$qidx]);
- @corord = split(/\./, $qansseq[$_]);
- #@selord = split(//,$qrsp[$_]);
- @selord = split(/\?/,$qrsp[$_]);
- shift @selord;
- $corhold = $_;
- if ($corinc == 0) {
- for (1 .. $#corord) {
- $ncountidx = int(($corord[$_]) * $#corord);
- $x = int($_ - 1);
- if ($selord[$x] ne 'xxx') {
- $ncountidx = $ncountidx + int($selord[$x]) - 1;
- } else {
- $ncountidx = int(($#corord * $#corord) + $_ - 1);
- }
- $qstatc[$ncountidx]++;
- }
- }
- $_ = $corhold;
- @selord = ();
- @corord = ();
- } else {
- $qstatc[$#qstatc]++;
- }
- }
- ### DED 8/20/2002 If checked, don't count
- ### "No Response" in statistics
- if ($FORM{'exnoresp'}) {
- if ($qstatsqc[$qidx] > $qstatc[$#qstatc]) {
- $denom = $qstatsqc[$qidx] - $qstatc[$#qstatc];
- } else {
- $denom = 1;
- }
- for (my $i = 0; $i <= $#qstatc-1; $i++ ) {
- $qstatp[$i] = format_percent($qstatc[$i] / $denom);
- }
- } else {
- for (my $i = 0; $i <= $#qstatc; $i++ ) {
- $qstatp[$i] = format_percent($qstatc[$i] / $qstatsqc[$qidx]);
- }
- }
-
- $qstatsqrc[$qidx] = "";
- foreach $qstat (@qstatc) {
- $qstatsqrc[$qidx] = join('', $qstatsqrc[$qidx], "$qstat\;");
- }
- $qstatsqrp[$qidx] = "";
- ### DED 8/22/2002 Exclude "No Response"
- ### from statistics
- if ($FORM{'exnoresp'}) {
- $count = $#qstatc-1;
- } else {
- $count = $#qstatp
- }
- for (0 .. $count) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstatp[$_]\;");
- }
- }
- if (($qstatsqf[$qidx] eq 'mcm') || ($qstatsqf[$qidx] eq 'mch') || ($qstatsqf[$qidx] eq 'ord') || ($qstatsqf[$qidx] eq 'mtx') || ($qstatsqf[$qidx] eq 'mtr')) {
- $npctidxend = $#qstatc - 3;
- $nincidx = $#qstatc - 1;
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $npctidxend; $i++ ) {
- if ($ntotinc == 0) {
- $qstatp[$i] = 0;
- } else {
- $qstatp[$i] = format_percent($qstatc[$i] / $ntotinc);
- }
- }
- $qstatsqrp[$qidx] = "";
- foreach $qstat (@qstatp) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
- }
- } elsif ($qstatsqf[$qidx] eq 'esa') {
- $npctidxend = $#qstatc - 3;
- $ncoridx = $#qstatc - 2;
- $nincidx = $#qstatc - 1;
- $ntotcor = $qstatc[$ncoridx];
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $npctidxend; $i++ ) {
- if ($ntotcor == 0) {
- $qstatp[$i] = 0;
- } else {
- $qstatp[$i] = format_percent($qstatc[$i] / $ntotcor);
- }
- }
- $qstatsqrp[$qidx] = "";
- foreach $qstat (@qstatp) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
- }
- $nincidx = $#qstatc - 1;
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $#qstatsqwc; $i++ ) {
- if ($ntotinc == 0) {
- $qstatsqwp[$i] = 0;
- } else {
- $qstatsqwp[$i] = format_percent($qstatsqwc[$i] / $ntotinc);
- }
- }
- }
- @qstato = ();
- @qstatc = ();
- @qstatp = ();
- }
-}
-
-if ($#qucmts != -1) {
- @qsumry=sort @qucmts;
- @qucmts=@qsumry;
- @qsumry=();
-}
-
- print HTMLHeaderPlain("Question Response Statistics");
- print "
Question Response Statistics
\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 "$nresponses Completed Responses -\n"; -print HTMLFooter(); -} - -sub HTMLHeaderPlain { - return "\n\n-
\n"; -print "-"; -$sobsolete = ""; -if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $incresponse = ""; -} else { - $incresponse = "INCORRECT"; -} -for (1 ..$#questions) { - ($test,$qid) = split(/\./, $qstatsid[$_]); - if (!($FORM{'exunans'} && $qstatsqc[$qid] < $FORM{'minunans'})) { - if ($qstatsqf[$qid] eq 'obs') { - if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') { - $sobs = " - - -$qstatsid[$_] -INACTIVE -$qstatsqt[$qid] -- "; - $sobsolete = join('', $sobsolete, $sobs); - } - } else { - if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || ($qstatsqf[$qid] eq 'esa') || ($qstatsqf[$qid] eq 'mtx') || ($qstatsqf[$qid] eq 'mtr')) { - if ($qstatsqf[$qid] eq 'mch') { - @qstato = split(/
/, $qstatsqr[$qid]); - } else { - @qstato = split(/\;/, $qstatsqr[$qid]); - } - if ($qstatsqf[$qid] eq 'esa') { - @qstatw = split(/\;/, $qstatsqw[$qid]); - shift @qstatw; - } - $rowspan1 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4; - $rowspan2 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4; - } else { - @qstato = split(/\;/, $qstatsqr[$qid]); - if ( $qstatsqf[$qid] eq 'nrt' ){ - $qstato[1] =~ s/\/\//
/g; - $qstato[1] =~ s/\//
/g; - $qstato[1] =~ s/:/
/g; - $qstato[1] =~ s/\+/ /g; - } - $rowspan1 = 2; - $rowspan2 = 2; - } - if ($FORM{'showcmts'} eq 'withq') { - $rowspan1++; - $rowspan2++; - } - $outary[$_] .= " -- "; - - @qstatc = split(/\;/, $qstatsqrc[$qid]); - @qstatp = split(/\;/, $qstatsqrp[$qid]); - if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || $qstatsqf[$qid] eq 'esa' || $qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') { - $ncountidx = $#qstatc - 2; - $qstatccor = $qstatc[$ncountidx]; - $qstatpcor = $qstatp[$ncountidx]; - $qstatcinc = $qstatc[$ncountidx+1]; - $qstatpinc = $qstatp[$ncountidx+1]; - $qstatcnor = $qstatc[$ncountidx+2]; - $qstatpnor = $qstatp[$ncountidx+2]; - if ($TEST{'seq'} ne svy && $TEST{'seq'} ne dmg) { - $outary[$_] .= " -$qstatsid[$_] -$qstatsqc[$qid] -$qstatsqp[$qid]\% -$qstatsqt[$qid] -- "; - $outary[$_] .= " -$qstatccor -$qstatpcor\% -$xlatphrase[137] -- "; - } else { - $outary[$_] .= " -$qstatcinc -$qstatpinc\% -INCORRECT -- "; - } - $outary[$_] .= " -$qstatcinc -$qstatpinc\% -RESPONSES -- - "; - } - if (($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord')) { - if ($qstatsqf[$qid] eq 'mch') { - $sphrase = "(matched to \>\;\>\;\>\;)"; - @matchwords = (); - @matchtos = (); - foreach $qstat (@qstato) { - ($matchword, $matchto) = split(/\=\=\=/, $qstat); - push @matchwords, $matchword; - push @matchtos, $matchto; - } - push @matchtos, "Left Blank"; - } else { - $sphrase = "(ordered as number \>\;\>\;\>\;)"; - @matchwords = (); - @matchtos = @qstato; - $matchidx = 1; - foreach $qstat (@qstato) { - push @matchwords, "$matchidx"; - $matchidx++; - } - push @matchtos, "Not Used"; - } - $colspan = int((($#matchwords + 1) * 2) + 1); - $outary[$_] .= "$qstatcnor "; - if ($FORM{'exnoresp'}) { - $outary[$_] .= "\n"; - } else { - $outary[$_] .= " $qstatpnor\% \n"; - } - $outary[$_] .= "$xlatphrase[670] -- "; - } elsif ($qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') { - ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qid]); - ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); - @qiar = split("\;", $qiar); - @qiac = split("\;", $qiac); - $holdmcm = $_; - if ($qstatsqf[$qid] eq 'mtr') - { - $colspan = ($#qiac + 1) * 3 + 1; - $colspan2 = 3; - } - else - { - $colspan = ($#qiac + 1) * 2 + 1; - $colspan2 = 2; - } - $outary[$_] .= " -- --
-- -BREAKDOWN OF $incresponse RESPONSES -- -"; - foreach $matchword (@matchwords) { - $outary[$_] .= " - $sphrase $matchword "; - } - $outary[$_] .= " -"; - foreach $matchword (@matchwords) { - $outary[$_] .= " - "; - $matchidx = 0; - foreach $matchto (@matchtos) { - $outary[$_] .= " -Cnt -Pct "; - } - $outary[$_] .= " -"; - if ($matchto eq $matchtos[$#matchtos]) { - $outary[$_] .= " - "; - } - $outary[$_] .= " -$matchto "; - } else { - $outary[$_] .= " -$matchto "; - } - foreach $matchword (@matchwords) { - $outary[$_] .= " -$qstatc[$matchidx] -$qstatp[$matchidx]\% "; - $matchidx++; - } - $outary[$_] .= " -- "; - } elsif ($qstatsqf[$qid] eq 'mcm') { - $outary[$_] .= " -- --
-- -BREAKDOWN OF $incresponse RESPONSES -- -"; - foreach $qiacol (@qiac) - { - $outary[$_] .= " $qiacol "; - } - $outary[$_] .= "\n- \n"; - $i=0; - foreach $qiarow (@qiar) - { - $outary[$_] .= ""; - foreach $qiacol (@qiac) - { - if ($qstatsqf[$qid] eq 'mtr') - { - $outary[$_] .= " "; - } - $outary[$_] .= " Rank - Cnt "; - } - $outary[$_] .= "\n Pct - \n"; - } - $outary[$_] .= "\n$qiarow "; - foreach $qiacol (@qiac) - { - if ($qstatsqf[$qid] eq 'mtr') - { - $outary[$_] .= ""; - for $irank (1 .. 10) - { - $outary[$_] .= "$irank "; - $outary[$_] .= "
"; - } - $outary[$_] .= ""; - for $irank (1 .. 10) - { - $outary[$_] .= "$qstatc[$i+$irank-1] "; - $outary[$_] .= "
"; - } - $outary[$_] .= ""; - for $irank (1 .. 10) - { - $outary[$_] .= "$qstatp[$i+$irank-1]\% "; - $i += 10; - } - else - { - $outary[$_] .= "
"; - } - $outary[$_] .= "$qstatc[$i] "; - $outary[$_] .= "$qstatp[$i]\% "; - $i++; - } - } - $outary[$_] .= "\n- "; - } elsif ($qstatsqf[$qid] eq 'esa') { - $outary[$_] .= " -- --
-- -BREAKDOWN OF $incresponse RESPONSES -- -- Response Option - Cnt - Pct - -- "; - foreach $qstat (@qstato) { - $outary[$_] .= "$qstat -
"; - } - $outary[$_] .= "- "; - $holdmcm = $_; - $endidx = $#qstatc - 3; - for (0 .. $endidx) { - $outary[$_] .= "$qstatc[$_] -
"; - } - $outary[$_] .= "- "; - for (0 .. $endidx) { - $outary[$_] .= "$qstatp[$_]\% -
"; - } - $_ = $holdmcm; - $outary[$_] .= "- "; - } elsif ($qstatsqf[$qid] eq 'nrt' ) { - - ##### v ADT - 7/03/2002 ################################################ - # If you want to remove the NRT statistics, delete between these comments - ######################################################################## - $outary[$_] .= " -- --
-- -BREAKDOWN OF $xlatphrase[137] RESPONSES -- -- Response Option - Cnt - Pct - -- "; - foreach $qstat (@qstato) { - $outary[$_] .= "$qstat -
"; - } - $outary[$_] .= "- "; - $holdmcm = $_; - $endidx = $#qstatc - 3; - for (0 .. $endidx) { - $outary[$_] .= "$qstatc[$_] -
"; - } - $outary[$_] .= "- "; - for (0 .. $endidx) { - $outary[$_] .= "$qstatp[$_]\% -
"; - } - $_ = $holdmcm; - $outary[$_] .= ""; - $outary[$_] .= " -
-
-- -BREAKDOWN OF $incresponse RESPONSES -- -- Response Option - Cnt - Pct - -- "; - foreach $qstat (@qstatw) { - $outary[$_] .= "$qstat -
"; - } - $outary[$_] .= "- "; - $holdmcm = $_; - foreach (@qstatsqwc) { - $outary[$_] .= "$_ -
"; - } - $outary[$_] .= "- "; - foreach (@qstatsqwp) { - $outary[$_] .= "$_\% -
"; - } - $_ = $holdmcm; - $outary[$_] .= "- "; - $outary[$_] .= " -- "; - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .="$qstatc[2] -
$qstatc[1]"; - } else { - $outary[$_] .="$qstatc[0]
$qstatc[2]
$qstatc[1]"; - } - $outary[$_] .= "- "; - if ($FORM{'exnoresp'}) { - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .=" -
$qstatp[1]\%"; - } else { - $outary[$_] .="$qstatp[0]\%
$qstatp[1]\%"; - } - } else { - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .="$qstatp[2]\%
$qstatp[1]\%"; - } else { - $outary[$_] .="$qstatp[0]\%
$qstatp[2]\%
$qstatp[1]\%"; - } - } - $outary[$_] .= "- "; - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .="$qstato[1] "; - $outary[$_] .= " -
$qstato[0]"; - } else { - $outary[$_] .="$qstato[0]
$qstato[2]
$qstato[1]"; - } - $outary[$_] .= "- - "; - ##### ^ ADT - 7/03/2002 - End Delete ################################### - - ##### v ADT - 7/03/2002 ################################################ - # Added code to print NRT answers in the form of the comments - ######################################################################## - #print "\n\t"; - $outary[$_] .= " - "; - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .=" -
$qstato[2]"; - } else { - $outary[$_] .="
$qstato[3]"; - } - $outary[$_] .= " -\n\t\t \n"; - ##### ^ ADT - 7/03/2002 ################################################ - - } else { - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $bs = ""; - $be = ""; - } else { - $bs = ""; - $be = ""; - } - $outary[$_] .= " -"; - #print "\n\t\t\t \n\t\n\t\t\t\t
\n\t\t\n"; - #print "\t\t\t\t\t \n"; - #print "\t\t\tAnswers: \n"; - #print "\t\t\t\t\t"; - #for $i (0 .. $#qresponses) { - #@columns=split(/\&/, $qresponses[$i]); - #if ($columns[0] eq $qid) { - #print "$columns[1]\: \n"; - #print "\t\t\t\t
\n"; - #while (length($columns[2]) > 50) { - #$j=index($columns[2]," ",45); - #if ($j==-1) { - #$qresponse=substr($columns[2],0,50); - #$columns[2]=substr($columns[2],50); - #} else { - #$qresponse=substr($columns[2],0,$j); - #$j++; - #$columns[2]=substr($columns[2],$j); - #} - #print "$qresponse
\n"; - #} - #print "$columns[2]
\n"; - #} - #} - # - #print "- \n"; - } - if (($FORM{'showcmts'} eq 'withq') && ($#qucmts != -1)) { - ##### v ADT - 7/03/2002 ################################################ - # Modified code to add the comments to the same table cell as the - # answers if the question is a Narrative question - ######################################################################## - #if( $qstatsqf[$qid] ne 'nrt' ) { - print "\t- "; - $boldtag = $bs; - $boldtagend = $be; - foreach $qstat (@qstatc) { - $outary[$_] .= "$boldtag$qstat$boldtagend -
"; - $boldtag = ""; - $boldtagend = ""; - } - $outary[$_] .= "- "; - $boldtag = $bs; - $boldtagend = $be; - foreach $qstat (@qstatp) { - $outary[$_] .= "$boldtag$qstat\%$boldtagend -
"; - $boldtag = ""; - $boldtagend = ""; - } - $outary[$_] .= "- "; - $boldtag = $bs; - $boldtagend = $be; - foreach $qstat (@qstato) { - $outary[$_] .= "$boldtag$qstat$boldtagend -
"; - $boldtag = ""; - $boldtagend = ""; - } - $outary[$_] .= "\n\t\t \n"; - } - $outary[$_] .= " -\n\t\t\t -"; - #} - $outary[$_] .= "
-- -\nComments: -\n"; - ##### ^ ADT - 7/03/2002 ################################################ - for $i (0 .. $#qucmts) { - @columns=split(/\&/, $qucmts[$i]); - if ($columns[0] eq $qid) { - $outary[$_] .= "$columns[1]\: -
\n"; - while (length($columns[2]) > 50) { - $j=index($columns[2]," ",45); - if ($j==-1) { - $qucmt=substr($columns[2],0,50); - $columns[2]=substr($columns[2],50); - } else { - $qucmt=substr($columns[2],0,$j); - $j++; - $columns[2]=substr($columns[2],$j); - } - $outary[$_] .= "$qucmt
\n"; - } - $outary[$_] .= "$columns[2]
\n"; - } - } - $outary[$_] .= "- \n"; - @qstato = (); - @qstatc = (); - @qstatp = (); - } - } -} -if (($FORM{'showcmts'} eq 'atend') && ($#qucmts != -1)) { - $outary[$_] .= "- \n"; - $outary[$_] .= " \n"; - $outary[$_] .= " Comments \n"; -} -@qucmts=(); -# Read in .rgo file which defines question presentation order -if ($FORM{'tstid'} =~ /SAS/) { - $lookupfile = join($pathsep,$dataroot,"IntegroSAS.rgo"); -} else { - $lookupfile = join($pathsep,$dataroot,"IntegroTAQ.rgo"); -} -if (-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"; - $outary[$_] .= " \n\n
\n"; - for (1 ..$#questions) { - ($test,$qid) = split(/\./, $qstatsid[$_]); - if ($qstatsqf[$qid] ne 'obs') { - for $i (0 .. $#qucmts) { - @columns=split(/\&/, $qucmts[$i]); - if ($columns[0] eq $qid) { - $outary[$_] .= " ID User Comments \n"; - $outary[$_] .= " \n"; - } - } - $outary[$_] .= "$qstatsid[$_] \n"; - $outary[$_] .= "$columns[1] \n"; - $outary[$_] .= "\n"; - while (length($columns[2]) > 70) { - $j=index($columns[2]," ",65); - if ($j==-1) { - $qucmt=substr($columns[2],0,70); - $columns[2]=substr($columns[2],70); - } else { - $qucmt=substr($columns[2],0,$j); - $j++; - $columns[2]=substr($columns[2],$j); - } - $outary[$_] .= "$qucmt \n"; - $outary[$_] .= "
\n"; - } - $outary[$_] .= "$columns[2]
\n"; - $outary[$_] .= "\n"; - } - } - $outary[$_] .= "\n\n \n"; - $out .= " $section \n"; - } - foreach my $sub (@line) { - my ($subheader, $quess) = split(/:/,$sub); - if ($subheader ne "") { - $out .= " \n"; - } - @ques = split(/\,/,$quess); - foreach my $quesid (@ques) { - $out .= $outary[$quesid]; - } - } - } - print $out; - } -} else { - for (1 ..$#questions) { - print $outary[$_]; - } -} -if ($FORM{'showobs'}) { - print "$sobsolete"; -} -print " $subheader:
".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"; -} - -if ($FORM{'export'}) { - print "Content-Type: application/doc\n\n"; - $bExport=1; -} elsif ($FORM{'csv'}) { - print "Content-Type: text/x-csv\n\n"; -} else { - print "Content-Type: text/html\n\n"; - $bExport=0; -} -#print STDERR Dumper(\%FORM,$idlist); -if (&get_session($FORM{'tid'})) { - if ($FORM{'testsummary'} eq 'composite') { - &show_test_composite($idlist); - } elsif ($FORM{'testsummary'} eq 'bycnd') { - &show_test_resultsbycnd($idlist); - } else { - &extract_test_data(); - } -} -if ($bExport) { - exit(0); -} - -sub extract_test_data() { - &LanguageSupportInit(); - &get_client_profile($SESSION{'clid'}); - &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); - my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}"); - my @colhdrs=(); - push @colhdrs,""; - if ($FORM{'cndnme'}) { - push @colhdrs,"left:Last Name"; - push @colhdrs,"left:First Name"; - push @colhdrs,"left:MI"; - } - push @colhdrs,"left:User ID"; - if ($FORM{'cndeml'}) { - push @colhdrs,"left:Email Address"; - } - if ($FORM{'cnd1'}) { - push @colhdrs,"left:$CLIENT{'clcnd1'}"; - } - if ($FORM{'cnd2'}) { - push @colhdrs,"left:$CLIENT{'clcnd2'}"; - } - if ($FORM{'cnd3'}) { - push @colhdrs,"left:$CLIENT{'clcnd3'}"; - } - if ($FORM{'cnd4'}) { - push @colhdrs,"left:$CLIENT{'clcnd4'}"; - } - if ($FORM{'cndscr'}) { - push @colhdrs,"center:Correct"; - push @colhdrs,"center:Incorrect"; - push @colhdrs,"right:Score"; - } - my @dataflds=(); - my @unsorted=(); - my $row=""; - my @qsumry=(); - my $user=""; - my $joint="\&"; - my $colhdr; - my $colalgn; - my $fidx; - for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$CLIENT{'clid'}.//; - my $excuser="inc$user"; - if ($FORM{$excuser}) { - next; - } - &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - &get_candidate_profile($CLIENT{'clid'},$user); - if ($FORM{'cndnme'}) { - $row=join($joint,$row,"$CANDIDATE{'nml'}"); - $row=join($joint,$row,"$CANDIDATE{'nmf'}"); - $row=join($joint,$row,"$CANDIDATE{'nmm'}"); - } - $row=join($joint,$row,"$user"); - if ($FORM{'cndeml'}) { - $row=join($joint,$row,"$CANDIDATE{'eml'}"); - } - if ($FORM{'cnd1'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd1'}"); - } - if ($FORM{'cnd2'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd2'}"); - } - if ($FORM{'cnd3'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd3'}"); - } - if ($FORM{'cnd4'}) { - $row=join($joint,$row,"$CANDIDATE{'cnd4'}"); - } - if ($FORM{'cndscr'}) { - $row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]); - } - push @unsorted, $row; - $row=""; - } - my @sorted=sort @unsorted; - @unsorted=(); - my $rowcount=$#filelist+1; - &print_report_dataextract_header($rowcount,@colhdrs,@colalign); - my ($i); - for $i (0 .. $#sorted) { - @dataflds=split($joint, $sorted[$i]); - if ($bExport) { - for $i (1 .. $#dataflds) { - print "$dataflds[$i]"; - if ($i == $#dataflds) { - print "\n"; - } else { - print "\t"; - } - } - } else { - print "
\n"; - print "Raw Data Extraction
\n"; - print "$ncount Completed Responses\n"; - #print "
| $colhdr | \n"; - } - print "\t<\TR>\n"; - } -} - -sub date_out_of_range { - my ($completedat,$datefm,$dateto) = @_; - my @unsorted=(); - push @unsorted, $completedat; - push @unsorted, $datefm; - push @unsorted, $dateto; - my @sorted = sort @unsorted; - my $bretyes = ($sorted[1] eq $unsorted[0]) ? 0 : 1; - @unsorted=(); - @sorted=(); - return $bretyes; -} - -$^W=1; -sub sort_test_results { - my ($sortby,@rows) = @_; - if ($sortby eq 'Name') { - #print STDERR "by Name\n"; - return sort {$a->{'columns'}->[0] cmp $b->{'columns'}->[0];} @rows; - } elsif ($sortby eq 'LoginID') { - #print STDERR "by LoginID\n"; - return sort {$a->{'columns'}->[1] cmp $b->{'columns'}->[1];} @rows; - } elsif ($sortby eq 'Date') { - #print STDERR "by Date\n"; - return sort {$a->{'end'} <=> $b->{'end'};} @rows; - } else { - #print STDERR "by Nothing\n"; - return @rows; - } -} - -sub show_test_resultsbycnd { - &LanguageSupportInit(); - &get_client_profile($SESSION{'clid'}); - &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'}); - my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}"); - my ($url) = ("$cgiroot/teststats.pl?"); - if (not $FORM{'sortby'}) {$FORM{'sortby'}=$sortbys[0];} - if (not $FORM{'reverse'}) {$FORM{'reverse'}=0;} - foreach (keys %FORM) { - if (($_ ne 'sortby') and ($_ ne 'reverse') and ($FORM{$_} !~ /\s+/)) { - #print STDERR "$_=$FORM{$_}\n"; - $url .= "&$_=$FORM{$_}"; - } else { - #print STDERR "NOT $_=$FORM{$_}\n"; - } - } - my $csvurl = $url."&csv=1&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); - my $reverseurl = $url."&sortby=$FORM{'sortby'}&reverse=".($FORM{'reverse'}?0:1); - my %sorturls; - foreach my $sorter (@sortbys) { - $sorturls{$sorter} = $url."&sortby=$sorter"; - } - my @sorted=(); - my @unsorted=(); - my $user; - my $test; - my $qidx; - my $trash; - my $subjskl; - my $subj; - my $sklvl; - my $subjlist=","; - my @qids=(); - my @qsumry=(); - my @corincs=(); - my $bysubjflag = ($FORM{'statsbysubj'} ne '') ? 1 : 0; - my @subjects=(); - my @subjcnts=(); - my @subjtot=(); - my @subjmean=(); - my @subjmedian=(); - my @meanscore=split('\,',"0,0,0,0,100,0,0"); - my @medianscore=(); - my $i=0; - my $j=0; - my $fidx; - my @rows=(); - my $row={}; - my @answ=(); - my $qid; - my $usrnm; - my $nresultcount=$#filelist+1; - my $mtime; - my $completedat; - my $displaydate; - if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";} - if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";} - if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";} - if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";} - my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}"; - my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}"; - for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$CLIENT{'clid'}.//; - my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'}); - if (not defined $history) { - #print STDERR "$user from history.\n"; - $history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'}); - } else { - #print STDERR "$user from log.\n"; - } - if (not defined $history) { - # no log file entry for this test - #print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n"; - my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9]; - $history->{'end'} = $mtime; - $history->{'start'} = $history->{'end'}; - #print STDERR Dumper($history); - } - #$trash=join($pathsep,$testcomplete,$filelist[$fidx]); - #open (TMPFILE, "<$trash"); - #$mtime = (stat(TMPFILE))[9]; - #close TMPFILE; - $completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'}); - $displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'}); - #print STDERR "$completedat $displaydate $datefm $dateto\n"; - if (&date_out_of_range($completedat,$datefm,$dateto)) { - $nresultcount--; - next; - } - my $excuser="inc$user"; - if ($FORM{$excuser}) { - $nresultcount--; - next; - } - &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); - @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); - @answ=split(/\&/,$SUBTEST_ANSWERS{2}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - @corincs = split(/\//, $qsumry[$#qsumry]); - for $i (0 .. $#subjects) { - $subjcnts[$i][0]=0; - $subjcnts[$i][1]=0; - $subjcnts[$i][2]=0; - $subjcnts[$i][3]=0; - } - &get_candidate_profile($CLIENT{'clid'},$user); - $usrnm="$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}"; - $row={'columns' => [$usrnm,$user,$displaydate]}; - $row->{'start'} = $history->{'start'}; - $row->{'end'} = $history->{'end'}; - #print STDERR "Survey = $TEST_SESSION{'srvy'}\n"; - if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { - for $qid (1 .. $#qids) { - ($test,$qidx) = split(/\./, $qids[$qid]); - ($trash,$subjskl) = split(/::/, $answ[$qid]); - ($subj,$sklvl,$trash)=split(/\.|\:/,$subjskl); - unless ($subjlist =~ /\,$subj\,/i) { - $subjlist = join('',$subjlist,"$subj\,"); - push @subjects,"$subj"; - $i=$#subjects; - $subjcnts[$i][0]=0; # questions in subject area - $subjcnts[$i][1]=0; # correct answers - $subjcnts[$i][2]=0; # incorrect answers - $subjcnts[$i][3]=0; # pct correct - $subjtot[$i][0]=0; - $subjtot[$i][1]=0; - $subjtot[$i][2]=0; - $subjtot[$i][3]=0; - $subjmean[$i][0]=0; # population count - $subjmean[$i][1]=0; # population value summation - $subjmean[$i][2]=0; # population mean - $subjmean[$i][3]=0; # population standard deviation - $subjmean[$i][4]=100; # population range-low - $subjmean[$i][5]=0; # population range-high - } - for $i (0 .. $#subjects) { - if ($subj eq $subjects[$i]) { - $subjcnts[$i][0]++; - $subjtot[$i][0]++; - if (substr($corincs[$qid],0,1) eq '1') { - $subjcnts[$i][1]++; - $subjtot[$i][1]++; - } else { - $subjcnts[$i][2]++; - $subjtot[$i][2]++; - } - $subjcnts[$i][3]=int((($subjcnts[$i][1]/$subjcnts[$i][0])*100)); - $subjtot[$i][3]=int((($subjtot[$i][1]/$subjtot[$i][0])*100)); - last; - } - } - } - if ($bysubjflag) { - for $i (0 .. $#subjects) { - push @{$row->{'columns'}},$subjcnts[$i][0],$subjcnts[$i][1],$subjcnts[$i][2],$subjcnts[$i][3]; - $subjmean[$i][0]++; - $subjmean[$i][1]+=$subjcnts[$i][3]; - $subjmean[$i][2]=int(($subjmean[$i][1]/$subjmean[$i][0])); - #$subjmean[$i][4]=(($subjcnts[$i][3] < $subjmean[$i][4]) || ($subjmean[$i][4] == 0)) ? $subjcnts[$i][3] : $subjmean[$i][4]; - $subjmean[$i][4]=($subjcnts[$i][3] < $subjmean[$i][4]) ? $subjcnts[$i][3] : $subjmean[$i][4]; - $subjmean[$i][5]=($subjcnts[$i][3] > $subjmean[$i][5]) ? $subjcnts[$i][3] : $subjmean[$i][5]; - $subjmedian[$i][$fidx]=$subjcnts[$i][3]; - $subjcnts[$i][0]=0; - $subjcnts[$i][1]=0; - $subjcnts[$i][2]=0; - $subjcnts[$i][3]=0; - } - } - $meanscore[0]++; # data count - $meanscore[1]+=$qsumry[2]; # sum of values - $meanscore[2]=int(($meanscore[1]/$meanscore[0])); # unbiased population mean - $meanscore[4]=($qsumry[2] < $meanscore[4]) ? $qsumry[2] : $meanscore[4]; - $meanscore[5]=($qsumry[2] > $meanscore[5]) ? $qsumry[2] : $meanscore[5]; - $medianscore[$fidx]=$qsumry[2]; - } - push @{$row->{'columns'}},$qsumry[0],$qsumry[1],$qsumry[2]; - push @rows, $row; - } - @sorted=sort {$a <=> $b} @medianscore; - $j=$#sorted/2; - $i=$sorted[$j]; - if (($#sorted % 2) == 0) { - @medianscore=(); - $medianscore[0]=$i; - } else { - $j++; - $i+=$sorted[$j]; - @medianscore=(); - $medianscore[0]=int(($i/2)); - } - my @scores=(); - for $i (0 .. $#subjects) { - for $j (0 .. $#filelist) { - $scores[$j]=$subjmedian[$i][$j]; - } - @sorted=sort {$a <=> $b} @scores; - @scores=(); - $j=$#sorted/2; - $qid=$sorted[$j]; - if (($#sorted % 2) == 0) { - $subjmedian[$i][0]=$qid; - } else { - $j++; - $qid+=$sorted[$j]; - $subjmedian[$i][0]=int(($qid/2)); - } - } - # The sorting block - if ($FORM{'reverse'}) { - @sorted = reverse &sort_test_results($FORM{'sortby'},@rows); - } else { - @sorted = &sort_test_results($FORM{'sortby'},@rows); - } - # end of the sorting block - @rows=(); - if ($FORM{'csv'}) { - &print_report_bycnd_csv(@sorted); - return; - } - my $colspan=&print_report_bycnd_header($nresultcount,$bysubjflag,\%sorturls,$FORM{'sortby'}, - $csvurl,$reverseurl,@subjects); - @unsorted=(); - @subjcnts=(); - my $symbol=""; - my @cols=(); - my @rowhdrs=('Questions','Correct','Incorrect','Pct Correct'); - my $rowspan=($bysubjflag) ? ($#rowhdrs+1) : 1; - foreach my $row (@sorted) { - @cols=@{$row->{'columns'}}; - my ($start,$end,$duration,$datestamp,$total); - if ($bExport) { - print "$cols[0]\t$cols[1]\t$cols[2]\t"; - if ($bysubjflag) { print "\n";} - } else { - #($start,$end,$duration) = get_teststartend($CLIENT{'clid'},$cols[1],$FORM{'tstid'}); - $start = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'start'}))[0..2])); - $end = sprintf("%02d:%02d:%02d",reverse((localtime($row->{'end'}))[0..2])); - $duration = &fmtDuration($row->{'end'} - $row->{'start'}); - if ($end == "Unknown" ) { - $datestamp = ""; - } else { - my $gmend = sprintf("%02d:%02d:%02d",reverse((gmtime($row->{'end'}))[0..2])); - $datestamp = "$cols[2] $gmend GMT"; - $datestamp =~ s/ /_/g; - } - $total = $cols[-3] + $cols[-2]; - - my $params = "tid=$SESSION{'tid'}&clid=$CLIENT{'clid'}&cndid=". - uri_escape($cols[1]). - "&tstid=$FORM{'tstid'}&correct=$cols[-3]&incorrect=$cols[-2]&total=$total&percent=$cols[-1]"; - print "\t||||||||||||||||||||||
| $cols[0] | \n"; - print "\t\t$cols[1] | \n"; - print "\t\t$cols[2] | \n"; - } - if ($bysubjflag) { - for $j (0 .. $#rowhdrs) { - $symbol=($j==3) ? "\%" : ""; - if ($j > 0) { - if ($bExport == 0) { - print "\t||||||||||||||||||||
| $rowhdrs[$j] | \n"; - } - for $fidx (0 .. $#subjects) { - $qid=($fidx*4)+$j+3; - if ($bExport) { - print "$cols[$qid]\t"; - } else { - print "\t\t$cols[$qid]$symbol | \n"; - } - if ($j==3) { - $subjmean[$fidx][3]+=(($subjmean[$fidx][2]-$cols[$qid])*($subjmean[$fidx][2]-$cols[$qid])); - } - } - if ($j == 0) { - $fidx=$#cols-2; - if ($bExport) { - print "$cols[$fidx++]\t"; - print "$cols[$fidx++]\t"; - print "$cols[$fidx]\t"; - } else { - print "\t\t$cols[$fidx++] | \n"; - print "\t\t$cols[$fidx++] | \n"; - print "\t\t$cols[$fidx]\% | \n"; - } - } - if ($bExport) { - print "\n"; - } else { - print "\t$start | \n"; - print "\t\t$end | \n"; - print "\t\t$duration | \n"; - if ($SUBTEST_SUMMARY{2} ne 'Not Scored by Definition') { - print "\t\t$cols[$j++] | \n"; - print "\t\t$cols[$j++] | \n"; - print "\t\t$cols[$j]\% | \n"; - } else { - print "\t\tNot Scored by Definition | \n"; - } - print "\t\n"; - } - } - if ($bysubjflag) { - if ($bExport==0) { - print "\t|||||||||||
| Composite | \n"; - } - } else { - if ($bExport) { - print "\t\t"; - } - } - if ($bExport) { - print "$rowhdrs[$j]\t"; - } else { - print "\t\t$rowhdrs[$j] | \n"; - } - if ($j < 4) { - $symbol=($j==3) ? "\%" : ""; - for $fidx (0 .. $#subjects) { - if ($bExport) { - print "$subjtot[$fidx][$j]\t"; - } else { - print "\t\t$subjtot[$fidx][$j]$symbol | \n"; - } - } - if ($j == 0) { - if ($bExport) { - print "\t\t"; - } else { - print "\t\t\ \; | \n";
- }
- } elsif ($j == 3) {
- if ($bExport) {
- print "\tOverall\t";
- } else {
- print "\t\tOverall | \n"; - } - } - } else { - $symbol="\%"; - $i=$j-2; - for $fidx (0 .. $#subjects) { - if ($i == 6) { - if ($bExport) { - print "$subjmedian[$fidx][0]\t"; - } else { - print "\t\t$subjmedian[$fidx][0]$symbol | \n"; - } - } else { - if ($i==3) { - $subjmean[$fidx][3]=int((sqrt(($subjmean[$fidx][3]/$subjmean[$fidx][0])))); - if ($bExport) { - print "$subjmean[$fidx][$i]\t"; - } else { - print "\t\t\&\#177$subjmean[$fidx][$i]$symbol | \n"; - } - } else { - if ($bExport) { - print "$subjmean[$fidx][$i]\t"; - } else { - print "\t\t$subjmean[$fidx][$i]$symbol | \n"; - } - } - } - } - $i=$j-2; - if ($i==3) { - if ($bExport) { - print "\t$meanscore[$i]\t"; - } else { - print "\t\t\&\#177$meanscore[$i]$symbol | \n"; - } - } elsif ($i==6) { - if ($bExport) { - print "\t$medianscore[0]\t"; - } else { - print "\t\t$medianscore[0]$symbol | \n"; - } - } else { - if ($bExport) { - print "\t$meanscore[$i]\t"; - } else { - print "\t\t$meanscore[$i]$symbol | \n"; - } - } - } - if ($bExport) { - print "\n"; - } else { - print "\t||||||||||||
| Composite | \n"; - } - } - if ($bExport) { - print "\t$rowhdrs[$j]\t"; - } else { - print "\t\t$rowhdrs[$j] | \n"; - } - if ($j==1) { - if ($bExport) { - print "\t\t$meanscore[$i]"; - } else { - print "\t\t\&\#177$meanscore[$i]$symbol | \n"; - } - } elsif ($j==4) { - if ($bExport) { - print "\t\t$medianscore[0]"; - } else { - print "\t\t$medianscore[0]$symbol | \n"; - } - } else { - if ($bExport) { - print "\t\t$meanscore[$i]"; - } else { - print "\t\t$meanscore[$i]$symbol | \n"; - } - } - if ($bExport) { - print "\n"; - } else { - print "\t||||||||||||||||||
| \n";
- foreach (@sortbys) {
- if ($_ ne $sortby) {
- print "\t\t\t{$_}\">Sort by $_ \n"; - } else { - print "\t\t\tSorted by $_ \n"; - } - } - print "\t\t\t | ";
- print "CSV Report\n\t\t\t "; - print "Change to ".($FORM{'reverse'}?'ascending':'descending')."\n\t\t | \n";
- print "\t||||||||
| Candidate | \n"; - print "\t\tLoginID | \n"; - print "\t\tDate | \n"; - if ($bysubj) { - print "\t\tSubject Areas | \n"; - } else { - print "\t\tStart | \n"; - print "\t\tEnd | \n"; - print "\t\tDuration | \n"; - } - print "\t\tOverall | \n"; - print "\t||
| \ \; | \n"; - for $i (0 .. $nsubjects) { - print "\t\t$subjects[$i] | \n"; - } - }; - print "\t\tCorrect | \n"; - print "\t\tIncorrect | \n"; - print "\t\tScore | \n"; - print "\t|||||
/g; - ($test,$qid) = split(/\./, $id); - $qstatsid[$qid] = $id; - $qstatsqc[$qid] = 0; # occurrences of question - $qstatsqp[$qid] = 0; # percent occurrences of question - $qstatsqt[$qid] = $qtx; # question text - if ($qil eq 'Y') { - $qstatsqf[$qid] = "obs"; # question type - } else { - $qstatsqf[$qid] = $qtp; # question type - $qallans = ""; - if ($qtp eq 'tf') { - $qallans = "$qca\;$qia\;$xlatphrase[670]"; #670=No Response - } elsif ($qtp eq 'mcs' || $qtp eq 'mca' || $qtp eq 'lik') { - if ($qca eq '') { - $qallans = "$qia\;$xlatphrase[670]"; - } else { - $qallans = "$qca\;$qia\;$xlatphrase[670]"; - } - } elsif ($qtp eq 'mtx' || $qtp eq 'mtr') { - # DED When qca is saved correctly in tdef, - # put this back and delte rest: - # $qallans = "$qca"; - ### DED 2/25/05 Assumes RC labels, not lblall - ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); - @qiar = split("\;", $qiar); - @qiac = split("\;", $qiac); - $qallans = ""; - foreach $qiarow (@qiar) - { - foreach $qiacol (@qiac) - { - $qallans .= "xxx\;"; - } - } - } elsif ($qtp eq 'mcm') { - if ($qca eq '') { - $qallans = "$qia"; - } else { - $qallans = "$qca\;$qia"; - } - } elsif ($qtp eq 'esa') { - if ($qca eq '') { - $qallans = ""; - } else { - $qallans = "$qca"; - } - } elsif ($qtp eq 'nrt') { - if ($qca eq 'N/A') { - $qallans = "Other\;$xlatphrase[670]\;"; - } else { - $qallans = "$qca\;Other\;$xlatphrase[670]\;"; - } - } elsif ($qtp eq 'mch') { - @qcans = split(/\;/, $qca); - @qians = split(/\;/, $qia); - for (my $i = 0; $i <= $#qcans; $i++ ) { - $qallans = join('', $qallans, "$qcans[$i]===$qians[$i]
"); - } - } elsif ($qtp eq 'ord') { - $qallans = "$qca"; - } - $qallans =~ s/\;\;/\;/g; - $qstatsqr[$qid] = $qallans; # response options - $fqstatsqr[$qid] = $qallans; ### DED for FBQ - $qstatsqw[$qid] = (); - if (($qtp eq 'mch') || ($qtp eq 'ord')) { - if ($qtp eq 'mch') { - @qstato = split(/
/, $qallans); - } else { - @qstato = split(/\;/, $qallans); - } - $ncount = $#qstato + 1; - $ncount = int(($ncount * ($ncount + 1)) + 3); - for (my $i = 0; $i <= $ncount; $i++ ) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } elsif ($qtp eq 'mcm' || $qtp eq 'esa' || $qtp eq 'mtx' || $qtp eq 'mtr') { - ### ASSUMES rank=1..10 - need to allow for other ranks - @qstato = split(/\;/, $qallans); - if ($qtp eq 'mtr') - { - # Have to allow for [1..10] in - # each answer, so make it big! - $ncount = (($#qstato + 1) * 10) + 3; - } - else - { - $ncount = $#qstato + 3; - } - for (my $i = 0; $i <= $ncount; $i++ ) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } else { - @qstato = split(/\;/, $qallans); - foreach $qstat (@qstato) { - $qstatsqrc[$qid] = join('', $qstatsqrc[$qid], "0\;"); # response option count - $qstatsqrp[$qid] = join('', $qstatsqrp[$qid], "0\;"); # response option percentage - } - } - } - @qstato = (); - } - # Collect the answers from each test. - $ncount = $#filelist + 1; - @qucmts=(); - $nresponses=$#filelist+1; - for (my $fidx = 0; $fidx <= $#filelist; $fidx++ ) { - $user = $filelist[$fidx]; - $user =~ s/.$TEST{'id'}$//; - $user =~ s/^$CLIENT{'clid'}.//; - if (defined $idlist and not $idlist->{$user}) { - $nresponses--; - next; - } - my $excuser="inc$user"; - if ($FORM{$excuser}) { - $nresponses--; - next; - } - &get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'}); - @qids = split(/\&/, $SUBTEST_QUESTIONS{2}); - @qrsp = split(/\&/, $SUBTEST_RESPONSES{2}); - @qsumry = split(/\&/, $SUBTEST_SUMMARY{2}); - @corincs = split(/\//, $qsumry[5]); - @qsumry = (); - @qsumry = split(/\&/, $SUBTEST_ANSWERS{2}); - @qansseq = (); - $fqid=""; - $fqididx=""; - for (1 .. $#qids) { - ($test,$qidx) = split(/\./, $qids[$_]); - ($qansord,$trash) = split(/::/, $qsumry[$_]); - $qansord =~ s/\=([0-1])//g; - $qansseq[$_] = $qansord; - - ($qresp,$qucmt) = split(/::/, $qrsp[$_]); - $qresp=~ tr/+/ /; - $qresp=~ tr/'//d; - $qrsp[$_]=$qresp; - - ##### v ADT - 7/03/2002 ################################### - # Added code to print NRT answers in the form of the comments - #push @qresponses, "$qidx\&$user\&$qresp"; - - if ($qucmt ne '') { - $qucmt =~ tr/+/ /; - $qucmt =~ tr/'//d; - push @qucmts, "$qidx\&$user\&$qucmt"; - } - ### DED 10/28/2002 Support for filter-by-question (FBQ) - if ($FORM{'question'} eq $qids[$_]) { - $fqididx=$_; - ($trash,$fqid)=split(/\./,$qids[$_]); - } - } - ### DED 10/28/2002 Support for filter-by-question (fbq) - #print "
FormQues= $FORM{'question'} Ans= $FORM{'answer'} Qansseq= $qansseq[$fqididx]
\n"; - if ($fqid ne "" && $FORM{'answer'} ne "") { - $fmatch=0; - if ($qstatsqf[$fqid] eq 'mcs' || $qstatsqf[$fqid] eq 'mca' || $qstatsqf[$fqid] eq 'lik') { - @fqansseq=split(/\?/,$qansseq[$fqididx]); - shift @fqansseq; - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - foreach $fans (@fans) { - @ffresp=(); - $fresp=""; - for (0 .. $#fqansseq) { - $fqseqans[$fqansseq[$_]]=$_; - $ffresp[$_]="xxx"; - } - if ($fans ne "No+Response") { - $ffresp[$fqseqans[$fans]]=$fqseqans[$fans]; - } - if ($ffresp[0] eq "") { - $fresp=""; - } else { - foreach (@ffresp) { - $fresp=join('?',$fresp,$_); - } - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { - $fmatch=1; - } - @ffresp=(); - if ($fmatch == 1) { break; } - } - @fqansseq=(); - @fans=(); - } elsif ($qstatsqf[$fqid] eq 'mcm') { - @fqansseq=split(/\?/,$qansseq[$fqididx]); - shift @fqansseq; - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - @ffresp=(); - $fresp=""; - for (0 .. $#fqansseq) { - $fqseqans[$fqansseq[$_]]=$_; - $ffresp[$_]="xxx"; - } - if ($fans[0] ne "No+Response") { - foreach (@fans) { - $ffresp[$fqseqans[$_]]=$fqseqans[$_]; - } - } - if ($ffresp[0] eq "") { - $fresp=""; - } else { - foreach (@ffresp) { - $fresp=join('?',$fresp,$_); - } - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "") { - $fmatch=1; - } - @fqansseq=(); - @fans=(); - @ffresp=(); - } elsif ($qstatsqf[$fqid] eq 'tf') { - if ($FORM{'answer'} eq "\&0" ) { - $fresp=$qansseq[$fqididx]; - } elsif ($FORM{'answer'} eq "\&1" ) { - SWITCH: for ($qansseq[$fqididx]) { - $fresp = /TRUE/ && "FALSE" - || /FALSE/ && "TRUE" - || /YES/ && "NO" - || /NO/ && "YES" - || "bad"; - } - } elsif ($FORM{'answer'} eq "\&No+Response") { - $fresp=""; - } else { - $fresp="bad"; - } - if ($qrsp[$fqididx] eq $fresp && $fresp ne "bad") { - $fmatch=1; - } - } elsif ($qstatsqf[$fqid] eq 'esa') { - ($fqstatsqr,$trash)=split(/;Other/,$fqstatsqr[$fqid]); - @fqr=split(/\;/,$fqstatsqr); - @fans=split(/\&/,$FORM{'answer'}); - shift @fans; - if ($fans[0] eq "No+Response") { - $fqr=""; - if ($fqr eq $qrsp[$fqididx]) { - $fmatch=1; - } - } else { - foreach (@fans) { - $fqr=lc($fqr[$_]); - $fqrsp=lc($qrsp[$fqididx]); - if ($fqr eq $fqrsp && $fqr ne "") { - $fmatch=1; - last; - } - } - } - @fqr=(); - @fans=(); - } - #print "
FQid= $fqid Qtp= $qstatsqf[$fqid] Qstatsid= $qstatsid[$fqid] Fresp= $fresp Qrsp=$qrsp[$fqididx]
\n";
- if ($fmatch == 0) {
- ### Don't count this one
- #print "...Skipping...";
- $nresponses--;
- @fqucmts = @qucmts;
- @qucmts = ();
- foreach (@fqucmts) {
- if (!($_ =~ /\&$user\&/)) {
- push @qucmts, "$_";
- }
- }
- next;
- }
- $fresp="";
- }
- ### DED End fbq support
- @qsumry=();
- for (1 .. $#qids) {
- ($test,$qidx) = split(/\./, $qids[$_]);
- if ($qstatsqf[$qidx] ne 'obs') {
- $qstatsqc[$qidx]++;
- $qstatsqp[$qidx] = format_percent(($qstatsqc[$qidx] / $ncount),
- { fmt => "%.0f" } );
- @qstatc = split(/\;/, $qstatsqrc[$qidx]);
- @qstatp = split(/\;/, $qstatsqrp[$qidx]);
- if ($qstatsqf[$qidx] eq 'tf') {
- @qstato = split(/\;/, $qstatsqr[$qidx]);
- if ($qrsp[$_] eq $qstato[0]) {
- $qstatc[0]++;
- } elsif ($qrsp[$_] eq $qstato[1]) {
- $qstatc[1]++;
- } else {
- $qstatc[2]++;
- }
- }elsif ($qstatsqf[$qidx] eq 'esa'){
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/\+/ /g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 1) {
- @qansord = split(/\;/, $qansseq[$_]);
- for $q (0 .. $#qansord) {
- if ($qansord[$q] eq $qresp) {
- $qstatc[$q]++;
- last;
- }
- }
- } else { # incorrect
- $found=0;
- @qstatw=split(/\;/,$qstatsqw[$qidx]);
- shift(@qstatw);
- for $q (0 .. $#qstatw) {
- if ($qstatw[$q] eq $qresp) {
- $qstatsqwc[$q]++;
- $found=1;
- last;
- }
- }
- if ($found != 1) {
- $qstatsqwc[$#qstatw+1]=1;
- $qstatsqw[$qidx]=join(';',$qstatsqw[$qidx],$qresp);
- }
- @qstatq=();
- }
- } else {
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- } elsif ($qstatsqf[$qidx] eq 'nrt'){
- # HBI This is the code to put the narrative answers in the report.
- if ($qrsp[$_] ne '') {
- $qstatc[1]++;
- $qrsp[$_] =~ s/\;/\:/g;
- $qrsp[$_] =~ s/\r//g;
- $qrsp[$_] =~ s/\n/\\n/g;
-
- $qstatsqr[$qidx] = join('
',$qstatsqr[$qidx],$qrsp[$_]);
- } else {
- $qstatc[2]++;
- }
- } elsif ($qstatsqf[$qidx] eq 'mcs' || $qstatsqf[$qidx] eq 'mca' || $qstatsqf[$qidx] eq 'lik') {
- ### DED Filter out "?" and "xxx" in qrsp so will match
- $qrsp[$_] =~ s/\?//g;
- $qrsp[$_] =~ s/xxx//g;
- @qansord = split(/\?/, $qansseq[$_]);
- shift @qansord;
- $found = 0;
- ### DED 10/09/02 Changed to allow for
- ### randomized answers
- #for (my $i = 0; $i <= $#qansord; $i++ ) {
- #if (("$qansord[$i]" eq "$qrsp[$_]") && ($qrsp[$_] ne '')) {
- if ($qrsp[$_] ne '') {
- $qstatc[$qansord[$qrsp[$_]]]++;
- $found = 1;
- }
- #}
- unless ($found) {
- # increment "No Response"
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- } elsif ($qstatsqf[$qidx] eq 'mtx') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
- ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
- @qiar = split("\;", $qiar);
- @qiac = split("\;", $qiac);
-
- # skipping answer sequence part (no rand answ)
- $holding3 = $_;
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- $i=0;
- foreach $qiarow (@qiar)
- {
- foreach $qiacol (@qiac)
- {
- if ($qresps[$i] ne "xxx") {
- $qstatc[$i]++;
- }
- $i++;
- }
- }
- }
- } else {
- # increment No Response counter
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mtr') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qidx]);
- ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia);
- @qiar = split("\;", $qiar);
- @qiac = split("\;", $qiac);
-
- # skipping answer sequence part (no rand answ)
- $holding3 = $_;
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- $iqresps=0;
- $iqstatc=0;
- foreach $qiarow (@qiar)
- {
- foreach $qiacol (@qiac)
- {
- if ($qresps[$iqresps] ne "xxx")
- {
- # $qresps[$iqresps] will be [1..10], so adjust index accordingly
- $irank = $iqstatc + $qresps[$iqresps] - 1;
- $qstatc[$irank]++;
- }
- $iqresps++;
- $iqstatc += 10;
- }
- }
- }
- } else {
- # increment No Response counter
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mcm') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- if ($corinc == 0) {
- @qansord = split(/\?/, $qansseq[$_]);
- shift @qansord;
- $holding3 = $_;
- #$found = 0;
- ### DED 10/18/02 Changed to allow for
- ### randomized answers & new format
- @qresps = split(/\?/, $qrsp[$_]);
- shift @qresps;
- foreach $qresp (@qresps) {
- if ($qresp ne "xxx") {
- $qstatc[$qansord[$qresp]]++;
- }
- }
- }
- } else {
- $qstatc[$#qstatc]++;
- }
- @qansord = ();
- $_ = $holding3;
- } elsif ($qstatsqf[$qidx] eq 'mch') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
- ### DED 10/18/02 Changed for
- ### random answers and new format
-
- #
- # Count occurrence of each match
-
- # $qansseq[$qidx] [Wrong! DED]
- # $qansseq[$_]
- # &a.3.2.0.6.5.8.4.7.1::MATCH.0:1:1:0
- # $qrsp[$_]
- # &dgihbfcea [Old format]
- # &?d?g?i?h?b?f?c?e?a [New]
-
- #$qansseq[$qidx] =~ s/\&//g;
- $qansseq[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/ //g;
- #@corord = split(/\./, $qansseq[$qidx]);
- @corord = split(/\./, $qansseq[$_]);
- #@selord = split(//,$qrsp[$_]);
- @selord = split(/\?/,$qrsp[$_]);
- shift @selord;
- $corhold = $_;
- if ($corinc == 0) {
- for (0 .. $#selord) {
- if ($selord[$_] ne 'xxx') {
- ($x = &get_label_index($corord[0],$selord[$_]))++;
- $y = $corord[$x];
-
- #$ncountidx = int($_ * $#corord + $y);
- $ncountidx = int($y * $#corord + $_);
- } else {
- $ncountidx = int(($#corord * $#corord ) + $_);
- }
- $qstatc[$ncountidx]++;
- }
- }
- $_ = $corhold;
- @selord = ();
- @corord = ();
- } else {
- $qstatc[$#qstatc]++;
- }
- } elsif ($qstatsqf[$qidx] eq 'ord') {
- $ncountidx = $#qstatc - 2;
- $qresp = $qrsp[$_];
- $qresp =~ s/xxx//g;
- ### DED 10/18/02 Changed for
- ### random answers and new format
- $qresp =~ s/\?//g;
- if ($qresp ne '') {
- #
- # if answered, Determine from the score summary
- # if answered correctly
- #
- $corinc = substr($corincs[$_], 0, 1);
- if ($corinc == 0) {
- $ncountidx++;
- }
- $qstatc[$ncountidx]++;
-
- #
- # Count occurrence of each incorrect order
- # &o.2.3.4.1.0::ORDERED.0:1:1:0
- # &34521 [Old format]
- # &?3?4?5?2?1 [New]
- #
- #$qansseq[$qidx] =~ s/\&//g;
- $qansseq[$_] =~ s/\&//g;
- $qrsp[$_] =~ s/\&//g;
- #@corord = split(/\./, $qansseq[$qidx]);
- @corord = split(/\./, $qansseq[$_]);
- #@selord = split(//,$qrsp[$_]);
- @selord = split(/\?/,$qrsp[$_]);
- shift @selord;
- $corhold = $_;
- if ($corinc == 0) {
- for (1 .. $#corord) {
- $ncountidx = int(($corord[$_]) * $#corord);
- $x = int($_ - 1);
- if ($selord[$x] ne 'xxx') {
- $ncountidx = $ncountidx + int($selord[$x]) - 1;
- } else {
- $ncountidx = int(($#corord * $#corord) + $_ - 1);
- }
- $qstatc[$ncountidx]++;
- }
- }
- $_ = $corhold;
- @selord = ();
- @corord = ();
- } else {
- $qstatc[$#qstatc]++;
- }
- }
- ### DED 8/20/2002 If checked, don't count
- ### "No Response" in statistics
- if ($FORM{'exnoresp'}) {
- if ($qstatsqc[$qidx] > $qstatc[$#qstatc]) {
- $denom = $qstatsqc[$qidx] - $qstatc[$#qstatc];
- } else {
- $denom = 1;
- }
- for (my $i = 0; $i <= $#qstatc-1; $i++ ) {
- $qstatp[$i] = format_percent($qstatc[$i] / $denom);
- }
- } else {
- for (my $i = 0; $i <= $#qstatc; $i++ ) {
- $qstatp[$i] = format_percent($qstatc[$i] / $qstatsqc[$qidx]);
- }
- }
-
- $qstatsqrc[$qidx] = "";
- foreach $qstat (@qstatc) {
- $qstatsqrc[$qidx] = join('', $qstatsqrc[$qidx], "$qstat\;");
- }
- $qstatsqrp[$qidx] = "";
- ### DED 8/22/2002 Exclude "No Response"
- ### from statistics
- if ($FORM{'exnoresp'}) {
- $count = $#qstatc-1;
- } else {
- $count = $#qstatp
- }
- for (0 .. $count) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstatp[$_]\;");
- }
- }
- if (($qstatsqf[$qidx] eq 'mcm') || ($qstatsqf[$qidx] eq 'mch') || ($qstatsqf[$qidx] eq 'ord') || ($qstatsqf[$qidx] eq 'mtx') || ($qstatsqf[$qidx] eq 'mtr')) {
- $npctidxend = $#qstatc - 3;
- $nincidx = $#qstatc - 1;
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $npctidxend; $i++ ) {
- if ($ntotinc == 0) {
- $qstatp[$i] = 0;
- } else {
- $qstatp[$i] = format_percent($qstatc[$i] / $ntotinc);
- }
- }
- $qstatsqrp[$qidx] = "";
- foreach $qstat (@qstatp) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
- }
- } elsif ($qstatsqf[$qidx] eq 'esa') {
- $npctidxend = $#qstatc - 3;
- $ncoridx = $#qstatc - 2;
- $nincidx = $#qstatc - 1;
- $ntotcor = $qstatc[$ncoridx];
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $npctidxend; $i++ ) {
- if ($ntotcor == 0) {
- $qstatp[$i] = 0;
- } else {
- $qstatp[$i] = format_percent($qstatc[$i] / $ntotcor);
- }
- }
- $qstatsqrp[$qidx] = "";
- foreach $qstat (@qstatp) {
- $qstatsqrp[$qidx] = join('', $qstatsqrp[$qidx], "$qstat\;");
- }
- $nincidx = $#qstatc - 1;
- $ntotinc = $qstatc[$nincidx];
- for (my $i = 0; $i <= $#qstatsqwc; $i++ ) {
- if ($ntotinc == 0) {
- $qstatsqwp[$i] = 0;
- } else {
- $qstatsqwp[$i] = format_percent($qstatsqwc[$i] / $ntotinc);
- }
- }
- }
- @qstato = ();
- @qstatc = ();
- @qstatp = ();
- }
-}
-
-if ($#qucmts != -1) {
- @qsumry=sort @qucmts;
- @qucmts=@qsumry;
- @qsumry=();
-}
-
- print HTMLHeaderPlain("Question Response Statistics");
- print "
Question Response Statistics
\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 "$nresponses Completed Responses -\n"; -print HTMLFooter(); -} - -sub HTMLHeaderPlain { - return "\n\n-
\n"; -print "-"; -$sobsolete = ""; -if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $incresponse = ""; -} else { - $incresponse = "INCORRECT"; -} -for (1 ..$#questions) { - ($test,$qid) = split(/\./, $qstatsid[$_]); - if (!($FORM{'exunans'} && $qstatsqc[$qid] < $FORM{'minunans'})) { - if ($qstatsqf[$qid] eq 'obs') { - if ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') { - $sobs = " - - -$qstatsid[$_] -INACTIVE -$qstatsqt[$qid] -- "; - $sobsolete = join('', $sobsolete, $sobs); - } - } else { - if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || ($qstatsqf[$qid] eq 'esa') || ($qstatsqf[$qid] eq 'mtx') || ($qstatsqf[$qid] eq 'mtr')) { - if ($qstatsqf[$qid] eq 'mch') { - @qstato = split(/
/, $qstatsqr[$qid]); - } else { - @qstato = split(/\;/, $qstatsqr[$qid]); - } - if ($qstatsqf[$qid] eq 'esa') { - @qstatw = split(/\;/, $qstatsqw[$qid]); - shift @qstatw; - } - $rowspan1 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4; - $rowspan2 = ($TEST{'seq'} ne 'svy' && $TEST{'seq'} ne 'dmg') ? 5 : 4; - } else { - @qstato = split(/\;/, $qstatsqr[$qid]); - if ( $qstatsqf[$qid] eq 'nrt' ){ - $qstato[1] =~ s/\/\//
/g; - $qstato[1] =~ s/\//
/g; - $qstato[1] =~ s/:/
/g; - $qstato[1] =~ s/\+/ /g; - } - $rowspan1 = 2; - $rowspan2 = 2; - } - if ($FORM{'showcmts'} eq 'withq') { - $rowspan1++; - $rowspan2++; - } - $outary[$_] .= " -- "; - - @qstatc = split(/\;/, $qstatsqrc[$qid]); - @qstatp = split(/\;/, $qstatsqrp[$qid]); - if (($qstatsqf[$qid] eq 'mcm') || ($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord') || $qstatsqf[$qid] eq 'esa' || $qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') { - $ncountidx = $#qstatc - 2; - $qstatccor = $qstatc[$ncountidx]; - $qstatpcor = $qstatp[$ncountidx]; - $qstatcinc = $qstatc[$ncountidx+1]; - $qstatpinc = $qstatp[$ncountidx+1]; - $qstatcnor = $qstatc[$ncountidx+2]; - $qstatpnor = $qstatp[$ncountidx+2]; - if ($TEST{'seq'} ne svy && $TEST{'seq'} ne dmg) { - $outary[$_] .= " -$qstatsid[$_] -$qstatsqc[$qid] -$qstatsqp[$qid]\% -$qstatsqt[$qid] -- "; - $outary[$_] .= " -$qstatccor -$qstatpcor\% -$xlatphrase[137] -- "; - } else { - $outary[$_] .= " -$qstatcinc -$qstatpinc\% -INCORRECT -- "; - } - $outary[$_] .= " -$qstatcinc -$qstatpinc\% -RESPONSES -- - "; - } - if (($qstatsqf[$qid] eq 'mch') || ($qstatsqf[$qid] eq 'ord')) { - if ($qstatsqf[$qid] eq 'mch') { - $sphrase = "(matched to \>\;\>\;\>\;)"; - @matchwords = (); - @matchtos = (); - foreach $qstat (@qstato) { - ($matchword, $matchto) = split(/\=\=\=/, $qstat); - push @matchwords, $matchword; - push @matchtos, $matchto; - } - push @matchtos, "Left Blank"; - } else { - $sphrase = "(ordered as number \>\;\>\;\>\;)"; - @matchwords = (); - @matchtos = @qstato; - $matchidx = 1; - foreach $qstat (@qstato) { - push @matchwords, "$matchidx"; - $matchidx++; - } - push @matchtos, "Not Used"; - } - $colspan = int((($#matchwords + 1) * 2) + 1); - $outary[$_] .= "$qstatcnor "; - if ($FORM{'exnoresp'}) { - $outary[$_] .= "\n"; - } else { - $outary[$_] .= " $qstatpnor\% \n"; - } - $outary[$_] .= "$xlatphrase[670] -- "; - } elsif ($qstatsqf[$qid] eq 'mtx' || $qstatsqf[$qid] eq 'mtr') { - ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$qid]); - ($qiar, $numqiar, $numqiac, $qiac) = split("::", $qia); - @qiar = split("\;", $qiar); - @qiac = split("\;", $qiac); - $holdmcm = $_; - if ($qstatsqf[$qid] eq 'mtr') - { - $colspan = ($#qiac + 1) * 3 + 1; - $colspan2 = 3; - } - else - { - $colspan = ($#qiac + 1) * 2 + 1; - $colspan2 = 2; - } - $outary[$_] .= " -- --
-- -BREAKDOWN OF $incresponse RESPONSES -- -"; - foreach $matchword (@matchwords) { - $outary[$_] .= " - $sphrase $matchword "; - } - $outary[$_] .= " -"; - foreach $matchword (@matchwords) { - $outary[$_] .= " - "; - $matchidx = 0; - foreach $matchto (@matchtos) { - $outary[$_] .= " -Cnt -Pct "; - } - $outary[$_] .= " -"; - if ($matchto eq $matchtos[$#matchtos]) { - $outary[$_] .= " - "; - } - $outary[$_] .= " -$matchto "; - } else { - $outary[$_] .= " -$matchto "; - } - foreach $matchword (@matchwords) { - $outary[$_] .= " -$qstatc[$matchidx] -$qstatp[$matchidx]\% "; - $matchidx++; - } - $outary[$_] .= " -- "; - } elsif ($qstatsqf[$qid] eq 'mcm') { - $outary[$_] .= " -- --
-- -BREAKDOWN OF $incresponse RESPONSES -- -"; - foreach $qiacol (@qiac) - { - $outary[$_] .= " $qiacol "; - } - $outary[$_] .= "\n- \n"; - $i=0; - foreach $qiarow (@qiar) - { - $outary[$_] .= ""; - foreach $qiacol (@qiac) - { - if ($qstatsqf[$qid] eq 'mtr') - { - $outary[$_] .= " "; - } - $outary[$_] .= " Rank - Cnt "; - } - $outary[$_] .= "\n Pct - \n"; - } - $outary[$_] .= "\n$qiarow "; - foreach $qiacol (@qiac) - { - if ($qstatsqf[$qid] eq 'mtr') - { - $outary[$_] .= ""; - for $irank (1 .. 10) - { - $outary[$_] .= "$irank "; - $outary[$_] .= "
"; - } - $outary[$_] .= ""; - for $irank (1 .. 10) - { - $outary[$_] .= "$qstatc[$i+$irank-1] "; - $outary[$_] .= "
"; - } - $outary[$_] .= ""; - for $irank (1 .. 10) - { - $outary[$_] .= "$qstatp[$i+$irank-1]\% "; - $i += 10; - } - else - { - $outary[$_] .= "
"; - } - $outary[$_] .= "$qstatc[$i] "; - $outary[$_] .= "$qstatp[$i]\% "; - $i++; - } - } - $outary[$_] .= "\n- "; - } elsif ($qstatsqf[$qid] eq 'esa') { - $outary[$_] .= " -- --
-- -BREAKDOWN OF $incresponse RESPONSES -- -- Response Option - Cnt - Pct - -- "; - foreach $qstat (@qstato) { - $outary[$_] .= "$qstat -
"; - } - $outary[$_] .= "- "; - $holdmcm = $_; - $endidx = $#qstatc - 3; - for (0 .. $endidx) { - $outary[$_] .= "$qstatc[$_] -
"; - } - $outary[$_] .= "- "; - for (0 .. $endidx) { - $outary[$_] .= "$qstatp[$_]\% -
"; - } - $_ = $holdmcm; - $outary[$_] .= "- "; - } elsif ($qstatsqf[$qid] eq 'nrt' ) { - - ##### v ADT - 7/03/2002 ################################################ - # If you want to remove the NRT statistics, delete between these comments - ######################################################################## - $outary[$_] .= " -- --
-- -BREAKDOWN OF $xlatphrase[137] RESPONSES -- -- Response Option - Cnt - Pct - -- "; - foreach $qstat (@qstato) { - $outary[$_] .= "$qstat -
"; - } - $outary[$_] .= "- "; - $holdmcm = $_; - $endidx = $#qstatc - 3; - for (0 .. $endidx) { - $outary[$_] .= "$qstatc[$_] -
"; - } - $outary[$_] .= "- "; - for (0 .. $endidx) { - $outary[$_] .= "$qstatp[$_]\% -
"; - } - $_ = $holdmcm; - $outary[$_] .= ""; - $outary[$_] .= " -
-
-- -BREAKDOWN OF $incresponse RESPONSES -- -- Response Option - Cnt - Pct - -- "; - foreach $qstat (@qstatw) { - $outary[$_] .= "$qstat -
"; - } - $outary[$_] .= "- "; - $holdmcm = $_; - foreach (@qstatsqwc) { - $outary[$_] .= "$_ -
"; - } - $outary[$_] .= "- "; - foreach (@qstatsqwp) { - $outary[$_] .= "$_\% -
"; - } - $_ = $holdmcm; - $outary[$_] .= "- "; - $outary[$_] .= " -- "; - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .="$qstatc[2] -
$qstatc[1]"; - } else { - $outary[$_] .="$qstatc[0]
$qstatc[2]
$qstatc[1]"; - } - $outary[$_] .= "- "; - if ($FORM{'exnoresp'}) { - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .=" -
$qstatp[1]\%"; - } else { - $outary[$_] .="$qstatp[0]\%
$qstatp[1]\%"; - } - } else { - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .="$qstatp[2]\%
$qstatp[1]\%"; - } else { - $outary[$_] .="$qstatp[0]\%
$qstatp[2]\%
$qstatp[1]\%"; - } - } - $outary[$_] .= "- "; - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .="$qstato[1] "; - $outary[$_] .= " -
$qstato[0]"; - } else { - $outary[$_] .="$qstato[0]
$qstato[2]
$qstato[1]"; - } - $outary[$_] .= "- - "; - ##### ^ ADT - 7/03/2002 - End Delete ################################### - - ##### v ADT - 7/03/2002 ################################################ - # Added code to print NRT answers in the form of the comments - ######################################################################## - #print "\n\t"; - $outary[$_] .= " - "; - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $outary[$_] .=" -
$qstato[2]"; - } else { - $outary[$_] .="
$qstato[3]"; - } - $outary[$_] .= " -\n\t\t \n"; - ##### ^ ADT - 7/03/2002 ################################################ - - } else { - if ($TEST{'seq'} eq 'svy' || $TEST{'seq'} eq 'dmg') { - $bs = ""; - $be = ""; - } else { - $bs = ""; - $be = ""; - } - $outary[$_] .= " -"; - #print "\n\t\t\t \n\t\n\t\t\t\t
\n\t\t\n"; - #print "\t\t\t\t\t \n"; - #print "\t\t\tAnswers: \n"; - #print "\t\t\t\t\t"; - #for $i (0 .. $#qresponses) { - #@columns=split(/\&/, $qresponses[$i]); - #if ($columns[0] eq $qid) { - #print "$columns[1]\: \n"; - #print "\t\t\t\t
\n"; - #while (length($columns[2]) > 50) { - #$j=index($columns[2]," ",45); - #if ($j==-1) { - #$qresponse=substr($columns[2],0,50); - #$columns[2]=substr($columns[2],50); - #} else { - #$qresponse=substr($columns[2],0,$j); - #$j++; - #$columns[2]=substr($columns[2],$j); - #} - #print "$qresponse
\n"; - #} - #print "$columns[2]
\n"; - #} - #} - # - #print "- \n"; - } - if (($FORM{'showcmts'} eq 'withq') && ($#qucmts != -1)) { - ##### v ADT - 7/03/2002 ################################################ - # Modified code to add the comments to the same table cell as the - # answers if the question is a Narrative question - ######################################################################## - #if( $qstatsqf[$qid] ne 'nrt' ) { - print "\t- "; - $boldtag = $bs; - $boldtagend = $be; - foreach $qstat (@qstatc) { - $outary[$_] .= "$boldtag$qstat$boldtagend -
"; - $boldtag = ""; - $boldtagend = ""; - } - $outary[$_] .= "- "; - $boldtag = $bs; - $boldtagend = $be; - foreach $qstat (@qstatp) { - $outary[$_] .= "$boldtag$qstat\%$boldtagend -
"; - $boldtag = ""; - $boldtagend = ""; - } - $outary[$_] .= "- "; - $boldtag = $bs; - $boldtagend = $be; - foreach $qstat (@qstato) { - $outary[$_] .= "$boldtag$qstat$boldtagend -
"; - $boldtag = ""; - $boldtagend = ""; - } - $outary[$_] .= "\n\t\t \n"; - } - $outary[$_] .= " -\n\t\t\t -"; - #} - $outary[$_] .= "
-- -\nComments: -\n"; - ##### ^ ADT - 7/03/2002 ################################################ - for $i (0 .. $#qucmts) { - @columns=split(/\&/, $qucmts[$i]); - if ($columns[0] eq $qid) { - $outary[$_] .= "$columns[1]\: -
\n"; - while (length($columns[2]) > 50) { - $j=index($columns[2]," ",45); - if ($j==-1) { - $qucmt=substr($columns[2],0,50); - $columns[2]=substr($columns[2],50); - } else { - $qucmt=substr($columns[2],0,$j); - $j++; - $columns[2]=substr($columns[2],$j); - } - $outary[$_] .= "$qucmt
\n"; - } - $outary[$_] .= "$columns[2]
\n"; - } - } - $outary[$_] .= "- \n"; - @qstato = (); - @qstatc = (); - @qstatp = (); - } - } -} -if (($FORM{'showcmts'} eq 'atend') && ($#qucmts != -1)) { - $outary[$_] .= "- \n"; - $outary[$_] .= " \n"; - $outary[$_] .= " Comments \n"; -} -@qucmts=(); -# Read in .rgo file which defines question presentation order -if ($FORM{'tstid'} =~ /SAS/) { - $lookupfile = join($pathsep,$dataroot,"IntegroSAS.rgo"); - } elsif ($FORM{'tstid'} =~ /^TAQ/) { - $lookupfile = join($pathsep,$dataroot,"IntegroTAQ.rgo"); -} -if (-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"; - $outary[$_] .= " \n\n
\n"; - for (1 ..$#questions) { - ($test,$qid) = split(/\./, $qstatsid[$_]); - if ($qstatsqf[$qid] ne 'obs') { - for $i (0 .. $#qucmts) { - @columns=split(/\&/, $qucmts[$i]); - if ($columns[0] eq $qid) { - $outary[$_] .= " ID User Comments \n"; - $outary[$_] .= " \n"; - } - } - $outary[$_] .= "$qstatsid[$_] \n"; - $outary[$_] .= "$columns[1] \n"; - $outary[$_] .= "\n"; - while (length($columns[2]) > 70) { - $j=index($columns[2]," ",65); - if ($j==-1) { - $qucmt=substr($columns[2],0,70); - $columns[2]=substr($columns[2],70); - } else { - $qucmt=substr($columns[2],0,$j); - $j++; - $columns[2]=substr($columns[2],$j); - } - $outary[$_] .= "$qucmt \n"; - $outary[$_] .= "
\n"; - } - $outary[$_] .= "$columns[2]
\n"; - $outary[$_] .= "\n"; - } - } - $outary[$_] .= "\n\n \n"; - $out .= " $section \n"; - } - foreach my $sub (@line) { - my ($subheader, $quess) = split(/:/,$sub); - if ($subheader ne "") { - $out .= " \n"; - } - @ques = split(/\,/,$quess); - foreach my $quesid (@ques) { - $out .= $outary[$quesid]; - } - } - } - print $out; - } -} else { - for (1 ..$#questions) { - print $outary[$_]; - } -} -if ($FORM{'showobs'}) { - print "$sobsolete"; -} -print " $subheader:
".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
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| All Groups | \n". - "Choose Groups \n". - " | Specific User "; - print " | ||
| ||||
Time Stamp:
|
\n"; - print "Display reports as PDF\n"; - print "
- Team Trust Level Report ". - "
- Team Alignment Report ". - "
General Reports
- Comments "; - print "
- Comments by Category "; - print "\n"; - print "\n"; - #my $commurl = "/cgi-bin/teststats.pl?tstid=SAS01". -# "&tid=$FORM{'tid'}&rptid=ACT-C-004&rptdesc=Test%20Statistics%20by%20Test". -# "&testsummary=composite&showcmts=donot"; - print "
- Question Statistics \n"; - print ""; - print "\n"; - print HTMLFooter(); -} - -# Also known as the Group Alignment report -sub CommEffectReport { - my ($idlist,$groups,$timestamp,$cndid) = @_; - my $data = &CommEffectData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups); - my $user; - if ($cndid) {$user = &CommEffectData($CLIENT{'clid'},$TEST{'id'},{$cndid => 1},$groups);&get_candidate_profile($CLIENT{'clid'},$cndid);} - my $claritysum = $data->{'organization'}->{'claritysum'}; - my $approvalsum = $data->{'organization'}->{'approvalsum'}; - my $histograms = $data->{'organization'}->{'histogram'}; - print HTMLHeaderPlain("Team Alignment Report"); - print "
- $_ \n"; - } - $outary[$i] .= "
- No Comments
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 "
| Very Unclear | ". - " | Moderately Unclear | Moderately Clear | ". - "Very Clear | Team Clarity | ". - "Team Approval | |||
|---|---|---|---|---|---|---|---|---|---|
| $row | "; - for my $i (0..6) { - print "";
- 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 " "; - } - 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 " "; - } - 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 " | ";
- }
- printf "%.1f %% | \n", $claritysum->{$row}->{'value'}; - printf "%.1f %% | \n", $approvalsum->{$row}->{'value'}; - print "
Position = Team Clarity
\nCountenance = Personal Approval
\n"; - #print "| Clarity | %.1f %% |
|---|---|
| Approval | %.1f %% |
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 "
| Clarity | Approval | |
|---|---|---|
| Overall | "; - printf "%.1f %% | ",$data->{'organization'}->{'overallclarity'}; - printf "%.1f %% |
| Group Breakdown | ||
| Group | Clarity | Approval |
| $groups->{$grp}->{'grpnme'} | "; - printf "%.1f %% | ", $data->{'groups'}->{$grp}->{'overallclarity'}; - printf "%.1f %% |
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 "
| Team Trust Level | ||
|---|---|---|
| $row | "; - print "%.1f%% |
Overall Team Level of Trust = %.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 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 "
| Team Trust Level | |
|---|---|
| Overall | "; - printf "%.1f %% |
| Group Breakdown | |
| Group | Team Trust Level |
| $groups->{$grp}->{'grpnme'} | "; - printf "%.1f %% |
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"; - - my @outary = (); - for (my $i=1; $i <=40; $i++) { - if ($comments[$i] == -1) { - # inactive question - next; - } - $outary[$i] = "\n"; - #print "
\n"; - $outary[$i] .= "$questions[$i]->[0] - $questions[$i]->[4]\n"; - if (@{$comments[$i]}) { - $outary[$i] .= "
\n"; - foreach (@{$comments[$i]}) { - $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,"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 .= " \n"; - } - foreach my $sub (@line) { - my ($subheader, $quess) = split(/:/,$sub); - if ($subheader ne "") { - $out .= " $section \n"; - } - my @ques = split(/\,/,$quess); - foreach my $quesid (@ques) { - $out .= $outary[$quesid]; - } - } - } - print $out; - } - } else { - for (1 .. $#outary) { - print $outary[$_]; - } - } - - print " $subheader:
\n"; - print "
".Dumper(\@questions,\@comments)."\n"; - print "
- -
| Test ID | -Description | -Cmp | -InP | -Pnd | -
label_names ' . "@label_names" . '
' ; - # print '
value_points ' . "@value_points" . '
' ; - if ($#label_names != $#value_points) { - print '
ERROR BuildBarGraph has different number of labels and data values.
' ; - } - $labels = join (":", map {munge($_)} @label_names ) ; - $values = join (":", map {munge($_)} @value_points ) ; - $values2 = join (":", map {munge($_)} @value2_points ) ; - # my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&title=Trust%20Level&ylabel=Respondents"; - my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&values=$values" ; - if ($xdim or $xdim == 0) { $baseurl .= "&xdim=" . $xdim ; } - if ($ydim or $ydim == 0) { $baseurl .= "&ydim=" . $ydim ; } - if ($hbar or $hbar == 0) { $baseurl .= "&hbar=" . $hbar ; } - if ($title or $title == 0) { $baseurl .= "&title=" . munge( $title) ; } - if ($xlabel or $xlabel == 0) { $baseurl .= "&xlabel=" . munge( $xlabel) ; } - if ($ylabel or $ylabel == 0) { $baseurl .= "&ylabel=" . munge( $ylabel) ; } - if ($ymax or $ymax == 0) { $baseurl .= "&ymax=" . $ymax ; } - if ($ymin or $ymin == 0) { $baseurl .= "&ymin=" . $ymin ; } - if ($t_margin or $t_margin == 0) { $baseurl .= "&t_margin=" . $t_margin ; } - if ($b_margin or $b_margin == 0) { $baseurl .= "&b_margin=" . $b_margin ; } - if ($l_margin or $l_margin == 0) { $baseurl .= "&l_margin=" . $l_margin ; } - if ($r_margin or $r_margin == 0) { $baseurl .= "&r_margin=" . $r_margin ; } - if ($colorscheme) { $baseurl .= "&colorscheme=" . $colorscheme ; } - if ($yticknum or $yticknum == 0) { $baseurl .= "&yticknum=" . $yticknum ; } - return "
label_names ' . "@label_names" . '
' ; - # print '
value_points ' . "@value_points" . '
' ; - if ($#label_names != $#value_points) { - print '
ERROR BuildBarGraph has different number of labels and data values.
' ; - } - $labels = join (":", map {munge($_)} @label_names ) ; - $values = join (":", map {munge($_)} @value_points ) ; - $values2 = join (":", map {munge($_)} @value2_points ) ; - # my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&title=Trust%20Level&ylabel=Respondents"; - my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&values=$values" ; - if ($xdim or $xdim == 0) { $baseurl .= "&xdim=" . $xdim ; } - if ($ydim or $ydim == 0) { $baseurl .= "&ydim=" . $ydim ; } - if ($hbar or $hbar == 0) { $baseurl .= "&hbar=" . $hbar ; } - if ($title or $title == 0) { $baseurl .= "&title=" . munge( $title) ; } - if ($xlabel or $xlabel == 0) { $baseurl .= "&xlabel=" . munge( $xlabel) ; } - if ($ylabel or $ylabel == 0) { $baseurl .= "&ylabel=" . munge( $ylabel) ; } - if ($ymax or $ymax == 0) { $baseurl .= "&ymax=" . $ymax ; } - if ($ymin or $ymin == 0) { $baseurl .= "&ymin=" . $ymin ; } - if ($t_margin or $t_margin == 0) { $baseurl .= "&t_margin=" . $t_margin ; } - if ($b_margin or $b_margin == 0) { $baseurl .= "&b_margin=" . $b_margin ; } - if ($l_margin or $l_margin == 0) { $baseurl .= "&l_margin=" . $l_margin ; } - if ($r_margin or $r_margin == 0) { $baseurl .= "&r_margin=" . $r_margin ; } - if ($colorscheme) { $baseurl .= "&colorscheme=" . $colorscheme ; } - if ($yticknum or $yticknum == 0) { $baseurl .= "&yticknum=" . $yticknum ; } - return "
".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 'LikertWQ') { - &LikertWQ($idlist, $groups, $timestamp); - } elsif ($FORM{'reportname'} eq 'LikertWQG') { - &LikertWQG($idlist, $groups, $timestamp); - } else { - &ReportChooser(); - } - -# There should only be function definitions beyond this point. -exit(0); - -sub HTMLHeader { - return "\n\n
Copyright (c) $year, Integro Learning Company"; - } - return "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - # Print HTML for heading. - print "
| Category Scores | " ; - print "||||
|---|---|---|---|---|
| Category | " ; - print "Questions | " ; - print "Points Possible | " ; - print "Points Earned | " ; - print "% Earned | " ; - print "
| $supercat | " ; - print "$questions | " ; - print "$possible | " ; - print &rep_cell_str($earned, $possible) ; - print "||
| Total | " ; - print "$tot_poss | " ; - print &rep_cell_str($tot_earned, $tot_poss) ; - print "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - # Print HTML for heading. - print "
| " ; - my $supercat ; - foreach $supercat (sort keys %{$sumdata}) { - print " | $supercat | \n" ; - } - print "Total | " ; - print "
|---|---|---|
| Overall | \n" ; - my @supercats = sort keys %{$sumdata} ; - for $supercat (@supercats) { - # my $questions = "" ; - my $possible = 0 ; - my $earned = 0 ; - # $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ; - $possible = $sumdata->{$supercat}->{'PointsAvail'} ; - $earned = $sumdata->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "||
| Group Breakdown | ||
| Supervisor | " ; - for $supercat (@supercats) { - print "$supercat | " ; - } - print "Total |
| Pick Groups for more detail | ||
| " ; - # print "$group " ; - print $all_groups->{$group}->{'grpnme'} ; - print " | " ; - my $tot_poss = 0 ; my $tot_earned = 0 ; - for $supercat (@supercats) { - my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ; - my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "
" . - # "" . -"
| Test ID | " . - "Description | " . - "Cmp | " . - "InP | " . - "Pnd | " . - "
".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 'LikertWQ') { - &LikertWQ($idlist, $groups, $timestamp); - } elsif ($FORM{'reportname'} eq 'LikertWQG') { - &LikertWQG($idlist, $groups, $timestamp); - } else { - &ReportChooser(); - } - -# There should only be function definitions beyond this point. -exit(0); - -sub HTMLHeader { - return "\n\n
Copyright (c) $year, Integro Learning Company"; - } - return "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - my (@img_labels, @img_data) ; - my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ; - my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ; - @img_labels = () ; @img_data = () ; @values2 = () ; - ($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ; - ($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) = - (800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ; - - # Print HTML for heading. - print "
| Category Scores | " ; - print "||||
|---|---|---|---|---|
| Category | " ; - print "Questions | " ; - print "Points Possible | " ; - print "Points Earned | " ; - print "% Earned | " ; - print "
| $supercat | " ; - print "$questions | " ; - print "$possible | " ; - print &rep_cell_str($earned, $possible) ; - push @img_labels, $supercat ; - my ($percent) = int ((100.0 * $earned / $possible) +0.5) ; - push @img_data, $percent ; - $ydim += 15 ; # add length to the chart for another row. - print "||
| Total | " ; - print "$tot_poss | " ; - print &rep_cell_str($tot_earned, $tot_poss) ; - print "
\n" ; - print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, - $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, - $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ; - print "
\n" ; - } - - print HTMLFooter(); -} - -sub LikertWQG { - # This does the Summary on the Likert Scale questions, - # for everybody, or just groups, and lists group results. - # $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups. - # $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the group ids, and the values are the group ids. - # $FORM{'idlist'} is a comma separated list of the group ids of the selected groups. - # $FORM{'grouping'} is "subset" when the report should only cover the selected groups. - # $FORM{'grouping'} is "all" when the report should cover everybody. - # HBI - Pick it up here. - my ($idlist,$groups,$timestamp) = @_; - my $all_groups = getGroups($CLIENT{'clid'}) ; - my $group_membership_required ; - if ($groups) { - $group_membership_required = 1 ; - my $group_p ; - for $group_p (keys %{$all_groups}) { - unless ($groups->{$group_p}) { - undef $all_groups->{$group_p} ; - } - } - } else { - $group_membership_required = 0 ; - } - my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ; - # warn "sumdata" ; - # warn &Dumper(\$sumdata) ; - # warn "grpdata" ; - # warn &Dumper(\$grpdata) ; - - print HTMLHeaderPlain("Likert Scale Group Results"); - print "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - # Print HTML for heading. - print "
| " ; - my $supercat ; - foreach $supercat (sort keys %{$sumdata}) { - print " | $supercat | \n" ; - } - print "Total | " ; - print "
|---|---|---|
| Overall | \n" ; - my @supercats = sort keys %{$sumdata} ; - for $supercat (@supercats) { - # my $questions = "" ; - my $possible = 0 ; - my $earned = 0 ; - # $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ; - $possible = $sumdata->{$supercat}->{'PointsAvail'} ; - $earned = $sumdata->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "||
| Group Breakdown | ||
| Supervisor | " ; - for $supercat (@supercats) { - print "$supercat | " ; - } - print "Total |
| Pick Groups for more detail | ||
| " ; - # print "$group " ; - print $all_groups->{$group}->{'grpnme'} ; - print " | " ; - my $tot_poss = 0 ; my $tot_earned = 0 ; - for $supercat (@supercats) { - my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ; - my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "
" . - # "" . -"
| Test ID | " . - "Description | " . - "Cmp | " . - "InP | " . - "Pnd | " . - "
".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 'LikertWQ') { - &LikertWQ($idlist, $groups, $timestamp); - } elsif ($FORM{'reportname'} eq 'LikertWQG') { - &LikertWQG($idlist, $groups, $timestamp); - } else { - &ReportChooser(); - } - -# There should only be function definitions beyond this point. -exit(0); - -sub HTMLHeader { - return "\n\n
Copyright (c) $year, Integro Learning Company"; - } - return "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - my (@img_labels, @img_data) ; - my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ; - my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ; - @img_labels = () ; @img_data = () ; @values2 = () ; - ($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ; - ($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) = - (800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ; - - # Print HTML for heading. - print "
| Category Scores | " ; - print "||||
|---|---|---|---|---|
| Category | " ; - print "Questions | " ; - print "Points Possible | " ; - print "Points Earned | " ; - print "% Earned | " ; - print "
| $supercat | " ; - print "$questions | " ; - print "$possible | " ; - print &rep_cell_str($earned, $possible) ; - push @img_labels, $supercat ; - my ($percent) = int ((100.0 * $earned / $possible) +0.5) ; - push @img_data, $percent ; - $text_summ .= $supercat . ": " . $percent . "||
| Total | " ; - print "$tot_poss | " ; - push @img_labels, "Total" ; - my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ; - push @img_data, $percent ; - $text_summ .= "Total" . ": " . $percent . "
\n" ; - print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, - $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, - $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ; - print "
\n" ; - } - - print HTMLFooter(); -} - -sub LikertWQG { - # This does the Summary on the Likert Scale questions, - # for everybody, or just groups, and lists group results. - # $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups. - # $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the group ids, and the values are the group ids. - # $FORM{'idlist'} is a comma separated list of the group ids of the selected groups. - # $FORM{'grouping'} is "subset" when the report should only cover the selected groups. - # $FORM{'grouping'} is "all" when the report should cover everybody. - # HBI - Pick it up here. - my ($idlist,$groups,$timestamp) = @_; - my $all_groups = getGroups($CLIENT{'clid'}) ; - my $group_membership_required ; - if ($groups) { - $group_membership_required = 1 ; - my $group_p ; - for $group_p (keys %{$all_groups}) { - unless ($groups->{$group_p}) { - undef $all_groups->{$group_p} ; - } - } - } else { - $group_membership_required = 0 ; - } - my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ; - # warn "sumdata" ; - # warn &Dumper(\$sumdata) ; - # warn "grpdata" ; - # warn &Dumper(\$grpdata) ; - - print HTMLHeaderPlain("Likert Scale Group Results"); - print "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - # Print HTML for heading. - print "
| " ; - my $supercat ; - foreach $supercat (sort keys %{$sumdata}) { - print " | $supercat | \n" ; - } - print "Total | " ; - print "
|---|---|---|
| Overall | \n" ; - my @supercats = sort keys %{$sumdata} ; - for $supercat (@supercats) { - # my $questions = "" ; - my $possible = 0 ; - my $earned = 0 ; - # $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ; - $possible = $sumdata->{$supercat}->{'PointsAvail'} ; - $earned = $sumdata->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "||
| Group Breakdown | ||
| Supervisor | " ; - for $supercat (@supercats) { - print "$supercat | " ; - } - print "Total |
| Pick Groups for more detail | ||
| " ; - # print "$group " ; - print $all_groups->{$group}->{'grpnme'} ; - print " | " ; - my $tot_poss = 0 ; my $tot_earned = 0 ; - for $supercat (@supercats) { - my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ; - my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "
" . - # "" . -"
| Test ID | " . - "Description | " . - "Cmp | " . - "InP | " . - "Pnd | " . - "
".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 'LikertWQ') { - &LikertWQ($idlist, $groups, $timestamp); - } elsif ($FORM{'reportname'} eq 'LikertWQG') { - &LikertWQG($idlist, $groups, $timestamp); - } else { - &ReportChooser(); - } - -# There should only be function definitions beyond this point. -exit(0); - -sub HTMLHeader { - return "\n\n
Copyright (c) $year, Integro Learning Company"; - } - return "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - my (@img_labels, @img_data) ; - my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ; - my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ; - @img_labels = () ; @img_data = () ; @values2 = () ; - ($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ; - ($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) = - (800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ; - - # Print HTML for heading. - print "
| Category Scores | " ; - print "||||
|---|---|---|---|---|
| Category | " ; - print "Questions | " ; - print "Points Possible | " ; - print "Points Earned | " ; - print "% Earned | " ; - print "
| $supercat | " ; - print "$questions | " ; - print "$possible | " ; - print &rep_cell_str($earned, $possible) ; - push @img_labels, $supercat ; - my ($percent) = int ((100.0 * $earned / $possible) +0.5) ; - push @img_data, $percent ; - $text_summ .= $supercat . ": " . $percent . " %||
| Total | " ; - print "$tot_poss | " ; - push @img_labels, "Total" ; - my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ; - push @img_data, $percent ; - $text_summ .= "Total" . ": " . $percent . " %
\n" ; - print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, - $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, - $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ; - print "
\n" ; - } - - print HTMLFooter(); -} - -sub LikertWQG { - # This does the Summary on the Likert Scale questions, - # for everybody, or just groups, and lists group results. - # $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups. - # $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the group ids, and the values are the group ids. - # $FORM{'idlist'} is a comma separated list of the group ids of the selected groups. - # $FORM{'grouping'} is "subset" when the report should only cover the selected groups. - # $FORM{'grouping'} is "all" when the report should cover everybody. - # HBI - Pick it up here. - my ($idlist,$groups,$timestamp) = @_; - my $all_groups = getGroups($CLIENT{'clid'}) ; - my $group_membership_required ; - if ($groups) { - $group_membership_required = 1 ; - my $group_p ; - for $group_p (keys %{$all_groups}) { - unless ($groups->{$group_p}) { - undef $all_groups->{$group_p} ; - } - } - } else { - $group_membership_required = 0 ; - } - my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ; - # warn "sumdata" ; - # warn &Dumper(\$sumdata) ; - # warn "grpdata" ; - # warn &Dumper(\$grpdata) ; - - print HTMLHeaderPlain("Likert Scale Group Results"); - print "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - # Print HTML for heading. - print "
| " ; - my $supercat ; - foreach $supercat (sort keys %{$sumdata}) { - print " | $supercat | \n" ; - } - print "Total | " ; - print "
|---|---|---|
| Overall | \n" ; - my @supercats = sort keys %{$sumdata} ; - for $supercat (@supercats) { - # my $questions = "" ; - my $possible = 0 ; - my $earned = 0 ; - # $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ; - $possible = $sumdata->{$supercat}->{'PointsAvail'} ; - $earned = $sumdata->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "||
| Group Breakdown | ||
| Supervisor | " ; - for $supercat (@supercats) { - print "$supercat | " ; - } - print "Total |
| Pick Groups for more detail | ||
| " ; - # print "$group " ; - print $all_groups->{$group}->{'grpnme'} ; - print " | " ; - my $tot_poss = 0 ; my $tot_earned = 0 ; - for $supercat (@supercats) { - my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ; - my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "
" . - # "" . -"
| Test ID | " . - "Description | " . - "Cmp | " . - "InP | " . - "Pnd | " . - "
".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 'LikertWQ') { - &LikertWQ($idlist, $groups, $timestamp); - } elsif ($FORM{'reportname'} eq 'LikertWQG') { - &LikertWQG($idlist, $groups, $timestamp); - } else { - &ReportChooser(); - } - -# There should only be function definitions beyond this point. -exit(0); - -sub HTMLHeader { - return "\n\n
Copyright (c) $year, Integro Learning Company"; - } - return "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - my (@img_labels, @img_data) ; - my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ; - my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ; - @img_labels = () ; @img_data = () ; @values2 = () ; - ($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ; - ($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) = - (800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ; - - # Print HTML for heading. - print "
| Category Scores | " ; - print "||||
|---|---|---|---|---|
| Category | " ; - print "Questions | " ; - print "Points Possible | " ; - print "Points Earned | " ; - print "% Earned | " ; - print "
| $supercat | " ; - print "$questions | " ; - print "$possible | " ; - print &rep_cell_str($earned, $possible) ; - push @img_labels, $supercat ; - my ($percent) = int ((100.0 * $earned / $possible) +0.5) ; - push @img_data, $percent ; - $text_summ .= $supercat . ": " . $percent . " %||
| Total | " ; - print "$tot_poss | " ; - push @img_labels, "Total" ; - my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ; - push @img_data, $percent ; - $text_summ .= "Total" . ": " . $percent . " %
\n" ; - print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, - $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, - $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ; - print "
\n" ; - } - - print HTMLFooter(); -} - -sub LikertWQG { - # This does the Summary on the Likert Scale questions, - # for everybody, or just groups, and lists group results. - # $idlist is the list of candidate ids to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the candidate ids, and the value is 1 for candidates in the choosen groups. - # $groups is the hash of groups to report on. It is undef when all groups (everyone) is choosen. - # It is a reference to a hash. The keys are the group ids, and the values are the group ids. - # $FORM{'idlist'} is a comma separated list of the group ids of the selected groups. - # $FORM{'grouping'} is "subset" when the report should only cover the selected groups. - # $FORM{'grouping'} is "all" when the report should cover everybody. - # HBI - Pick it up here. - my ($idlist,$groups,$timestamp) = @_; - my $ResponseRequired = 1 ; # Do not count questions if there was no response. - my $all_groups = getGroups($CLIENT{'clid'}) ; - my $group_membership_required ; - if ($groups) { - $group_membership_required = 1 ; - my $group_p ; - for $group_p (keys %{$all_groups}) { - unless ($groups->{$group_p}) { - undef $all_groups->{$group_p} ; - } - } - } else { - $group_membership_required = 0 ; - } - my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required,$ResponseRequired) ; - # warn "sumdata" ; - # warn &Dumper(\$sumdata) ; - # warn "grpdata" ; - # warn &Dumper(\$grpdata) ; - - print HTMLHeaderPlain("Likert Scale Group Results"); - print "
" ; - print "Survey/Test $TEST{'desc'}
\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($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."
\n" ; - } else { - print "$xlatphrase[798] $xlatphrase[799]
\n"; - } - print $timestamp; - print "" ; - - # Print HTML for heading. - print "
| " ; - my $supercat ; - foreach $supercat (sort keys %{$sumdata}) { - print " | $supercat | \n" ; - } - print "Total | " ; - print "
|---|---|---|
| Overall | \n" ; - my @supercats = sort keys %{$sumdata} ; - for $supercat (@supercats) { - # my $questions = "" ; - my $possible = 0 ; - my $earned = 0 ; - # $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ; - $possible = $sumdata->{$supercat}->{'PointsAvail'} ; - $earned = $sumdata->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "||
| Group Breakdown | ||
| Supervisor | " ; - for $supercat (@supercats) { - print "$supercat | " ; - } - print "Total |
| Pick Groups for more detail | ||
| " ; - # print "$group " ; - print $all_groups->{$group}->{'grpnme'} ; - print " | " ; - my $tot_poss = 0 ; my $tot_earned = 0 ; - for $supercat (@supercats) { - my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ; - my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ; - $tot_poss += $possible ; - $tot_earned += $earned ; - print &rep_cell_str($earned, $possible, 1) ; - } - print &rep_cell_str($tot_earned, $tot_poss, 1) ; - print "
" . - # "" . -"
| Test ID | " . - "Description | " . - "Cmp | " . - "InP | " . - "Pnd | " . - "
| $colhdr | \n"; - } - print "\t
| Question | \n"; - print "Answer | \n"; - print "|
| \n"; - #print " | \n"; - #print "\n";
- print " \n"; - print " | \n";
- print "\n"; - print "\n"; - print " | \n"; - print "\n"; - print "
Filter By User
\n"; - &print_report_dataextract_header($rowcount,@colhdrs); - $jsarray = ""; - for $i (0 .. $#sorted) { - @dataflds=split($joint, $sorted[$i]); - print "
| $colhdr | \n"; - } - print "\t
![](\"$graphroot/noimageassigned.gif\")
";
- if ($QUESTION{'qim'} eq '1') {
- $QUESTION{'qim1'} = "SELECTED";
- } elsif ($QUESTION{'qim'} eq '2') {
- $QUESTION{'qim2'} = "SELECTED";
- } elsif ($QUESTION{'qim'} eq '3' ) {
- $QUESTION{'qim3'} = "SELECTED";
- $QUESTION{'illustration'} = "