#! /usr/bin/perl
use strict;
no strict 'refs';
use warnings;
use DBI;
use Date::Calc qw(:all);
use File::Temp qw/ tempfile tempdir /;

my $version = '0.2';

#############################################################################
#    CONTENTS
#############################################################################

#Section 1. Description and copyright statement
#Section 2. Setup and instructions
#Section 3. User definable variables
#Section 4. Code





#############################################################################
#    Section 1. DESCRIPTION AND COPYRIGHT STATEMENT
#############################################################################


#this script is used to print out WIC enconter sets from OSCAR EMR

#	 (c) Robbie Coull, 2009
# 	 robbie@coull.net
#
#    This code 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 3 of the License, or
#    (at your option) any later version.
#
#    This code is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    see <http://www.gnu.org/licenses/>.





#############################################################################
#    Section 2. SETUP AND INSTRUCTIONS
#############################################################################


# Copy this script to a suitable location (eg: /usr/local/scripts)

# Make sure that it can be used by any user
#     sudo chmod 777 /usr/local/scripts/WICPrint.pl

#note: must have mysql root password set to '' and the test database created
#for this to work and make sure MySQL is running!

# sudo apt-get install mysql-server
# sudo /etc/init.d/mysql start

#For this script to work you need to install perl modules
# sudo perl -MCPAN -e shell

# cpan> install Bundle::CPAN
# cpan> install Bundle::DBI
# cpan> install Date::Calc
# cpan> install File::Temp
# cpan> exit

#once the modules are installed, make sure MySQL on the local server is NOT running
# sudo /etc/init.d/mysql stop

#turn MySQL off in the services section of admin to prevent it starting at boot

#you will need the following programs installed for this script to work
# enscript
# sudo apt-get install enscript

#if OSCAR is installed on a remote server
#then you will need to set up a keychain access to that server
#to allow this script to access the upload folders
#
#eg: ssh -D 8080 -fN $USER@$remoteserver
#    ssh -nNL 3306:127.0.0.1:3306 $USER@$remoteserver &> /dev/null &
#
#which provides SSH tunnel access to the server and to the MySQL server









#############################################################################
#    Section 3. USER VARIABLES
#############################################################################

my $serveraddress 	= 'yourserver.net';
my $serverlogin 	= getlogin();
my $login_id;

my $max_reports_to_print='100';

my $default_report_title = 'WALK IN CLINIC REPORT';
my $default_report_center = '';
my $default_report_right = 'OSCAR ELECTRONIC MEDICAL RECORD';

my %pref;
$pref{mysql_database}	= 'oscar_mcmaster';
$pref{mysql_read}		= 'read user';
$pref{mysql_read_pass}	= 'read user password';
$pref{mysql_write}		= 'write user';
$pref{mysql_write_pass}	= 'write user password';
$pref{mysql_host}		= '127.0.0.1';
$pref{mysql_port}		= '3306';
$pref{mysql_log}		= '/home/rscoull/Desktop/mysql_log';

#provider number for orphan patients
my $no_doctor='8999';

#set to 1 for test mode, 0 for normal mode
my $test_mode = 0;


#declare subroutine variables
my $sec;
my $min;
my $hr;
my $mday;
my $mon;
my $year;
my $wday;
my $yday;
my $isdst;
my $longyr;
my $fixmo;
my $sql_date;
my $sql_time;
my $sql_datetime;
my $string_to_be_padded;
my $desired_string_length;
my $padding_character;
my $right_or_left_justify;
my $decimal_places;
my $decimals;
my $decimal_places_digit;
my $missing_digits;
my $mysql_user;
my $mysql_login;
my $mysql_pass;
my $dbh_name;
my $mysql_preferred_user;
my $mysql_original_user;
my $dbh_inuse;
my $sql;
my @mysql_row;
my $mysql_query;
my $mysql_record;
my @mysql_result;
my @mysql_insert;
my $mysql_update_table;
my $mysql_update_table_array;
my $mysql_disconnect;
my $error;
my $this_sql_insert;
my $mysql_insert_table;
my $sql_data;
my $tempath;
my $path;
my $mysql_result;
my $mysql_set_insert;
my %mysql_set_insert;









