• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
notifies billing department of new referral locations on 1st use
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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

BEGIN {
    use FindBin qw($Bin); # warn $Bin;
    use lib (
        "$Bin/../../../lib",
        '/home/raj/perl5/lib/perl5',
    );
}

use Data::Dumper;
use LIMS::Local::ExcelHandler;
use LIMS::Local::ScriptHelpers;

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

############ recipients from contacts.lib ######################################
my @recipients = qw( katie.wheatley tim.branch philip.keogh raj );
################################################################################

# 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 Referral Source";

# get list of referral_source ids where location only used once:
my $ids = _get_single_use_referral_sources();

# get id(s) of single_use referral_sources registered yesterday:
my $sql = $sql_lib->retr('new_referral_sources');
my $locations = $dbix->query($sql, @$ids)->hashes;

exit unless @$locations; # warn Dumper $locations;

my @new_locations;

for my $d(@$locations) {
    my $xl = LIMS::Local::ExcelHandler->new(); # $self->debug($xl);
    $xl->source($d->{description});
	
    # array of hashrefs:
    my $match = $xl->parse($d->{organisation_code}); # warn Dumper $matches;
    
    # check only 1:
    if ( scalar @$match == 1 ) {
        push @new_locations, $match->[0];
    }
    else { # not hospital or practice, or > 1 match for org_code:
        my %data = (
            code => $d->{organisation_code},
            display => $d->{display_name},
        );
        push @new_locations, \%data;
    }
} # warn Dumper \@new_locations;

my $message_body = join "\n",
    map { join ', ', @{$_}{qw(code display)} } @new_locations;

my %mail = (		
	config  => $config,
	message => $message_body,
	subject => $subject, 	
); # warn Dumper \%mail; # next;
    
$tools->send_mail(\%mail, \@recipients);

sub _get_single_use_referral_sources {
    my $sql = $sql_lib->retr('single_use_referral_sources');
    my $ids = $dbix->query($sql)->flat;
    return $ids;    
}