#! /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 letters to patients who fail to attend appointments
#booked via OSCAR EMR
#
#It will print a warning letter the first time they FTA, and issue
#a request for payment for each missed appointment thereafter
#
#Note also that patients will be given a roster status of 'SU' for suspended
#and will have a patient status set to inactive on the second letter
#being issued.

#	 (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

#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
#
#
#This script requires a new datbase table in the OSCAR database on your
#OSCAR server (not the local machine you are running the script from).
#
#As mysql admin or root:
#
#mysql> create table no_shows (
#		no_show_id smallint unsigned not null auto_increment,
#		no_show_demographic_no int(10),
#		no_show_date date,
#		no_show_notification varchar(20),
#		no_show_notification_date datetime,
#		primary key (no_show_id)
#	);
#
#





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

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

my $max_reports_to_print='100';
my $provider_no		= '1000';
my $fta_fee		= '30.00';
my $policy_start_date	= '2009-11-23';

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/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;
my %mysql_update;
my $mysql_where;






#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 @months=qw(
    Jan
    Feb
    Mar
    Apr
    May
    Jun
    Jul
    Aug
    Sep
    Oct
    Nov
    Dec
);

my @days=qw(
    Sun
    Mon
    Tue
    Wed
    Thu
    Fri
    Sat
);



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



#get the date time
get_time();






#connect to the database
mysql_connect();




my $clinic_details = mysql_hash_query("SELECT * FROM clinic");
my $provider = mysql_hash_query("SELECT first_name, last_name FROM provider WHERE provider_no='$provider_no'");
${$provider}{'last_name'}=~s/^ //;


print "\n\nPrinting no show letters.....\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 'demographicNo',
		appointment_date,
		start_time
	FROM appointment, demographic
	WHERE demographic.demographic_no=appointment.demographic_no
	        && appointment.status LIKE 'N%' 
	        && demographic.provider_no='$provider_no'
		&& demographic.demographic_no NOT IN (
			SELECT no_show_demographic_no FROM no_shows WHERE no_show_demographic_no=appointment.demographic_no
			&& no_show_date=appointment_date
			&& (no_show_notification='letter' || no_show_notification='email')
		)
		&& appointment_date > '$policy_start_date'
	GROUP BY demographic.demographic_no
");

my @no_shows = @mysql_result;

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

