#!/usr/local/bin/perl -Tw
###############################################################################
###############################################################################
##
## EnterData.pl
##
## This program generated the initial CGI form page for ECG entry.  It
## connects to the MySQL database in order to dynamically generate
## form elements corresponding to the SQL column datatypes.
##
## Input: Nothing.
##
## Output: Valid HTML fillout form passed to users browser.
##
## Calls: VerifyData.pl
##
## Uses: perl modules CGI and DBI
##
## This program begins the data entry process.  It uses DBI:mysql to
## connect to the MySQL database.  It outputs an appropriate HTML form
## for entering data to the database using calls to MakeFormElement.
## When the form is submitted VerifyData.pl is called.
##
###############################################################################
###############################################################################

# Extend the terse diagnostics normally produced by perl compiler and
# perl interpreter to print more readable information.
use diagnostics -verbose;

# Disallow symbolic references, undeclared variables, and bareword
# identifiers.
use strict;

# Load the perl CGI and DBI modules
use DBI;
use CGI;

# Variable declaration section
my $Database="ecg";		# Name of database to connect to
my $User="hpaul";		# Name of Database user
my $Password="ralph";		# Database user's password
my $dbh;			# Database handle object

my $query=new CGI;		# CGI form object
my $method="POST";		# Form method for data transmission
my $action="VerifyData.pl";	# CGI script called on submit for CGI form object;
my $encoding=$CGI::MULTIPART;	# HTML encoding type
$encoding = $CGI::MULTIPART;	# Set twice to avoid annoying lint error

# Generate appropriate HTML for the beginning of a page
print $query->header;
print $query->start_html; 

# Generate appropriate HTML for the beginning of a form
print $query->start_multipart_form($method,$action,$encoding);
print $query->isindex($action);

# Connect the database handle
$dbh = DBI->connect("DBI:mysql:$Database:",$User,$Password)
# If the database handle can't be connected, die with some useful information
  or die "Can't connect to the database!\n";

# Print Fill-out form using calls to MakeFormElement
print "<h1><center>Administrative Data</center></h1>\n";
print "<br>Case Number: \n";
MakeFormElement ($dbh, 'ECG', 'CaseNumber','0');
print "<br>Date & Time: \n";
MakeFormElement ($dbh, 'ECG', 'DateAndTime','0');
print "<br>Orderer: \n";
MakeFormElement ($dbh, 'ECG', 'Orderer','0');
print "<br>Recorder: \n";
MakeFormElement ($dbh, 'ECG', 'Recorder','0');
print "<hr>\n";

print "<h1><center>Raw Data</center></h1>";
print "<br>Image: \n";
MakeFormElement ($dbh, 'ECG', 'Image','0');

###############################################################################
# Millimeters per second and Millivolts per centimeter are used for
# processing the tiff into an eWav format.  These form elements are
# generated manually since they are not columns in the ECG table;
print "<br>Millimeters per Second\n";

print $query->textfield  ('-name'=>'MMperSec',
			  'default'=>'25',
			  'size'=>'4',
			  'maxlength'=>'4');
print "Millivolts per Centimeter\n";
print $query->textfield  ('-name'=>'MVperCM',
			  'default'=>'0.5',
			  'size'=>'4',
			  'maxlength'=>'4');
print "<hr>\n";
###############################################################################
print "<h1><center>Abnormalities, etc</center></h1>\n";
print "<br>Intraventricular Conduction Defects:\n";
MakeFormElement ($dbh, 'ECG', 'IntraventricularConductionDefects','0');

print "<br>Chamber Enlargements:\n";
MakeFormElement ($dbh, 'ECG', 'ChamberEnlargements','0');

print "<br>Other Comments:\n";
MakeFormElement ($dbh, 'ECG', 'OtherComments','0');
print "<hr>\n";
###############################################################################
print "<h1><center>Arrhythmias</center></h1>\n";
print "<br>Atrioventricular Dissociation:\n";
MakeFormElement ($dbh, 'ECG', 'AtrioventricularDissociation','0');

