#! /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.1';

#############################################################################
#    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 scan patient files in for use in 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)
#     sudo mv oscarscan.pl /usr/local/scripts/oscarscan.pl

# Make sure that it can be used by any user
#     sudo chmod 777 /usr/local/scripts/oscarscan.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

#For this script to work
#you need to have the following programs installed on Ubuntu:
# pdftk
# imagemagic
#
#sudo apt-get install pdftk
#sudo apt-get install imagemagick

#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


#I recommend using three user logins for MySQL (read only, read write, admin)
#This helps prevent disasters when the wrong command is issued by accident.  
#If you do most of your database work from a read only user, then you can't 
#accidentally delete anything.
#
#Set up a read-only user and a read-write user as follows:
#log in to mysql
#mysql -uroot -p
#
#GRANT all ON oscar_mcmaster.* TO readonly@localhost IDENTIFIED BY '[password]';
#GRANT select ON oscar_mcmaster.* TO readwrite@localhost IDENTIFIED BY '[password]';
#
#exit
#
#You will need to enter the user names and passwords of these two users
#in the section below - make sure this script can only be accessed by trusted users!









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

#scanner settings
my $device		= ' ';

# scan dimensions
my $sizeX		= '-x 215.9';
my $sizeY 		= '-y 279.4';


#scan settings
my $resolution 		= '200';
my $mode 		= 'Lineart';
my $imageformat 	= 'tiff';

#upload settings
my $uploadfolder 	= '/usr/local/share/scanned_for_upload';
my $serveraddress 	= 'yourserver.net';
my $serverlogin 	= getlogin();

#set duplexmodeon to '1' to offer a duplex option when scanning
my $duplexmodeon 	= 1;

#set the length in digits of the local  HIN
my $province		= 'PE';
my $phn_length		= '8';
my $phn_length_plus1	=  $phn_length+1;
my $phn_length_plus2	=  '12';


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/$serverlogin/oscar_scan_sql.log";

#set diagnostics on or off
my $diagnostic;
#$diagnostic 		= 'on';

#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 @month_names = qw(
  blank
  Jan
  Feb
  Mar
  Apr
  May
  Jun
  July
  Aug
  Sept
  Oct
  Nov
  Dec
);


#declare variables
my $scanimage;
my $scanningtodo;
my $thisbatch;
my $correct;
my $correct2;
my $last_name;
my $first_name;
my $demographic_no;
my $phn;
my $hc_type;
my $description;
my $document_type;
my %bloods;
my $source;
my $patient_details;
my $lab;
my $test;
my %test;
my $this_test;
my $this_result;
my $test_name;
my %test_result;
my $document_date;
my $duplex;
my $duplex1;
my $add_pages;
my $document;
my $tempdir;
my $scan_document;
my $destination;
my $scan_ok;
my $add_more_pages;
my $no_more_pages;
my $quit_requested;
my $new_patient_requested;
my $document_year;
my $document_month;
my $document_day;
my $lab_hash_name;
my %this_lab_hash;
my $this_measurement;
my $measurement_type;
my %measurement_instructions;
my $this_test_result;
my $provider_no;
my $login_id='';
my $random;
my $outputfile;
my $document_number;
my $results_stored_message;
my $temp;
my $image_file;
my $image_file2;
my $prevention;
my $patient_provider;


#declare subroutine variables
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;
















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



#get the date time

(my $sec,my $min,my $hr,my $mday,my $mon,my $year,my $wday,my $yday,my $isdst) = 
	localtime(time);

my $longyr = $year + 1900;
my $fixmo = $mon + 1;


if ($isdst == 1) {
	my $tz = "CDT";
} else {
	my $tz = "CST";
}

if ($hr<10) {
	my $hr="0".$hr;
}

if ($min<10) {
	my $min="0".$min;
}

my $sqlmo=$fixmo;
if ($sqlmo<10) {
	$sqlmo="0".$sqlmo;
}

my $sqlmday=$mday;
if ($sqlmday<10) {
	$sqlmday="0".$sqlmday;
}

my $sql_date="$longyr-$fixmo-$mday";
my $sql_time="$hr:$min:$sec";
my $sql_datetime="$sql_date $sql_time";





$device = find_scanner();


#set up the scanner functions by scanner
my $adf_source		= '--source ADF';	#use this line for the HP
my $duplex_source	= '--source Duplex';	#use this line for the HP

