package LIMS::Controller::Audit;
use Moose;
BEGIN { extends 'LIMS::Base'; }
with (
'LIMS::Controller::Roles::Misc',
'LIMS::Controller::Roles::SessionStore',
);
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use Data::Dumper;
use Statistics::Descriptive;
# ------------------------------------------------------------------------------
# default() should never be called direct - redirect to start page:
sub default : StartRunmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->redirect( $self->query->url );
}
# ------------------------------------------------------------------------------
sub turnaround : Runmode { # calculates as average and 95th-percentile
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $selection = $self->param('id'); # eg specimen_type, location, etc
my $calc_method = $self->param('Id'); # average, 95th-percentile
my $vars = $self->query->Vars();
$vars->{selection} = $selection; # warn Dumper $vars;
my ($data, $title, $parsed, $tt);
if ( $calc_method eq 'average' ) {
($data, $title)
= $self->model('Audit')->turnaround_times_average($vars);
# sort data by requested field (defaults to specimen type):
$parsed = $self->_sort_turnaround_data_average($data); # AoH (sorted)
$tt = 'audit/turnaround_average.tt';
}
elsif ( $calc_method eq 'percentile' ) {
($data, $title)
= $self->model('Audit')->turnaround_times_percentile($vars);
$parsed = $self->_calc_turnaround_data_percentile($data);
$tt = 'audit/turnaround_percentile.tt';
}
$self->tt_params(
data => $parsed,
title => $title,
start_date => $self->model('Request')->get_first_request_date(),
);
return $self->tt_process($tt);
}
# ------------------------------------------------------------------------------
sub turnaround_chart : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $specimen = $self->param('id');
my $vars = $self->query->Vars();
$vars->{specimen} = $specimen; # warn Dumper $vars;
my ($data, $title) = $self->model('Audit')->turnaround_times_chart($vars); # warn Dumper $data;
# warn Dumper [ LIMS::Local::Utils::n_sort($data) ]; # to dump for manual calculation
my $stat = Statistics::Descriptive::Full->new();
$stat->add_data(@$data);
my %s = ( chart_title => $title ); # for session
{ # generate frequency data & add to session for chart:
my $unique = LIMS::Local::Utils::get_unique_elements($data); # warn Dumper $unique;
my @monotonic = LIMS::Local::Utils::n_sort($unique); # warn Dumper \@monotonic;
my %f = $stat->frequency_distribution(\@monotonic); # warn Dumper \%f;
# require every x-axis val from 0 to max to get 95th percentile line consistent:
my $max_val = LIMS::Local::Utils::get_max_val(\@monotonic);
$f{$_} ||= 0 for ( 0 .. $max_val ); # so chart doesn't skip empties
$s{chart_data} = \%f;
}
# callback for .tt (call in scalar context to get value only):
my $x_percentile = sub { my $x = $stat->percentile(@_); $x };
$self->tt_params( x_percentile => $x_percentile );
my $ninety_five = $stat->percentile(95); # call in scalar context
my %stats = (
count => $stat->count(),
mean => $stat->mean(),
sum => $stat->sum(),
median => $stat->median(),
mode => $stat->mode(),
range => $stat->sample_range(),
marker => $ninety_five,
std_dev => $stat->standard_deviation(),
variance => $stat->variance(),
);
$s{chart_stats} = \%stats;
# add all _turnaround_chart_* to session:
$self->session->param( _turnaround_chart => \%s );
$self->tt_params(
start_date => $self->model('Request')->get_first_request_date(),
stats => \%stats,
);
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub nhs_number : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars();
my ($data, $title) = $self->model('Audit')->nhs_number_supplied($vars);
$self->tt_params(
data => $data,
title => $title,
start_date => $self->model('Request')->get_first_request_date(),
);
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub revised_diagnoses : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars(); # warn Dumper $vars;
$vars->{sort_by} ||= 'date'; # temp. until constraints can pass env vars
my ($data, $title) = $self->model('Audit')->revised_diagnoses($vars);
my $total_reported = $data->{total_reported}; # count
my $user_reported = $data->{user_report_counts}; # if sort_by ne 'date'
my $user_details = $data->{user_details}; # if sort_by ne 'date'
my $revisions = $data->{revisions}; # arrayref; maybe manipulated below, so:
my $request_ids = $data->{request_ids}; # arrayref
my $rev_count = scalar @$request_ids; # revisions count
# get specimens map:
my $specimen_map = $self->specimen_map($request_ids);
$self->tt_params(
total_count => $total_reported,
specimen_map => $specimen_map,
user_details => $user_details,
user_counts => $user_reported,
rev_count => $rev_count,
revisions => $revisions,
title => $title,
sort_by => $vars->{sort_by},
start_date => $self->model('Request')->get_first_request_date(),
);
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub user_workload : Runmode {
my $self = shift;
my $vars = $self->query->Vars(); # warn Dumper $vars;
my @actions = qw( screened reported authorised );
my %args = ( action => \@actions, vars => $vars );
my $data = $self->model('Audit')->user_workload(\%args); # warn Dumper $data;
my $stats = $data->{stats}; # AoH
$self->stash( duration => $data->{title}, vars => $vars ); # for .tt
my %h1 = (); # for chart
my %h2 = (); # for table cols
my %h3 = (); # for individual result breakdown
for my $entry (@$stats) { # warn Dumper $entry;
my $request_specimen = $entry->{specimen};
my $specimen_type = $self->_get_specimen_type($request_specimen);
# warn Dumper [$request_specimen, $specimen_type];
my $action = $entry->{action};
my $user = $entry->{username};
$h1{$action}{$user}++;
$h2{$action}{$user}{$specimen_type}++;
$h3{$action}{$user}{$specimen_type}{$request_specimen}++;
} # warn Dumper [\%h1, \%h2, \%h3];
# freeze stats data in session for chart (to save 3 more db queries):
$self->session_store_hashref(\%h1, '_user_workload_data');
$self->tt_params(
data => \%h2,
detail => \%h3,
sum => sub { LIMS::Local::Utils::sum_list(@_) }, # callback to calculate totals
);
$self->tt_process();
}
# ------------------------------------------------------------------------------
sub _get_specimen_type {
my ($self, $sample_code) = @_; # warn $sample_code if $sample_code =~ '-';
# only interested in BMAT, BMA, PB or Tissue biopsy:
return $sample_code if grep $sample_code eq $_, qw(BMAT BMA PB); # single specimens
return 'Tissue' if $sample_code =~ /\A[DGLRTX](A|[BS][LP]|F|U)/;
# for multi-specimen requests:
return 'BMAT' if $sample_code =~ /BMAT/;
return 'BMA' if $sample_code =~ /BMA/;
return 'PB' if $sample_code =~ /PB/;
return 'Other'; # everything else, including multi-specimen request not matched
}
# ------------------------------------------------------------------------------
sub _calc_turnaround_data_percentile {
my $self = shift;
my $data = shift;
my %h;
while ( my($specimen, $d) = each %$data ) { # warn Dumper $d;
for my $action ( qw/delta_report delta_authorise/ ) {
next unless $d->{$action}; # next unless $specimen eq 'foo';
# next unless $specimen eq 'Slide';
=begin # using Statistics::Descriptive
# sort numerical vals in ascending order:
my @vals = sort { $a <=> $b } @{ $d->{$action} }; # warn Dumper \@vals;
# take array position of 95%:
my $index = @vals * 0.95; warn $index; # array pos for 95% value
# get value for 95%:
my $x = $vals[ int ( $index - 1 ) ]; # warn Dumper [$specimen, $x];
=cut
my $stat = Statistics::Descriptive::Full->new();
$stat->add_data( @{ $d->{$action} } );
my ($x, $index) = $stat->percentile(95); # warn Dumper [$index, $x];
$h{$specimen}{$action} = $x;
}
$h{$specimen}{count} = $d->{count};
}
return \%h;
}
# ------------------------------------------------------------------------------
sub _sort_turnaround_data_average {
my $self = shift;
my $data = shift;
# default order_by is specimen type:
my $order_by = $self->query->param('order_by') || 'type';
my %methods = (
type => \&_sort_by_specimen_type,
totals => \&_sort_by_totals,
delta_r2a => \&_sort_by_delta_r2a, # report -> auth diff
delta_auth => \&_sort_by_delta_authorise,
delta_report => \&_sort_by_delta_report,
);
# get required sort method:
my $sort_method = $methods{$order_by};
# get sort order for $data as a list of $data keys:
my $sort_order = $sort_method->($data); # warn Dumper $sort_order;
# add $data key (specimen type) to its own hashref val:
$data->{$_}->{type} = $_ for keys %$data;
# create array from $data in requested sort order:
my @sorted_data = map $data->{$_}, @$sort_order; # add $data vals in sort order
return \@sorted_data;
}
# ------------------------------------------------------------------------------
sub _sort_by_specimen_type {
my $data = shift; # warn Dumper $data;
my @sort_order = sort { $a cmp $b } keys %$data;
return \@sort_order;
}
# ------------------------------------------------------------------------------
sub _sort_by_totals {
my $data = shift; # warn Dumper $data; # hashref
my @sort_order = sort {
$data->{$a}->{count} <=> $data->{$b}->{count}
|| # 2nd sort by keys (ie specimen type) in case similar counts:
$a cmp $b
} keys %$data; # warn Dumper \@sort_order;
return \@sort_order;
}
# ------------------------------------------------------------------------------
sub _sort_by_delta_report {
my $data = shift; # warn Dumper $data;
my @sort_order = sort {
$data->{$a}->{delta_report} / $data->{$a}->{count}
<=>
$data->{$b}->{delta_report} / $data->{$b}->{count}
|| $a cmp $b # 2nd sort by keys (ie specimen type) in case similar counts
} keys %$data;
return \@sort_order;
}
# ------------------------------------------------------------------------------
sub _sort_by_delta_authorise {
my $data = shift; # warn Dumper $data;
my @sort_order = sort {
$data->{$a}->{delta_authorise} / $data->{$a}->{count}
<=>
$data->{$b}->{delta_authorise} / $data->{$b}->{count}
|| $a cmp $b # 2nd sort by keys (ie specimen type) in case similar counts
} keys %$data;
return \@sort_order;
}
# ------------------------------------------------------------------------------
sub _sort_by_delta_r2a { # diff. between delta_report & delta_authorisation
my $data = shift; # warn Dumper $data;
my @sort_order = sort {
(
$data->{$a}->{delta_authorise} / $data->{$a}->{count} -
$data->{$a}->{delta_report} / $data->{$a}->{count}
)
<=>
(
$data->{$b}->{delta_authorise} / $data->{$b}->{count} -
$data->{$b}->{delta_report} / $data->{$b}->{count}
)
|| $a cmp $b # 2nd sort by keys (ie specimen type) in case similar counts
} keys %$data;
return \@sort_order;
}
1;
