#!/usr/bin/perl # Copyright 2001-2025 Leslie Richardson # This file is part of Open Admin for Schools. my %lex = ('Main' => 'Main', 'Error' => 'Error', 'Needs Assessment' => 'Needs Assessment', 'Student' => 'Student', 'Reading Level' => 'Reading Level', 'Continue' => 'Continue', 'Category' => 'Category', 'Name' => 'Name', 'Save' => 'Save', 'Score' => 'Score', 'Test Date' => 'Test Date', 'Values must be from 1-4' => 'Values must be from 1-4', 'No User Id' => 'No User Id', 'No Password' => 'No Password', 'Please Log In' => 'Please Log In', 'Grade' => 'Grade', 'Homeroom' => 'Homeroom', 'Select' => 'Select', 'Blank=All' => 'Blank=All', 'Check' => 'Check', 'Record Exists' => 'Record Exists', 'Edit Record' => 'Edit Record', 'Required' => 'Required', 'Date and Reading Level' => 'Date and Reading Level', 'Only' => 'Only', 'No Blanks Allowed' => 'No Blanks Allowed', 'Skipping' => 'Skipping', 'Next Page' => 'Next Page', ); use DBI; use CGI; my %exceptions = ( 'moved' => 'Moved', 'attendance' => 'Persistent Absences', 'altprog' => 'Alternate Program', 'other' => 'Other' ); my @exceptions = ( 'moved', 'attendance', 'altprog', 'other'); my $self = 'needsAdd.pl'; my %recommend = ( 'EDPSY' => 'Ed Psych', 'SLP' => 'Speech Language', 'MH' => 'Mental Health', 'SPEC' => 'Special Ed', 'OT' => 'Occupational Therapy', 'TB' => 'Targeted Behaviour', ); my $q = new CGI; my %arr = $q->Vars; my @time = localtime(time); my $year = $time[5] + 1900; my $month = $time[4] + 1; my $currdate = "$year-$month-$time[3]"; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $self: $@
\n"; die $lex{Error}. "$self: $@\n"; } # get global read-only userid and password eval require qq{/opt/openadmin/global/global.conf}; if ( $@ ) { print $lex{Error}. " $self: $@
\n"; die $lex{Error}. "$self: $@\n"; } my @temp = split('/', $iepdir); my $iepdb = $temp[-1]; # end one #print qq{

IEP DB:$iepdb

