#!/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 @locations = qw( Hull ); # MUST MATCH ################################################################################ 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 contents of email_contacts table: my $email_contacts = get_active_email_contacts(); # AoH # get date yesterday - handles BST: my $yesterday = $tools->date_subtract(days => 1)->dmy('/'); # warn $yesterday; exit; my $requests = $sql_lib->retr('requests_received'); # my $reports = $sql_lib->retr('reports_dispatched'); # enable if required #------------------------------------------------------------------------------- # 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 $subject = "Requests registered at HMDS on $yesterday"; do_requests( $request_ids, \@contacts, $subject ) if @$request_ids; } =begin { # reports dispatched: my $request_ids = $dbix->query($reports, @bind)->flat; my $subject = "Reports dispatched from HMDS on $yesterday"; do_requests( $request_ids, \@contacts, $subject ) if @$request_ids; } } =cut } sub do_requests { my ($request_ids, $contact, $subject) = @_; # warn Dumper [$request_ids, $contact]; my $sql = $sql_lib->retr('requests_and_reports'); my $requests = $dbix->query($sql, @$request_ids)->arrays; # warn Dumper $requests; # email message body row format: my $row_format = "%-12s %-12s %-12s %-10s %-11s %-10s %-10s [%s]\n"; my $message_body = sprintf $row_format, qw( LastName FirstName DoB NHSNumber UnitNumber Source Referrer Dept); $message_body .= sprintf $row_format, @$_ for @$requests; my %mail = ( config => $config, message => $message_body, subject => $subject, ); # warn Dumper \%mail; exit; # $tools->send_mail(\%mail, $contact); } 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; push @required, $contact; } return \@required; }