• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
notifies billing department of new referrers and referral locations - uses
new_national_codes table - updated automatically on insert of new referrer or
location via triggers. Modified 28/8/13 to skip referrers in new_national_code
with no corresponding entry in referrer_department (due to change or deletion
before script runs); any subsequent 1st use of referrer OK as do_new_referrer
does a 'replace into' insert which updates new_national_code.created_at to NOW()
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 0; # email to ra.jones only

use lib '/home/raj/perl5/lib/perl5';
use Data::Dumper;

use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Local::ScriptHelpers;
use LIMS::Local::ExcelHandler;

my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

############ recipients from contacts.lib ######################################
my @recipients = qw( pathology.coding raj );
my $duration = 1; # days
################################################################################

# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib();
my $config  = $tools->config();
my $dbix    = $tools->dbix();

# email subject line:
my $subject = 'New HILIS National Codes';

# get list of new national codes registered yesterday:
my $codes = _get_new_codes(); # warn Dumper $codes;
exit unless @$codes;

my %data;
CODE: for my $entry (@$codes) { # warn Dumper $entry;
	my $national_code = $entry->{national_code}; # warn $national_code;

	if ( $entry->{type} eq 'referrer' ) {
		my $sql = $sql_lib->retr('new_referrer'); # warn $sql;
		# get data or skip if empty - possible if new referrer added, then changed before
		# script runs, or request registered then deleted - see 17918/13 in deleted_requests
		# table and 2013-08-27 13:17:23 entry for new_national_code
		my $data = $dbix->query( $sql, $national_code )->hash || next CODE; # warn Dumper $data;

		{ # get location details from CfH files using org-code:
			my $location_code = $data->{organisation_code};
			$data->{location_name} = _get_location_name($location_code);
		} # warn Dumper $data;

		my @fields = qw( national_code name department organisation_code
			location_name ); # parent_code organisation - getting actual location now

        my $row = sprintf '%s, %s, %s, %s, %s', @{$data}{@fields};
		push @{ $data{referrer} }, $row;
	}
	else { # location - do CfH data lookup for more details than ref_src tbl:
		my $location_name = _get_location_name($national_code); # warn $location_name;

		my $row = join ', ', $national_code, $location_name;
		push @{ $data{location} }, $row;
	}
} # warn Dumper \%data; exit;

exit unless %data;

my $message_body;

if ( my $referrer = $data{referrer} ) {
	$message_body .= "Referrer:\n";
	$message_body .= join "\n", @$referrer;
	$message_body .= "\n\n";
}

if ( my $location = $data{location} ) {
	$message_body .= "Location:\n";
	$message_body .= join "\n", @$location;
	$message_body .= "\n\n";
}

my %mail = (
	config  => $config,
	message => $message_body,
	subject => $subject,
); # warn Dumper \%mail; # next;

$tools->send_mail(\%mail, \@recipients);

sub _get_new_codes {
    my $sql = $sql_lib->retr('new_national_code');
    my $data = $dbix->query($sql, $duration)->hashes; # warn Dumper $data;
    return $data;
}

sub _get_location_name {
	my $national_code = shift; # warn $national_code;

	my $sql = $sql_lib->retr('new_location');
	my $data = $dbix->query($sql, $national_code)->hash; # warn Dumper $data;

    my $xl = LIMS::Local::ExcelHandler->new(); # $self->debug($xl);
	$xl->source($data->{description});

    my $location = $xl->parse($national_code); # warn Dumper $location;

    # if location type NOT hospital or practice, @$location will be empty
    unless (@$location) { # try some more CfH data files:
        my @CfH = qw(trust scot-org NI-org branch independant prison);
        for my $type (@CfH) { # warn $type;
            $xl->source($type);
            $location = $xl->parse($national_code); # warn Dumper $location;
            last if @$location;
        }
    }
    # as last resort, do referral_sources table lookup:
    unless (@$location) {
        my $sql = q!select display_name as 'display' from referral_sources where
            organisation_code = ?!; # create same data structure (AoH) as $xl->parse():
        $location = $dbix->query($sql, $national_code)->hashes;
    }

    my $location_name = $location->[0]->{display}; # warn $location_name;
    return uc $location_name; # inconsistent capitalisation in CfH files
}