package LIMS::Model::Audit;
use Moose;
with (
'LIMS::Model::Roles::Query', # get_sql_with_constraint(), get_relationships(), sql_lib()
'LIMS::Model::Roles::DBIxSimple', # get_sql_with_constraint()
);
extends 'LIMS::Model::Base';
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable;
use Data::Dumper;
use LIMS::Local::Utils;
#-------------------------------------------------------------------------------
sub turnaround_times {
my $self = shift;
my $vars = shift; # warn Dumper $vars; # hashref eg selection = 'specimen'
$self->params($vars);
my $dbix = $self->lims_dbix;
# for calculation of delta workings days:
my $delta_days = sub { LIMS::Local::Utils::delta_business_days(@_) };
my %h = (
pnh => [ 'PNH', 'PNH (PB)' ],
hiv => [ 'HIV', 'HIV monitoring' ],
cmp => [ 'Community monitoring', 'Outreach' ],
mol => [
qw/CMPD Chimerism Molec/, 'CML follow-up', 'Follow-up CML (PB)'
],
);
my $sql_lib = $self->_get_sql_lib_entry_for_selection($vars->{selection});
my @attr = ($sql_lib, 'h1.time'); # h1.action = 'reported'
my $sql = $self->get_sql_with_constraint(@attr); # warn $sql; return 1;
my $query = $dbix->query( $sql ); # warn Dumper $query;
my %data = (); # controller needs array for sorting, but easier to create hashref for 'count'
while ( my $vars = $query->hash ) {
my $sample = $vars->{sample_code}; # warn $sample;
my $screen = $vars->{description};
# need to split PB's according to request:
if ($sample eq 'PB') {
if ( grep $screen eq $_, @{ $h{hiv} } ) { $sample = 'PB [HIV]' }
elsif ( grep $screen eq $_, @{ $h{pnh} } ) { $sample = 'PB [PNH]' }
elsif ( grep $screen eq $_, @{ $h{cmp} } ) { $sample = 'PB [CMP]' }
elsif ( grep $screen =~ /^$_/, @{ $h{mol} } )
{ $sample = 'PB [Mol]' }
} # warn $screen if $sample eq 'PB [PNH]';
$data{$sample}{count}++; # increment specimen count
# get registered, reported & authorised dates; using DATE_FORMAT in sql
# MUCH faster than dt conversion afterwards:
my ($registered, $reported, $authorised)
= @{$vars}{ qw(registered reported authorised) };
# calculate registered => reported & registered => auth'ed durations:
my $delta = &$delta_days($registered, $reported);
$data{$sample}{delta_report} += $delta;
if ($authorised) { # if using authorisation stage
my $delta = &$delta_days($registered, $authorised);
$data{$sample}{delta_authorise} += $delta;
}
} # warn Dumper \%data;
my $title = $self->constraint_title; # set in Role _set_search_constraints()
return (\%data, $title); # return array format
}
#-------------------------------------------------------------------------------
sub nhs_number_supplied {
my $self = shift;
my $vars = shift || {}; # will be empty on 1st call
$self->params($vars);
my $dbix = $self->lims_dbix;
my $dbh = $self->lims_db->dbh; # warn Dumper $dbh;
# exempted NHS number:
if ( my $yaml = $self->get_yaml_file('nhs_number_exempt') ) { # warn Dumper $yaml;
my $clinical_trials = $yaml->{clinical_trial};
my $presentation = $yaml->{presentation};
my $screens = join ',', map $dbh->quote($_), @$presentation;
my $trials = join ',', map $dbh->quote($_), @$clinical_trials;
$self->add_constraint( qq!s.description NOT IN ($screens)! );
$self->add_constraint( qq!ct.trial_name NOT IN ($trials)! );
}
my @attr = ('nhs_number_compliance', 'r.created_at');
my $sql = $self->get_sql_with_constraint(@attr); # warn $sql;
my $data = $dbix->query( $sql )->hashes; # warn Dumper $data;
my $title = $self->constraint_title; # set in Role _get_search_constraints()
return ($data, $title); # return array format
}
#-------------------------------------------------------------------------------
sub teaching_cases {
my $self = shift;
my $days = shift; # default is 365
my $dbix = $self->lims_dbix;
my $sql = $self->sql_lib->retr('teaching_cases');
my $data = $dbix->query($sql, $days)->hashes; # warn Dumper $data;
return $data;
}
#-------------------------------------------------------------------------------
sub user_workload {
my ($self, $args) = @_; # warn Dumper $args;
my $actions = $args->{action}; # arrayref
$self->params($args->{vars});
my @attr = ('user_workload_stats', 'rh.time', 'one_month');
my $sql = $self->get_sql_with_constraint(@attr); # warn $sql;
my $dbix = $self->lims_dbix;
my $data = $dbix->query( $sql, @$actions )->hashes; # warn Dumper $data;
return {
title => $self->constraint_title, # set in get_date_constraints()
stats => $data,
};
}
#-------------------------------------------------------------------------------
sub revised_diagnoses {
my $self = shift;
my $vars = shift || {}; # will be empty on 1st call (except sort_by)
$self->params($vars);
my $dbix = $self->lims_dbix;
my $revisions;
{ # get revised diagnoses over duration:
my @attrs = ('revised_diagnoses', 'dh.time', 'one_month'); # default to 1 month
my $sql = $self->get_sql_with_constraint(@attrs); # warn $sql;
$revisions = $dbix->query($sql)->hashes; # warn Dumper $revisions;
}
my @request_ids = map $_->{id}, @$revisions; # before $revisions gets revised!!
my %data = (
request_ids => \@request_ids,
);
my $constraint = join ' AND ', $self->all_constraints; # set in Role::get_sql_with_constraint
$constraint =~ s/\w+\.(\w+)/$1/; # remove alias - only have 1 table to search
my $sql = qq!select count(*) from request_history where $constraint
and action = 'reported'!; # warn $sql;
{ # get total reported over duration:
my $total = $dbix->query($sql)->list;
$data{total_reported} = $total;
}
# need to manipulate & extend $revisions data if either apply:
if ( grep $vars->{sort_by} eq $_, qw(reporter reviser) ) {
my $data = $self->_sort_revisions($revisions); # sort data
$data{revisions} = $data;
if ( my @usernames = keys %$data ) { # will be empty if no revisions
my $users = LIMS::DB::User::Manager->get_users(
query => [ username => \@usernames ]
);
{ # add user_details to %data:
my %user_details = map { $_->{username} => $_ } @$users;
$data{user_details} = \%user_details;
}
# add user contstraint to $sql:
$sql .= q! and user_id = ?!;
{ # need report count for each user:
for (@$users) {
my $username = $_->username;
my $user_id = $_->id;
my $report_count = $dbix->query($sql, $user_id)->list;
$data{user_report_counts}{$username} = $report_count;
}
}
}
}
else {
$data{revisions} = $revisions;
}
my $title = $self->constraint_title; # set in Role _get_search_constraints()
return (\%data, $title); # return array format
}
# ------------------------------------------------------------------------------
sub _sort_revisions {
my $self = shift;
my $data = shift; # warn Dumper $data;
my $functionary = $self->params->{sort_by}; # reporter / reviser
my %sorted;
for my $event (@$data) { # warn Dumper $event;
my $user = $event->{$functionary}; # ie reporter / reviser
push @{ $sorted{$user} }, $event; # warn Dumper $user;
}
return \%sorted;
}
#-------------------------------------------------------------------------------
sub _get_sql_lib_entry_for_selection { # remove this if not selecting by specimen, location, etc
my ($self, $selection) = @_;
my %t = (
specimen => 'turnaround_times_specimen',
);
my $lib_entry_name = $t{$selection};
# have to modify lib_entry_name if authorisation stage not in use:
if (! $self->does_authorisation) {
$lib_entry_name .= '_no_authorisation';
}
return $lib_entry_name;
}
1;