print "<br>Atrioventricular Blocks:\n";
MakeFormElement ($dbh, 'ECG', 'AtrioventricularBlocks','0');

print "<br>Ventricular Arrhythmias:\n";
MakeFormElement ($dbh, 'ECG', 'VentricularArrhythmias','0');

print "<br>Atrioventricular Arrhythmias:\n";
MakeFormElement ($dbh, 'ECG', 'AtrioventricularArrhythmias','0');

print "<br>Supraventricular Arrhythmias:\n";
MakeFormElement ($dbh, 'ECG', 'SupraventricularArrhythmias','0');

print "<br>Abnormal Sinoatrial Arrhythmias:\n";
MakeFormElement ($dbh, 'ECG', 'AbnormalSinoatrialArrhythmias','0');
print "<hr>\n";
###############################################################################
print "<h1><center>Morphology</center></h1>\n";
print "<br>Average Heart Rate:\n";
MakeFormElement ($dbh, 'ECG', 'AverageHeartRate','0');

print "<br>PQ Interval:\n";
MakeFormElement ($dbh, 'ECG', 'PQInterval','0');

print "<br>Q Wave Amplitude:\n";
MakeFormElement ($dbh, 'ECG', 'QWaveAmplitude','0');

print "<br>QRS Wave Duration:\n";
MakeFormElement ($dbh, 'ECG', 'QrsWaveDuration','0');

print "<br>QT Interval:\n";
MakeFormElement ($dbh, 'ECG', 'QtInterval','0');

print "<br>S Wave Amplitude:\n";
MakeFormElement ($dbh, 'ECG', 'SWaveAmplitude','0');

print "<br>ST Segment Displacement:\n";
MakeFormElement ($dbh, 'ECG', 'StSegmentDispl','0');

print "<br>ST Segment Displacement Lead:\n";
MakeFormElement ($dbh, 'ECG', 'StSegmentDisplLead','0');

print "<br>T Wave Amplitude:\n";
MakeFormElement ($dbh, 'ECG', 'T_Wave_Amplitude','0');

print "<br>ST Segment:\n";
MakeFormElement ($dbh, 'ECG', 'St_Segment','0');

print "<br>P Wave Morphology:\n";
MakeFormElement ($dbh, 'ECG', 'P_Wave_Morphology','0');

print "<br>Predominant Rhythm:\n";
MakeFormElement ($dbh, 'ECG', 'Predominant_Rhythm','0');
print "<hr>\n";
###############################################################################
print "<h1><center>Artifact source:</center></h1>\n";
print "<br>Artifacts:\n";
MakeFormElement ($dbh, 'ECG', 'Artifacts','0');
print "<hr>\n";
###############################################################################

# Disconnect the database handle. This actually disconnects you from
# the database specified by $dbh
$dbh->disconnect;

# Generate HTML submit button
print $query->submit; 

# Generate HTML suitablr for end of page
print $query->endform; 
print $query->end_html; 
#











###############################################################################
###############################################################################
##
## Subroutine MakeFormElement
##
## This subroutine takes as arguments a database handle object, a
## table name, a column name, and a debug flag.  It outputs an HTML
## form element corresponding to the type of columns passed.
##
## Inputs: Database Handle
##         Table name
##         Column name 
##         Debug Flag
##
## Outputs: HTML form element corresponding to the type of columns
##          passed
##
## Returns: Nothing
##
## Uses: perl modules CGI and DBI
## 
## This subroutine uses an SQL call to the database to determine a
## column's type.  It then uses regular expressions to format the
## returned datatype (if enum or set) to be an appropriate fomat for
## the 'values' argument to the various CGI make form-element calls.
## Depending on the variable type a different form generating funtion
## is called from CGI.pm
##
###############################################################################
###############################################################################
sub MakeFormElement
  
