• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends summary of requests received and reports disptched to MDT contact for centre
using YEARWEEK(<date>, 1) to make Monday = 1st dow, so week = Monday - Sunday
# see example script after __END__
=cut ---------------------------------------------------------------------------

use Getopt::Std;
getopts('d:'); # days
our($opt_d); # warn $opt_d; exit;

use strict;
use warnings;

my $JUST_TESTING = 0; # dumps contents to file and sets recipient to raj

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

use lib '/home/raj/perl5/lib/perl5';
use Data::Dumper;
use DateTime::Format::MySQL;

use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;

use vars qw($fh);

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 $received    = $sql_lib->retr('requests_received');
my $authorised  = $sql_lib->retr('requests_authorised');
my $requests    = $sql_lib->retr('requests_and_reports');
#-------------------------------------------------------------------------------

if ($JUST_TESTING) { # only open $fh if needed:
    open $fh, '>', "$Bin/requests_and_reports.html" or die $!;
}

# go:
{
    ENTRY: # loop through each contact and get request_id's as required:
    for my $recipient (@$email_contacts) { # warn Dumper $recipient;
        my $location = $recipient->{display_name};
        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;

		my %data = (
			location => $location,
			contact  => \@contacts, #arrayref
		);

        { # requests received:
            my $request_ids = $dbix->query($received, @bind)->flat;
            if (@$request_ids) {
                my $results = $dbix->query($requests, @$request_ids)->hashes;
                to_datetime($results); # convert mysql dates
                $data{requests}{registered} = $results;
            }
        }
        { # reports authorised:
            my $request_ids = $dbix->query($authorised, @bind)->flat;
            if (@$request_ids) {
                my $results = $dbix->query($requests, @$request_ids)->hashes;
                to_datetime($results); # convert mysql dates
                $data{requests}{authorised} = $results;
            }
        }

        do_requests(\%data);
    }
}

sub do_requests {
    my $args = shift; # hashref

    my $requests = $args->{requests}; # hashref
	my $location = $args->{location};
	my $contact  = $JUST_TESTING
        ? ['ra.jones@nhs.net'] # expects arrayref
        : $args->{contact};

    my $tt_file = 'cron/requests_and_reports.tt';
    my $message_body = $tools->process_template($tt_file, $requests);

    my $subject = "$location HMDS requests since $date";

	my %mail = (
		config  => $config,
        content => 'html',
		message => $message_body,
		subject => $subject,
	); # warn Dumper \%mail; exit;

	if ($fh) {
		print $fh $message_body; # return;
	}
    $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;
}

sub to_datetime {
    my $data = shift; # AoH

    my $dfm = DateTime::Format::MySQL->new();

    for (@$data) {
        my $registered = $dfm->parse_date($_->{registered}); # always exists
        $_->{registered} = $registered;

        if ( my $authorised = $_->{authorised} ) {
            $_->{authorised} = $dfm->parse_date($authorised);
        }

        if ( my $dob = $_->{dob} ) {
            $_->{dob} = $dfm->parse_date($dob);
        }
    }
}

__END__

use DateTime;
use LIMS::Local::ScriptHelpers;

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

my $date = DateTime->new( year => 2011, month => 1, day => 1 );

for (0 .. 365) {
	my $inc = $date->clone->add(days => $_);
	$dbix->query( "select yearweek(?, 1)", $inc->ymd )->into( my $yr_week );
	my $day = join ' ', $inc->day_abbr, $inc->ymd;
	warn "$day: $yr_week";
}