#!/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 = ('Main' => 'Main',
	   'Error' => 'Error',
	   'Add Reading Tests' => 'Add Reading Tests',
	   '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',
	   'Absences' => 'Absences',

	   );

use DBI;
use CGI;
# use CGI::Session;
use Cwd;

my %exceptions = ( 'moved' => 'Moved', 'attendance' => 'Persistent Absences', 'altprog' => 'Alternate Program', 'other' => 'Other' );
my @exceptions = ( 'moved', 'attendance', 'altprog', 'other');


my $self = 'readTestAdd.pl';

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: $@<br>\n";
    die $lex{Error}. "$self: $@\n";
}

my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);

print $q->header( -charset, $charset );

my $mycss = $css;
if ( getcwd() =~ /tcgi/ ){ # we are in cgi
    $mycss = $tchcss;
}

# Page Header
my $title = qq{$lex{'Add Reading Tests'} - DRA 2};
print qq{$doctype\n<html><head><title>$title</title>\n}; 
print qq{<link rel="stylesheet" href="$mycss" type="text/css">\n};

print qq{<link rel="stylesheet" type="text/css" media="all" };
print qq{href="/js/calendar-blue.css" title="blue">\n};
print qq{<script type="text/javascript" src="/js/calendar.js"></script>\n};
print qq{<script type="text/javascript" src="/js/lang/calendar-en.js"></script>\n};
print qq{<script type="text/javascript" src="/js/calendar-setup.js"></script>\n};

print qq{$chartype\n</head><body style="padding:1em 2em;">\n};
print qq{[ <a href="$tchpage">$lex{Main}</a> ]\n};
print qq{<h1>$title</h1>\n};


if ( $g_DRA3 ) { # stop script here.
    print qq{<h3>DRA 3 mode is turned on at your school.<br>\n};
    print qq{Please use the DRA 3 script to add test scores</h3>\n};
    print qq{[ <a  href="./readTestAddDra3.pl">Add DRA 3 Test</a> ]\n};
    print qq{</body></html>\n};
    exit;
}
# dra3mode previously set

    
if ( not $arr{page} ) {
    showStartPage();

} elsif ( $arr{page} == 1 ) {
    delete $arr{page};
    selectStudents();

} elsif ( $arr{page} == 2 ) {
    delete $arr{page};
    enterTests();

} elsif ( $arr{page} == 3 ) {
    delete $arr{page};
    writeRecords();

} elsif ( $arr{page} == 4 ) {
    delete $arr{page};
    writeExceptions();
}



