#!/usr/bin/perl
#  Copyright 2001-2024 Leslie Richardson

# Nov 11/24 Updated to allow decimal score values (ie. 3.2)
# Nov 28 - added filtering to disallow values > 4.

#  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' => 'Add',
	   'Scores' => 'Scores',
	   'Common Math Assessment' => 'Common Math Assessment',

	   'Student' => 'Student',
	   'Continue' => 'Continue',
	   'Save' => 'Save',
	   'Date' => 'Date',
	   'No User Id' => 'No User Id',
	   'No Password' => 'No Password',
	   'Please Log In' => 'Please Log In',
	   'Grade' => 'Grade',
	   'Homeroom' => 'Homeroom',
	   'Select' => 'Select',
	   'Record' => 'Record',
	   'Skipping' => 'Skipping',
	   'Students' => 'Students',
	   'Test' => 'Test',
	   'Missing Value' => 'Missing Value',
	   'Score' => 'Score',
	   'Record Exists' => 'Record Exists',
	   'Added' => 'Added',

	   'Select by' => 'Select by',
	   'Or' => 'Or',
	   'Updated' => 'Updated',

	   'Check' => 'Check',
	   'Next Page' => 'Next Page',
	   
	   );

use DBI;
use CGI;
use CGI::Session;
use Time::JulianDay;


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

my $self = 'cmaAdd.pl';

# Now loaded from config
# my @phases = qw(Emergent Matching Quantifying Partitioning Factoring Operating);


my $q = new CGI;
my %arr = $q->Vars;

my @time = localtime(time);
my $year = $time[5] + 1900;
my $month = $time[4] + 1;
my $day = $time[3];
if ( length $month == 1 ) { $month = '0'. $month; }
if ( length $day == 1 ) { $day = '0'. $day; }
my $currdate = "$year-$month-$day";

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




# Session Setup Here
my $session = new CGI::Session("driver:mysql;serializer:FreezeThaw",
 undef,{Handle => $dbh}) or die CGI::Session->errstr;

# Get/Set  Session Values (a defined userid means it was passed)
if ( $arr{userid} ){ # we want to login, passed userid/password pair.

    # Check password/userid against database (-1 no user, -2 wrong password);
    my $error = checkPassword($arr{userid}, $arr{password}, $dbh);
    if ($error == -1){ print $q->header( -charset, $charset ); print qq{<h3>$lex{'No User Id'}</h3>}; }
    if ($error == -2){ print $q->header( -charset, $charset ); print qq{<h3>$lex{'No Password'}</h3>}; }

    $cookietime = checkCookieTime( $arr{duration} );

    # Set values for userid and logged_in in session
    $session->param( 'logged_in','1');
    $session->expire( 'logged_in', $cookietime );
    $session->param( 'userid',$arr{userid} );
    $session->param( 'duration',$cookietime );

    $userid = $arr{userid};


} else { # check logged_in value in session

    if ( not $session->param('logged_in') ){
	$userid = $session->param('userid');
        print $q->header( -charset, $charset );
	print qq{<form action="../tlogin.pl" method="post" style="display:inline;">\n};
	print qq{<input type="hidden" name="userid" value="$userid">\n};
	print qq{<input type="hidden" name="script" value="mathcommon/$self">\n};
	print qq{<input type="submit" value="$lex{'Please Log In'}">\n};
	print qq{</form></body></html>\n};
        exit;
    }
    # Ok, we have a login. Values below we have in environment.

    $userid = $session->param('userid');
    $duration = $session->param('duration');

    if ( not ($duration =~ /\+/)) { # if not in +20m format, do so.
	$duration = checkCookieTime( $duration );
    }

    $session->expire('logged_in', $duration );


} # End of check for logged_in value

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

# Session Setup End

# Page Header
my $title = qq{$lex{Add} $lex{'Common Math Assessment'} $lex{Scores}};