if ($device=~m/fujitsu/i) {
    $adf_source 	= ' ';				#use this line for the fujitsu
    $duplex_source	= "--source 'ADF Duplex'";	#use this line for the fujitsu
}




#connect to the mysql database
mysql_connect();



#download the measurement instructions list
mysql_hash_query("SELECT * FROM measurementType");
for $this_measurement (@mysql_result) {
	$measurement_type=${$this_measurement}{'type'};
	$measurement_instructions{$measurement_type}=${$this_measurement}{'measuringInstruction'};
}



header();

print "Scanner.................$device\n";
print "ADF command:............$adf_source\n";
print "ADF duplex command:.....$duplex_source\n";
print "Scan dimension width.... $sizeX\n";
print "               height... $sizeY\n";
print "     resolution.........  $resolution\n";
print "     mode...............  $mode\n";
print "     image format.......  $imageformat\n";
print "Duplex mode (1=on)......  $duplexmodeon\n";
print "Login ID................  $login_id\n";
print "Server address..........  $serveraddress\n\n";
print "Upload folder location:\n$uploadfolder\n";
print "\n";



#get the provider_no
$provider_no = mysql_array_query("SELECT provider_no FROM security WHERE user_name='$serverlogin'");


until ($provider_no) {
	print "USER NAME:     [$serverlogin] ";
	$login_id=<STDIN>;
	$login_id=~s/[^A-Z0-9\.\-\_]//gi;
	unless ($login_id) {
		$login_id = $serverlogin;
	}
    
	$provider_no = mysql_array_query("SELECT provider_no FROM security WHERE user_name='$login_id'");
	
	unless ($provider_no) {
		print "\n";
		print "Sorry, user name $login_id is not recognised.\n";
		print "\n";
	}
}








##variables the script uses
my $newpatient='1';

#set up blank references to avoid errors
my $empty_original_patient_details = qw{};


