package LIMS::Controller::Audit;
use Moose;
BEGIN { extends 'LIMS::Base'; }
with (
'LIMS::Controller::Roles::Misc',
);
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use Data::Dumper;
# ------------------------------------------------------------------------------
# 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 {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $selection = $self->param('id'); # eg specimen_type, location, etc
my $constraint = $self->query->param('constraint_type');
my $vars = $self->query->Vars();
$vars->{selection} = $selection; # warn Dumper $vars;
my ($data, $title) = $self->model('Audit')->turnaround_times($vars);
# sort data by requested field (defaults to specimen type):
my $sorted = $self->_sort_turnaround_data($data); # AoH (sorted)
$self->tt_params(
data => $sorted,
title => $title,
start_date => $self->model('Request')->get_first_request_date(),
);
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 $duration = $self->query->param('duration') || 30; # days default
$self->stash( duration => $duration ); # for .tt
my @actions = qw( screened reported authorised );
my %args = ( duration => $duration ); # common field
my %data = ();
for my $action (@actions) {
$args{action} = $action; # variable field
my $o = $self->model('Audit')->user_workload(\%args); # AoH
for my $entry(@$o) {
my $username = $entry->{username};
my $sample_code = $entry->{sample_code};
my $specimen_type = $self->_get_specimen_type($sample_code);
$data{$action}{$username}{$specimen_type}++;
}
}
$self->tt_process({ data => \%data });
}
# ------------------------------------------------------------------------------
sub _get_specimen_type {
my ($self, $sample_code) = @_;
# only interested in BMAT, BMA, PB or Tissue biopsy:
return $sample_code if grep $sample_code eq $_, qw(BMAT BMA PB);
return 'Tissue' if $sample_code =~ /\A[DGLRTX](A|[BS][LP]|F|U)/;
return 'Other'; # everything else
}
# ------------------------------------------------------------------------------
sub _sort_turnaround_data {
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;