{
    my $dbh    = $_[0];		# Database handle object
    my $Table  = $_[1];		# Name of table in database
    my $Column = $_[2];		# Name of Column in table
    my $Debug  = $_[3];		# Debug flag
    
    my $sql;			# SQL code to execute
    my $sth;			# Statement Handle
    
    my $Field;			# Column Name
    my $Type;			# SQL datatype including length information : varchar(30)
    my $Null;
    my $Key;
    my $Default;		# Default value if unassigned
    my $Extra;
    my $DataType;		# SQL datatype: varchar, datetime, blob, 
				# integer, set, enum, etc.
    
    my $Num_Elements;
    my @ValueArray;
    my $Values;			# Possible elements if Type enum or set, length if integet 
				# or text, undefined if blob
    
    
    if ($Debug) 
    {
	print "<br>dbh, Table, Column = $dbh, $Table, $Column<br>\n\n";
    }
    
    # Get data about column from database
    my $q_Column = $dbh->quote($Column);
    $sql = "show columns from $Table like $q_Column";
    $sth = $dbh->prepare($sql);
    $sth->execute or warn $dbh->errstr;
    ($Field, $Type, $Null, $Key, $Default, $Extra) = $sth->fetchrow_array;
    $sth->finish;

    # Split data into useful variables
    ($DataType, $Values) = split /[\(\)]/, $Type;
    $Num_Elements=0;
    if ($Values) 
    {
	$Values =~ s/'//g;                             # Fix xemacs auto-indent bug  --> ';
	@ValueArray = split /,/, $Values;           
	$Num_Elements = scalar(@ValueArray);
    }
    
    # Keep picklists from getting absurdly long
    if ($Num_Elements > 6) { $Num_Elements = 7;}
    
    # Print some debugging info
    if ($Debug) 
    {
	print "Field = $Field<br>\n";
	print "Type = $Type<br>\n";
	print "Datatype = $DataType<br>\n";
	print "Values = ";
	if (!$Values) 
	{
	    print "*UNDEFINED*<br>\n";
	} 
	else 
	{
	    print "\"$Values\"<br>\n"
	};
	print "ValueArray = "; 
	foreach $Values (@ValueArray) 
	{ 
	    print "\"$Values\"\t";
	} 
	print "\n";
	print "Null = $Null<br>\n";
	print "Key = $Key<br>\n";
	print "Default = " ;  
	if (!$Default)
	{ 
	    print "*UNDEFINED*<br>\n"; 
	} 
	else
	{ 
	    print "$Default<br>\n"; 
	}
	print "Extra = $Extra<br>\n";
    }
    
    ###########################################################################
    # Here we generate a form element appropriate to the database
    # column being represented.
    ###########################################################################
    if ($DataType eq 'set') 
    {
	print $query->scrolling_list	('-name'=>$Column,
					 'values'=>\@ValueArray,
					 'default'=>$Default,
					 'size'=>$Num_Elements,
					 'multiple'=>'true');
    }
    ###########################################################################
    elsif ($DataType eq 'enum') 
    {
	print $query->popup_menu ('-name'=>$Column,
				  'values'=>\@ValueArray,
				  'default'=>$Default);
    }
    ###########################################################################
    elsif ($DataType eq 'smallint' || $DataType eq 'varchar' 
	   || $DataType eq 'mediumint') 
    {
	print $query->textfield  ('-name'=>$Column,
				  'default'=>$Default,
				  'size'=>$Values,
				  'maxlength'=>$Values);
    }
    ###########################################################################
    elsif ($DataType eq 'float') 
    {
	print $query->textfield ('-name'=>$Column,
				 'default'=>$Default,
				 'size'=>'15',
				 'maxlength'=>'15');
    }
    ###########################################################################
    elsif ($DataType eq 'datetime') 
    {
	print $query->textfield  ('-name'=>$Column,
				  'default'=>$Default,
				  'size'=>'20',
				  'maxlength'=>'20');
    }
    ###########################################################################
    elsif ($DataType eq 'longblob') 
    {
	print $query->filefield  ('-name'=>$Column,
				  'size'=>'50',
				  'maxlength'=>'80');
    }
    ###########################################################################
    else
    {
	print "<h1>Datatype \"$DataType\" not recognized</h1>\n";
    }
    print "\n\n";
    
}
#