#month variables
my %month_names = (
	'JAN' 		=> '1',
	'FEB' 		=> '2',	
	'MAR' 		=> '3',	
	'APR' 		=> '4',	
	'MAY' 		=> '5',	
	'JUN' 		=> '6',	
	'JUL' 		=> '7',	
	'AUG' 		=> '8',	
	'SEP' 		=> '9',	
	'SEPT' 		=> '9',	
	'OCT' 		=> '10',	
	'NOV' 		=> '11',	
	'DEC' 		=> '12',	
	'JANUARY' 	=> '1',	
	'FEBUARY' 	=> '2',	
	'MARCH' 	=> '3',	
	'APRIL' 	=> '4',	
	'MAY' 		=> '5',	
	'JUNE' 		=> '6',	
	'JULY' 		=> '7',	
	'AUGUST' 	=> '8',	
	'SEPTEMBER' 	=> '9',	
	'OCTOBER' 	=> '10',	
	'NOVEMBER' 	=> '11',
	'DECEMBER'	=> '12',			
);
my $this_month_name;





my %shorthand = (
	'RAINBOW' => 'Review appointment if no better or worse.',	
);





#############################################################################
#    Section 4. CODE
#############################################################################



#get the date time
get_time();






#connect to the database
mysql_connect();


#get the provider_no
my $provider='';

header();
until ($provider) {
	print "Doctor's user name: [$serverlogin] ";
	$login_id=<STDIN>;
	$login_id=~s/[^A-Z0-9\.\-\_]//gi;
	unless ($login_id) {
		$login_id = $serverlogin;
	}
	$provider = mysql_hash_query("SELECT security.provider_no, first_name, last_name FROM security, provider WHERE security.provider_no=provider.provider_no && user_name='$login_id'");
	
	if ($provider) {
  		print "\n";
		print "${$provider}{'provider_no'} - ${$provider}{'last_name'}, ${$provider}{'first_name'}.\n";
		print "\n";          
        }
        
        else {
		print "\n";
		print "Sorry, user name $login_id is not recognised.\n";
		print "\n";
	}
}



#get the date of the WIC

my $wic_date='';
my $wic_month;
my $wic_day;
my $wic_year=$longyr;

while (($wic_date!~m/^\d{4}-\d{1,2}-\d{1,2}$/) || ($wic_year>$longyr)) {
        print "Date of WIC: ($longyr-$fixmo-$mday) "; 
        $wic_date = <stdin>;
        $wic_date = uc $wic_date;
        $wic_date=~s/[.: ]/\-/g;
        $wic_date=~s/[^A-Z0-9\-]//g;
        
        if ($wic_date) {
                #look for word versions of months
                for $this_month_name (keys %month_names) {
                        $wic_date=~s/\-$this_month_name\-/\-$month_names{$this_month_name}\-/;
                }
                
                #correct if DD-MM-YYYY format entered
                if ($wic_date=~m/^(\d{1,2})\-(\d{1,2})\-(\d{2,4})$/) {
                        $wic_date="$3-$2-$1";
                }
                
                #add year if only MM-DD format entered
                if ($wic_date=~m/^(\d{1,2})\-(\d{1,2})$/) {
                        $wic_date="$longyr-$1-$2";
                }
                
                #correct year if only 2 digits entered
                if ($wic_date=~m/^\d{2}-\d{1,2}-\d{1,2}$/) {
                        $wic_date="20$wic_date";
                }
                
                $wic_date=~m/^(\d{4})-(\d{1,2})-(\d{1,2})$/;
        }
        
        else {
                $wic_date="$longyr-$fixmo-$mday";	
        }
        
        ($wic_year, $wic_month, $wic_day) = split('-', $wic_date);
}


#get the times to print out
my $clinic_start_time = 1;
while (($clinic_start_time!~m/^\d{2}\:\d{2}$/) && ($clinic_start_time ne 'ALL')) {
    print "\n\nClinic Start Time: (eg. 10:00)  [all] ";
    $clinic_start_time=<STDIN>;
	$clinic_start_time = uc $clinic_start_time;
	chomp $clinic_start_time;
	unless ($clinic_start_time) {
		$clinic_start_time='ALL';
	}
	
	unless ($clinic_start_time eq 'ALL') {
		$clinic_start_time=~s/[\.\ \-]/\:/g;
		$clinic_start_time=~s/[^\d\:]//gi;
	}
}

