• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
emails list of errors (rh.action contains 'recorded error code') for previous week
patient edits too difficult to relate back to request to get original regsitrant
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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

############ recipients from contacts.lib ######################################
my @recipients = qw( lynda.blythe.secure raj );
my $duration = 7; # over past number of days
################################################################################

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

use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
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 (@rows, @seen);

=begin # not using for hilis4:
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);
while (my $ref = $result->hash) { # warn Dumper $vars; next;
    { # get some vals:
        _get_registration_user($ref);
        _get_error_action($ref);
        _get_labno($ref);
    }
    my @fields = qw(time modifier action error_action labno register_user);
    push @rows, [ @{$ref}{@fields} ];

    push @seen, $ref->{err_history_id}; # don't want this entry again
} # warn Dumper \@err_code_ids;
=cut

{ # get error codes entries in history log:
    my $sql = $sql_lib->retr('request_history_error_codes');
    my $result = $dbix->query($sql, $duration);
    while ( my $ref = $result->hash ) {
        # skip error code entries already collected:
#        next if grep $ref->{request_history_id} == $_, @seen; # not using
        
        {  # get some vals:
            _get_registration_user($ref);
            _get_labno($ref);
        }        
        my @fields = qw(time modifier action labno register_user);
        push @rows, [ @{$ref}{@fields} ];
    }
}

=begin # too difficult to relate patient_edit back to request for registrant
{ # patient edits:
    my $sql = $sql_lib->retr('error_log_patient_edits');
    # see M::History::_parse_patient_history_for_changes for details
}
=cut

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->{request_id})->into($ref->{register_user});    
}

sub _get_error_action {
    my $ref = shift;
    
    my ($error_action) = $ref->{err_code_action} =~ /recorded (error code .*)/;
    $ref->{error_action} = $error_action;
}

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 );
}