#!/usr/bin/perl
# Copyright 2001-2024 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.
# Description: copy values from the student medical field into new student_medical table
my %lex = ('Main' => 'Main',
'Medical' => 'Medical',
'Copy' => 'Copy',
'Records' => 'Records',
'Copy Record(s)' => 'Copy Record(s)',
'Category' => 'Category',
'New' => 'New',
'Undefined' => 'Undefined',
'Record(s) Stored' => 'Record(s) Stored',
'Contact' => 'Contact',
'Error' => 'Error',
'Results' => 'Results',
'Record Exists' => 'Record Exists',
'Skipping' => 'Skipping',
'Missing' => 'Missing',
'or' => 'or',
'Not Found' => 'Not Found',
);
my $self = 'medcopy.pl';
use DBI;
use CGI;
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 $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Print Page Header
print qq{$doctype\n$lex{Copy} $lex{Medical} $lex{Records}\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} ]\n};
print qq{
$lex{Copy} $lex{Medical} $lex{Records}
\n};
if ( not $arr{page} ) {
showStartPage();
} else {
delete $arr{page};
writeRecords();
}
#----------------
sub showStartPage {
#----------------
# Get Existing Categories
my @category = ();
my $sth = $dbh->prepare("select distinct category from student_medical order by category");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $ref = $sth->fetchall_arrayref;
foreach my $val ( @$ref ) {
if ( $val->[0] ) { push @category, $val->[0]; }
}
# Start the Form
print qq{\n};
exit;
}
#---------------
sub writeRecords {
#---------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key} \n}; }
print qq{
\n};
print qq{
$lex{Results}
\n};
# SQL Setup
my $sth = $dbh->prepare("select count(*) from student_medical where studnum = ? and category = ?");
my $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
my $sth2 = $dbh->prepare("insert into student_medical ( studnum, category, description ) values ( ?, ?, ? )");
foreach my $key ( sort keys %arr ) {
my ( $val, $studnum ) = split(/:/,$key);
if ( $val eq 'D' or $val eq 'N' ) { next; }
my $dkey = "D:$studnum";
my $nkey = "N:$studnum";
my $ckey = "C:$studnum";
# Get Student Name
$sth1->execute( $studnum );
if ( $DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my ( $lastname, $firstname ) = $sth1->fetchrow;
if ( not $lastname ) {
$lastname = qq{$lex{'Not Found'}};
}
# Set Category, Description
my ($category, $description);
if ( $arr{$nkey} ) { $arr{$ckey} = $arr{$nkey}; } # new cat replaces cat.
if ( not $arr{$dkey} ) { next; } # no description, skip to next.
$category = $arr{$ckey};
$description = $arr{$dkey};
if ( not $category ) { # an error
print qq{
\n};
next;
}
# Check for duplicates, this student, this category
$sth->execute( $studnum, $category );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my $catcount = $sth->fetchrow;
if ( $catcount ) {
print qq{
\n};
next;
}
# print line for this record.
print qq{
$lastname, $firstname ($studnum) - $category
\n};
# Insert the record
$sth2->execute( $studnum, $category, $description );
if ( $DBI::errstr ){ print $DBI::errstr; last; }
} # Next Student
if ( not $DBI::errstr ) {
print qq{