[Gnumed-devel] link to a PERL script hack (used with Oscar EMR) to display waiting times

[James Busser]

For possible future consideration

http://tech.oscarpei.net/2009/08/waiting-room-display.html

The script is at

https://www.locum123.com//downloads/appt_on_time.pl.txt

..........................................................

#! /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 display which providers are consulting today and
#if they are not running to time, how late they are running

#        (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/thisscript.pl

#For this script to work you need to install perl modules
# % sudo perl -MCPAN -e shell
# cpan> install DBI
# cpan> install Date::Calc
# cpan> install File::Temp

#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 address@hidden
#    ssh -nNL 3306:127.0.0.1:3306 address@hidden &> /dev/null &
#
#which provides SSH tunnel access to the server and to the MySQL server









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

my $serveraddress       = '[enter your server address here]';
my $serverlogin         = getlogin();
my $login_id;

my %pref;
$pref{mysql_database}   = '[name of database]';
$pref{mysql_read}       = '[mysql read user login name]';
$pref{mysql_read_pass}  = '[mysql read user password]';
$pref{mysql_write}      = '[mysql write user login name]';
$pref{mysql_write_pass} = '[mysql write user password]';
$pref{mysql_host}       = '127.0.0.1';
$pref{mysql_port}       = '3306';
$pref{mysql_log}        = '/home/[your username]/mysql_log';

#uppercase output
my $uppercase_output = 1;

#screen width
my $screenwidth = 50;

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


#month variables
my @month_names = qw(
        January
        February
        March
        April
        May
        June
        July
        August
        September
        October
        November
        December
);


#month variables
my @day_names = qw(
        Sunday
        Monday
        Tuesday
        Wednesday
        Thursday
        Friday
        Saturday
);


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
















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

get_time();


#connect to the database
mysql_connect();



#get the clinic name
my $clinic = mysql_hash_query("SELECT * FROM clinic LIMIT 0,1");
if ($uppercase_output) {
        ${$clinic}{'clinic_name'} = uc ${$clinic}{'clinic_name'};
}



#search for providers that have patients booked for today
my $provider='';
my $next_patient_waiting_time;


mysql_hash_query("SELECT provider_no, first_name, last_name
        FROM provider
        WHERE provider_no IN
                (SELECT provider_no
                FROM appointment
                WHERE appointment_date=CURDATE()
                )"
        );
my @providers = @mysql_result;

my $loop = 1;

while ($loop) {
        
        get_time();
        
        system ("clear");
        print ' '.'_'x$screenwidth."\n";
        print " ${$clinic}{'clinic_name'}\n";
        print " $day_names[$wday] $mday $month_names[$mon] $longyr $hr:$min 
hrs\n";
        print ' '.'_'x$screenwidth."\n";
        print "\n";
        print " CONSULTING TODAY:\n";
        print "\n";
        
        for my $provider (@providers) {
                
                #skip providers who's name starts with an _
                my $this_provider = "${$provider}{'last_name'}, 
${$provider}{'first_name'}";
                
                unless ($this_provider=~/^_/) {
                
                        $this_provider=~s/_/ /g;
                        while ($this_provider=~/^[^A-Z]/i) {
                                $this_provider=~s/^[^A-Z]//i;
                        }
                        
                        $this_provider = pad_for_tabulation($this_provider, 22, 
'.', 'L', 0);           
                        if ($uppercase_output) {
                                $this_provider = uc $this_provider;
                        }
                        
                        print " $this_provider";
                        
                        #check to see if this provider has seen all of their 
booked patients
                        my $patients_to_see = mysql_hash_query("SELECT 
provider_no FROM provider
                                WHERE provider_no IN
                                        (SELECT provider_no FROM appointment
                                        WHERE appointment_date=CURDATE()
                                        && (status='H' || status='P')
                                        )
                                ");
                        
                        $patients_to_see = ${$patients_to_see}{'provider_no'};
                        
                        
                        if ($patients_to_see) {
                        
                                #work out if this provider is running late
                                $next_patient_waiting_time = 
mysql_hash_query("SELECT TIMEDIFF(start_time, CURTIME()) AS 'late'
                                        FROM appointment
                                        WHERE 
provider_no='${$provider}{'provider_no'}'
                                        && appointment_date=CURDATE()
                                        && status='H'
                                        ORDER BY start_time
                                        LIMIT 0,1"
                                );
                                
                                $next_patient_waiting_time = 
${$next_patient_waiting_time}{'late'};
                                
                                #check if this provider has any patients waiting
                                if ($next_patient_waiting_time) {
                                        
                                        #translate the 'hh:mm:ss' late return 
into minutes
                                        (my $late_hrs, my $late_mins, my 
$late_secs) = split (/:/, $next_patient_waiting_time);
                                        
                                        
                                        if ($late_hrs=~s/^\-//) {
                                                #this was a negative time, so 
the provider is running late
                                                my $minutes_late = 
($late_hrs*60)+$late_mins;
                                                $next_patient_waiting_time = " 
running $minutes_late min".'s'x($minutes_late>1)." late";

                                        }
                                        
                                        else {
                                                #patient waiting has not 
reached their booked time yet, so doctor on time
                                                $next_patient_waiting_time = ' 
running on time';
                                        }
                                        
                                }
                                
                                else {
                                        #no patients waiting, so on time by 
definition
                                        $next_patient_waiting_time = ' running 
on time';
                                }
                                
                
                        }
                        
                        else {
                                #no patients to see
                                $next_patient_waiting_time = ' running on time';
                        }
                        
                        
                                
                        if ($uppercase_output) {
                                $next_patient_waiting_time = uc 
$next_patient_waiting_time;
                        }
                        print $next_patient_waiting_time;
                        
                        print "\n";
                        
                }
                
        }


        sleep 60;

}


#disconnect from the database
mysql_disconnect();

print "\n\n\n";

exit;

























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


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; }
                $sql_data=~s/\s/ /g;
                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()) {
                        @address@hidden;
                }
                
        } 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;
}