#now keep going until $newpatient is null
while ($newpatient eq '1') {
	
		
    # variables to increment file names to store scanned pages
    $scanningtodo='3';
    $thisbatch='0';

    header();
		
    if ($diagnostic) {
        print "DIAGNOSTICS20: \$phn='$phn', looking for new patient detaisl\n";
    }
    
    #we need to find a new patient
    $correct = '2';

    #keep looking until the user selects '1' for $correct
    while ($correct eq '2') {
        
        
        if ($diagnostic) {
            print "DIAGNOSTICS30: \$correct='$correct', keep looking until \$correct=1\n";
        }
        
        #reset the patient details
        ${$patient_details}{'last_name'}= q{};
        $patient_details                = 'empty_original_patient_details';
        $phn                            ='1';

        #keep asking until the user gets a last_name
        until (${$patient_details}{'last_name'}) {
            
            $hc_type = $province;
    
            if ($diagnostic) {
                print "DIAGNOSTICS40: \${\$patient_details}{'last_name'}='${$patient_details}{'last_name'}', keep asking for user name\n";
            }
            
            #keep getting input until you get a $phn_length digit number
            while ($phn!~m/^\d{4,30}$/) {
                    	
	    	if ($diagnostic) {	
	               print "DIAGNOSTICS50: \$phn='$phn', keep looking for $phn_length long input\n";
	        }
	               
		print "Enter 2 letter province code and health # (eg: PE 12345678)\n";
		print "[return empty to quit]\n";
	        print "\n";
		print "Health#: ";
	        $phn = <STDIN>;

		chomp $phn;
		$phn = uc $phn;
	
		if ($phn=~m/^[A-Z]{2}[\ \:\-\,\.]?/) {
			($hc_type, $phn) = split (/[\ \:\-\,\.]/, $phn);			
		};

	        $phn=~s/\D//g;
                
	        unless ($phn) {
	            print "\n\nGoodbye.\n\n";
	            exit;
	        }
	                
	
		if ($hc_type eq $province) {
	                #pad out with zeros
	                $phn = pad_for_tabulation($phn, $phn_length_plus2, '0' ,'R' ,'');	
	                
	                #some labs add extra zeros to the start of the PHN, remove it
	                while (($phn=~m/^\d{$phn_length_plus1}/) && ($phn=~m/^0/)) {
	                    $phn=~s/^0//;
	                }
	                
	                unless ($phn=~m/^\d{$phn_length}$/) {
	                    header();
	                    print "Health Numbers must be 8 digits long - $phn is not an 8 digit number.\n\n\n";
	                }
	
    	        }
    	        
	    }

    	    #now connect to the mysql server and pull this patient's details
    	    $patient_details = mysql_hash_query("SELECT last_name, first_name, demographic_no, provider_no FROM demographic WHERE hin='$phn' && hc_type='$hc_type'");
    	        
    	    #check a patient was found
    	    unless (defined $patient_details) {
    	        #undefined strings cause errors, so define the empty string if nothing found
    	        $patient_details = 'empty_original_patient_details';	
    	    }
    	        
    	    unless (${$patient_details}{'last_name'}) {
    	        header();
    	        print "No record found for Health # $phn.\n\n\n";
    	        #the user will need to enter a new number, so reset $phn
    	        $phn = '1';
    	    }
    	    
    	    $last_name  	    = ${$patient_details}{'last_name'};
    	    $first_name 	    = ${$patient_details}{'first_name'};
    	    $demographic_no	    = ${$patient_details}{'demographic_no'};
    	    $patient_provider	= ${$patient_details}{'provider_no'};
    	    
    	    header();
    	    patient_details();
    	    print  "\n";
    	    print "Is this the correct patient?\n";
    	
		print  "\n";
        	print  "1) Yes.\n";
        	print  "\n";
        	print  "2) No.  I want to enter the Health# again.\n";
        	print  "\n";
        	print  "Q) 			QUIT. I'm finished.\n";
        	print  "\n";
        	$correct = <stdin>;
        	$correct = lc $correct;
        	$correct=~s/[^12q]//g;
        	
        	if ($correct eq 'q') {
        	    print "\n\nGoodbye.\n\n";
        	    exit;
        	}
        	
        	if ($correct eq '2') {
        	    header();
        	    #the user has chosen to enter a new number, so reset $phn
        	    $phn = '1';
     		}
        
    	}
	
	#we have a PHN that the user is happy with	
	
	$newpatient=2;
	
	while ($newpatient eq '2') {
	
		$description 	= 'Old Chart';
            	$document 	= 'oldchart';
        	$document_date	="$longyr-$fixmo-$mday";	
		$document_year 	= $longyr;
                $document_month = $fixmo;
                $document_day 	= $mday;

		#scan the document
		$scanningtodo=1;
		
		#create a temporary directory to store the files in
		$tempdir = tempdir();
	
		while ($scanningtodo ne '4') {
		
            		$scanningtodo=1;
    
			header();
			patient_details();
			
    			print "Document date: $document_day-$month_names[$document_month]-$document_year\n";
        		print "\n";
        		print "Type:          $document \n";
            		print "\n";
            		print "Description:   $description\n" ;
            		print "\n";
			
            		if ($diagnostic) {
				print "DIAGNOSTICS150: \$scanningtodo='$scanningtodo', loop where \$scanningtodo ne '4'\n";
			}
			
			if ($scanningtodo eq '9') {
				#delete the most recent scanned pages
                	
				if ($diagnostic) {
	                		print "DIAGNOSTICS160: \$scanningtodo='$scanningtodo', delete most recent scanned pages because \$scanningtodo eq '9'\n";
        	        	}
                
				print "**LAST BATCH OF FILING DELETED**\n\n";
				print "  rescan batch\n\n";
			}
			
			#ask if these pages are simplex or duplex
			$duplex=1;
			if ($duplexmodeon eq "1") {
				print "\n";
				print "1) Simple / single / 1 sided scan\n";
				print "\n";
				print "2) Duplex / double / 2 sided scan\n";
				print "\n";
				$duplex=<stdin>;
				$duplex=~s/\D//g;
				
			} 
			
			#increment the batch number to prevent earlier files being overwritten
			++$thisbatch;

			# format of filenames to store
			$destination="$tempdir/batch$thisbatch.out%04d.$imageformat";
			
			$duplex1='duplex mode off';
			$source=$adf_source;
			if ($duplex eq "2") {
				$source=$duplex_source;
				$duplex1='DUPLEX MODE ON';
			}

			print  "$duplex1\n";
			print  "\n";
			print  "Ready to scan - make sure documents are in the feeder and press ENTER\n";
			print  "\n";
			<stdin>;

			print  "\n";
			print  "\n";

			# scan pages
			$device = find_scanner();
			print  "Scanning pages...\n\n";
			$scanimage="scanimage $device --batch=$tempdir/batch$thisbatch.out%04d.$imageformat --format=$imageformat --mode $mode --resolution $resolution $source $sizeX $sizeY";
			print "\n\n$scanimage\n\n";
			system($scanimage);
			
			#ask if the scan was ok, or if the user wants to redo this scan or if there are more pages for THIS document
			
			while ($scanningtodo!~m/^[349q]$/i) {
				header();
				
                		if ($diagnostic) {
                		    print "DIAGNOSTICS170: \$scanningtodo='$scanningtodo', loop where \$scanningtodo not matching '[349q]'\n";
                		}
                
				print  "$first_name $last_name, $phn, $description\n";
				print  "\n";
				print  "Pages scanned in but NOT YET UPLOADED TO SERVER.\n";
				print  "\n";
				print  "\n";
				print  "\n";
				print  "3) ADD MORE scanned pages with the SAME DOCUMENT type and description.\n";
				print  "\n";
				print  "4) UPLOAD THIS DOCUMENT TO THE SERVER - the document is complete.\n";
				print  "\n";
				print  "9)             DELETE the pages I just scanned and scan in the pages again.\n";
				print  "\n";
				print  "Q)             QUIT - cancel scanning in documents and exit program.\n";
				print  "\n";
				$scanningtodo=<stdin>;
                		$scanningtodo=lc $scanningtodo;
				$scanningtodo=~s/[^349q]//g;
				
				if ($scanningtodo eq 'q') {
					print  "\n";
					print  "\n";
					print "ARE YOU SURE YOU WANT TO QUIT?";
					print "THIS DOCUMENTS WILL NOT BE UPLOADED TO THE SERVER.\n";
					print  "\n";
					print  "Enter 'quit' to quit: ";
					$scanningtodo=<stdin>;
					$scanningtodo=lc $scanningtodo;
					chomp $scanningtodo;
					
					if ($scanningtodo eq 'quit') {
                        			print "\n\nGoodbye.\n\n";
						exit;
					}
					
					
				}
				
				
				if ($scanningtodo eq '9') {
					print  "\n";
					print  "\n";
					print "ARE YOU SURE YOU WANT TO DELETE THE MOST RECENT BATCH OF SCANNED PAGES?";
					print  "\n";
					print  "Enter 'delete' to DELETE BATCH: ";
					$scanningtodo=<stdin>;
					$scanningtodo=lc $scanningtodo;
					chomp $scanningtodo;
					
					if ($scanningtodo eq 'delete') {
						#delete the most recent scanned pages
						system("rm $tempdir/batch$thisbatch.*.$imageformat") || die ("Can't delete $tempdir/batch$thisbatch.*.$imageformat");
						$scanningtodo = '9';
					}
                    
                    			$scanningtodo = qw{};
				}
                
			}
		
		
			
		}
		
		
		#uplead the scanned pages
				
		# assemble into a single output file
		#convert the image files to pdf files
		opendir(TEMPDIR, $tempdir) or die $!;
		while ($image_file = readdir(TEMPDIR)) {
			#we only want files
			next unless (-f "$tempdir/$image_file");
			
			#we only want the image files
			next unless ($image_file =~ m/\.$imageformat$/);
			
                     	#convert the file via ps to pdf (or use tiff2pdf in 9.10)
                        $image_file2=$image_file;
                        $image_file2=~s/\.$imageformat$//;

                        #this conversion does not work in 9.10
                        #system("convert $tempdir/$image_file2.$imageformat $tempdir/$image_file2.ps");
                        #system("convert $tempdir/$image_file2.ps $tempdir/$image_file2.pdf");

                        system("tiff2pdf $tempdir/$image_file2.tiff > $tempdir/$image_file2.pdf");

			#convert the file via ps to pdf
			#$image_file2=$image_file;
			#$image_file2=~s/\.$imageformat$//;
			#system("convert $tempdir/$image_file2.$imageformat $tempdir/$image_file2.ps");
			#system("convert $tempdir/$image_file2.ps $tempdir/$image_file2.pdf");
		}
		closedir(TEMPDIR);

		#generate a random number for the end of the file to avoid overwriting files
		$random=rand_id();
		$outputfile="$last_name.$first_name.$description.$document.$random.pdf";
		$outputfile=~s/[^A-Z0-9\.\_\-]//gi;	
		system("pdftk $tempdir/*.pdf cat output $tempdir/$outputfile");

		#copy the resulting pdf over to the upload scanning folder on the server
		#make sure the file permissions are right first
		chmod(0666, "$tempdir/$outputfile") || die ("Can't change permissions on file $tempdir/$outputfile");
		system("scp $tempdir/$outputfile $login_id\@$serveraddress:$uploadfolder/$outputfile");
		
		# remove temporary directory and all of its contents
		system("rm -rf $tempdir");
	
		#enter the document data into the MySQL database
		%mysql_set_insert=(
			doctype                 =>  $document,
			docdesc                 =>  $description,
			docfilename             =>  $outputfile,
			doccreator              =>  $provider_no,
			program_id              =>  '-1',
			updatedatetime  	=>  $sql_datetime,
			status                  =>  'A',
			contenttype             =>  'application/pdf',
			public1                 =>  '0',
			observationdate 	=>  $document_date
		);
		mysql_set_insert('document');
	
		#get the document_no to link to the patient record
		$document_number = mysql_array_query("SELECT document_no FROM document WHERE docfilename='$outputfile'");
	
	
		#link the document to the patient record
		%mysql_set_insert=(
			module                  =>  'demographic',
			module_id               =>  $demographic_no,
			document_no             =>  $document_number,
			status                  =>  'A',
		);
		mysql_set_insert('ctl_document');



		
		#zero $newpatient while we work out what to do next
		$newpatient = 'What next?';
		
		while ($newpatient!~m/^[12q]$/i) {
            
            		if ($diagnostic) {
				print "DIAGNOSTICS180: \$scanningtodo='$scanningtodo', \$newpatient='$newpatient'; loop where \$scanningtodo not matching [12q]\n";
			}
            
			print "\n";
			print "Scan job completed.\n";
			print "\n";
			print "Document(s) uploaded to server and entered into patient's chart.\n";
			print "\n";
			print "1) Start a NEW SCAN JOB for a different patient\n";
			print "\n";
			print "2) Scan another document for $last_name, $first_name\n";
			print "\n";
			print "Q)                 Quit\n";
			print "\n";
			$newpatient=<STDIN>;
			$newpatient= lc $newpatient;
			$newpatient=~s/[^0-9q]//g;
            
            
            		if ($diagnostic) {
                		print "DIAGNOSTICS190: \$newpatient='$newpatient', exit if \$newpatient eq 'q'\n";
            		}
           
           
			if ($newpatient eq 'q') {
                		print "\n\nGoodbye.\n\n";
				exit;
			}
		}

	    }

	}

}


