• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends summary of requests received and reports disptched to MDT contact for centre
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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

############ display_name from email_contacts table ############################
my @skip_locations = qw( ); # don't want to receive lists - display_name MUST match
my $duration = 7; # over past number of days
################################################################################

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

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

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

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

#-------------------------------------------------------------------------------
# get all locations with mdt contacts:
my $locations = get_mdt_centres(); # warn Dumper $locations; exit;
# get email_contacts for above list (excluding any @skip_locations):
my $email_contacts = get_active_email_contacts(); # warn Dumper $email_contacts; # AoH

# get date from:
my $date = $tools->date_subtract( days => $duration )->dmy;

# get queries:
my $requests = $sql_lib->retr('requests_received');
my $reports  = $sql_lib->retr('requests_reported');

# columns for email:
my @fields = qw( LastName FirstName DoB NHSNumber UnitNumber Source Referrer
    Dept Date );
#-------------------------------------------------------------------------------

# substitute date restriction in sql (using 'IN' for rs.id so can't use placeholder)
s/%days%/$duration/ for ($requests, $reports); # warn Dumper [$requests,$reports];

# go:
{   
    ENTRY: # loop through each contact and get request_id's as required:
    for my $recipient (@$email_contacts) { # warn Dumper $recipient;
        my $src_id = $recipient->{referral_source_id};
        my $scope  = $recipient->{scope}; # dept, hospital or organisation

        # using GROUP_CONCAT on contact_address to avoid repeat data retrieval:
        my @contacts = split ',', $recipient->{contacts}; # maybe > 1

        my @bind = ($src_id); # need at least local ref_src_id

        # info can be for hospital or organisation:
        if ( $scope eq 'organisation' ) {
            # find all ref_src's under parent_organisation of ref_src_id:
            my $sql = q!select id from referral_sources where parent_organisation_id
                in ( select parent_organisation_id from referral_sources where id
                = ? )!;
            my $ref_src_ids = $dbix->query( $sql, $src_id )->flat;
            # add other ref_src_ids for this parent:
            push @bind, grep $_ != $src_id, @$ref_src_ids;     
        } # warn Dumper \@bind;     

        { # requests received:
            my $request_ids = $dbix->query($requests, @bind)->flat;
            my $action = 'registered';
            do_requests( $request_ids, \@contacts, $action ) if @$request_ids;
        }

        { # requests authorised:
            my $request_ids = $dbix->query($reports, @bind)->flat;
            my $action = 'authorised';
            do_requests( $request_ids, \@contacts, $action ) if @$request_ids;
        }
    }
}

sub do_requests {
    my ($request_ids, $contact, $action) = @_; # warn Dumper [$request_ids, $contact];
    
    my $sql = $sql_lib->retr('requests_and_reports');
    my $requests = $dbix->query($sql, @$request_ids)->arrays; # warn Dumper $requests;
    
    return unless @$requests;
    
    # email message body row format:
    my $row_format = "%-12s %-12s %-12s %-10s %-11s %-10s %-10s [%s] %s\n";
    
    my $subject = sprintf 'Requests %s at HMDS since %s', $action, $date;
    
    my $message_body = uc sprintf "Requests %s [%s]:\n\n",
        $action, scalar @$requests; 
    $message_body .= sprintf $row_format, @fields; # headers
    {
        no warnings 'uninitialized'; # dob, nhs number, etc
        $message_body .= sprintf $row_format, @$_ for @$requests;
    } # warn Dumper $message_body;
    
	my %mail = (		
		config  => $config,
		message => $message_body,
		subject => $subject, 	
	); # warn Dumper \%mail; exit;
    
    # $tools->send_mail(\%mail, $contact);
}

sub get_mdt_centres {
    my $sql = q!select distinct(display_name) from email_contacts where
        type = 'mdt' and is_active = 'yes'!;
    my $results = $dbix->query($sql)->flat;
    return $results;
}

sub get_active_email_contacts { # get array of hashrefs of location/scope => email:
    my $sql = $sql_lib->retr('get_email_contacts');
    my $results = $dbix->query($sql, 'mdt')->hashes; # warn Dumper $email_contacts;
    
    my @required = (); # only return data for required locations:
    for my $contact (@$results) {
        next unless grep $contact->{display_name} eq $_, @$locations;
        next if grep $contact->{display_name} eq $_, @skip_locations;
        push @required, $contact;
    }
    return \@required;
}