#!/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; }