#disconnect from the database
mysql_disconnect();

print "\n\nGoodbye.\n\n";
                        
exit;

























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


sub header {
	system ("clear");
	print  "-----------------------------------\n";
	print  "OSCAR OLD CHART SCANNING UTILITY v$version           $login_id\n";
	print  "-----------------------------------\n";
	print  "\n" 	;
}

sub patient_details {
    print "Health#:       $phn \n";
    print "\n";
    print "Name:          $last_name, $first_name\n";
    print "\n";
}
	

sub find_scanner {
	#find out which scanner to use
	until ($device=~m/^--device-name/) {
		my @devices = `scanimage -L`;
	
		for my $this_device (@devices) {
			if ($this_device=~m/scanner/) {	
				$this_device=~m/(\`.*\')/;
				$device	= "--device-name $1";
				$device=~s/\`/\'/g;
			}
		}
		
		unless ($device=~m/^--device-name/) {
			header();
			print "No scanner detected.\n\n";
			print "Please ensure the scanner is connected and turned on, then press enter\n\n";
			$temp=<STDIN>;
			print "\n\nSearching for scanner.....";
		}
	}
	
	return $device;

}



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];
	}
    
    my $mysql_set_something_to_insert = 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) {
        if ($mysql_set_insert{$this_sql_insert}) {
            ++$mysql_set_something_to_insert;
    		$mysql_set_insert{$this_sql_insert}=~s/\'/\`/g;
        	$sql.="$this_sql_insert='$mysql_set_insert{$this_sql_insert}', ";
        }
    }
	$sql=~s/, $//;
	
    #check that at least one insert row was valid
    if ($mysql_set_something_to_insert > 0) {
    	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)
	
		#eg $bar = pad_for_tabulation($foo,'12',' ','R','');	
	
	($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;
}