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; } =begin # was very slow query before addition of results_summary table, now faster: #------------------------------------------------------------------------------- sub get_wgs_requests { # split into 2 queries, get request_id's first: my $self = shift; 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', 'results_summary.lab_section', ], multi_many_ok => 1, ); LIMS::DB::Request::Manager->get_objects(%args); }; # warn Dumper $requests; return 0 unless @$requests; my @request_ids = map $_->id, @$requests; # warn Dumper \@request_ids; my %args = ( query => [ id => \@request_ids ], require_objects => [ 'patient_case.patient', 'patient_case.referral_source', 'referrer_department.referrer', 'referrer_department.hospital_department', ], with_objects => [ # may not be reported at worklist generation time: # 'request_report.diagnosis', ], ); my $data = LIMS::DB::Request::Manager->get_objects(%args); return $data; } =cut 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; } #------------------------------------------------------------------------------- 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;