• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
emails list of errors (action contains 'modified' or 'recorded error code' for
# previous week
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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

############ recipients from contacts.lib ######################################
my @recipients = qw( lynda.blythe.secure raj.secure );
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 DateTime;
use Data::Dumper;
use DateTime::Format::MySQL;
use LIMS::Local::ScriptHelpers;

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

#-------------------------------------------------------------------------------
my $date    = $tools->time_now->dmy;
my $subject = "HILIS errors week ending $date";
#-------------------------------------------------------------------------------

my $sql_lib  = $tools->sql_lib();
my $config   = $tools->config(); 
my $dbix     = $tools->dbix();

my $query = $sql_lib->retr('error_log');
    
my @terms = qw(LName FName PatNo NHSNo DoB Specimen Source Clinician BlockRef
    Private Urgent Store Treatment Research Monitor );
my $regexp = join '|', @terms;

$query =~ s/%REGEXP%/$regexp/; # warn $query; exit;

my $result = $dbix->query($query, $duration);

my (@rows, @err_code_ids);

while (my $ref = $result->hash) { # warn Dumper $vars; next;
    # get original registering user (can't combine this with query??):
    _get_registration_user($ref);
    _get_labno($ref);
    
    $ref->{error_action} = $ref->{err_code_action} =~ /recorded (error code .*)/;
    
    push @rows,
        [ @{$ref}{ qw(time modifier action error_action labno register_user) } ];
    push @err_code_ids, $ref->{err_code_id}; # don't want this err code again
} # warn Dumper \@err_code_ids;

{ # now get error codes without modification entries in history log:
    my $sql = $sql_lib->retr('error_log_non_modification');
    my $result = $dbix->query($sql, $duration);
    while ( my $ref = $result->hash ) {
        next if grep $ref->{id} == $_, @err_code_ids; # can't do (??) as using for duration
        # get original registering user (can't combine this with query??):
        _get_registration_user($ref);
        _get_labno($ref);
        
        push @rows, [ @{$ref}{ qw(time modifier action labno register_user) } ];
    }
}

my $msg = join "\n", map { join ' | ', @$_ } sort by_time @rows;
# print $msg; exit;

my %mail = (		
	config  => $config,
	message => $msg,
	subject => $subject, 	
); # warn Dumper \%mail;

$tools->send_mail(\%mail, \@recipients);

sub _get_registration_user {
    my $ref = shift;
    
    my $sql = q!select UCASE(username) from request_history rh join users u on
        rh.user_id = u.id where rh.request_id = ? and rh.action = 'registered'!;
    $dbix->query($sql, $ref->{id})->into($ref->{register_user});    
}

sub _get_labno {
    my $ref = shift;
    
    $ref->{labno} = sprintf 'H%s/%s',
        $ref->{request_number}, $ref->{year} - 2000;
}

sub by_time {
    my $dtA = DateTime::Format::MySQL->parse_datetime($a->[0]);
    my $dtB = DateTime::Format::MySQL->parse_datetime($b->[0]);
    
    return DateTime->compare( $dtA, $dtB );
}