#! /usr/bin/perl # Copyright 2001-2018 Leslie Richardson # This file is part of Open Admin for Schools. # Open Admin for Schools is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # based on report 8 from central site. my %lex = ('Main' => 'Main', 'Continue' => 'Continue', 'Homeroom' => 'Homeroom', 'Grade' => 'Grade', 'Select by' => 'Select by', 'Error' => 'Error', 'Sort by' => 'Sort by', 'Name' => 'Name', 'Common Math Assessment' => 'Common Math Assessment', 'Report' => 'Report', 'OR' => 'OR', 'No Selection' => 'No Selection', 'School Year' => 'School Year', 'Show Withdrawn' => 'Show Withdrawn', ); my $self = 'cmaRpt8local.pl'; my $pct = '%'; use DBI; use CGI; use Cwd; use Number::Format qw(:all); use Time::JulianDay; my @strands = qw(P N SS SP); my %strandnames = ('P' => 'Patterns and Relations', 'N' => 'Numbers and Operations', 'SS' => 'Shape and Space', 'SP' => 'Stats and Prob' ); my $configpath = '../../..'; if ( getcwd() =~ /tcgi/ ){ # we are in tcgi $configpath = '../..'; } eval require "$configpath/etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } if ( getcwd() !~ /tcgi/ ) { # we are in cgi $tchcss = $css; $tchpage = $homepage; } my $q = new CGI; print $q->header( -charset, $charset ); my %arr = $q->Vars; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; if ( $arr{nopct} ) { $pct = ''; } my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $iddst) = localtime(time); $year = $year + 1900; $wday++; $mon++; my $currdate = "$year-$mon-$mday"; my $title = qq{$lex{'Common Math Assessment'} $lex{Report} 8 - }. qq{Students and Mathematics Completion(%) by Grade}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{
[ $lex{Main} ]
\n}; print qq{

$title

\n}; print qq{

Show CMA outcome Progress on a YTD (Year to Date) Basis.

\n}; showReport(); #------------- sub showReport { #------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } print qq{

Schoolyear $schoolyear

