#!/usr/bin/perl # Copyright 2001-2021 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. my %lex = ('Cohort' => 'Cohort', 'Report' => 'Report', 'Error' => 'Error', 'Main' => 'Main', 'Start Date' => 'Start Date', 'End Date' => 'End Date', 'Continue' => 'Continue', 'Student' => 'Student', 'Enrollment' => 'Enrollment', 'Attendance' => 'Attendance', 'Days' => 'Days', 'Average' => 'Average', 'Blocks' => 'Blocks', 'Beginning' => 'Beginning', 'Current' => 'Current', 'Retention' => 'Retention', ); my $self = 'rptcohort.pl'; use DBI; use CGI; use Time::JulianDay; use Number::Format qw(:all); eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # load attendance library eval require "../../lib/libattend.pl"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $q = new CGI; print $q->header( -charset, $charset ); my %arr = $q->Vars; my $dsn = "DBI:$dbtype:dbname=$dbase"; $dbh = DBI->connect($dsn,$user,$password); # Set Date my @tim = localtime(time); my $year = @tim[5] + 1900; my $month = @tim[4] + 1; my $day = @tim[3]; my $currdate = "$year-$month-$day"; my $currdate1 = "$month[$month] $day, $year"; my $title = qq{$lex{Cohort} $lex{Report}}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} |\n}; print qq{ $lex{Attendance} ] $currdate1\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { showReport(); } #---------------- sub showStartPage { #---------------- print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{'Start Date'}}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; exit; } #------------- sub showReport { #------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $startjd = julian_day( split /-/, $arr{sdate} ); my $endjd = julian_day( split /-/, $arr{edate} ); my $currjd = julian_day( split /-/, $currdate ); # Find current enrollment. my %students; my $sth = $dbh->prepare("select studnum, lastname, firstname from student"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $studnum, $lastname, $firstname ) = $sth->fetchrow ) { $students{ $studnum } = "$lastname, $firstname"; } my %currstud = %students; # Current Student Cohort my $currentenrol = keys %students; # Back up through transfers until we get to start date (Sept 30). $sth = $dbh->prepare("select studnum, type, date from transfer where to_days(date) >= to_days('$arr{sdate}') order by date desc"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # Setup for name retrieve; my $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); my %wddate = (); # withdrawal dates while ( my ( $studnum, $type, $date ) = $sth->fetchrow ) { if ( $type eq 'withdraw' ) { # then ADD student to students hash. if ( not $wddate{ $studnum } ) { $wddate{ $studnum } = [ $date ]; } else { # have an existing value push @{ $wddate{ $studnum } }, $date; } # Get Name $sth1->execute( $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname ) = $sth->fetchrow; if ( not $lastname ) { $lastname = '-1'; } $students{ $studnum } = "$lastname, $firstname"; } else { # it's an enrol, # then REMOVE from list delete $students{ $studnum }; } } # Start the table print qq{\n}; print qq{\n}; print qq{}; # Now Compare the 2 Hashes: Start Vs Current - Who is still here. my $startsize = keys %students; print qq{\n}; my %remainstud = (); # Combine the 2 hashes. my %masterstud = ( %students, %currstud ); my %withdrawstud; foreach my $studnum ( sort keys %masterstud ) { if ( $currstud{$studnum} and $students{$studnum} ) { # student still here $remainstud{ $studnum } = $currstud{ $studnum }; } if ( $students{$studnum} and not $currstud{$studnum} ) { # withdrawn student $withdrawstud{ $studnum } = $students{$studnum}; } } my $remainsize = keys %remainstud; print qq{\n}; my $retentionpercent; if ( $startsize ) { $retentionpercent = $remainsize / $startsize * 100; } else { $retentionpercent = 0; } $retentionpercent = format_number( $retentionpercent, 2); print qq{\n}; print qq{
$lex{Current} $lex{Enrollment} ($currdate)$currentenrol
$lex{Beginning} $lex{Enrollment} ($arr{sdate})$startsize
Remaining $lex{Enrollment}$remainsize
}; print qq{$lex{Retention}: $retentionpercent\%

\n}; print qq{

Withdrawn Students Stay Length

\n}; # now show the stay length for these withdrawn students. my %studenrolblock = (); my %studsort = (); my $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); foreach my $sn ( sort keys %withdrawstud ) { $active = 0; # since withdrawn currently. my @enrolblocks = findEnrollmentBlocks( $sn, $schoolstart, $currdate, $dbh ); $studenrolblock{$sn} = \@enrolblocks; $sth->execute( $sn ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname ) = $sth->fetchrow; $studsort{"$lastname$firstname$sn"} = $sn; my ( $blockcount, $daysEnrolled ); foreach my $block ( @enrolblocks ){ my $start = $block->{start}; my $end = $block->{end}; # print qq{
ST: $start END: $end }; my $blocklength = calcDaysOpen($start,$end); $blockcount++; $daysEnrolled += $blocklength; # print qq{
Student: $sn BlockLen: $blocklength : $blockcount
\n}; } my $staylength; if ( $blockcount ) { $staylength = $daysEnrolled / $blockcount; } else { $staylength = 0; } # print qq{Stay: $staylength
\n}; $studentstay{$sn} = format_number($staylength, 1); } # Setup Table to Display print qq{\n}; print qq{\n}; my $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); my $sth1 = $dbh->prepare("select exittype, description from transfer where studnum = ? and date = ?"); my ($total, $count); my $studcount = 1; foreach my $key ( sort keys %studsort ) { my $sn = $studsort{$key}; $sth->execute( $sn ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname ) = $sth->fetchrow; print qq{\n}; $count++; $total += $studentstay{$sn} } my $averagestay; if ( $count ) { $averagestay = format_number( $total / $count, 2 ); } else { $averagestay = 0; } print qq{\n}; print qq{\n}; exit; }
$lex{Student}$lex{Days}$lex{Blocks}
$studcount. $lastname, $firstname ($sn)$studentstay{$sn}}; $studcount++; my $first = 1; foreach my $block ( @{$studenrolblock{$sn}} ){ my $start = $block->{start}; my $end = $block->{end}; $sth1->execute( $sn, $end ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $exittype, $description ) = $sth1->fetchrow; if ( not $first ) { print qq{
}; } else { $first = 0; } print qq{$start — $end ($exittype - $description)}; } print qq{
}; print qq{$lex{Average}: $averagestay $lex{Days}