\n}; my $dsnS = "DBI:$dbtype:dbname=$iepdb"; my $dbhS = DBI->connect($dsnS,$guser,$gpassword); # end of IEP Checking my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); print $q->header( -charset, $charset ); my $userid = $ENV{'REMOTE_USER'}; # Page Header my $title = "$lex{Add} $lex{Student} $lex{'Needs Assessment'}"; 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{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectStudents(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; enterNeeds(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; writeRecords(); } elsif ( $arr{page} == 4 ) { delete $arr{page}; writeExceptions(); } #---------------- sub showStartPage { #---------------- print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Select} $lex{Student}\n}; print qq{\n}; print qq{ $lex{'Blank=All'}
$lex{Check} $lex{'Next Page'}\n}; print qq{
\n
\n}; print qq{
\n}; print qq{\n}; exit; } # end of showStartPage #---------------- sub selectStudents { #---------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $groupvalue = $arr{groupvalue}; delete $arr{groupvalue}; my $chk = $arr{chk}; delete $arr{chk}; my $select; if ( $groupvalue ) { # we're picking a group if ( $arr{groupname} eq 'grade') { $select = 'where grade = ?'; } else { $select = 'where homeroom = ?'; } } # Check if IEP student my $sth1 = $dbhS->prepare("select count(*) from special where studnum = ? or studnum_local = ?"); my $sth = $dbh->prepare("select lastname, firstname, studnum from student $select order by lastname, firstname"); if ( $select ) { $sth->execute( $groupvalue ); } else { $sth->execute; } if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Form Header print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; while ( my ( $lastname, $firstname, $studnum ) = $sth->fetchrow ) { $sth1->execute($studnum, $studnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $iepcount = $sth1->fetchrow; my $iep; if ( $iepcount ) { $iep = qq{IEP}; } print qq{\n}; print qq{\n}; print qq{}; } print qq{
Needs
Assess		Absent
$iep $lastname, $firstname ($studnum)
\n}; print qq{
\n}; print qq{\n}; exit; } # end of selectStudents #------------- sub enterNeeds { #------------- #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Passed Student numbers in key my $sth = $dbh->prepare("select lastname, firstname, grade from student where studnum = ?"); my @absent; my @students; my %students; # Extract the absences foreach my $key ( keys %arr ) { my ($flag, $id ) = split(':', $key); if ( $flag eq 'ABS' ) { push @absent, $id; delete $arr{$key}; } else { $sth->execute( $key ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } my ( $ln, $fn, $gr) = $sth->fetchrow; $students{"$ln$fn$key"} = $key; } } # sort students by name foreach my $key ( sort keys %students ) { push @students, $students{$key}; } # Print Form Heading print qq{
\n}; print qq{\n}; foreach my $studnum ( @absent ) { print qq{\n}; } print qq{
\n}; # Check if IEP student my $sth1 = $dbhS->prepare("select count(*) from special where studnum = ? or studnum_local = ?"); foreach my $studnum ( @students ) { # Get Student Name $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname, $grade ) = $sth->fetchrow; # Check if IEP $sth1->execute($studnum, $studnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $iepcount = $sth1->fetchrow; my $iep; if ( $iepcount ) { $iep = qq{IEP}; } print qq{
}; print qq{$lastname, $firstname $iep
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; print qq{}; print qq{\n}; print qq{}; print qq{\n}; print qq{}; print qq{\n}; print qq{
Strengths
Challenges
Support
Received		}; print qq{
Recommendations}; for my $key ( sort keys %recommend ) { print qq{ $recommend{$key}
\n}; #print qq{ Speech Language
\n}; #print qq{ Mental Health
\n}; #print qq{ Spec Ed
\n}; #print qq{ Occupational Therapy
\n}; } print qq{
Other Recommendations}; print qq{
Classroom
Recommendations

\n}; } if ( $first ) { # no student tests, could be absences if ( @absent ) { print qq{

}; print qq{

\n}; } else { # No students, no absences. Stop print qq{

$lex{'No Students Found'}

\n}; print qq{\n}; exit; } } else { print qq{
\n}; } print qq{
\n}; exit; } #--------------- sub writeRecords { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Extract the absences my @absent; foreach my $key ( keys %arr ) { my ($flag, $id ) = split(':', $key); if ( $flag eq 'ABS' ) { push @absent, $id; delete $arr{$key}; } } # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Load student record my $sth1 = $dbh->prepare("select * from studentall where studnum = ?"); my $sth2 = $dbh->prepare("select userid from staff_multi where field_name = 'homeroom' and field_value = ?"); my $sth3 = $dbh->prepare("select lastname, firstname from staff where userid = ?"); foreach my $key ( sort keys %arr ) { my ( $studnum, $label ) = split(/:/, $key); if ( $label ne 'STR' ) { next; } # skip all elements but strengths. my $chakey = qq{$studnum:CHA}; my $supkey = qq{$studnum:SUP}; my $othkey = qq{$studnum:OTH}; my $clskey = qq{$studnum:CLS}; # Get Student Record $sth1->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth1->fetchrow_hashref; my %r = %$ref; # foreach my $key ( sort keys %r ) { print qq{K:$key V:$r{$key}
\n}; } # Get Homeroom teacher; $sth2->execute( $r{homeroom} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $hruserid = $sth2->fetchrow; $sth3->execute( $hruserid ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ($tlastname, $tfirstname ) = $sth3->fetchrow; my $hrteacher = "$tfirstname $tlastname ($hruserid)"; my %newrec; # holds values to write $newrec{strengths} = $arr{$key}; $newrec{challenges} = $arr{$chakey}; $newrec{support} = $arr{$supkey}; $newrec{'rec_other'} = $arr{$othkey}; $newrec{'rec_classroom'} = $arr{$clskey}; # Student Info $newrec{studnum} = $studnum; $newrec{treatynum} = $r{treaty}; $newrec{lastname} = $r{lastname}; $newrec{firstname} = $r{firstname}; $newrec{birthdate} = $r{birthdate}; $newrec{grade} = $r{grade}; $newrec{hrteacher} = $hrteacher; $newrec{date} = $currdate; $newrec{author} = $userid; # from login. # Assemble recommendations. my $rfield; foreach my $rkey ( keys %recommend ) { my $key = "$studnum:$rkey"; if ( $arr{$key} ) { # is this recommendation checked? $rfield .= "$rkey;"; } } $newrec{recommendations} = $rfield; # values stored as semicolon separated list. #print qq{New Record
\n}; #foreach my $key ( sort keys %newrec ) { print qq{K:$key V:$newrec{$key}
\n}; } # Prepare to insert the record. my (@fields, @values, @qst ); foreach my $key ( sort keys %newrec ) { push @fields, $key; push @values, $newrec{$key}; push @qst, '?'; } my $fields = join(',', @fields); my $qst = join(',', @qst); # print qq{Fields:$fields QST:$qst
\n}; # print qq{Values: @values
\n}; my $sth = $dbh->prepare( "insert into student_needs ( $fields ) values ( $qst )" ); $sth->execute( @values ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } print qq{
Record added for $r{firstname} $r{lastname}
\n}; } # Add SSP Exceptions for absent students my $sth = $dbh->prepare("select lastname, firstname, grade from studentall where studnum = ?"); my $first = 1; foreach my $studnum ( @absent ) { # Get Student Info $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %r = %$ref; if ( $first ) { # Print Form Heading print qq{
\n}; print qq{\n}; print qq{\n}; # Table print qq{

