package LIMS::Controller::Local::Worklist; # only ucfirst or need an entry in Dispatch
# provides methods for local worklists - requires entry in config/.local/worklists.yml
use base 'LIMS::Base';
use Moose;
with (
'LIMS::Controller::Roles::PDF',
'LIMS::Controller::Roles::Misc',
'LIMS::Controller::Roles::Barcode',
'LIMS::Controller::Roles::History',
'LIMS::Controller::Roles::DataMap',
'LIMS::Controller::Roles::DataFile',
);
has 'tt_name' => (is => 'rw', isa => 'Str');
use Data::Dumper;
use Array::Diff;
use IO::All;
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
# ------------------------------------------------------------------------------
sub default : StartRunmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
# get function_name from query param, or return to start (in case user cleared menu):
my $function_name = $self->query->param('function_name')
|| return $self->redirect( $self->query->url . '/worklist' ); # warn $function_name;
# check method exists or return error:
unless ( UNIVERSAL::can($self, $function_name) ) {
return $self->error( qq!no method "$function_name" found at !
. $self->get_current_runmode );
}
# process method - all tmpl data handled in method
do{ $self->$function_name }; # don't need rtn value - returns 0 if no hits
# or return $self->error($function_name.'() did not return a true value');
# use render_view to override default template name (unless supplied in rm):
$self->tt_name || $self->tt_name('worklist/local/'.$function_name.'.tt');
return $self->render_view($self->tt_name, {}); # tt_params set in methods
}
# ------------------------------------------------------------------------------
# collects outstanding data from flow_screen table, for fresh tissue samples only
# formats request number in '%02d_%05d' format
#
sub pre_screen : Runmode {
my $self = shift; $self->_debug_path(); # not called directly
# optional list of lab-tests
my @tests = $self->query->param('test_name'); # warn Dumper \@tests;
# optional lab-test status:
my $status_option_id = $self->query->param('status_option_id'); # warn Dumper $status_option_id;
# get Flow cytometry lab_section object (used by flow screen data & status opts)
my $lab_section
= $self->model('LabSection')->get_lab_section_by_name('Flow cytometry');
{ # get data for flow screen panels:
# need to supply list of lab_test id's to model:
my $lab_test_names = @tests
? \@tests
: $self->get_yaml_file('pre_screen_panel'); # warn Dumper $lab_test_names;
# hash map for tt:
my %included_lab_tests = map +($_ => 1), @$lab_test_names;
$self->tt_params( included_lab_tests => \%included_lab_tests );
my $lab_tests = do {
my %args = (
section_name => 'Flow cytometry',
test_name => $lab_test_names, # arrayref
);
$self->model('LabTest')->get_section_lab_tests(\%args);
}; # warn Dumper $lab_tests;
my @lab_test_ids = map { $_->id } @$lab_tests;
return 1 unless @lab_test_ids; # or will get error in downstream model
# get outstanding flow screen investigations:
my $args = {
status_option_id => $status_option_id,
lab_test_id => \@lab_test_ids,
};
my $flow_screen_data # arrayref:
= $self->model('WorkList')->get_outstanding_investigations($args);
# parse flow screen data for template (returns hashref or undef):
if ( my $data = $self->_parse_flow_screen_data($flow_screen_data) ) {
# get a list of unique request_ids
my $unique_ids = $self->get_unique_request_ids($flow_screen_data);
{ # get specimen_map for template:
my $map = $self->specimen_map($unique_ids);
$self->tt_params( specimen_map => $map );
}
{ # request_options:
my $map = $self->request_options_map($unique_ids);
$self->tt_params( request_options_map => $map );
}
{ # get section notes for flow cytometry section:
# stash section object for request_section_notes_map():
$self->stash( lab_section => $lab_section );
my $map = $self->request_section_notes_map($unique_ids);
$self->tt_params( request_section_notes_map => $map );
}
{ # haematology data:
my @requests = keys %$data; # warn Dumper \@requests;
my $o = $self->model('Result')->get_multiple_haem(\@requests);
for ( @$o ) { # warn Dumper $_->as_tree;
my $lab_number = $_->lab_number; # warn Dumper $data;
$data->{$lab_number}{haematology} = $_->as_tree;
}
}
$self->tt_params( flow_screen_data => $data );
}
}
# get unregistered data from pre_registration tables:
my $cases = $self->model('Local')->get_unregistered_requests;
if (@$cases) {
$self->tt_params( unregistered_cases => $cases );
my @prereg_specimen_ids;
{ # get list of pre_registration_specimen.id's from $cases:
for my $case (@$cases) { # warn Dumper $case->as_tree;
my $pre_registration_specimen = $case->pre_registration_specimen;
foreach my $reg_specimen (@$pre_registration_specimen) {
push @prereg_specimen_ids, $reg_specimen->id;
}
} # warn Dumper \@prereg_specimen_ids;
}
# get map of lab_tests for unregistered requests (if any):
if (@prereg_specimen_ids) {
my $lab_tests_map = $self->model('Local')
->get_unregistered_request_lab_tests(\@prereg_specimen_ids);
$self->tt_params( unregistered_request_lab_tests => $lab_tests_map );
# warn Dumper $lab_tests_map;
}
}
{ # lab_test status_options for this section:
my $options = $self->get_status_options_for_select($lab_section->id);
$self->tt_params( status_opts => $options );
}
return 1;
}
# ------------------------------------------------------------------------------
sub haem_data : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my @args = ('RequestHaematology', { query => [ status => 'default' ] } );
my $data = $self->model('Base')->get_objects(@args);
{ # haem data, converted from sysmex to real values:
my @haem = map $_->as_tree(deflate => 0), @$data; # extract data as hashrefs
# massage haem data - convert params from sysmex to real (far too slow in tt):
$self->_parse_haem_data(\@haem); # also adds param_flags & param_fields for tt
$self->tt_params( haem_data => \@haem );
}
{ # lab_number (nn_nnnnn) => request.id map:
my @lab_numbers = map $_->lab_number, @$data; # warn Dumper \@lab_numbers;
my $map = $self->model('Request')
->get_request_id_from_lab_number(\@lab_numbers);
$self->tt_params( requestId_map => $map );
}
return 1;
}
# ------------------------------------------------------------------------------
sub outreach_clinic_returns : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $id = $self->param('id');
if ($id) { # update request_clinic_return table & redirect back to worklist:
my $vars = $self->query->Vars; # warn Dumper $vars;
$vars->{request_id} = $id; # warn Dumper $vars;
my $rtn = $vars->{appointment_date} # just return error if no data submitted:
? $self->model('Outreach')->update_clinic_appointment($vars) # rtn 0 OR $err
: $self->messages('worklist')->{no_data_submitted};
# any $rtn is an error, otherwise update success:
my $msg = $rtn || $self->messages('action')->{edit_success};
my $f = $rtn ? 'error' : 'info';
$self->flash( $f => $msg );
my $addr = 'local_worklist?function_name=outreach_clinic_returns';
# this works as we arrived direct to rm, not via default() using function_name param:
return $self->redirect( $self->query->url . '/' . $addr );
}
# get list of unreported cases which still require gross-description:
my $requests = $self->model('Outreach')->get_outstanding_clinic_returns;
$self->tt_params( requests => $requests );
return 1;
}
# ------------------------------------------------------------------------------
sub gross_description : Runmode {
my $self = shift; $self->_debug_path(); # not called directly
my $id = $self->param('id');
if ($id) { # update request_specimen_detail table & redirect back to worklist:
my $vars = $self->query->Vars; # warn Dumper $vars;
$vars->{request_id} = $id; # warn Dumper $vars;
my $rtn = $vars->{gross_description} # just return error if no data submitted:
? $self->model('Local')->update_gross_description($vars) # rtn 0 OR $err
: $self->messages('worklist')->{no_data_submitted};
# any $rtn is an error, otherwise update success:
my $msg = $rtn || $self->messages('action')->{edit_success};
my $f = $rtn ? 'error' : 'info';
$self->flash( $f => $msg );
my $addr = 'local_worklist?function_name=gross_description';
# this works as we arrived direct to rm, not via default() using function_name param:
return $self->redirect( $self->query->url . '/' . $addr );
}
# get list of unreported cases which still require gross-description:
my $requests = $self->model('Local')->get_outstanding_gross_description;
$self->tt_params( requests => $requests );
return 1;
}
# ------------------------------------------------------------------------------
sub histology_processing : Runmode {
my $self = shift; $self->_debug_path(); # not called directly
# name of test for this worklist:
my $test_name = 'cut_up';
return $self->_format_lab_test_data($test_name);
}
# ------------------------------------------------------------------------------
sub histology_blocks : Runmode {
my $self = shift; $self->_debug_path(); # not called directly
my $data = $self->model('WorkList')->get_outstanding_histology_blocks;
{ # create hash of year => $data:
my %h;
for (@$data) {
my $yr = $_->request->year;
push @{ $h{$yr} }, $_;
};
$self->tt_params( requests => \%h );
}
# get a list of unique request_ids, return if empty:
my $request_ids = $self->get_unique_request_ids($data); # warn Dumper $request_ids;
return 0 unless @$request_ids;
{ # get specimen_map for requests:
my $specimen_map = $self->specimen_map($request_ids);
$self->tt_params( specimen_map => $specimen_map );
}
{ # create map of request_id => block_ref for tmpl:
my %block_refs = map { $_->request_id => $_->external_reference } @$data;
$self->tt_params( block_refs_map => \%block_refs );
}
$self->csrf_insert_token; # prevent form resubmission
return 1;
}
# ------------------------------------------------------------------------------
sub histology_staining : Runmode {
my $self = shift; $self->_debug_path(); # not called directly
# name of test for this worklist:
my $test_name = 'haematoxylin_eosin';
return $self->_format_lab_test_data($test_name);
}
# ------------------------------------------------------------------------------
sub immunohistochemistry : Runmode {
my $self = shift; $self->_debug_path(); # not called directly
# get list of lab_tests for immunohistochemistry secion:
my %args = (
section_name => 'Immunohistochemistry',
);
my $lab_tests = $self->model('LabTest')->get_section_lab_tests(\%args);
my @lab_test_ids = map { $_->id } @$lab_tests;
my @field_labels = map { $_->field_label } @$lab_tests;
# get requests where test status is not complete:
my $data = $self->model('WorkList')
->get_outstanding_investigations({ lab_test_id => \@lab_test_ids });
$self->tt_params( requests => $data );
# get a list of unique request_ids, return if empty:
my $request_ids = $self->get_unique_request_ids($data); # warn Dumper $request_ids;
return 0 unless @$request_ids;
{ # get specimen_map for requests:
my $specimen_map = $self->specimen_map($request_ids);
$self->tt_params( specimen_map => $specimen_map );
}
{ # request_options:
my $map = $self->request_options_map($request_ids);
$self->tt_params( request_options_map => $map );
}
{ # get lab_test history for tests:
my %args = (
request_ids => $request_ids,
field_label => \@field_labels, # history table uses field label
);
my $lab_test_status_map
= $self->lab_test_status_for_field_label_map(\%args);
$self->tt_params( lab_test_status_map => $lab_test_status_map );
}
return 1;
}
# ------------------------------------------------------------------------------
sub fish_worksheets : Runmode {
my $self = shift; $self->_debug_path(); # not called directly
# get lab_section object for FISH:
my $lab_section =
$self->model('LabSection')->get_lab_section_by_name('FISH');
my $sort_order = $self->query->param('sort_by') || ''; # optional
my %args = ( # includes possible args accepted by model method:
lab_section_id => $lab_section->id,
sort_by => $sort_order,
fetch_only => undef,
lab_test_id => undef,
lab_number_from => undef,
status_option_id => undef,
);
my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);
$self->tt_params( data => $data );
{ # get some data maps for tmpl:
my $unique_ids = $self->get_unique_request_ids($data); # arrayref of request_ids
{ # specimens:
my $map = $self->specimen_map($unique_ids);
$self->tt_params( specimen_map => $map );
}
{ # request_options:
my $map = $self->request_options_map($unique_ids);
$self->tt_params( request_options_map => $map );
}
}
return 1;
}
# ------------------------------------------------------------------------------
sub genomics_slf_cancer_tissue { shift->genomics_slf_requests('cancer_tissue') }
# ------------------------------------------------------------------------------
sub genomics_slf_cancer_blood { shift->genomics_slf_requests('cancer_blood') }
# ------------------------------------------------------------------------------
sub genomics_slf_rare_disease { shift->genomics_slf_requests('rare_disease') }
# ------------------------------------------------------------------------------
# common function for rare_disease, cancer_blood, cancer_tissue:
sub genomics_slf_requests {
my $self = shift; $self->_debug_path();
my $type = shift; # rare_disease, cancer_blood, cancer_tissue
my $data = $self->model('Local')->genomics_slf_requests($type);
$self->tt_params(
requests => $data,
slf_type => $type,
);
$self->tt_name('worklist/local/genomics/slf_select.tt');
return 1;
}
# ------------------------------------------------------------------------------
sub genomics_slf_data : Runmode {
my $self = shift; $self->_debug_path();
my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;
unless (@request_ids) {
my $msg = $self->messages('worklist')->{slf_no_request_ids};
# my $addr = '/local_worklist?function_name=genomics_sample_linkage_select';
return $msg; # will open in new tab so just close it
}
my $slf_type = $self->query->param('slf_type'); # warn $slf_type;
$self->tt_params( slf_type => $slf_type );
my $data = $self->model('Local')->genomics_slf_data(\@request_ids);
my $tmpl = 'worklist/local/genomics/sample_linkage_form_2d.tt';
my $_self = $self; weaken $_self; # or get circular refs inside the callbacks
my $barcode = sub {
my $text = shift || return undef; # warn $text;
if ($tmpl =~ /2d/) { # 2d barcode:
my %args = ( css_class => 'hbc2d' );
return $_self->barcode_data_matrix($text, %args); # excludes css
}
# 1d (linear) barcode:
my %args = ( show_text => 0, bar_height => 25 );
return $_self->barcode_code128($text, %args); # excludes css
};
$self->tt_params( render_barcode => $barcode );
my $html;
for my $req (@$data) { # warn Dumper $req;
my $ref = $self->render_view($tmpl, { data => $req });
$html .= $$ref; # de-refererence it 1st;
} # warn $html; return $html;
{ # add css:
my $css = $self->cfg->{path_to_www_docs}.'/css/local/genomics/slf.css';
$self->add_webkit_stylesheet($css);
}
my $pdf = do {
# landscape orientation, and apply 30mm bottom margin for linear barcodes to
# prevent content under-spill (not for 2d barcodes but still need to supply value):
my $margin_bottom = $tmpl =~ /2d/ ? '10mm' : '30mm'; # 10mm is default
my %args = (
orientation => 'landscape',
margin_bottom => $margin_bottom,
margin_top => '5mm',
);
$self->inline_html_to_pdf(\$html, %args);
};
$self->header_add(-type => 'application/pdf', -expires => 'now');
return $pdf;
}
# ------------------------------------------------------------------------------
sub xna_stabilisation_worksheet {
my $self = shift; $self->_debug_path(); # not called directly
# DNA & RNA extraction:
my %args = (
section => 'Molecular',
lab_test => [ qw(dna_extraction rna_extraction) ],
status => 'new', # status to get
);
return $self->_xna_extraction(\%args);
}
# ------------------------------------------------------------------------------
sub dna_extraction_worksheet {
my $self = shift; $self->_debug_path();
my %args = (
section => 'Molecular',
lab_test => [ qw(dna_extraction) ],
status => 'stabilised', # status to get
);
$self->tt_params( extraction_type => 'dna' );
return $self->_xna_extraction(\%args);
}
# ------------------------------------------------------------------------------
sub trial_dna_extraction_worksheet {
my $self = shift; $self->_debug_path();
my %args = (
section => 'Clinical trials',
lab_test => [ qw(trial_dna_extraction) ],
status => 'new', # status to get
);
$self->tt_params( extraction_type => 'dna' );
$self->tt_name('worklist/local/dna_extraction_worksheet.tt'); # don't need new tt
return $self->_xna_extraction(\%args);
}
# ------------------------------------------------------------------------------
sub rna_extraction_worksheet {
my $self = shift; $self->_debug_path();
my %args = (
section => 'Molecular',
lab_test => [ qw(rna_extraction) ],
status => 'stabilised', # status to get
);
$self->tt_params( extraction_type => 'rna' );
return $self->_xna_extraction(\%args);
}
# ------------------------------------------------------------------------------
sub trial_rna_extraction_worksheet {
my $self = shift; $self->_debug_path();
my %args = (
section => 'Clinical trials',
lab_test => [ qw(trial_rna_extraction) ],
status => 'new', # status to get
);
$self->tt_params( extraction_type => 'rna' );
$self->tt_name('worklist/local/rna_extraction_worksheet.tt'); # don't need new tt
return $self->_xna_extraction(\%args);
}
# ------------------------------------------------------------------------------
sub outreach_unreported { # redirect to main worklist url:
my $self = shift;
my $addr = '/worklist/request_status?status_query=unreported_outreach';
$self->tt_name('worklist/local/outreach/request_status.tt'); # just needs to exist
return $self->redirect( $self->query->url . $addr );
}
# ------------------------------------------------------------------------------
sub outreach_unauthorised { # redirect to main worklist url:
my $self = shift;
my $addr = '/worklist/request_status?status_query=unauthorised_outreach';
$self->tt_name('worklist/local/outreach/request_status.tt'); # just needs to exist
return $self->redirect( $self->query->url . $addr );
}
# ------------------------------------------------------------------------------
sub outreach_tests_complete { # redirect to main worklist url:
my $self = shift;
my $addr = '/worklist/request_status?status_query='
. 'unreported_tests_complete_outreach';
$self->tt_name('worklist/local/outreach/request_status.tt'); # just needs to exist
return $self->redirect( $self->query->url . $addr );
}
# ------------------------------------------------------------------------------
# common method for xna_stabilisation_worksheet & d/rna_extraction_worksheets
sub _xna_extraction {
my ($self, $args) = @_; $self->_debug_path();
my $lab_test = $args->{lab_test}; # arrayref
my $section = $args->{section};
my $function = $self->query->param('function_name');
my $status = $args->{status};
# get lab-test id's corresponding to lab_test arrayref entries:
my @lab_test_ids = do {
my %args = ( section_name => $section );
my $lab_tests = $self->model('LabTest')->get_section_lab_tests(\%args);
my %map = map +($_->test_name => $_->id), @$lab_tests; # warn Dumper \%map;
@map{@$lab_test}; # get lab-test id's from test_name's
}; # warn Dumper \@lab_test_ids;
# status options map (for 'stabilised'):
my $status_option_map = $self->lab_test_status_options_map('description');
my %args = ( # includes possible args accepted by model method:
lab_number_from => undef,
lab_section_id => undef,
lab_test_id => \@lab_test_ids,
fetch_only => undef,
sort_by => undef, # default (lab number) is OK
status_option_id => $status_option_map->{$status}->{id},
);
# skip any unwanted screened-as requests:
if ( my $cfg = $self->get_yaml_file('worklist_cfg') ) { # warn Dumper $yaml;
# check it's generating hashref or die (can't return $self->error here):
die "worklist_cfg.yml doesn't return hashref" unless ref $cfg eq 'HASH';
if ( my $skip = $cfg->{xna_extraction}->{skip_screens} ) {
$args{query_args} = [
'request.request_initial_screen.screen.description',
{ ne => $skip }, # eg Gallium trial
];
}
}
my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);
$self->tt_params( requests => $data );
{ # get some data maps for tmpl:
my $unique_ids = $self->get_unique_request_ids($data); # arrayref of request_ids
return 1 unless @$unique_ids; # or next 2 blocks throw error:
{
my $specimen_map = $self->_xna_extraction_specimen_map($unique_ids);
$self->tt_params( specimen_map => $specimen_map );
}
{ # request_options:
my $map = $self->request_options_map($unique_ids);
$self->tt_params( request_options_map => $map );
}
{ # section lab-tests
my %args = (
section_name => $section,
test_type => 'test',
is_active => 'yes',
); # warn Dumper \%args;
my $tests = $self->model('LabTest')->get_section_lab_tests(\%args);
$self->tt_params( lab_tests => $tests );
}
# get map to restrict requests if specific lab tests selected:
if ( my @test_ids = $self->query->param('lab_test_id') ) {
# get requests with @lab_test_ids:
my @args = ( request_id => $unique_ids, lab_test_id => \@test_ids);
my $o = $self->model('Base')
->get_objects('RequestLabTestStatus', { query => \@args } );
my %h = map +($_->request_id => 1), @$o;
$self->tt_params( restrict_request_map => \%h );
{ # get test name(s):
my $tests_map = $self->lab_tests_map;
my @test_names = map $tests_map->{$_}, @test_ids; # warn Dumper \@test_names;
$self->tt_params( test_names => \@test_names );
}
}
$self->tt_params( # add some params for tt:
function_name => $function,
lab_section => $section,
);
}
return 1;
}
# ------------------------------------------------------------------------------
sub xna_extraction_worksheet : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars(); # warn Dumper $vars;
my $extraction_type = $vars->{extraction_type} # DNA or RNA
|| return $self->error('no extraction type param submitted'); # warn $extraction_type;
my $function_name = $vars->{function_name} # trial_dna_extraction, rna_extraction, etc
|| return $self->error('no function name param submitted'); # warn $function_name;
my $lab_section = $vars->{lab_section} # molecular, Clinical trial, etc
|| return $self->error('no lab-section param submitted'); # warn $lab_section;
# if redirect from dna extraction labels print, data is already in session:
my $have_session_data = $vars->{print_labels};
# get request_id's from request_specimen form param or session:
my @params = $have_session_data # ie redirect from label print
? @{ $self->session->param('dna_extraction_request_specimen') } # session
: $self->query->param('request_specimen'); # from query param, as array!!
my $request_id = $self->_extract_request_specimen(\@params); # warn Dumper $request_id;
unless (@$request_id) { # at least 1 submitted
$self->flash( error => $self->messages('worklist')->{no_print_ids} );
my $url = sprintf '%s/local_worklist?function_name=%s',
$self->query->url(), $function_name;
return $self->redirect($url);
}
# save request_specimen param to session for print labels if DNA extraction:
if ( $extraction_type eq 'dna' && ! $have_session_data ) { # unless already there
my @params = $self->query->param('request_specimen'); # warn Dumper \@params;
$self->session->param( dna_extraction_request_specimen => \@params );
}
{ # get request & report data for request_ids:
my %args = ( # to use existing method used by Search function
search_constraints => { id => $request_id },
args_for_search => {
sort_by => [ qw(requests.year requests.request_number) ],
},
); # warn Dumper \%args;
my $requests = $self->model('Request')->find_requests(\%args);
$self->tt_params( requests => $requests ); # warn Dumper $requests;
}
{ # get screening terms:
my $o = $self->model('Screen')->get_initial_screens($request_id);
# convert to hashref map for tt:
my %map = map { $_->request_id => $_->screen->description } @$o;
$self->tt_params( presentations => \%map ); # warn Dumper \%map;
}
# some params for .tt:
$self->tt_params( function_name => $function_name );
$self->tt_params( lab_section => $lab_section );
# DNA extraction .tt same for clinical trial & molecular section, not so for RNA:
$extraction_type = 'trial_rna'
if lc $lab_section =~ 'trial' && lc $extraction_type eq 'rna'; # warn $extraction_type;
my $tt = "worklist/local/molecular/${extraction_type}_extraction.tt";
return $self->render_view($tt);
}
# ------------------------------------------------------------------------------
sub sequencing_worksheet : Runmode {
my $self = shift; $self->_debug_path();
my %args = (
function => 'Sequencing',
status => 'PCR', # required lab-test status
);
return $self->_pcr_and_sequencing_worksheet(\%args);
}
# ------------------------------------------------------------------------------
sub pcr_worksheet : Runmode {
my $self = shift; $self->_debug_path();
my %args = (
function => 'PCR',
status => 'new', # required lab-test status
);
return $self->_pcr_and_sequencing_worksheet(\%args);
}
# ------------------------------------------------------------------------------
sub pcr_status_overview : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
if ( my @test_ids = $self->query->param('lab_test_id') ) {
my $data = $self->model('Local')->pcr_status_overview(\@test_ids);
$self->tt_params( incomplete_requests => $data );
{ # get test name(s):
my $tests_map = $self->lab_tests_map;
my @test_names = map $tests_map->{$_}, @test_ids; # warn Dumper \@test_names;
$self->tt_params( test_names => \@test_names );
}
}
else {
my $lab_tests = $self->_get_section_lab_tests('Molecular');
$self->tt_params( lab_tests => $lab_tests );
}
return 1;
}
# ------------------------------------------------------------------------------
sub chimerism_worksheet : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
# get all molecular tests:
my $lab_tests = $self->_get_section_lab_tests('Molecular');
# get active chimerism lab-tests (eg CD3_chimerism, CD15_chimerism, etc):
my @test_ids = map { $_->id } grep {
$_->is_active eq 'yes' && $_->test_name =~ /chimerism/;
} @$lab_tests; # warn Dumper \@test_ids;
my $args = { lab_test_id => \@test_ids };
my $o = $self->model('WorkList')->get_outstanding_investigations($args);
my $unique_request_ids = do { # unique request_id's from request_lab_test_status object
my @ids = map $_->request_id, @$o;
LIMS::Local::Utils::get_unique_elements(\@ids);
}; # warn Dumper $unique_request_ids;
{ # skip requests where dna-extraction status not 'extracted':
# get dna_extraction test_id - there's only 1 but needs to be array:
my @test_id = map { $_->id }
grep { $_->test_name eq 'dna_extraction' } @$lab_tests;
my %args = (
request_id => $unique_request_ids,
lab_test_id => \@test_ids,
); # warn Dumper \%args;
# get dna-extraction status for requests (returns AoH - in case both dna & rna):
my $dna_extraction_status = $self->_get_xna_extraction_status(\%args);
my @data;
REQ: for my $req (@$o) { # warn Dumper $req->as_tree;
my $request_id = $req->request_id;
# $dna_extraction_status values = array of 1 href (as we only asked for dna):
my $ref = $dna_extraction_status->{$request_id}->[0]; # 1st (and only) aref
next REQ unless $ref->{status} eq 'complete';
push @data, $req;
}
$self->tt_params( requests => \@data );
}
{ # specimen map:
my $specimen_map = $self->specimen_map($unique_request_ids);
$self->tt_params( specimen_map => $specimen_map );
}
{ # request_options:
my $map = $self->request_options_map($unique_request_ids);
$self->tt_params( request_options_map => $map );
}
}
# ------------------------------------------------------------------------------
sub outreach_pack_forms : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $data = $self->model('Outreach')->get_packs_due_details;
$self->tt_params( packs => $data );
{ # callback for blood-tube-type:
my $_self = $self; weaken $_self;
$self->tt_params( tube_type => sub { $_self->get_blood_tube_type(@_) } );
}
return 1;
}
# ------------------------------------------------------------------------------
sub outreach_pack_labels : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $data = $self->model('Outreach')->pack_labels;
$self->tt_params( addresses => $data );
return 1;
}
# ------------------------------------------------------------------------------
# looks for outreach cases where no new sample received by return due date
sub outreach_outstanding : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $data = $self->model('Outreach')->get_overdue_packs; # warn Dumper $data;
$self->tt_params( requests => $data );
return 1;
}
# ------------------------------------------------------------------------------
sub outreach_notifications : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $data # use same model as outreach_outstanding() but include flag:
= $self->model('Outreach')->get_overdue_packs({ notifications => 1 });
$self->tt_params( requests => $data ); # warn Dumper $requests;
# callback to extract GP surname (split $_[0] on space, return 1st element):
my $referrer = sub { (split(' ', shift))[0] };
$self->tt_params( get_referrer_surname => $referrer );
return 1;
}
# ------------------------------------------------------------------------------
sub outreach_notification_dispatch : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->outreach_notifications(); # uses same data & tt params (except callback)
}
# ------------------------------------------------------------------------------
sub outreach_report_labels : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return 1; # requires date input - function handled by Outreach controller
}
# ------------------------------------------------------------------------------
sub outreach_reports_to_issue : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $data = $self->model('Outreach')->reports_to_issue;
$self->tt_params( requests => $data );
return 1;
}
# ------------------------------------------------------------------------------
sub outreach_pack_dispatch : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $data = $self->model('Outreach')->get_packs_due_summary;
$self->tt_params( packs => $data );
return 1;
}
# ------------------------------------------------------------------------------
sub outreach_packs_future : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $data = $self->model('Outreach')->get_packs_due_future;
$self->tt_params( packs => $data );
return 1;
}
# ------------------------------------------------------------------------------
sub _pcr_and_sequencing_worksheet { # used by sequencing_worksheet() & pcr_worksheet()
my $self = shift; $self->_debug_path();
my $args = shift;
my $function = $args->{function};
my $status = $args->{status};
# set worklist name from 'function' arg:
$self->tt_params( worklist_function => $function );
# set tt name (override default set by runmode) - do BEFORE possible return:
$self->tt_name('worklist/local/pcr_and_sequencing_worksheet.tt');
# lab_test_id can be multi-select:
my @test_ids = $self->query->param('lab_test_id'); # warn Dumper \@test_ids;
if (@test_ids) { # get requests for status option = new PCR lab-test(s):
my $option_id = do {
my $map = $self->lab_test_status_options_map('description'); # warn Dumper $map;
$map->{$status}->{id};
};
my $args = { lab_test_id => \@test_ids, status_option_id => $option_id };
# add request.id's if supplied by form (for printing final list):
if ( my @params = $self->query->param('request_specimen') ) {
# extract request_id's from request_specimen form param:
my $request_id = $self->_extract_request_specimen(\@params); # arrayref
$args->{request_id} = $request_id;
}
my $o = $self->model('WorkList')->get_outstanding_investigations($args);
$self->tt_params( requests => $o );
{ # get test name(s):
my $tests_map = $self->lab_tests_map;
my @test_names = map $tests_map->{$_}, @test_ids; # warn Dumper \@test_names;
$self->tt_params( test_names => \@test_names );
}
my @request_ids = do { # get unique request id.s:
my %h = map +($_->request_id => 1), @$o;
keys %h;
}; # warn Dumper \@request_ids;
return 0 if ! @request_ids; # no need to continue
{ # specimen map:
my $specimen_map = $self->specimen_map(\@request_ids);
$self->tt_params( specimen_map => $specimen_map );
}
{ # request_options:
my $map = $self->request_options_map(\@request_ids);
$self->tt_params( request_options_map => $map );
}
if ( $function eq 'PCR' ) { # dna/rna extraction status:
my %args = (
request_id => \@request_ids,
lab_test_id => \@test_ids,
); # warn Dumper \%args;
my $extraction_status = $self->_get_xna_extraction_status(\%args);
$self->tt_params( extraction_status => $extraction_status );
}
# add lab test ids for tt to pass back as hidden fields:
$self->tt_params( lab_test_ids => \@test_ids );
# override tt_name to load a printable worksheet tmpl if flag passed:
if ( $self->query->param('print_worksheet') ) {
my $tt = 'worklist/local/molecular/pcr_and_sequencing_worksheet.tt';
$self->tt_name($tt);
}
}
else {
my $lab_tests = $self->_get_section_lab_tests('Molecular');
$self->tt_params( lab_tests => $lab_tests );
}
return 1;
}
# ------------------------------------------------------------------------------
sub _format_lab_test_data {
my ($self, $test_name) = @_; $self->_debug_path();
# get lab_test:
my $lab_test = $self->get_lab_test_for_unique_test_name($test_name)
|| # have to die as default() caller doesn't handle err rtn:
die "test_name = '$test_name' either not found, or is not unique";
# get requests where test status is not complete:
my $data = $self->model('WorkList')
->get_outstanding_investigations({ lab_test_id => $lab_test->id });
$self->tt_params( requests => $data );
# get a list of unique request_ids, return if empty:
my $request_ids = $self->get_unique_request_ids($data); # warn Dumper $request_ids;
return 0 unless @$request_ids;
{ # get specimen_map for requests:
my $specimen_map = $self->specimen_map($request_ids);
$self->tt_params( specimen_map => $specimen_map );
}
{ # request_options:
my $map = $self->request_options_map($request_ids);
$self->tt_params( request_options_map => $map );
}
{ # get lab_test history for test:
my %args = (
request_ids => $request_ids,
field_label => $lab_test->field_label, # history table uses field label
);
my $lab_test_status_map
= $self->lab_test_status_for_field_label_map(\%args);
$self->tt_params( lab_test_status_map => $lab_test_status_map );
}
{ # get test results:
my %args = (
request_id => $request_ids,
lab_section_id => $lab_test->lab_section_id,
);
my $results_map # may return empty, so default is empty hashref:
= $self->get_lab_test_results_for_lab_section(\%args) || {};
$self->tt_params( results_map => $results_map ); # warn Dumper $results_map;
}
return 1;
}
# get pieces_and_blocks results:
sub _pieces_and_blocks {
my ($self, $unique_ids) = @_; # arrayref of request_ids
my $all_results =
$self->model('Result')->get_request_lab_test_results($unique_ids);
my %h; # capture last numerical character of result eg 5ae(2), (1)AE:
for my $r (@$all_results) {
next unless $r->lab_test->test_name eq 'pieces_blocks';
my $request_id = $r->request_id;
my $result = $r->result; # warn $result;
$result =~ s/\D//g; # remove non-numerical chars # warn $result;
$h{$request_id} = substr($result, -1); # last digit
} # warn Dumper \%h;
return \%h;
}
# get external_refs:
sub _external_refs {
my ($self, $unique_ids) = @_; # arrayref of request_ids
my %args = ( query => [ request_id => $unique_ids ] );
my $o = $self->model('Base')->get_objects('RequestExternalRef', \%args);
my $sum = sub { LIMS::Local::Utils::sum_list(@_) };
my %h;
for my $r(@$o) {
my $request_id = $r->request_id;
my $n = &$sum([ 0, $r->external_reference =~ /x\s?(\d+)p/ig ]);
# warn Dumper [$r->external_reference, $n];
$h{$request_id} = $n;
}
return \%h;
}
# ------------------------------------------------------------------------------
# require separate entries for xFU composite samples, and then multiply each
# specimen by number of blocks from pieces_blocks & external_ref data:
sub _xna_extraction_specimen_map {
my ($self, $request_ids) = @_; # arrayref
my $specimen_map = $self->specimen_map($request_ids); # warn Dumper $map;
my $ext_ref_map = $self->_external_refs($request_ids);
my $blocks_map = $self->_pieces_and_blocks($request_ids);
while ( my ($request_id, $data) = each %$specimen_map ) {
my @sample_code = @{ $data->{sample_code} }; # arrayref
{ # separate xFU into xF & xU:
my $str = join ',', @sample_code; # easiest to create a ...
$str =~ s/(\w)FU/$1F,$1U/g; # temp string and substitute
@sample_code = split ',', $str; # warn Dumper \@sample_code;
}
{ # multiply xU & xF by number of blocks from pieces_blocks result:
my $blocks = $blocks_map->{$request_id} || 1;
if ( $blocks > 1 ) { # warn $blocks;
my @expanded = map { # expands xU & xF by no. of blocks:
($_) x ( /(F|U)$/ ? $blocks : 1 )
} @sample_code; # warn Dumper [$blocks, \@expanded];
@sample_code = @expanded;
}
}
{ # multiply xBL by number of blocks from external_ref entry:
my $blocks = $ext_ref_map->{$request_id} || 1;
if ( $blocks > 1 ) { # warn $blocks;
my @expanded = map { # expands xBL by no. of blocks:
($_) x ( /BL$/ ? $blocks : 1 )
} @sample_code; # warn Dumper [$blocks, \@expanded];
@sample_code = @expanded;
}
}
# replace $d->{sample_code} with (possibly) expanded @sample_code:
my @data_refs = ( $data->{sample_code}, \@sample_code );
$data->{sample_code} = \@sample_code if
LIMS::Local::Utils::array_diff_count(@data_refs);
}
return $specimen_map;
}
# ------------------------------------------------------------------------------
# shared between pcr_worksheet() & chimerism_worksheet():
sub _get_xna_extraction_status {
my $self = shift;
my $args = shift;
my $o = $self->model('Local')->get_xna_extraction_status($args);
my %h;
for my $req (@$o) { # warn Dumper
my $id = $req->id; # request.id
# request_lab_tests_status is arrayref (1-2-many rel), even
# though should only be dna OR rna extraction associated per test:
my $test_status = $req->request_lab_tests_status; # arrayref
TEST: for (@$test_status) { # warn Dumper $_->as_tree;
my $test_name = $_->lab_test->test_name; # only want extractions:
next TEST unless $test_name =~ /[dr]na_extraction\Z/;
my %data = (
test_name => $test_name,
status => $_->status->description,
);
push @{ $h{$id} }, \%data;
};
}
return \%h;
}
# ------------------------------------------------------------------------------
# need labno, sample type, last_name, flow_details & array of lab-test data for
# flow screen section for each entry in $flow_data:
sub _parse_flow_screen_data {
my ($self, $flow_screen_data) = @_; $self->_debug_path();
my $data; # hashref to hold parsed flow screen data
REQUEST: # foreach request in $flow_screen_data:
for my $request( @$flow_screen_data ) {
# create lab_number in '%02d_%05d' format:
my $lab_number = sprintf '%02d_%05d',
$request->request->year - 2000,
$request->request->request_number;
# get lab-test data:
my %lab_test_data = (
name => $request->lab_test->test_name,
user => $request->user->as_tree,
status => $request->status->description,
);
# if lab_tests attr exists from any previous loop, just add new lab-test data:
if ( my $lab_test_data = $data->{$lab_number}->{lab_tests} ) {
push @$lab_test_data, \%lab_test_data;
next REQUEST;
}
# create arrayref structure for lab_test_data, for re-use in any future loop:
$data->{$lab_number}->{lab_tests} = [ \%lab_test_data ];
$data->{$lab_number}->{request_id} = $request->request->id;
$data->{$lab_number}->{patient}
= $request->request->patient_case->patient->as_tree;
}
return $data;
# my @data = map { $_->as_tree(deflate => 0) } @$data; # preserve datetime
}
sub _parse_haem_data {
my ($self, $data) = @_; # warn Dumper $data; # AoH
my @fields = qw( wbc rbc hb plt hct mcv mch mchc lymph_percent lymph
mixed_percent mixed neutr_percent neutr );
my $flag = {}; # hashref of params with flags
my $NULL = qr{[*0]000}; # *000 or 0000
for my $d(@$data) {
my $lab_number = $d->{lab_number};
PARAM: for my $f(@fields) {
my $flag_field = sprintf '%s_f', $f; # eg hb_f, wbc_f, mixed_f, etc
# add row param to $flag if <param>_f > 0, or param value = *000 or 0000:
$flag->{$lab_number}{$f}++ if $d->{$flag_field} || $d->{$f} =~ /^$NULL\Z/;
next PARAM if $d->{$f} =~ /^$NULL\Z/; # don't calculate, just report param
# adjust sysmex params to 'real' values:
if ( $f eq 'rbc' ) {
$d->{rbc} = sprintf '%.2f', $d->{rbc} / 100; # rbc to 2dp eg 0277 => 2.77
}
elsif ( grep $f eq $_, qw/hb plt mchc/ ) {
$d->{$f} = $d->{$f} / 1; # convert to int eg 0080 => 80, 0277 => 277
}
else { # convert to 1dp eg 0080 => 8.0, 0277 => 27.7
$d->{$f} = sprintf '%.1f', $d->{$f} / 10;
}
}
} # warn Dumper \%flag;
$self->tt_params(
param_fields => \@fields,
param_flags => $flag,
);
}
sub _get_section_lab_tests {
my ($self, $section_name) = @_;
my %query = (
section_name => $section_name,
test_type => 'test', # or comment out if panels required
is_active => 'yes',
);
my $sort_by = 'field_label'; # optional
my $data = $self->model('LabTest')->get_section_lab_tests(\%query, $sort_by);
return $data;
}
# split request_specimen form param into request_id & specimen, return request_ids:
# shared between pcr_worksheet() & xna_extraction_worksheet()
sub _extract_request_specimen {
my ($self, $params) = @_; # warn Dumper $params; # arrayref
my %map;
for (@$params) {
# data in "request_id~specimen" format (request_specimen lacks 'id' col):
my ($request_id, $specimen) = split '~';
push @{ $map{$request_id} }, $specimen; # create array of specimens
} # warn Dumper \%map;
$self->tt_params( request_specimen_map => \%map );
# extract (unique) request_id's:
my @request_ids = keys %map;
return \@request_ids;
}
1;