my $clinic_end_time = 1;

if ($clinic_start_time eq 'ALL') {
		$clinic_start_time='00:01';
		$clinic_end_time = '23:59';		
}

else {	
		while ($clinic_end_time!~m/^\d{2}\:\d{2}$/) {
				print "\n\nClinic End Time: [eg. 10:00] ";
				$clinic_end_time=<STDIN>;
				$clinic_end_time=~s/[\.\ \-]/\:/g;
				$clinic_end_time=~s/[^\d\:]//gi;
		}
}


#get the title of the report
my $report_title = $default_report_title;
my $summary_report = 1;

print "\n";
print "Preface report title with '#' for summary report.\n";
print "\n";
print "Title of report: [$report_title] ";
$report_title = <stdin>;

if ($report_title) {
		if ($report_title=~m/^#/) {
				$summary_report = 2;
		}
}

$report_title = uc $report_title;
$report_title=~s/[^0-9A-Z\ \-\.\,\(\)]//g;

unless ($report_title) {
		$report_title = $default_report_title;
}

$report_title = pad_for_tabulation($report_title, '22', ' ', 'L');






my $clinic_details = mysql_hash_query("SELECT * FROM clinic");



print "\n\nPrinting reports from clinic on $wic_date.....\n";


#get all the appointments from this date for this provider
#only for patient that do not belong to this provider or 'Dr Other'
mysql_hash_query("
    SELECT demographic.demographic_no AS 'patient_demographic_no',
        demographic.last_name AS 'patient_last_name',
        demographic.first_name AS 'patient_first_name',
        demographic.hin AS 'hin',
        demographic.month_of_birth AS 'month_of_birth',
        demographic.date_of_birth AS 'date_of_birth',
        demographic.year_of_birth AS 'year_of_birth',
        provider.provider_no AS 'provider_no',
        provider.last_name AS 'provider_last_name',
        provider.first_name AS 'provider_first_name'
    FROM appointment, demographic, provider
    WHERE demographic.demographic_no=appointment.demographic_no
        && provider.provider_no=demographic.provider_no
        && YEAR(appointment_date)='$wic_year'
        && MONTH(appointment_date)='$wic_month'
        && DAY(appointment_date)='$wic_day'
		&& appointment.start_time BETWEEN '$clinic_start_time' AND '$clinic_end_time'
        && appointment.status LIKE '%E%' 
        && demographic.provider_no!='${$provider}{'provider_no'}'
        && demographic.provider_no!='$no_doctor'
    GROUP BY patient_demographic_no
    ORDER BY provider_last_name, provider_first_name, patient_last_name, patient_first_name
");

my @appointments = @mysql_result;

#create a temporary directory to store the files in
my $tempdir = tempdir();
my $random;
my $message;
my $report_number=0;
my $report_right = $default_report_right;


if ($summary_report == 2) {
		$message = "**CONFIDENTIAL SUMMARY REPORT**\n";
		$message.= "\n";
		$message.= pad_for_tabulation(${$clinic_details}{'clinic_name'}, 40, ' ', 'L', 0)."\n";
		$message.= pad_for_tabulation(${$clinic_details}{'clinic_address'}, 40, ' ', 'L', 0)."\n";
		$message.= pad_for_tabulation(${$clinic_details}{'clinic_city'}, 40, ' ', 'L', 0)."                      Tel. ${$clinic_details}{'clinic_phone'}\n";
		$message.= pad_for_tabulation("${$clinic_details}{'clinic_province'} ${$clinic_details}{'clinic_postal'}", 40, ' ', 'L', 0)."                      Fax. ${$clinic_details}{'clinic_fax'}\n";
		$message.= "\n";
		$message.= "_______________________________________________________________________________________\n";
		$message.= "\n";
		$message.= "SEEN BY:       ${$provider}{'first_name'}${$provider}{'last_name'}, M.D.\n";
		$message.= "DATE SEEN:     $wic_date\n";
		$message.= "\n";

}

for my $this_appointment (@appointments) {
    
		++$report_number;
		$tempath = "$tempdir/report.$report_number.txt";
		
		#get encounters for this patient
		my $this_encounter = mysql_array_query("SELECT encounter FROM eChart WHERE demographicNo='${$this_appointment}{'patient_demographic_no'}' ORDER BY timestamp DESC LIMIT 0,1");
		
		#split up the encounter and use just the last one with the correct date (this avoids duplicates when the encounter has been edited)
		my @encounters = split (/-----------------------------------/, $this_encounter);
		my $encounter_to_include='';
		for my $this_encounter (@encounters) {
			if ($this_encounter=~m/\[$wic_year\.0?$wic_month\.0?$wic_day\]?/) {
				#remove the crap from the encounter element
				$this_encounter=~s/\[.*\]//g;
				$this_encounter=~s/^\s*//;
				$encounter_to_include="$this_encounter\n";
			}
		}
		
		#replace any shorthand text
		for my $shorthand (keys %shorthand) {
			$encounter_to_include=~s/$shorthand/$shorthand{$shorthand}/g;
		};
		
		
		#get the family doctor's address
		my $family_doctor = mysql_hash_query("SELECT * FROM family_doctors WHERE family_doctor_id='${$this_appointment}{'provider_no'}'");
		
		if ($summary_report == 1) {   
				$message = "    **CONFIDENTIAL**\n";
				$message.= "    ".pad_for_tabulation(${$clinic_details}{'clinic_name'}, 40, ' ', 'L', 0)."\n";
				$message.= "    ".pad_for_tabulation(${$clinic_details}{'clinic_address'}, 40, ' ', 'L', 0)."\n";
				$message.= "    ".pad_for_tabulation(${$clinic_details}{'clinic_city'}, 40, ' ', 'L', 0)."                      Tel. ${$clinic_details}{'clinic_phone'}\n";
				$message.= "    ".pad_for_tabulation("${$clinic_details}{'clinic_province'} ${$clinic_details}{'clinic_postal'}", 40, ' ', 'L', 0)."                      Fax. ${$clinic_details}{'clinic_fax'}\n";
				$message.= "\n";
				$message.= "SEEN BY:       ${$provider}{'first_name'}${$provider}{'last_name'}, M.D.\n";
				$message.= "DATE SEEN:     $wic_date\n";
				$message.= "_______________________________________________________________________________________\n";
				$message.= "\n";
				$message.= "    ${$this_appointment}{'provider_first_name'} ${$this_appointment}{'provider_last_name'}, M.D.\n";
				$message.= "    ${$family_doctor}{'family_doctor_address'}\n";
				$message.= "    ${$family_doctor}{'family_doctor_street'}\n";
				$message.= "    ${$family_doctor}{'family_doctor_city'}  ${$family_doctor}{'family_doctor_province'}  ${$family_doctor}{'family_doctor_postal'}\n";
				$message.= "_______________________________________________________________________________________\n";
				$message.= "\n";
				$message.= "PATIENT NAME:  ${$this_appointment}{'patient_last_name'}, ${$this_appointment}{'patient_first_name'}\n";
				$message.= "DoB:           ${$this_appointment}{'year_of_birth'}-${$this_appointment}{'month_of_birth'}-${$this_appointment}{'date_of_birth'}\n";
				$message.= "HEALTH #:      ${$this_appointment}{'hin'}\n";
				$message.= "_______________________________________________________________________________________\n";
				$message.= "\n";
				$message.= "CLINICAL NOTE:\n";
				$message.= "\n";
				$message.= "$encounter_to_include";
				$message.= "_______________________________________________________________________________________\n";
				$message.= "OSCAR - the free Canadian Electronic Medical Record - http://blog.oscarpei.net\n";
				
				#check if the patient name should be used on the right
				unless ($default_report_right) {
					$report_right = "${$this_appointment}{'patient_last_name'}, ${$this_appointment}{'patient_first_name'}";
				}
				$report_right = pad_for_tabulation($report_right, '35', ' ', 'R');
				
				open (MESSAGE, ">$tempath");
				print MESSAGE $message;
				close (MESSAGE);
				
				print "$report_number Printing report for ${$this_appointment}{'patient_last_name'}, ${$this_appointment}{'patient_first_name'}\n";
				system ("enscript --header-font='Bookman-Demi14' --header='$report_title|$default_report_center|$report_right' --footer='' --word-wrap $tempath");
		}
		
		else {
				$message.= "_______________________________________________________________________________________\n";
				$message.= "\n";
				$message.= "PATIENT NAME:  ${$this_appointment}{'patient_last_name'}, ${$this_appointment}{'patient_first_name'}\n";
				$message.= "DoB:           ${$this_appointment}{'year_of_birth'}-${$this_appointment}{'month_of_birth'}-${$this_appointment}{'date_of_birth'}\n";
				$message.= "HEALTH #:      ${$this_appointment}{'hin'}\n";
				$message.= "\n";
				$message.= "CLINICAL NOTE:\n";
				$message.= "\n";
				$message.= "$encounter_to_include";
				
		}
		
		if ( ($report_number >= $max_reports_to_print) || ($test_mode) ) {
			last;
		}

}


if ($summary_report == 2) {
		open (MESSAGE, ">$tempath");
		print MESSAGE $message;
		close (MESSAGE);
		system ("enscript --header-font='Bookman-Demi14' --header='$report_title|$default_report_center|$report_right' --footer='' --word-wrap $tempath");
}

print "\n\nPrinting completed - $report_number reports printed.\n\n\n";



#print "Tidying up.  Setting all non-rostered patients to innactive.\n\n\n";


#update the database to make all NON-ROSTERED patients inactive
#mysql_write_simple("UPDATE demographic SET patient_status='IN' WHERE roster_status='NR'");



#disconnect from the database
mysql_disconnect();

print "\n";
print "\n";
print "Disconnected from database - press return to exit.\n";
print "\n";
my $temp = <stdin>;

exit;

























###########################
#subroutines
###########################


sub header {
	system ("clear");
	print  "-------------------------------------\n";
	print  "OSCAR WALK IN CLINIC PRINTOUT UTILITY v$version\n";
	print  "-------------------------------------\n";
	print  "\n" 	;
}


sub get_time {	
	
	#get the date time
	( $sec, $min, $hr, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
	
	$longyr = $year + 1900;
	$fixmo = $mon + 1;
	
	if ($isdst == 1) {
		my $tz = "CDT";
	} else {
		my $tz = "CST";
	}
	
	if ($hr<10) {
		$hr="0".$hr;
	}
	
	if ($min<10) {
		$min="0".$min;
	}
	
	my $sqlmo=$fixmo;
	if ($sqlmo<10) {
		$sqlmo="0".$sqlmo;
	}
	
	my $sqlmday=$mday;
	if ($sqlmday<10) {
		$sqlmday="0".$sqlmday;
	}
	
	$sql_date="$longyr-$fixmo-$mday";
	$sql_time="$hr:$min:$sec";
	$sql_datetime="$sql_date $sql_time";

}


sub mysql_log {

	if ($_[0]) {
		$sql_data=$_[0];
	}

	if ($pref{mysql_log}) {
		unless ($sql_data) {	$sql_data=$sql;	}
		open (MYSQL,">>$pref{mysql_log}");
		flock (MYSQL, 2);
		print MYSQL "$longyr-$fixmo-$mday $hr:$min:$sec - $sql_data\n";
		close (MYSQL);
	}
	return;

}





sub mysql_connect {

	#set up login and password for this user
	unless ($mysql_user) {
		$mysql_user="read";
	}
	$mysql_login="mysql_".$mysql_user;
	$mysql_pass="mysql_".$mysql_user."_pass";
	$dbh_name="dbh_$mysql_user";

	# Connect to the database
	mysql_log("mysql_connect : mysql_user=$mysql_user, dbh_name=$dbh_name, mysql_login=$mysql_login, mysql_pass=$mysql_pass");
	${$dbh_name} = DBI->connect("DBI:mysql:$pref{mysql_database}:$pref{mysql_host}:$pref{mysql_port}","$pref{$mysql_login}","$pref{$mysql_pass}") || ErrorMessage('Could not connect to database');
	
	#record that this database is in use
	$dbh_inuse="dbh_inuse_$mysql_user";
	${$dbh_inuse}=1;

	return;

}




sub mysql_disconnect {
	# Disconnect the current user ($mysql_user) from the database
	# but don't disconnect the read-only user
	#get the passed user name if passed directly
	if ($_[0]) {
		$mysql_user=$_[0];
	}
	
	if (($mysql_user) && ($mysql_user ne "read")) {
	
		#check that the user is connected first
		$dbh_inuse="dbh_inuse_$mysql_user";
		
		if (${$dbh_inuse}) {
			#this user is  connected
			
			$dbh_name="dbh_$mysql_user";
			mysql_log("mysql_disconnect : mysql_user=$mysql_user, dbh_name=$dbh_name, mysql_login=$mysql_login, mysql_pass=$mysql_pass");
			${$dbh_name}->disconnect || mysql_log('ERROR could not disconnect database');
			
			#record that this database is no longer in use
			${$dbh_inuse}=0;
		}	
	}
	
	return;

}



sub mysql_check_connection {
	#check that the preferred user is the one currently selected
	if ($mysql_user eq $mysql_preferred_user) {
		$mysql_original_user=$mysql_user;
	} else {
		$mysql_original_user=$mysql_user;
		$mysql_user=$mysql_preferred_user;
	}
	
	$dbh_name="dbh_$mysql_user";
	$dbh_inuse="dbh_inuse_$mysql_user";
	$mysql_disconnect=0;
	
	#check that the preferred user is connected
	unless (${$dbh_inuse}) {
		#this user is not connected
		$mysql_disconnect=1;
		mysql_connect();
	}	
	return;

}


sub mysql_check_connection_finish {	

	#check if this user was only connected for this event
	if ($mysql_disconnect) {
		mysql_disconnect();
	}
	
	#reset the current user to the original user
	$mysql_user=$mysql_original_user;
	
	return $mysql_user;

}



sub mysql_simple {
	#this subroutine is passed a full statement as $sql and sends it to the database as a 'read' user
	#get passed sql string if present
 	if ($_[0]) {
 		$sql=$_[0];
 	}
 	
 	$mysql_preferred_user="read";
	mysql_submit_simple($sql);
	return 1;

}


sub mysql_write_simple {
	#this subroutine is passed a full statement as $sql and sends it to the database as a 'write' user
 	#get passed sql string if present
 	if ($_[0]) {
 		$sql=$_[0];
 	}
	
	#print "\n\n**test mode** sub mysql_write_simple has had mysql_submit_simple($sql) commented out - your data has NOT been saved!\n\n$sql\n\n";
	
	$mysql_preferred_user="write";
	mysql_submit_simple($sql);
	return 1;

}


sub mysql_submit_simple {
	#this subroutine is passed a full statement as $sql and sends it to the database as the user $preferred_user
	
 	#get passed sql string if present
 	if ($_[0]) {
 		$sql=$_[0];
 	}
 	
	@mysql_row=();
	
	mysql_check_connection();
	
	mysql_log("mysql_submit_simple : $sql");
	$mysql_query = ${$dbh_name}->do ($sql) || ErrorMessage('Could not submit data to the database');
	
	mysql_check_connection_finish();
	return 1;

}



sub mysql_array_query {
 
 	#get passed sql string if present
 	if ($_[0]) {
 		$sql=$_[0];
 	}
	
	$mysql_preferred_user="read";
	mysql_check_connection();
	
	$mysql_query = ${$dbh_name}->prepare ($sql);
	@mysql_result=();
	
	if (defined($mysql_query)) {
	
		mysql_log("mysql_array_query : $sql");
		$mysql_query->execute() || ErrorMessage('Could not execute array query on database');
		
		while (@mysql_row = $mysql_query->fetchrow_array()) {
			@mysql_result=@mysql_row;
		}
		
	} else {
		mysql_log("mysql_array_query (not found) : $sql");
		ErrorMessage('Could not find query to submit to database');
	}
	$mysql_query->finish();
	
	mysql_check_connection_finish();
	
	#pass the first result back as a return value (or undefined, if no result)
	if ($mysql_result[0])	{
		return $mysql_result[0];
	}
	
	return;
	
}



sub mysql_hash_query {
 
 	#get passed sql string if present
 	if ($_[0]) {
 		$sql=$_[0];
 	}
 
	$mysql_preferred_user="read";
	mysql_check_connection();
	$mysql_query = ${$dbh_name}->prepare ($sql);
	@mysql_result=();
	
	if (defined($mysql_query)) {
		
		mysql_log("mysql_hash_query : $sql");
		$mysql_query->execute() || ErrorMessage('Could not execute hash query on database');
		
		
		
		@mysql_result=();
		while ($mysql_record = $mysql_query->fetchrow_hashref()) {
			push (@mysql_result, $mysql_record);
		}

		
	} else {
		mysql_log("mysql_hash_query (not found) : $sql");
		ErrorMessage('Could not find hash query to submit to database');
	}
	$mysql_query->finish();
	
	mysql_check_connection_finish();
	
	#return the mysql_result array (containing hash references), or undefined if no result
	if ($mysql_result[0])	{
		return $mysql_result[0];
	}
		
	return;
}


sub mysql_set_insert {

	#this subroutine is passed:
	#	1. the table name ($mysql_update_table)
	#	2. a hash of elements to include (%mysql_update)
	#and it then creates a mysql statement ($sql) and sends it to the database as a 'write' user

	#get the passed table name if passed directly
	if ($_[0]) {
		$mysql_insert_table=$_[0];
	}
	
	$mysql_preferred_user="write";
	mysql_check_connection();

	#insert this line in the database
	$error="mysql_insert";
	$sql="INSERT INTO $mysql_insert_table SET ";
	for $this_sql_insert (keys %mysql_set_insert) {
		$mysql_set_insert{$this_sql_insert}=~s/\'/\`/g;
		$sql.="$this_sql_insert='$mysql_set_insert{$this_sql_insert}', ";
	}
	$sql=~s/, $//;
	
	mysql_write_simple($sql);
	
	mysql_check_connection_finish();
	
	return;

}


sub pad_for_tabulation {

	#pads out the string
	
	#pass the following variables:
	#1. the string to be padded - including decimals, decimal places, and thousands separators
	#2. the desired length
	#3. the character to use for padding (usually ' ' or '0', defaults to '0')
	#4. right of left justify ('R' or 'L')
	#5. the number of decimal places to use, preceeded by T if thousands commas to be used (eg: '2', 'T2' or just'T' to just include thousands)
	
	($string_to_be_padded, $desired_string_length, $padding_character, $right_or_left_justify, $decimal_places) = @_;
	
	unless ($padding_character) {
		$padding_character='0';
	}
	
	#add decimal places
	if ($decimal_places) {
		$decimals=q{};
		if ($decimal_places =~m/\d/) {
			$decimal_places_digit=$decimal_places;
			$decimal_places_digit=~s/^T//;
			($string_to_be_padded, $decimals) = split (/\./, $string_to_be_padded);	
			$decimals.="0"x$decimal_places_digit;
			$decimals=substr ($decimals, 0, $decimal_places_digit);
			$decimals=".$decimals";
		}
		
		#add thousands separators if required
		if  ($decimal_places =~m/T/) {
			$string_to_be_padded=~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
		}
		
		$string_to_be_padded.=$decimals;
	}
	
	#next check if the string is too long, and truncate if required
	if (length $string_to_be_padded > $desired_string_length) {
		$string_to_be_padded=substr ($string_to_be_padded, 0, $desired_string_length);
	}
	
	
	$missing_digits = $desired_string_length - (length $string_to_be_padded);
	$missing_digits="$padding_character"x$missing_digits;
	if ($right_or_left_justify eq 'L') {
		$string_to_be_padded=$string_to_be_padded.$missing_digits;
	}
	else {
		$string_to_be_padded=$missing_digits.$string_to_be_padded;
	}

	return $string_to_be_padded;

}


sub rand_id {

	my $rand_id_digits = $_[0];
        
        unless ($rand_id_digits) {
            $rand_id_digits = 5;
        }
        
        my $rand_id='';
        
	while (length $rand_id < $rand_id_digits) {
		my $ftemp=int(rand 9)+1;
		$rand_id.=$ftemp;
	}
	
	return $rand_id;
	
}


sub ErrorMessage {
	print "\n";
	print "\n";
	print "Error: $_\n";
	exit;
}