#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. # File: rptenrolmon.pl # Monthly Enrollment report for Ethnic change reports # # Outline: 1) Find current enrollment # 2) Count back to month of interest. # 3) Find number of recorded transfers in that month and categorize into # non-native, metis/status native, etc. on the basis of enrol/withdraw. my $ignoregrade = 'PK'; # grade to ignore in calculations. # Comment out if you want all grades counted in this report. my %lex = ('Monthly Enrollment Change' => 'Monthly Enrollment Change', 'Start of month' => 'Start of month', 'Change' => 'Change', 'End of month' => 'End of month', 'Enrollment' => 'Enrollment', 'Main' => 'Main', 'Category' => 'Category', 'Enrollments' => 'Enrollments', 'Withdrawals' => 'Withdrawals', 'Error' => 'Error', 'Date in Month' => 'Date in Month', 'Continue' => 'Continue', 'Blank=Previous Month' => 'Blank=Previous Month', 'Summary' => 'Summary', ); use DBI; use CGI; # Read config variables eval require "../etc/admin.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } my $q = new CGI; print $q->header( -charset, $charset ); my %arr = $q->Vars; my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $iddst) = localtime(time); $year = $year + 1900; $wday++; $mon++; my $currdate = "$dow[$wday], $month[$mon] $mday, $year"; my $title = "$lex{'Monthly Enrollment Change'}"; print qq{$doctype\n$title\n}; print qq{\n}; if ( not $arr{page} ) { print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } print qq{$chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; showReport(); } #---------------- sub showStartPage { #---------------- print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{'Date in Month'}\n}; print qq{\n}; print qq{ $lex{'Blank=Previous Month'} }; print qq{
\n}; print qq{
\n}; print qq{\n}; print qq{\n}; exit; } #------------- sub showReport { #------------- # Date Setup my ($yr, $mo, $da); if ( not $arr{date} ) { # We'll go back 1 month. if ( $mon > 1 ){ # if not January (ie. 1) $mo = $mon - 1; $yr = $year; } else { # month is 1, go to prev dec. $mo = 12; $yr = $year - 1; } $da = "01"; } else { # We have been passed a date. ($yr, $mo, $da) = split /-/, $arr{date}; $da = "01"; } my $agingdate = "$yr-$mo-$da"; # Find start date of next month. my $nextmonth = $mo + 1; my $nextyear = $yr; if ( $nextmonth > 12 ) { $nextmonth = 1; $nextyear++; } my $nextdate = "$nextyear-$nextmonth". '-01'; # print qq{Next Date: $nextdate
\n}; # print qq{Aging Date: $agingdate
\n}; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; # populate the @ethnic hash... my @ethnic = (); my $sth = $dbh->prepare("select distinct ethnic from student where ethnic != '' and ethnic is not NULL order by ethnic"); $sth->execute; while ( my $eth = $sth->fetchrow ) { push @ethnic, $eth; } # Configure var my %ethnicount = (); foreach my $type ( @ethnic ){ $ethnicount{$type} = [0,0]; } my $select; if ( $ignoregrade ){ # if defined, skip this grade. $select = "where grade != '$ignoregrade'"; } # First count how many currently enrolled (in student table) my $sth = $dbh->prepare("select count(*) from student $select"); $sth->execute; my $curenrol = $sth->fetchrow; #print qq{Current Enrollment: $curenrol
\n}; # Now count backwards through entry records until we reach date of interest my $sth1 = $dbh->prepare("select * from transfer where to_days(date) >= to_days('$agingdate') order by date desc"); # NOTE: Quotes are needed inside the to_days function for aging date! $sth1->execute; if ($DBI::errstr) { print $DBI::errstr; die; } while ( my @arr = $sth1->fetchrow){ if ( $arr[3] ne 'withdraw' ) { # an enrol $curenrol--; } elsif ( $arr[3] eq 'withdraw') { $curenrol++; } else { # We have a programming error! print qq{Programming Error! $arr[3] for student $arr[1] on $arr[2]}; die; } } $startenrol = $curenrol; #print qq{Start Enrol: $startenrol
\n}; # $startenrol Should have the enrollment on the first day of the month # BEFORE any enrollment on that first day. # Now let's find all records in that month, and calc the ethnic results. my $sth1 = $dbh->prepare("select * from transfer where to_days(date) >= to_days('$agingdate') and to_days(date) < to_days('$nextdate') order by date desc"); $sth1->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } $entryrows = $sth1->rows; #print qq{Date: $searchdate Entryrows: $entryrows
\n}; my $change = 0; # Loop through the month adding up the counts in each ethnic category. while ( @arr = $sth1->fetchrow ){ $sth2 = $dbh->prepare("select * from student where studnum = '$arr[1]'"); $sth2->execute; if ($DBI::errstr) {print $DBI::errstr; die;} $studentrows = $sth2->rows; if ( $studentrows < 1 ) { # Student not found in student table; look in other $sth2 = $dbh->prepare("select * from studentwd where studnum = ?"); $sth2->execute( $arr[1] ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } @student = $sth2->fetchrow; # Skip PK or other set grade. if ( $student[5] eq $ignoregrade ) { #print qq{$student[1] $student[2] G:$student[5] D:$arr[2]
\n}; next; } foreach $type (@ethnic){ # Go through each ethnic type if ($student[12] eq $type) { # We have an ethnic type match. if ($arr[3] eq 'enrol' or $arr[3] eq 're-enrol') { $ethnicount{$type}->[0]++; # Zero are enrollment of this type $change++; } elsif ($arr[3] eq 'withdraw') { $ethnicount{$type}->[1]++; # Ones are withdrawals of this type. $change--; } } } } # End of Loop to count all transfers in month and evaluate $endenrol = $startenrol + $change; print qq{

$month[$mo], $year

\n}; print qq{\n}; print qq{\n}; # Now print out what was happening in each category... foreach my $type ( @ethnic ) { # Go through each ethnic type print qq{\n}; print qq{\n}; print qq{\n}; } print qq{
$lex{Category}$lex{Enrollments}\n}; print qq{$lex{Withdrawals}
$type$ethnicount{$type}->[0]$ethnicount{$type}->[1]

\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Enrollment} $lex{Summary}
$lex{Enrollment} - $lex{'Start of month'}$startenrol
$lex{Enrollment} - $lex{Change}$change
$lex{Enrollment} - $lex{'End of month'}$endenrol
\n}; }