• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
notifies billing department of new referral locations on 1st use, including
amendment of referral location any time after registration
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 1; # 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_sources registered or amended yesterday:
my $referral_sources = _get_referral_sources(); # warn Dumper $referral_sources;

my @new_locations;

# to query whether referral source been used before:
my $sql = $sql_lib->retr('referral_source_seen');
for my $location (@$referral_sources) { # warn $location->{display_name};
    my $date = $location->{reg_date}; # of request associated with location
    my $id = $location->{id}; # warn Dumper [$location->{display_name}, $id];

    next if $dbix->query($sql, $id, $date)->list; # next if already seen

    my $xl = LIMS::Local::ExcelHandler->new(); # $self->debug($xl);
    $xl->source($location->{description});
	
    # array of hashrefs:
    my $match = $xl->parse($location->{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 => $location->{organisation_code},
            display => $location->{display_name},
        );
        push @new_locations, \%data;
    }
} # warn Dumper \@new_locations;

exit unless @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_referral_sources {
    my $request_ids = _get_request_ids(); # warn Dumper $request_ids;
    my $referral_sources = []; # caller expects arrayref
    
    if ( my @ids = @$request_ids ) { # maybe none found (eg weekend/holiday)
        my $sql = $sql_lib->retr('unique_referral_sources');
        $referral_sources = $dbix->query($sql, @ids)->hashes; # warn Dumper $referral_sources;
    }
    return $referral_sources;
}

sub _get_request_ids {
    my $sql = $sql_lib->retr('unique_referral_source_request_ids');
    my $ids = $dbix->query($sql)->flat; # warn Dumper $ids;
    return $ids; 
}