\n}; # Now convert to short version my ($sy, $ey) = split('-', $schoolyear); $schoolyear = $ey; =head # Get the school dates from configuration system my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); foreach my $val ( qw(schoolstart schoolend )) { $sth->execute( $val ); my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } } =cut # populate jdclosed with dates from dates table; used by calcSchoolDays; my %jdclosed; my $sth = $dbh->prepare("select date, dayfraction from dates where date is not NULL and date != ''"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $date, $dayfraction ) = $sth->fetchrow ) { my $jd = julian_day( split( /-/, $date ) ); $jdclosed{$jd} = $dayfraction; } # Load School Year, and figure out where we are in it. (teaching days). # Need Total Teaching Days, and what day we are currently at. my ($currschoolday, $totalschooldays ) = split(':',calcSchoolDays($schoolstart, $schoolend, $currdate, \%jdclosed )); my $completed = format_number( $currschoolday * 100 / $totalschooldays, 1 ); print qq{\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; print qq{
Total School Days$totalschooldays
Current School Day$currschoolday
Percentage of School Year Complete$completed%
\n}; # Load all outcomes. my %outcomes; my %outcomesgr; # outcomes by grade; my $sth = $dbh->prepare("select * from mathca_outcomes"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; while ( my $ref = $sth->fetchrow_hashref ) { %r = %$ref; $outcomes{$r{oid}} = $r{odesc}; $outcomesgr{$r{grade}}{$r{oid}} = 1; } # Load the tests by grade and outcomes, count ( $data{grade}{outcome} = count ) my (%data,%scores); my $sth1 = $dbh->prepare("select distinct studnum, count(distinct outcome) from mathca_scores where schoolyear = ? and tgrade = ? and prepost = 'posttest' group by studnum"); my $sth2 = $dbh->prepare("select distinct studnum, avg(score) from mathca_scores where schoolyear = ? and tgrade = ? and prepost = 'posttest' group by studnum"); # my $sth = $dbh->prepare("select distinct tgrade from mathca_scores where schoolyear = ? and # tgrade is not null and tgrade != '' and prepost = 'posttest'"); # $sth->execute( $schoolyear); # if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; my @grades; my $sth = $dbh->prepare("select distinct grade from student where grade is not NULL and grade != ''"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; while ( my $gr = $sth->fetchrow ) { push @grades, $gr; } @grades = sort { $a <=> $b } @grades; foreach my $grade ( @grades ) { my @scores; # Get Outcomes my $outcomeflag; # make sure we have outcomes. $sth1->execute( $schoolyear, $grade ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; while ( my ($studnum, $outcount ) = $sth1->fetchrow ) { if ( $outcount ) { $data{$grade}{$studnum} = $outcount; $outcomeflag = 1; } } if ( not $outcomeflag ) { next; } # no outcomes for this grade. # Get Average Score for each student in this grade. $sth2->execute( $schoolyear, $grade ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; while ( my ($studnum, $avgscore ) = $sth2->fetchrow ) { push @scores, $avgscore; } # Get average score for this grade. my $sum; foreach my $score ( @scores ) { $sum += $score; } my $avg = 0; my $studcount = @scores; if ( $studcount ) { $avg = $sum / $studcount; } $scores{$grade} = $avg; # print qq{Grade:$grade SUM:$sum AVG:$avg
\n}; # print qq{ @scores
\n}; } print qq{\n}; print qq{}; print qq{\n}; print qq{}; foreach my $top ( qw( 10 20 30 40 50 60 70 80 90 )) { print qq{}; } print qq{}; print qq{\n}; my @totalwtavg; my %data1; my %gradeaverage; # $gradeaverage{$grade}{count/total} foreach my $grade ( sort keys %data ) { my $outcometotal = scalar keys %{ $outcomesgr{$grade}}; foreach my $studnum ( sort keys %{ $data{$grade} } ) { my $count = $data{$grade}{$studnum}; my $percent; if ( $outcometotal ) { $percent = format_number( $count * 100 / $outcometotal, 1 ); } $gradeaverage{$grade}{'total'} += $percent; $gradeaverage{$grade}{'count'} += 1; $data1{$grade}{$studnum} = $percent; } } my %topcount; # topcount{decade} = count my ( $tavgtotal, $tavgcount ); foreach my $grade ( sort {$a <=> $b} keys %data1 ) { my $outcometotal = scalar keys %{ $outcomesgr{$grade}}; my $studenttotal = scalar keys %{ $data{$grade}}; my $binsum; print qq{}; print qq{\n}; foreach my $bottom ( qw( 0 10 20 30 40 50 60 70 80 90 )) { my $top = $bottom + 10; my $binavg = ( $top + $bottom ) / 2; my $count; foreach my $studnum ( keys %{ $data1{$grade} } ) { my $topper = $top; if ( $top == 100 ) { $topper = 100.01; } # to solve the 100% issue if ( $data1{$grade}{$studnum} >= $bottom and $data1{$grade}{$studnum} < $topper ) { $count++; } } if ( $count ) { # we have students in this 'bin'. my $spercent = format_number( $count * 100 / $studenttotal, 0); $binsum += ( $count * $top ); #~~ was $binavg print qq{}; $topcount{$top} += $count; } else { print qq{}; } } # end decade loop my $gpercent = 0; if ( $gradeaverage{$grade}{'count'} ) { $gpercent = format_number( $gradeaverage{$grade}{'total'} / $gradeaverage{$grade}{'count'}, 1); } $tavgtotal += $gpercent; $tavgcount ++; my $wtavg = format_number( $binsum / $studenttotal, 1); push @totalwtavg, $wtavg; my $compdiff = format_number($gpercent - $completed, 1); my $avgscore = format_number( $scores{$grade}, 2,2); my $pctscore = format_number( $scores{$grade} * 25, 0); print qq{\n}; } # end of grade loop # BOTTOM ROW print qq{\n}; # Get sum of all %topcount values my ($topcountsum, $binsum); foreach my $key ( sort keys %topcount) { $topcountsum += $topcount{$key}; } foreach my $top ( qw( 10 20 30 40 50 60 70 80 90 100 )) { my $tpercent = 0; if ( $topcountsum ) { $tpercent = format_number( $topcount{$top} * 100 / $topcountsum, 1); } print qq{}; } # Weighted average calc for completion my ($wcount,$wsum ); foreach my $avg ( @totalwtavg ) { $wcount++; $wsum += $avg; } my $wtavg = 0; if ( $wcount ) { $wtavg = format_number( $wsum / $wcount, 1 ); } print qq{\n}; # Now find the average score for all grades; my $sum; foreach my $gr ( keys %scores ) { $sum += $scores{$gr}; } my $denom = keys %scores; my $avgtotalscore = 0; if ( $denom ) { $avgtotalscore = format_number( $sum / $denom, 2,2 ); } my $pctscore = 0; $pctscore = format_number( $avgtotalscore * 25, 0); print qq{\n}; print qq{
Grade# of
Outcomes
# of
Students
Number of Students with this Percentage of Completion
<$top%<=100%}; print qq{Wt
Comp
Avg
Score
$grade$outcometotal$studenttotal$spercent$pct$wtavg$pct$avgscore - $pctscore$pct
Totals$tpercent$pct$wtavg$pct$avgtotalscore - $pctscore$pct
\n}; print qq{\n}; return; } # end of showReport #---------------- sub showStartPage { # Entry Values for Custom Script #---------------- my @schoolyears = ( qw(2014 2015 2016 2017)); my $checked = qq{checked="checked"}; print "
\n"; print "\n"; print "\n"; # School Year print qq{}; print qq{\n}; # Pre/Post Test # print qq{\n}; print qq{\n}; foreach my $db ( @dbase ) { print qq{\n}; } print qq{\n}; print qq{
$lex{'School Year'}
Test Type}; # print qq{
$lex{Select} $lex{Schools}
}; print qq{\n}; print qq{$alldbase{$db} ($db)
\n}; print qq{
\n}; exit; } #--------------- sub calcSchoolDays { # calculate the current day in school year and also total length of school year #--------------- # passed a start date and an end date for a term, and a ref to a # hash storing the closure dates in julian day format, it will # return a count of the days open in the month. my %dowclosed = ('0' => 1, '6' => 1); # Day 0 is Sunday, Day 6 is Saturday # outline: convert start/end dates to jd. Loop over all days. Use modulus function to ident weekend days. my ($startdate, $enddate, $currdate, $closeref ) = @_; my %jdclosed = %$closeref; =head print "JDClosed
\n"; foreach my $key ( sort keys %jdclosed ) { print "K:$key V:$jdclosed{$key}
\n"; } print "End JDClosed
\n"; =cut my $startjd = julian_day(split(/-/,$startdate)); my $endjd = julian_day(split(/-/,$enddate)); my $currjd = julian_day(split(/-/,$currdate)); my %modclosed; # modulus for days closed foreach my $inc ( 0..6 ) { my $testjd = $startjd + $inc; my $dow = day_of_week($testjd); if ( $dowclosed{$dow} ) { # $testjd is a closed dow my $mod = $testjd % 7; $modclosed{$mod} = 1; } } # foreach my $d ( sort keys %modclosed ) { # print "Closed Mod: $d
\n"; # } my ($currcount, $totalcount); my ($daysopen, $daysclosed); foreach my $jd ( $startjd..$endjd ) { my $dow = day_of_week( $jd ); my $mod = $jd % 7; if ( $jd == $currjd ) { $currcount = $daysopen; } if ( $modclosed{$mod} ) { # closed for weekend next; } # check if a day closed my $cl = $jdclosed{ $jd }; if ( $cl ) { # this gives us the fraction closed $daysclosed += $cl; # only add on the fraction of day open $daysopen += (1 - $cl ); } else { $daysopen += 1; } } $totalcount = $daysopen; return "$currcount:$totalcount"; }