for my $this_no_show (@no_shows) {
    
	++$report_number;
	$tempath = "$tempdir/report.$report_number.txt";
	
	#get details for this patient
	my $this_patient = mysql_hash_query("SELECT * FROM demographic WHERE demographic_no='${$this_no_show}{'demographicNo'}'");
	
	#check if they have failed to attend an appointment in the past
	my $failed_to_attend_before = mysql_array_query("SELECT no_show_notification FROM no_shows WHERE no_show_demographic_no='${$this_no_show}{'demographicNo'}' && (no_show_notification='letter' || no_show_notification='email')");
		
	${$this_no_show}{'start_time'}=~s/\:\d\d$//;
	(my $no_show_year, my $no_show_month, my $no_show_day) = split (/-/, ${$this_no_show}{'appointment_date'});
	my $no_show_mon = $no_show_month - 1;




	#now enter this failure into the database
	 %mysql_set_insert=(
		'no_show_demographic_no' 	=>	${$this_patient}{'demographic_no'},
		'no_show_date' 			=>	${$this_no_show}{'appointment_date'},
		'no_show_notification' 		=>	'letter',
		'no_show_notification_date' 	=>	$sql_datetime,
        );
        mysql_set_insert('no_shows');
        
        #get the reference number for this entry
	my $this_id = mysql_array_query("SELECT no_show_id FROM no_shows WHERE no_show_date='${$this_no_show}{'appointment_date'}' && no_show_demographic_no='${$this_no_show}{'demographicNo'}'");
	
	
	#if this is a subsequent failure to attend, then suspend the patient's registration
	if ($failed_to_attend_before) {
		print "          SUSPENDING PATIENT: ${$this_patient}{'first_name'} ${$this_patient}{'last_name'}\n";	
		$mysql_where="demographic_no='${$this_patient}{'demographic_no'}'";
                %mysql_update=(
			'roster_status'   =>  'SU',
			'patient_status'  =>  'IN',
                );
                mysql_hash_update('demographic');
	}


		
	#now print the letter	
	$message = "    Dr. ${$provider}{'first_name'} ${$provider}{'last_name'}\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.= "    $mday-$months[$mon]-$longyr\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "    ${$this_patient}{'first_name'} ${$this_patient}{'last_name'}\n";
	$message.= "    ${$this_patient}{'address'}\n";
	$message.= "    ${$this_patient}{'city'}  ${$this_patient}{'province'}  ${$this_patient}{'postal'}\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "Dear ${$this_patient}{'first_name'} ${$this_patient}{'last_name'},\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "_______________________________________________________________________________________\n";
	$message.= "\n";
	
	if ($failed_to_attend_before) {
		$message.= "re: FAILURE TO ATTEND - \$$fta_fee FEE\n";
	}
	
	else {
		$message.= "re: FAILURE TO ATTEND - First Notification - No Fee.\n";
	}

	$message.= "\n";
	$message.= "_______________________________________________________________________________________\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "You had an appointment with us for ${$this_no_show}{'start_time'} on $no_show_day-$months[$no_show_mon]-$no_show_year. (Appt ID# $this_id)\n";
	$message.= "\n";
	$message.= "Unfortunately, you are listed on our system as having failed to attend that appointment.\n";
	$message.= "\n";
	$message.= "It is very important that you let us know in advance if you are not going to be able to make your appointment.  This is because we are very busy and we could give your appointment to someone else who is waiting to see us.\n";
	$message.= "\n";
	
	
	
	if ($failed_to_attend_before) {
		$message.= "This is not the first appointment you have missed.\n";
		$message.= "\n";
		$message.= "There is therefore a Failure To Attend Fee.\n";
		$message.= "\n";
		$message.= "Fee Due:  \$$fta_fee \n";
		$message.= "\n";
		$message.= "In the meantime your registration has been suspended.  You should still attend any appointments you have already booked, but you will not be able to book any new appointments until this fee has been paid.  You can still attend Walk In Clinics as normal.\n";
		$message.= "\n";
		$message.= "Please make cheques payable to 'Dr R. Coull' and mark them 'Failure To Attend Fee'.  You can post a cheque to the above address, or call in in person during office hours.\n";
	}
	
	else {
		$message.= "This is the first time we have written to you about a missed appointment.  There is therefore no fee on this occasion.\n";
		$message.= "\n";
		$message.= "However, there will be a fee if you fail to attend an appointment in the future.  We charge a fee of \$$fta_fee.  You would then not be able to book any future appointments with us until that fee had been paid.\n";

	}
		
	$message.= "\n";
	$message.= "If you have received this letter in error, then please call us so we can correct the error and update our records.\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "Yours sincerely,\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "\n";
	$message.= "Dr. ${$provider}{'last_name'}'s Clinic\n";
	
	open (MESSAGE, ">$tempath");
	print MESSAGE $message;
	close (MESSAGE);
	
	print "$report_number Printing letter for ${$this_patient}{'first_name'} ${$this_patient}{'last_name'}\n";
	system ("enscript --header-font='Bookman-Demi14' --header='' --footer='' --word-wrap $tempath");



	
	if ( ($report_number >= $max_reports_to_print) || ($test_mode) ) {
		last;
	}

}


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




#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_hash_update {

	#this subroutine is passed:
	#	1. the table name ($mysql_update_table)
	#	2. a hash of elements to update (%mysql_update)
	#	3. a where statement ($mysql_where) to select which entries to 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_update_table=$_[0];
	}
	
	#get the passed table array name if passed directly
	if ($_[1]) {
		my $mysql_update_table_hash=$_[1];
		%mysql_update=%{$mysql_update_table_hash};
	}	
	
	#get the passed where string if passed directly
	if ($_[2]) {
		$mysql_where=$_[2];
	}	
	
	$mysql_preferred_user="write";
	mysql_check_connection();

	#insert this line in the database
	$error="mysql_update";
	$sql="UPDATE $mysql_update_table SET ";
	
	for my $this_sql_update (keys %mysql_update) {
		$mysql_update{$this_sql_update}=~s/\'/\`/g;
        $mysql_update{$this_sql_update}=~s/\&\#39\;/\ /g;
		$sql.="$this_sql_update='$mysql_update{$this_sql_update}', ";
	}
	$sql=~s/, $/ WHERE $mysql_where/;
    
	unless ($sql=~m/WHERE/) {
	         ErrorMessage('No where statement in update:$sql');
	         exit;
	}
    
	mysql_write_simple($sql);
	
	mysql_check_connection_finish();
	
	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;
}