package LIMS::Model::WorkList;
use Moose;
extends 'LIMS::Model::Base';
with (
'LIMS::Model::Roles::SessionData', # provides $self->user_profile
);
use namespace::clean -except => 'meta';
has lab_test_status_options_map => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
has local_stash => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has form_data => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
__PACKAGE__->meta->make_immutable;
use Data::Dumper;
use LIMS::Local::Utils;
#-------------------------------------------------------------------------------
sub get_outstanding_investigations_count {
my $self = shift;
my $data = shift; # warn Dumper $data;
my $args = $self->_outstanding_investigations_query($data);
# stash for later:
$self->local_stash->{outstanding_investigations_query} = $args;
my $n = LIMS::DB::RequestLabTestStatus::Manager->get_objects_count(%$args);
return $n;
}
#-------------------------------------------------------------------------------
sub get_outstanding_investigations {
my $self = shift;
my $data = shift; # warn Dumper $data;
# get query from stash if called from C::Worklist::display():
my $args = $self->local_stash->{outstanding_investigations_query}
|| $self->_outstanding_investigations_query($data); # warn Dumper $args;
my $o = LIMS::DB::RequestLabTestStatus::Manager->get_objects(%$args);
return $o;
}
#-------------------------------------------------------------------------------
sub _outstanding_investigations_query { # shared by above 2 methods
my $self = shift;
my $data = shift; # warn Dumper $data;
my @query_params = ();
# add any query args direct to @query_params:
if ( my $args = $data->{query_args} ) {
push @query_params, @$args;
}
# restrict on optional lab_test_id if supplied:
if ( my $lab_test_id = $data->{lab_test_id} ) {
push @query_params, ( lab_test_id => $lab_test_id ); # str or arrayref
}
else {
push @query_params, ( 'lab_test.lab_section_id' => $data->{lab_section_id} );
}
# restrict on optional status_option_id if supplied:
if ( my $status_option_id = $data->{status_option_id} ) {
push @query_params, ( status_option_id => $status_option_id ) ; # str
}
# need to exclude 'complete' if status_option_id not supplied:
else {
# get lab_test_status_option.id for 'complete':
my $complete_id = $self->lab_test_status_options_map->{complete};
push @query_params, ( status_option_id => { ne => $complete_id } );
}
# restrict on >= optional lab number if supplied:
if ( my $lab_number = $data->{lab_number_from} ) {
my ($request_number, $year)
= LIMS::Local::Utils::split_labno($lab_number);
# how to get all requests from defined lab_number if previous yr eg 12000/09:
# WHERE ( request_number >= $request_number AND year = $year ) OR year > $year
push @query_params, (
or => [
and => [
request_number => { ge => $request_number },
year => $year,
],
year => { gt => $year },
],
);
} # warn Dumper \@query_params;
# restrict on optional request id's if supplied:
if ( my $request_id = $data->{request_id} ) {
push @query_params, ( request_id => $request_id );
}
my %sort_options = (
lab_number => [ qw(requests.year requests.request_number) ],
lab_tests => [
qw(
lab_test.test_type
lab_test.field_label
requests.year
requests.request_number
)
],
field_label => [ qw(
lab_test.field_label requests.year requests.request_number
) ],
);
# if sort_by supplied, use it:
my $sort_by = $data->{sort_by} || 'lab_number'; # default if not supplied
# warn Dumper [$data->{sort_by},$sort_by];
my %args = (
query => \@query_params,
require_objects => [
'request.patient_case.patient',
'request.patient_case.referral_source',
'lab_test.lab_section',
'status',
'user',
],
with_objects => [
'request.request_initial_screen.screen',
'request.request_external_ref',
],
nested_joins => 0, # THIS IS ESSENTIAL FOR EFFICIENT QUERY (ie 138 vs > 16 x 10^9 rows !!)
sort_by => $sort_options{$sort_by},
); # warn Dumper \%args;
# request_trial used in tt filter
push @{ $args{with_objects} }, 'request.request_trial';
# restrict db hit if only want selected table(s):
if ( my $selected_tables = $data->{fetch_only} ) {
$args{fetch_only} = $selected_tables;
}
return \%args;
}
#-------------------------------------------------------------------------------
sub get_active_sections_list {
my $self = shift;
my $complete_id = $self->lab_test_status_options_map->{complete};
my %args = (
query => [ status_option_id => { ne => $complete_id } ],
require_objects => 'lab_tests.request_lab_test_status',
multi_many_ok => 1, # to silence warning
sort_by => 'section_name',
distinct => 1,
);
my $active_sections = LIMS::DB::LabSection::Manager->get_lab_sections(%args);
return $active_sections;
}
#-------------------------------------------------------------------------------
sub get_requesting_user {
my ($self, $request_id, $field_label) = @_;
my @args = (
query => [
request_id => $request_id,
action => 'requested ' . $field_label,
],
select => 'user.username',
sort_by => 'id DESC', # most recent if multiple
limit => 1,
require_objects => 'user',
);
my $o = LIMS::DB::RequestLabTestHistory::Manager
->get_request_lab_test_histories(@args); # array(ref), size 1
return $o->[0] if $o;
}
#-------------------------------------------------------------------------------
sub get_active_investigations_for_section {
my ($self, $lab_section_id) = @_;
my $complete_id = $self->lab_test_status_options_map->{complete};
my %args = (
query => [
lab_section_id => $lab_section_id,
status_option_id => { ne => $complete_id },
],
require_objects => [ 'lab_section', 'request_lab_test_status' ],
sort_by => 'field_label',
distinct => 1,
);
my $investigations = LIMS::DB::LabTest::Manager->get_lab_tests(%args);
return $investigations;
}
#-------------------------------------------------------------------------------
sub get_outstanding_histology_blocks {
my $self = shift;
my %args = (
query => [ status => undef ], # IS NULL
sort_by => [ qw( request.year request.request_number ) ],
require_objects => [
'request.patient_case.patient',
'request.patient_case.referral_source',
],
);
my $data
= LIMS::DB::RequestExternalRef::Manager->get_request_external_ref(%args);
return $data;
}
#-------------------------------------------------------------------------------
sub get_wgs_requests {
my $self = shift;
# get requests with incomplete wgs_referral test:
my $requests = do {
my %args = (
select => [ 'id' ],
query => [
test_name => 'wgs_referral',
description => { ne => 'complete' },
section_name => 'Whole genome sequencing',
],
require_objects => [
'request_lab_tests_status.status',
'request_lab_tests_status.lab_test.lab_section',
],
multi_many_ok => 1,
);
LIMS::DB::Request::Manager->get_objects(%args);
}; # warn Dumper $requests;
return undef unless @$requests;
# get data on requests with incomplete wgs_referral test:
my @request_ids = map $_->id, @$requests; # warn Dumper \@request_ids;
my %args = (
query => [
id => \@request_ids,
'results_summary.lab_section.section_name'
=> 'Flow cytometry',
'lab_test_results.lab_test.lab_section.section_name'
=> 'Whole genome sequencing',
],
require_objects => [
'patient_case.patient',
'patient_case.referral_source',
'results_summary.lab_section',
'referrer_department.referrer',
'referrer_department.hospital_department',
'lab_test_results.lab_test.lab_section',
],
with_objects => [ # may not be reported at worklist generation time:
# 'request_report.diagnosis',
],
multi_many_ok => 1,
);
my $data = LIMS::DB::Request::Manager->get_objects(%args);
return $data;
}
=begin # too complicated to do in one query
sub get_wgs_requests {
my $self = shift;
my %args = (
query => [
test_name => 'wgs_referral',
description => { ne => 'complete' },
section_name => 'Whole genome sequencing',
],
require_objects => [
'patient_case.patient',
'patient_case.referral_source',
'lab_test_results.lab_test',
'results_summary.lab_section',
'request_lab_tests_status.status',
'request_lab_tests_status.lab_test',
'referrer_department.referrer',
'referrer_department.hospital_department',
],
multi_many_ok => 1,
);
my $data = LIMS::DB::Request::Manager->get_objects(%args);
return $data;
}
=cut
#-------------------------------------------------------------------------------
sub get_unreported_hts_requests {
my $self = shift;
my %args = (
query => [
description => 'screened',
section_name => 'High-throughput sequencing',
],
require_objects => [
'status_option',
'results_summary.lab_section',
],
);
my $data = LIMS::DB::Request::Manager->get_objects(%args);
return $data;
}
#-------------------------------------------------------------------------------
sub request_status_count {
my $self = shift;
my $args = shift; # warn Dumper $args; # href status_query & optional duration
my $query_args = $self->_get_request_status_query_args($args);
# warn Dumper $query_args;
my $n = LIMS::DB::Request::Manager->get_requests_count(%$query_args);
return $n;
}
#-------------------------------------------------------------------------------
sub request_status_query {
my $self = shift;
my $args = shift; # warn Dumper $args; # href status_query & duration
my $data = []; # caller expects arrayref returned
#$self->set_rose_debug(1);
my $query_args = $self->_get_request_status_query_args($args); # $self->debug($q);
if ($query_args) {
$data = LIMS::DB::Request::Manager->get_requests(%$query_args);
}
#$self->set_rose_debug(0);
return $data; # no longer requre separate _process_tests_complete() method
# test_completed requires further processing - too complex for get args method:
# return ( $args->{status_query} =~ /tests_completed/ )
# ? $self->_process_tests_complete($data)
# : $data;
}
#-------------------------------------------------------------------------------
=begin # combined methods in _get_request_status_query_args()
sub tests_completed_count {
my $self = shift;
=begin # query:
select count(distinct(r.id))
# select distinct(concat(r.request_number, '/', r.year - 2000))
from requests r
join status_options so on r.status_option_id = so.id
where so.description = 'screened'
and r.id not in (
select distinct(r.id)
from requests r
join status_options so on r.status_option_id = so.id
join ( request_lab_test_status ts
join lab_test_status_options ltso ON ts.status_option_id = ltso.id )
on ts.request_id = r.id
where so.description = 'screened'
and ltso.description <> 'complete'
)
#=cut
my @ids = do { # requests at status = screened with at least 1 lab-test incomplete:
my @args = (
require_objects => [
'status_option', 'request_lab_tests_status.status',
],
query => [
'status_option.description' => 'screened',
'request_lab_tests_status.status.description'
=> { ne => 'complete' },
],
distinct => 1,
);
my $o = LIMS::DB::Request::Manager->get_objects(@args);
map $_->id, @$o;
}; # warn Dumper \@ids;
my $n = do {
my @args = (
require_objects => 'status_option',
query => [
description => 'screened',
'!id' => \@ids,
],
);
LIMS::DB::Request::Manager->get_objects_count(@args);
};
return $n;
}
=cut
#-------------------------------------------------------------------------------
=begin # combined method in _get_request_status_query_args()
# skip requests from $data with any tests NOT set to complete:
sub _process_tests_complete {
my ($self, $data) = @_;
# get request_ids:
my @ids = map $_->id, @$data;
# get lab_test status:
my $query = [ request_id => \@ids ];
my $statii = LIMS::DB::RequestLabTestStatus::Manager
->get_objects( query => $query, require_objects => 'status' );
# get map of requests with at least 1 incomplete lab test:
my %status_map; map {
my $reqest_id = $_->request_id;
$status_map{$reqest_id}++ if $_->status->description ne 'complete';
} @$statii; # warn Dumper \%status_map;
my @no_outstanding; # list of request objects with no outstanding lab tests
for (@$data) {
my $request_id = $_->id;
# skip request if any outstanding lab tests:
next if $status_map{$request_id};
push @no_outstanding, $_;
}
return \@no_outstanding;
}
=cut
#-------------------------------------------------------------------------------
sub _get_request_status_query_args {
my $self = shift;
my $args = shift;
my $duration = $args->{duration};
my $status = $args->{status_query};
# args common to all status requests:
my %args = (
query => undef, # defined below
require_objects => [
'status_option',
'patient_case.patient',
'patient_case.referral_source',
],
with_objects => [ 'request_trial' ], # maybe modified below
nested_joins => 0,
sort_by => [ 'requests.created_at, request_number' ],
);
if ( $status eq 'urgent' ) {
push @{ $args{require_objects} }, 'request_option.option';
push @{ $args{with_objects} }, 'request_initial_screen.screen';
# only want unreported/unauthorised requests:
my @status_options = qw(new screened);
# add 'reported' to status_options if 'authorised' option in use:
my $option_authorised
= LIMS::DB::StatusOption->new(description => 'authorised')->load;
push @status_options, 'reported' if $option_authorised->is_active eq 'yes';
$args{query} = [
option_name => 'urgent',
'status_option.description' => \@status_options,
],
}
elsif ( $status eq 'unscreened' ) {
$args{query} = [ 'status_option.description' => 'new' ];
}
# unreported; all tests complete (** must come before /^unreported/ **)
elsif ( $status =~ /^unreported_tests_complete/ ) {
push @{ $args{require_objects} }, 'request_initial_screen.screen';
push @{ $args{query} }, ( 'status_option.description' => 'screened' );
# get list of screened requests with at least 1 lab-test NOT complete to exclude:
my @ids = do {
my @args = (
require_objects => [
'status_option', 'request_lab_tests_status.status',
],
query => [
'status_option.description' => 'screened',
'request_lab_tests_status.status.description'
=> { ne => 'complete' },
],
distinct => 1,
);
my $o = LIMS::DB::Request::Manager->get_objects(@args);
map $_->id, @$o;
}; # warn Dumper \@ids;
push @{ $args{query} }, ( '!id' => \@ids ) if @ids; # id NOT IN (...)
}
# unreported (not considering test status):
elsif ( $status =~ /^unreported/ ) { # could include _outreach
my $days = $duration; # warn $days;
$args{query} = [
'status_option.description' => 'screened',
created_at => { lt => DateTime->today->subtract(days => $days) },
];
push @{ $args{require_objects} }, 'request_initial_screen.screen';
}
# unauthorised - only supplied by template if 'authorised' status_option is active:
elsif ( $status =~ /^unauthorised/ ) { # could include _outreach
$args{query} = [ 'status_option.description' => 'reported' ];
push @{ $args{require_objects} },
( 'request_initial_screen.screen', 'request_status' );
} # warn Dumper \%args;
# reported/authorised, request status incomplete (not considering test status)
elsif ( $status eq 'incomplete' ) {
my $option_authorised
= LIMS::DB::StatusOption->new(description => 'authorised')->load;
my $status = $option_authorised->is_active eq 'yes'
? 'authorised'
: 'reported';
$args{query} = [ 'status_option.description' => $status ];
push @{ $args{require_objects} }, 'request_initial_screen.screen';
}
# reported/authorised, request status incomplete, all tests complete
elsif ( $status eq 'complete' ) {
my $option_authorised
= LIMS::DB::StatusOption->new(description => 'authorised')->load;
my $status = $option_authorised->is_active eq 'yes'
? 'authorised'
: 'reported';
push @{ $args{query} }, ( 'status_option.description' => $status );
# get list of reported/authorised requests with at least 1 lab-test NOT
# complete to exclude:
my @ids = do {
my @args = (
require_objects => [
'status_option', 'request_lab_tests_status.status',
],
query => [
'status_option.description' => $status,
'request_lab_tests_status.status.description'
=> { ne => 'complete' },
],
distinct => 1,
);
my $o = LIMS::DB::Request::Manager->get_objects(@args);
map $_->id, @$o;
}; # warn Dumper \@ids;
push @{ $args{query} }, ( '!id' => \@ids, ) if @ids; # id NOT IN (...)
}
else { # should never happen, but will return all records otherwise:
$args{query} = [ request_number => 0 ];
} # warn Dumper \%args;
# unreported_outreach, unauthorised_outreach, test_completed_outreach:
push @{ $args{query} }, ( 'screens.description' => { rlike => 'outreach' } )
if $status =~ /_outreach\Z/; # warn Dumper \%args;
return \%args;
}
#-------------------------------------------------------------------------------
sub _build_lab_test_status_options_map {
my $self = shift;
my $status_options = LIMS::DB::LabTestStatusOption::Manager->
get_lab_test_status_options;
my %map = map {
$_->description => $_->id;
} @$status_options;
return \%map;
}
1;