\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{}; print qq{\n}; } if ( not $first ) { print qq{
$lex{Student}Reasons for No Student Score
$r{firstname} $r{lastname}}; foreach my $key ( @exceptions ) { print qq{$exceptions{$key}
\n}; } print qq{If Other, Please Specify
\n}; print qq{
\n}; print qq{
\n}; } else { print qq{

[ $title |\n}; print qq{$lex{Main} ]

\n}; } print qq{\n}; exit; } #------------------ sub writeExceptions { #------------------ # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $tdate = $arr{tdate}; delete $arr{tdate}; my $sth1 = $dbh->prepare("select * from studentall where studnum = ?"); foreach my $key ( keys %arr ) { my ($type, $studnum ) = split(':', $key); if ( $type eq 'OTHER' ) { next; } # skip all 'Other' values. my $othercode = qq{OTHER:$studnum}; my $reasonother = $arr{$othercode}; my $reason = $arr{$key}; # Check for existing record my $sth = $dbh->prepare("select count(*) from ssp_exceptions where studnum = ? and tdate = ? and ssptype = ?"); $sth->execute( $studnum, $tdate, 'needs' ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $count = $sth->fetchrow; # Get Student Info $sth1->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $studref = $sth1->fetchrow_hashref; my %r = %$studref; if ( $count ) { # we've already written this record.. print qq{
$lex{'Record Exists'}\n}; print qq{- $rec{firstname} $rec{lastname} ($studnum)}; print qq{$lex{Test} $lex{Date}: $tdate -$lex{Skipping}\n}; next; } my $age = calcAge( $r{birthdate}, $tdate ); my $treatynum = $r{treaty}; if ( not $treatynum ) { $treatynum = $r{provnum}; } # Insert a record. $sth = $dbh->prepare("insert into ssp_exceptions ( studnum, treatynum, ssptype, tdate, tauthor, tgrade, tage, reasoncode, reasonother ) values ( ?, ?, ?, ?, ?, ?, ?, ?, ? )"); $sth->execute( $studnum, $treatynum, 'needs', $tdate, $userid, $r{grade}, $age, $reason, $reasonother ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } print qq{
$r{firstname} $r{lastname} Exception $lex{Record} $lex{Added}
\n}; } print qq{

[ $title |\n}; print qq{$lex{Main} ]

\n}; print qq{\n}; exit; } # end of writeExceptions #---------- sub calcAge { #---------- # Passed (birthdate, $currdate) my ( $birthdate, $currdate ) = @_; my ($byear,$bmonth,$bday) = split /-/,$birthdate; my ($cyear,$cmonth,$cday) = split /-/,$currdate; my $age = $cyear - $byear; my $month = $cmonth - $bmonth; #print qq{BD: $birthdate CD: $currdate Age: $age MO:$month
\n}; if ($cmonth < $bmonth){ $month = $month + 12; if ($cday < $bday){ $month--;} $age--; } elsif ($cmonth == $bmonth and $cday < $bday){ $age--; $month = 11; } elsif ($cmonth > $bmonth and $cday < $bday) { $month--; } if ( $age < 0 or $age > 100 ) { $age = 0; $month = 0; } return "$age:$month"; }