print qq{$doctype\n<html><head><title>$title</title>\n};
print qq{<link rel="stylesheet" href="$tchcss" type="text/css">\n};

if ( not $arr{page} ) {
    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};


# Get School Year
my ($sy, $ey) = split('-', $schoolyear);
if ( not $ey ) { 
    print qq{<h3>School Year not correctly defined. Contact Office!</h3>\n};
    print qq{</body></html>\n};
    exit;
}
# $ey will be value stored in table (end year).




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

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

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

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


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

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

    # Get Grades
    $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;

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

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


    print qq{<tr><td class="bra">Pretest or Posttest</td>};
    print qq{<td class="la"><select name="prepost"><option></option>\n};
    print qq{<option value="pretest">Pre-Test</option>};
    print qq{<option value="posttest">Post-Test</option></select></td></tr>\n};


    
    # Select Grade
    print qq{<tr><td colspan="2"><hr></td></tr>\n};
    print qq{<tr><td class="bra">$lex{'Select by'} $lex{Grade}</td>};
    print qq{<td><select name="grade"><option></option>\n};
    foreach my $gr ( @grades ) {
	print qq{<option>$gr</option>\n};
    }
    print qq{</select></td></tr>\n};

    # OR
    print qq{<tr><td></td><td class="bla" style="color:blue;">$lex{Or}</td></tr>\n};


    # Select Homeroom
    print qq{<tr><td class="bra">$lex{'Select by'} $lex{Homeroom}</td>};
    print qq{<td><select name="homeroom"><option></option>\n};
    foreach my $hr ( @homerooms ) {
	print qq{<option>$hr</option>\n};
    }
    print qq{</select></td></tr>\n};

    # Divider
    print qq{<tr><td colspan="2"><hr></td></tr>\n};

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


    print qq{<tr><td></td><td>\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 qq{K:$key V:$arr{$key}<br>\n}; }

    # Check for any Blanks
    foreach my $key ( 'prepost', 'tdate' ) {
	if ( not $arr{$key} ) {
	    print qq{<h3>$lex{'Missing Value'}: $key</h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }

    # Check Date format.
    my $err = checkDate( $arr{tdate} );
    if ( $err == 1 ) {
	print qq{<h3>$lex{Error}: Date Outside School Year: $arr{tdate}</h3>\n};
	print qq{</body></html>\n};
	exit;
	
    } elsif ( $err ) {
	print qq{<h3>Date Error: $err</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    
    my $checked;
    if ( $arr{chk} ) {
	$checked = 'CHECKED';
    }
    delete $arr{chk};
    
    
    my ($select, %grades, $group);
    if ( $arr{grade} ) {
	$select = 'where grade = ?';
	$grades{ $arr{grade} } = 1;
	
    } elsif ( $arr{homeroom}  ) {
	$select = 'where homeroom = ?';
	
	# Get the associated grade(s) for this homeroom
	my $sth = $dbh->prepare("select distinct grade from student where homeroom = ?");
	$sth->execute( $arr{homeroom} );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	while ( my $gr = $sth->fetchrow ) {
	    $grades{$gr} = 1;
	}
	
    } else { #error
	print qq{<h3>$lex{Error}: No Student Selection</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    
    # Get Outcomes for these Grade(s);
    my %outcomes;
    my $sth = $dbh->prepare("select oid, odesc from mathca_outcomes where grade = ?");
    foreach my $grade ( keys %grades ) {
        $sth->execute( $grade );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	while ( my ($oid, $odesc ) = $sth->fetchrow ) {
	    $outcomes{$grade}{$oid} = $odesc;
	}
    }

    
    if ( $arr{grade} ) {
	$group = $arr{grade};
    } else {
	$group = $arr{homeroom};
    }

    my $sth = $dbh->prepare("select * from student
     $select order by lastname, firstname");
    $sth->execute( $group );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }

    
    print qq{<div style="font-size:130%;"><b>$lex{Test} $lex{Date}</b> $arr{tdate}</div>\n};

    # Print Form Heading
    print qq{<form action="$self" method="post"> \n};
    print qq{<input type="hidden" name="page" value="2">\n};
    print qq{<input type="hidden" name="tdate" value="$arr{tdate}">\n};
    print qq{<input type="hidden" name="prepost" value="$arr{prepost}">\n};

    # Outcomes for this grade
    print qq{<table style="padding:0.5em 0;"><tr><th style="padding:0.5em;">\n};
    print qq{Outcome <select name="outcome"><option></option>\n};
    foreach my $grade ( sort keys %outcomes ) {
	foreach my $oid ( sort keys %{ $outcomes{$grade} } ) {
	    print qq{<option value="$oid">Gr $grade: $oid $outcomes{$grade}{$oid}</option>\n};
	}
    }
    print qq{</select></th></tr></table>\n};


    # Not required anymore
    # Replace Existing Scores
#    print qq{<div class="la" style="font-weight:bold;margin:1em 0;">};
#    print qq{<input type="checkbox" name="replacescore" value="1" checked="checked"> };
#    print qq{Replace Existing Scores</div>\n};

    
    my $first = 1;

    
    # Student Loop
    while ( my  $ref = $sth->fetchrow_hashref ) {

	my %r = %$ref;

	if ( $first ) {
	    print qq{<div class="la"><input type="submit" value="$lex{Continue}"></div>\n};
	    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	    print qq{<tr><th>$lex{Student}</th><th>$lex{Grade}</th></tr>\n};
	    $first = 0;
	}

	print qq{<tr><td class="la"><input type="checkbox" name="$r{studnum}" value="1" $checked> };
	print qq{<b>$r{lastname}</b>, $r{firstname}</td><td class="cn">$r{grade}</td></tr>\n};
    }

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

    exit;

} # end of selectStudent



#--------------
sub enterScores {
#--------------

    # print qq{<div>Enter Scores</div>\n};
    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }
    
    my $outcome = $arr{outcome};
    delete $arr{outcome};
    my $prepost = $arr{prepost};
    delete $arr{prepost};
    my $tdate = $arr{tdate};
    delete $arr{tdate};
    
    # Anything left in %arr will be student numbers.

    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }
  
    if ( not $outcome ) {
	print qq{<h3>$lex{Error}: Missing Outcome</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    if ( not %arr ) {
	print qq{<h3>$lex{Error}: No Student Selection</h3>\n};
	print qq{</body></html>\n};
	exit;
    }


    my (%sort, %student);
    my $sth = $dbh->prepare("select * from student where studnum = ?");
    foreach my $studnum  (keys %arr ) {
	$sth->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $ref = $sth->fetchrow_hashref;
	$student{$studnum} = $ref;
	my %r = %{ $ref };
	$sort{"$r{lastname}$r{firstname}$studnum"} = $studnum;
    }

    # Test Date
    print qq{<div style="font-size:130%;"><b>$lex{Test} $lex{Date}</b> $tdate</div>\n};
    # Display Outcome
    print qq{<div style="font-size:130%;margin-bottom:1em;"><b>Outcome</b> $outcome</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="tdate" value="$tdate">\n};
    print qq{<input type="hidden" name="prepost" value="$prepost">\n};
    print qq{<input type="hidden" name="outcome" value="$outcome">\n};

    

    my $first = 1;


    # Student Loop
    foreach my $key ( sort keys %sort ) {
	my $studnum = $sort{$key};
	my %r = %{ $student{$studnum}};

	
	if ( $first ) {
	    print qq{<div class="la"><input class="btn-grn" 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>$lex{Grade}</th><th>$lex{Score}</th></tr>\n};
	    $first = 0;
	}

	
	# Check for existing score for this student, this outcome, this year!
	my $sth = $dbh->prepare("select * from mathca_scores 
           where studnum = ? and outcome = ? and prepost = ? and schoolyear = ?");
	$sth->execute( $studnum, $outcome, $prepost, $ey );  # $ey is end school year defined near top.
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $sref = $sth->fetchrow_hashref;
	my ($id, $prevscore);
	if ($sref ) {
	    $id = qq{ID:$sref->{id}};
	    $prevscore = $sref->{score};
	}

	
	print qq{<tr><td class="bra">$r{firstname} $r{lastname}</td><td class="cn">$r{grade}</td>\n};
	print qq{<td class="la">\n};

	# Replaced  values to allow for decimal values.
#	my $checked;
#	foreach my $score ( 1, 2, 3, 4, 'N/A' ) {
#	    if ( $score eq 'N/A' ) { $checked = qq{checked="checked"} }
#	    print qq{<input type="radio" name="$r{studnum}" value="$score" $checked>$score&nbsp;&nbsp;};
	#	}

	if ( $id ) {
	    print qq{<input type="text" name="$id" value="$prevscore" style="width:4ch;"></td></tr>\n};
	    
	} else {
	    print qq{<input type="text" name="$r{studnum}" style="width:4ch;"></td></tr>\n};
	}

    }

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

    exit;

} # end of enterScores


#---------------
sub writeScores {
#---------------

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


    my $tdate = $arr{tdate};
    delete $arr{tdate};
    my $prepost = $arr{prepost};
    delete $arr{prepost};
    my $outcome = $arr{outcome};
    delete $arr{outcome};
    
#    my $replacescore = $arr{replacescore};
#    delete $arr{replacescore};

#    my @outcomes;  # figure out the outcomes to check/add/update
#    push @outcomes, $outcome;

    my $sth1 = $dbh->prepare("select * from studentall where studnum = ?");

    # Insert Record Prepare
    my $sth2 = $dbh->prepare("insert into mathca_scores
             ( studnum, treatynum, tdate, tauthor, tgrade, tage, prepost, outcome, score, schoolyear ) 
             values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, $ey )");

    # Update the record score
    my $sth3 = $dbh->prepare("update mathca_scores set score = ? where id = ?");

    # Read a math record
    my $sth4 = $dbh->prepare("select * from mathca_scores where id = ?");

    my @novalue; # handled later as exceptions.
    
    foreach my $key ( sort keys %arr ) {
	
	if ( not $arr{$key} ) {
	    push @novalue, $key;
	    next;
	} 

	if ( $arr{$key} > 4 ) { # value too big
	    my $studnum = $key;
	    # Get Student Info
	    $sth1->execute( $studnum );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $studref = $sth1->fetchrow_hashref;
	    my %r = %$studref;

	    print qq{<h3>Values greater than 4 not allowed for $r{firstname} $r{lastname}. Skipping!</h3>\n};
	    next;
	}

	
	my ($flag, $id) = split(':', $key ); # if we have an existing value, we'll have an record id.
	
	if ($id ) { # update the record score

	    # Get the math record, then get the name
	    $sth4->execute( $id );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $mref = $sth4->fetchrow_hashref;
	    my %m = %$mref;
	    my $studnum = $m{studnum};

	    # now the name
	    $sth1->execute( $studnum );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $sref = $sth1->fetchrow_hashref;
	    my %s = %$sref;
	    	    
	    $sth3->execute( $arr{$key}, $id );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }

	    print qq{<div>$s{firstname} <b>$s{lastname}</b> -  Score updated to $arr{$key}</div>\n};
	    
	    
	} else { # add a record.

	    my $studnum = $key;

	    # Get Student Info
	    $sth1->execute( $studnum );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $studref = $sth1->fetchrow_hashref;
	    my %r = %$studref;
	    
	    my $age = calcAge( $r{birthdate}, $tdate );
	    my $treatynum = $r{treaty};
	    if ( not $treatynum ) { $treatynum = $r{provnum}; }
	    
	    my $score = $arr{$studnum};
	    
	    $sth2->execute( $studnum, $treatynum, $tdate, $userid, $r{grade},
			$age, $prepost, $outcome, $score );
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    print qq{<div>$r{firstname} $r{lastname} $lex{Score} for $outcome $lex{Added}</div>\n};
	}

=head
	# Check for existing score for this student, this/these outcomes, this year!
	my %ocpresent; # stores which are already present.
	my $sth = $dbh->prepare("select id from mathca_scores 
           where studnum = ? and outcome = ? and prepost = ? and schoolyear = ?");

	foreach my $oc ( @outcomes ) {
	    $sth->execute( $studnum, $oc, $prepost, $ey );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $id = $sth->fetchrow;
	    $ocpresent{$oc} = $id;
	}
	
	
	foreach my $outcome ( @outcomes ) {
	    
	    if ( $ocpresent{$outcome} ) { # record exists.
		
		my $id = $ocpresent{$outcome};
		
		if ( not $replacescore ) { # just skip
		    print qq{<div><b>$lex{'Record Exists'}</b>\n};
		    print qq{- $r{firstname} $r{lastname} ($studnum)};
		    print qq{- $outcome - $lex{Skipping}</div>\n};
		    next;
		    
		} else { # update fields including score, tdate;
		    my %new = ('tage' => $age, 'tdate' => $tdate, 'score' => $score,
			       'tauthor' => $userid );
		    foreach my $field ( 'tage', 'tdate','score', 'tauthor' ) {
#			print qq{Field:$field  Val:$new{$field}<br>\n};
			my $sth = $dbh->prepare("update mathca_scores set $field = ? where id = ?");
			$sth->execute($new{$field},  $id );
			if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
		    }
		    print qq{<div>$r{firstname} $r{lastname} $lex{Score} $lex{Updated} };
		    print qq{for $outcome</div>\n};
		    next;
		}
		
	    } else {  # insert a record for this outcome.

		# Insert a record.
		$sth2->execute( $studnum, $treatynum, $tdate, $userid, $r{grade},
				$age, $prepost, $outcome, $score );
		if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }

		print qq{<div>$r{firstname} $r{lastname} $lex{Score} for $outcome $lex{Added}</div>\n};
	    }

	} # outcomes loop
=cut
	
    } # students loop

	
    # Add SSP Exceptions for some students
    my $first = 1;
    
    # foreach my $studnum ( keys %arr ) {
    # if ( $arr{$studnum} eq 'N/A' ) { # setup for exceptions

    foreach my $studnum ( @novalue ) {
    
	# Get Student Info
	$sth1->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $ref = $sth1->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="$tdate">\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>};
	print qq{ <input type="text" 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};
    }


    print qq{<p>[ <a href="$self">Add More</a> ]</p>\n};
    
    print qq{</body></html>\n};

    exit;

} # end of writeScores


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

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

    my $sth1 = $dbh->prepare("select * from  student 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, 'cma' );
	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{<div><b>$lex{'Record Exists'}</b>\n};
	    print qq{- $rec{firstname} $rec{lastname} ($studnum)};
	    print qq{<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, 'cma', $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 "$age:$month";

}


#------------
sub checkDate {
#------------

    # use Time::JulianDay; set at top of script
    
    my $date = shift;

    my ($y,$m,$d) = split('-',$date);
    
    if ( not $d ) { return 255; }  # wrong format.
    if ( $m > 12 or $m < 1 ) { return 255; }
    if ( $d > 31 or $d < 1 ) { return 255; }

    my $datejd = julian_day( $y, $m, $d );

    my $startjd = julian_day( split('-', $schoolstart ));
    my $endjd = julian_day( split('-', $schoolend ));
    
#    print qq{DATE:$date - $datejd Start:$schoolstart - $startjd  End:$schoolend - $endjd<br>\n};

    if ( $datejd > $endjd  or $datejd < $startjd ) {
	return 1; # different code for date outside of current year;
    }
    
    return 0;

}