#----------------
sub showStartPage {
#----------------

    # Get global reading levels.
    my (%readinglevel, @readinglevel );
    my $sth = $dbh->prepare("select distinct readlevel from read_level_dra2
      where readlevel is not NULL");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    while ( my $rl = $sth->fetchrow ) {
	$readinglevel{$rl} = 1;
    }
    @readinglevel = sort { $a <=> $b } keys %readinglevel;

    # Get Grades, Homerooms
    my (%grades, %homerooms);
    my $sth = $dbh->prepare("select distinct grade from student 
			    where grade != '' and grade is not NULL");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    while ( my $gr = $sth->fetchrow ) {
	$grades{$gr} = 1;
    }
    my @grades = sort { $a <=> $b } keys %grades;

    my $sth = $dbh->prepare("select distinct homeroom from student 
			    where homeroom != '' and homeroom is not NULL");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    while ( my $hr = $sth->fetchrow ) {
	$homerooms{$hr} = 1;
    }
    my @homerooms = sort { $a <=> $b } keys %homerooms;

    
    print qq{<form action="$self" method="post"> \n};
    print qq{<input type="hidden" name="page" value="1">\n};
    
    print qq{<table cellpadding="4" cellspacing="0" border="0" style="border:1px solid gray;">\n};

    print qq{<tr><td class="bra">$lex{'Test Date'}</td>\n};
    print qq{<td><input type="text" name="date" id="date" size="10">\n};
    print qq{<button type="reset" id="start_trigger">...</button>\n};
    print qq{(yyyy-mm-dd)</td></tr>\n};


    print qq{<tr><td class="bra">$lex{'Reading Level'}</td>\n};
    print qq{<td><select name="readlevel"><option></option>\n};
    foreach my $rl ( @readinglevel ) {
	print qq{<option>$rl</option>\n};
    }
    print qq{</select> $lex{Required}!</td></tr>\n};

    # Students - Grade
    print qq{<tr><td class="bra">$lex{Select} $lex{Student}</td><td></td></tr>\n};
    print qq{<tr><td class="ra">Grade</td><td><select name="grade"><option></option>};
    foreach my $grade ( @grades ) {
	print qq{<option>$grade</option>\n};
    }
    print qq{</select> <b>or</b></td></tr>\n};

    # Select Homeroom
    my $sth = $dbh->prepare("select lastname, firstname from staff s, staff_multi sm 
			    where s.userid = sm.userid and field_name = 'homeroom' 
			    and field_value = ?");

    print qq{<tr><td class="ra">Homeroom</td><td>};
    print qq{<select name="homeroom"><option></option>};
    foreach my $hr ( @homerooms ) {
	$sth->execute($hr);
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my ($lastname, $firstname) = $sth->fetchrow;
	my $hrname = $hr;
	if ( $lastname ) { $hrname = "$hr - $firstname $lastname"; }
	
	print qq{<option value="$hr">$hrname</option>\n};
    }
    print qq{</select>\n};


    print qq{ $lex{'Blank=All'}</td></tr>\n};


    print qq{<tr><td class="bra">$lex{Check} $lex{'Next Page'}</td>\n};
    print qq{<td><input type="checkbox" name="chk" value="checked">\n};
    print qq{</td></tr>\n};    

    print qq{<tr><td></td><td class="la">\n<input type="submit" value="$lex{Continue}"></td></tr>\n};

    print qq{</table>\n};
    print qq{</form>\n};

    print qq{<script type="text/javascript">
     Calendar.setup({
        inputField     :    "date", // id of the input field
        ifFormat       :    "%Y-%m-%d", // format of the input field
        button         :    "start_trigger", // trigger for the calendar (button ID)
        singleClick    :    false,        // double-click mode
        step           :    1             // show all years in drop-down boxes 
    });
   </script>\n};

    print qq{</body></html>\n};

    exit;

} # end of showStartPage



#----------------
sub selectStudents {
#----------------

    # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\n"; }

    my $chk = $arr{chk};
    delete $arr{chk};

    # Check for any Blanks in date or reading level
    foreach my $key ( 'date','readlevel' ) { 
	if ( not $arr{$key} ) {
	    print qq{<h3>$lex{'Date and Reading Level'} <b>$lex{Required}</b></h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }

    # Check for messed up Date Format
    my $errorflag;
    if ( $arr{date} =~ m/\// ) { # slashes rather than hyphens
	$errorflag = 1;
    } else {
	my ($y,$m,$d) = split('-', $arr{date});
	if ( not $m or ( $m < 1 or $m > 12 )) { $errorflag = 1; }
	if ( not $d or ( $d < 1 or $d > 31 )) { $errorflag = 1; }
    }
    if ( $errorflag ) {
	# print qq{<div>Year:$y Month:$m Day:$d</div>\n};
	print qq{<h3>$lex{'Test Date'} $lex{Error}: $arr{date}</h3>\n};
	print "</body></html>\n";
	exit;
    }

    my ($sth, $groupname);
    if ( $arr{grade} ) { # we're picking a group
	$sth = $dbh->prepare("select lastname, firstname, studnum from student
          where grade = ? order by lastname, firstname");
	$sth->execute( $arr{grade} );
	$groupname = qq{Grade $arr{grade}};
	
    } elsif ( $arr{homeroom} ) {
	$sth = $dbh->prepare("select lastname, firstname, studnum from student
          where homeroom = ? order by lastname, firstname");
	$sth->execute( $arr{homeroom} );
	$groupname = qq{Homeroom $arr{homeroom}};
	
    } else { # everyone
	$sth = $dbh->prepare("select lastname, firstname, studnum from student
          order by lastname, firstname");
	$sth->execute;
    }
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }

    
    # Print Reading Level
    print qq{<div style="font-size:130%;font-weight:bold;padding:0 0 0.5em 0;">};
    print qq{$lex{'Reading Level'} $arr{readlevel} };
    print qq{<span style="font-size:120%;">$lex{Only}</span></div>\n};

    # Form Header
    print qq{<form action="$self" method="post"> \n};
    print qq{<input type="hidden" name="page" value="2">\n};
    print qq{<input type="hidden" name="readlevel" value="$arr{readlevel}">\n};
    print qq{<input type="hidden" name="date" value="$arr{date}">\n};

    print qq{<table cellpadding="3" cellspacing="0" border="0">\n};

    print qq{<tr><td class="ra"><input type="submit" value="$lex{Continue}"></td>\n};
    print qq{<td colspan="2"><b>Test</b> - Add Test Score<br>};
    print qq{<b>Absent</b> - Add Reason for Absence</td></tr>\n};

    print qq{<tr><th>Test</th><th>Absent</th><th>$groupname</th></tr>\n};


    while ( my ( $lastname, $firstname, $studnum ) = $sth->fetchrow ) {
	print qq{<tr><td class="cn"><input type="checkbox" name="$studnum" value="1" $chk></td>\n};
	print qq{<td class="cn"><input type="checkbox" name="ABS:$studnum" value="1"></td>\n};
	print qq{<td class="la"><b>$lastname</b>, $firstname ($studnum)</td>};
    }

    print qq{<tr><td class="ra"><input type="submit" value="$lex{Continue}"></td><td></td></tr>\n};

    print qq{</table></form></body></html>\n};

    exit;

} # end of selectStudents



#-------------
sub enterTests {
#-------------

    # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\n"; }

    my $date = $arr{date};
    delete $arr{date};
    my $readlevel = $arr{readlevel};
    delete $arr{readlevel};
    # Now only student numbers left in hash...

    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};
    }


    # load objectives for this reading level.
    my $sth1 = $dbh->prepare("select id, seq, category, name from read_level_dra2 
      where readlevel = ? order by seq");
    $sth1->execute( $readlevel );
    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
    my %category = (); my %levelname = ();
    while ( my ( $id, $seq, $category, $name ) = $sth1->fetchrow ) {
	$category{ $seq } = $category;
	$levelname{ $seq } = $name;
	$id{ $seq } = $id;
    }

    # Print No Blanks Warning OR Not
#    if ( $dra3mode ) {
#	print qq{<div style="font-size:130%;font-weight:bold;padding:0 0 0.5em 0;color:blue;">};
#	print qq{DRA 3 Mode. Blank Reading Engagement Allowed</div>\n};

#    } else { # 
	print qq{<div style="font-size:130%;font-weight:bold;padding:0 0 0.5em 0;color:blue;">};
	print qq{$lex{'No Blanks Allowed'}</div>\n};
#    }


    # Print Form Heading
    print qq{<form action="$self" method="post"> \n};
    print qq{<input type="hidden" name="page" value="3">\n};
    print qq{<input type="hidden" name="readlevel" value="$readlevel">\n};
    print qq{<input type="hidden" name="date" value="$date">\n};

    foreach my $studnum ( @absent ) {
	print qq{<input type="hidden" name="ABS:$studnum" value="$studnum">\n};
    }


    my $first = 1;


    foreach my $studnum ( @students ) {

	if ( $first ) {
	    print qq{<div class="la"><input type="submit" value="$lex{Save}"></div>\n};
	    $first = 0;
	}


	# Get Student Name
	$sth->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my ( $lastname, $firstname, $grade ) = $sth->fetchrow;

	
	# Print Table Header and Heading values
	print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	print qq{<tr><th colspan="3">$lex{'Reading Level'} $readlevel };
	print qq{<span style="margin-left:2em;">$firstname $lastname</span></th></tr>\n};
	print qq{<tr><td colspan="3" class="bla">$lex{Grade} };
	print qq{<input type="text" name="$studnum:grade" value="$grade" style="width:3ch;"></td>};
	print qq{</tr>\n};

	print qq{<tr><th>$lex{Score}</th><th style="text-align:left;">$lex{Name}</th>};
	print qq{<th style="text-align:left;">$lex{Category}</th></tr>\n};

	
	foreach my $seq ( sort {$a <=> $b} keys %category ) {
	    print qq{<tr><td class="cn">};
	    print qq{<input type="text" name="$studnum:$id{$seq}" style="width:2ch;"></td>\n};
	    print qq{<td class="la">$levelname{$seq}</td><td class="la">$category{$seq}</td>\n};
	    print qq{</tr>\n};
	}
    
	print qq{</table><p></p>\n};

    }

    if ( $first ) { # no student tests, could be absences
	if ( @absent ) {
	    print qq{<h3 class="la"><input type="submit" };
	    print qq{value="$lex{Continue} to $lex{Absences}"></h3>\n};

	} else { # No students, no absences. Stop
	    print qq{<h3>$lex{'No Students Found'}</h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}

    } else {
	print qq{<div class="la"><input type="submit" value="$lex{Save}"></div>\n};
    }
	
    print qq{</form></body></html>\n};

    exit;

}


#---------------
sub writeRecords {
#---------------

    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }

    my $date = $arr{date};
    delete $arr{date};

    # Get Season from Date
    my ($y,$m, $d ) = split( '-', $date );
    my $season = 'Undefined';

    if ( $m == 9 or $m == 10 ) { # September, October - Fall (Sept 1 - Oct 31 );
	$season = qq{$y-Fall};

    } elsif ( $m == 1 or $m == 2 or $m == 3  ) { # Spring Jan 1 to March 31
	$season = qq{$y-Spring};
	
    } elsif ( $m == 6 or ($m == 5 and $d >= 15 ) ) { # Summer May 15 to June 30
	$season = qq{$y-Summer};
    }
    # Otherwise season is undefined.
    print qq{<h3>Season $season - $date</h3>\n};
    

    my $readlevel = $arr{readlevel};
    delete $arr{readlevel};
    # Now only student scores and grades left in hash...

    # 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}<br>\n}; }

    # Check for any Blanks
    foreach my $key ( sort keys %arr ) { 
	if ( not $arr{$key} ) {
	    print qq{<h3>$lex{'No Blanks Allowed'}</h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }


    # Now test for scores > 4.
    foreach my $key ( sort keys %arr ) {
	if ( $key =~ m/grade/ ) { next; } # skip grade field
	if ( $arr{$key} > 4 ) {
	    print qq{<h3>Values cannot be greater than 4</h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }

    my $sth1 = $dbh->prepare("select category, name, seq from read_level_dra2 where id  = ?");
    my $sth2 = $dbh->prepare("select lastname, firstname from student where studnum = ?");

    my $prevstudnum;
    my $currstudnum = -1;
    my $testid; # stored between loops.

    foreach my $key ( sort keys %arr ) {

	my ( $studnum, $id ) = split(/:/, $key);
	if ( $id eq 'grade' ) { next; } # skip grade elements

	$prevstudnum = $currstudnum;
	$currstudnum = $studnum;

	if ( $currstudnum != $prevstudnum ) { # new student.

	    # Check for existing test for this student, this reading level, and this date.
	    my $sth = $dbh->prepare("select id from read_test where studnum = ? and readlevel = ?
               and tdate = ? and tauthor = ?");
	    $sth->execute( $studnum, $readlevel, $date, $userid );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $id = $sth->fetchrow;

	    # Get Name
	    $sth2->execute( $studnum );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my ($lastname, $firstname ) = $sth2->fetchrow;

	    if ( $id ) { # we've already written this record..

		print qq{<h3>$lex{'Record Exists'}\n};

		print qq{- $firstname $lastname ($studnum) - $lex{'Reading Level'}:$readlevel - };
		print qq{$lex{'Test Date'}: $tdate -<b>$lex{Skipping}</h3>\n};

                next;
	    }

	    
	    # Book Type: fiction or nonfiction;
	    my $bktype = 'fiction';
	    if ( $readlevel eq '16N' or $readlevel eq '28N' or $readlevel eq '38N' ) {
		$bktype = 'nonfiction';
	    }

	    # First write the test record and get its testid.
	    $sth = $dbh->prepare("insert into read_test 
              ( studnum, readlevel, tdate, tauthor, tgrade, season, bktype, dratype ) 
              values ( ?, ?, ?, ?, ?, ?, ?, 2) "); # dra 2
	    my $gradekey = "$studnum:grade";
	    $sth->execute( $studnum, $readlevel, $date, $userid, $arr{$gradekey}, $season, $bktype );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    
	    $sth = $dbh->prepare("select id from read_test where studnum = ? and tdate = ? 
             and readlevel = ?");
	    $sth->execute( $studnum, $date, $readlevel );
	    $testid = $sth->fetchrow;

	    if ( not $testid ) {
		print qq{<h3>Error - Missing TestID for Student:$studnum Date:$date };
		print qq{Reading level:$readlevel<h3>\n};
		print qq{<h3>Please contact Les Richardson</h3>\n};
		print qq{</body></html>\n};
		exit;
	    }
	}


	# Now write the reading score;
	my $score = $arr{$key};
	
	# Get category and name for this objective (from global reading)
	$sth1->execute( $id );
	if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	my ( $category, $name, $seq ) = $sth1->fetchrow;

	if ( $score ) { # since we may have missing scores for dra3mode
	    $sth = $dbh->prepare("insert into read_test_score  
             ( testid, category, name, seq, score ) values ( ?, ?, ?, ?, ? )");
	    $sth->execute( $testid, $category, $name, $seq, $score );
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	}

    }


    # 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{<form action="$self" method="post"> \n};
	    print qq{<input type="hidden" name="page" value="4">\n};
	    print qq{<input type="hidden" name="tdate" value="$date">\n};
	    
	    # Table
	    print qq{<p></p><div class="la"><input type="submit" value="$lex{Save}"></div>\n};
	    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	    print qq{<tr><th>$lex{Student}</th><th>Reasons for No Student Score</th></tr>\n};
	    $first = 0;
	}

	print qq{<tr><td class="bra">$r{firstname} $r{lastname}</td>};
	print qq{<td class="la">};
	foreach my $key ( @exceptions ) {
	    print qq{<input type="radio" name="EX:$studnum" value="$key">$exceptions{$key}<br>\n};
	}
	print qq{<span style="font-size:80%;">If Other, Please Specify</span> <input type="text" };
	print qq{size="60" name="OTHER:$studnum"></td></tr>\n};

    }

    if ( not $first ) { 
	print qq{</table>\n};
	print qq{<div class="la"><input type="submit" value="$lex{Save}"></div>\n};
	print qq{</form>\n};

    } else {
	print qq{<p>[ <a href="$self">$lex{'Add Reading Tests'}</a> |\n};
	print qq{<a href="$tchpage">$lex{Main}</a> ]</p>\n};
    }

    print qq{</body></html>\n};

    exit;
}



#------------------
sub writeExceptions {
#------------------

    # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\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, 'dra' );
	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 "<div><b>$lex{'Record Exists'}</b>\n";
	    print "- $rec{firstname} $rec{lastname} ($studnum)";
	    print "<b>$lex{Test} $lex{Date}:</b> $tdate -<b>$lex{Skipping}</h3>\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, 'dra', $tdate, $userid, $r{grade}, $age, 
			$reason, $reasonother );
        if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }

	print qq{<div>$r{firstname} $r{lastname} Exception $lex{Record} $lex{Added}</div>\n};

    }

    print qq{<p>[ <a href="$self">$title</a> |\n};
    print qq{<a href="$tchpage">$lex{Main}</a> ]</p>\n};
    print qq{</body></html>\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<br>\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 qq{$age:$month};

}


