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 Spreadsheet::WriteExcel::Simple;
use Data::Dumper;
use Array::Diff;
use IO::All;
use LIMS::Controller::Local::Labels;
__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');
# all done if it's an xl file export (headers set upstream):
return $self->stash->{xl_data} if $self->stash->{xl_data};
# 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');
# lab_test status_options for this section:
my $lab_test_status_options
= $self->get_status_options_for_select($lab_section->id);
$self->tt_params( status_opts => $lab_test_status_options );
# want to hide status = 'analysed' unless explicitly requested:
if (! $status_option_id ) { # warn Dumper $lab_test_status_options;
# get map of lab_test_status_options, key = description:
my $map = $self->lab_test_status_options_map('description'); # warn Dumper $map;
# required id's = all except status = analyzed;
my @wanted = map $map->{$_->{description}}->{id},
grep $_->{description} ne 'analysed',
@$lab_test_status_options; # warn Dumper \@wanted;
$status_option_id = \@wanted;
}
{ # 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,
}; # warn Dumper $args;
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;
}
}
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 );
}
my $requests = $self->model('Outreach')->get_outstanding_clinic_returns;
$self->tt_params( requests => $requests );
return 1;
}
# ------------------------------------------------------------------------------
sub outreach_cml_prescription : 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 );
}
my $requests = $self->model('Outreach')->get_cml_prescriptions;
$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); # warn Dumper $specimen_map;
# tt skips any unwanted sample types (BMA/T, PB, etc)
$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_sample_report_rare_disease { shift->genomics_sample_report }
# ------------------------------------------------------------------------------
sub genomics_sample_report_cancer { shift->genomics_sample_report }
# ------------------------------------------------------------------------------
sub genomics_recruitment_report { shift->genomics_sample_report }
# ------------------------------------------------------------------------------
# common function for recruitment_report and rare_disease & cancer sample reports:
sub genomics_sample_report {
my $self = shift; $self->_debug_path();
my $date_begin = $self->query->param('date_begin'); # warn $date_begin;
my $date_end = $self->query->param('date_end'); # warn $date_end;
my $type = $self->query->param('function_name'); # warn $type;
$self->tt_params( type => $type );
if ( $date_begin && $date_end ) {
my $parser = sub { LIMS::Local::Utils::to_datetime_using_datecalc(@_) };
my $start_date = &$parser($date_begin);
my $end_date = &$parser($date_end); # warn ( $start_date < $end_date );
# check begin not after end:
if ( $start_date > $end_date ) {
my $msg = "start date $date_begin is *after* end date $date_end"; # warn $msg;
# $self->flash( error => $msg );
# my $url = $self->query->url(-path_info => 1) . '?function_name=' . $type;
# return $self->redirect($url); # does not print flash msg - wtf??
$self->stash ( error => $msg );
}
else {
my %h = (
start => $start_date,
type => $type,
end => $end_date,
);
my $data = $self->model('Local')->genomics_sample_report(\%h); # warn Dumper $data;
# return xls file if requested:
if ( my $param = $self->query->param('action') ) {
# formats data for xl:
return $self->_genomics_recruitment_export_format($data)
if $param eq 'Export';
}
$self->tt_params( reports => $data );
}
}
else {
my $today = LIMS::Local::Utils::today;
my %h = (
begin => $today->clone->subtract( days => 7 )->dmy,
end => $today->dmy,
);
$self->tt_params( dates => \%h );
}
my $tt_name = 'sample_report.tt';
# override tt name & get screen data if genomics_recruitment_report:
if ( $type eq 'genomics_recruitment_report') {
my $screens = $self->model('Screen')->get_all_screens;
$self->tt_params( screens => $screens );
$tt_name = 'recruitment_report.tt';
}
$self->tt_name('worklist/local/genomics/' . $tt_name);
return 1;
}
# ------------------------------------------------------------------------------
sub _genomics_recruitment_export_format {
my ($self, $data) = @_;
my $xl = Spreadsheet::WriteExcel::Simple->new;
my @headers = (
'Lab number', 'Last Name', 'First Name', 'NHS number', 'Participant ID',
'Presentation', 'Family ID', 'Source', 'Participant type', 'Registered',
'Consent given', 'Blood taken', 'OMICS taken', 'Blood DNA QC',
'Tumour resected', 'Tumour type', 'Tumour DNA QC', 'DNA dispatched',
'OMICS dispatched','Consent withdrawn'
);
$xl->write_bold_row(\@headers);
my $vars = $self->query->Vars(); # warn Dumper $vars;
REC:
for my $record (@$data) {
# apply filters:
if ( my $organisation_filter = $vars->{organisation} ) {
next REC if $organisation_filter eq 'leeds' &&
$record->{organisation} =~ /SHEFFIELD/;
next REC if $organisation_filter eq 'sheffield' &&
$record->{organisation} !~ /SHEFFIELD/;
}
if ( my $disease_type = $vars->{disease_type} ) {
if ( $disease_type eq 'all_cancer' ) {
next REC if $record->{presentation} eq 'Rare disease';
}
elsif ( $disease_type eq 'rd' ) {
next REC if $record->{presentation} ne 'Rare disease';
}
else { # must be specific cancer:
next REC unless $record->{presentation} eq $disease_type;
}
}
# add fields requiring pre-evaluation:
{ # lab number:
my $lab_number = join '/', $record->{request_number},
$record->{year} - 2000;
$record->{lab_number} = $lab_number;
}
{ # participant type:
my $participant_type = ( $record->{presentation} eq 'Rare disease' )
? $record->{family_id}
? ( $record->{unit_number} == $record->{family_id} )
? 'Proband' # unit number = family id
: 'Relative' # unit number != family id
: 'UNKNOWN' # RD with no family ID
: 'N/A'; # cancer type
$record->{participant_type} = $participant_type;
}
{ # OMICS sample taken:
my $has_omics = grep $record->{$_}, qw/paxgene_rna sst pst ccft_dna/;
$record->{omics_taken} = $has_omics ? 'Y' : 'N';
}
# adjust disease-type specific vals:
if ( $record->{presentation} eq 'Rare disease' ) {
map $record->{$_} = 'N/A',
qw(tumour_sample_taken clinic_sample_type tumour_summary_qc);
}
else { # cancer-type - family id not relevant
$record->{family_id} = 'N/A';
}
my @vars = map $record->{$_}, qw(
lab_number last_name first_name nhs_number unit_number presentation
family_id location participant_type registered consent_date
sample_taken omics_taken blood_summary_qc tumour_sample_taken
clinic_sample_type tumour_summary_qc dna_dispatched omics_dispatched
withdrawal_option
); # warn Dumper \@vars;
$xl->write_row(\@vars);
}
my $formatter = DateTime::Format::Strptime->new( pattern => '%Y%m%d' );
my $filename = sprintf 'genomics-recruitment-report-%s.xls',
LIMS::Local::Utils::time_now({ formatter => $formatter });
# set headers:
$self->header_props(
-type => 'application/excel',
-attachment => $filename,
-expires => 'now'
);
$self->stash( xl_data => $xl->data ); # also blocks tt loading in default()
}
# ------------------------------------------------------------------------------
sub genomics_slf_rare_disease { shift->genomics_slf_requests }
# ------------------------------------------------------------------------------
sub genomics_slf_haemonc { shift->genomics_slf_requests }
# ------------------------------------------------------------------------------
sub genomics_slf_cancer { shift->genomics_slf_requests }
# ------------------------------------------------------------------------------
# common function for rare_disease, haemonc & cancer slf requests:
sub genomics_slf_requests {
my $self = shift; $self->_debug_path();
my $type = $self->query->param('function_name');
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_param = $self->query->param('slf_type')
or return $self->error('no slf_type param passed to ' . $self->current_rm);
my ($slf_type) = $slf_type_param =~ /genomics_slf_(.*)/ # need to use 'or', not '||':
or return $self->error('cannot determine SLF type from ' . $slf_type_param); # warn $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;
# set slf_type for tt to load appropriate barcode snippet:
if ( $slf_type =~ /cancer/ ) { # 2 forms per request:
for my $barcode_type( qw/cancer_blood cancer_tissue/ ) {
$self->tt_params( slf_type => $barcode_type );
my $ref = $self->render_view($tmpl, { data => $req });
$html .= $$ref; # de-refererence it 1st
}
}
elsif ( $slf_type =~ /haemonc/ ) { # 10 labels split over 2 forms:
for my $barcode_type( qw/haemonc1 haemonc2/ ) {
$self->tt_params( slf_type => $barcode_type );
my $ref = $self->render_view($tmpl, { data => $req });
$html .= $$ref; # de-refererence it 1st
}
}
else {
$self->tt_params( slf_type => $slf_type );
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
my @lab_tests = qw( dna_extraction rna_extraction cd138_dna
100kg_dna_extraction);
# DNA & RNA extraction:
my %args = (
section => 'Molecular',
lab_test => \@lab_tests,
status => 'new', # status to get
);
return $self->_xna_extraction(\%args);
}
# ------------------------------------------------------------------------------
sub dna_extraction_worksheet {
my $self = shift; $self->_debug_path();
my @lab_tests = qw( dna_extraction cd138_dna );
my %args = (
section => 'Molecular',
lab_test => \@lab_tests,
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 trial_plasma_storage {
my $self = shift; $self->_debug_path();
my %args = (
section => 'Clinical trials',
lab_test => [ qw(store_plasma) ],
status => 'new', # status to get
);
$self->tt_name('worklist/local/plasma_storage_worksheet.tt');
return $self->_xna_extraction(\%args); # uses same logic as XNA extraction
}
# ------------------------------------------------------------------------------
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 plasma_storage_worksheet : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars(); # warn Dumper $vars;
my $function_name = $vars->{function_name} # trial_dna_extraction, rna_extraction, etc
|| return $self->error('no function name param submitted'); # warn $function_name;
# get request_id's from request_specimen form param:
my @params = $self->query->param('request_specimen'); # from query param, as array!!
$self->session->param( store_plasma_request_specimen => \@params );
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);
}
{ # 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->stash( requests => $requests ); # for trial numbers
$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;
}
{ # trial numbers:
my $requests = $self->stash->{requests}; # warn Dumper $requests;
my @patient_ids = map $_->patient_case->patient_id, @$requests; # warn Dumper \@patient_ids;
# trial ID for Maple:
my $trial_id = $self->model('Base')->get_object_by_param('ClinicalTrial',
{ trial_name => 'SCTU MaPLe' })->id; # warn $trial_id;
my %args = (
patient_id => \@patient_ids,
trial_id => $trial_id,
);
my $trial_numbers =
$self->model('ClinicalTrial')->get_trial_numbers(\%args);
$self->tt_params( trial_number_map => $trial_numbers );
}
{ # specimen taken dates:
my @args = (
RequestSpecimenDetail => { query => [ request_id => $request_id ] },
);
my $o = $self->model('Base')->get_objects(@args);
my %map = map { $_->request_id => $_->specimen_date } @$o;
$self->tt_params( specimen_date => \%map ); # warn Dumper \%map;
}
# some params for .tt:
$self->tt_params( function_name => $function_name );
my $tt = 'worklist/local/trials/plasma_storage.tt';
return $self->render_view($tt);
}
# ------------------------------------------------------------------------------
sub plasma_storage_labels : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars(); # warn Dumper $vars;
# retrieve data from session (param = store_plasma_request_specimen):
my $session_data = $self->session->param('store_plasma_request_specimen');
# warn Dumper $session_data;
my @data;
for (@$session_data) {
my ($req_id, $specimen) = split '~';
my $o = $self->model('Request')->get_patient_and_request_data($req_id);
# $self->debug( [$o->request_number, $o->year] );
my %d = (
request => $o->as_tree(max_depth => 0), # only want base object data
patient => $o->patient_case->patient->as_tree, # don't need dt object
specimen => $specimen,
);
push @data, \%d;
} # warn Dumper \@data;
my $tt = 'worklist/local/trials/plasma_storage_labels.tt';
return $self->render_view($tt, { data => \@data }); # need to pass tt as 1st arg
}
# ------------------------------------------------------------------------------
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('xna_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:
unless ( $have_session_data ) { # unless already there
my @params = $self->query->param('request_specimen'); # warn Dumper \@params;
$self->session->param( xna_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->_molecular_worksheets(\%args);
}
# ------------------------------------------------------------------------------
sub pcr_worksheet : Runmode {
my $self = shift; $self->_debug_path();
my %args = (
function => 'PCR',
status => 'new', # required lab-test status
);
return $self->_molecular_worksheets(\%args);
}
# ------------------------------------------------------------------------------
sub cell_selection_worksheet : Runmode {
my $self = shift; $self->_debug_path();
my %args = (
function => 'Cell_selections',
status => 'new', # required lab-test status
);
return $self->_molecular_worksheets(\%args);
}
# ------------------------------------------------------------------------------
sub mlpa_quantification : Runmode {
my $self = shift; $self->_debug_path();
{ # get lab_test_id as query param for mlpa_quantification (no point selecting
# sole test on form):
my %args = (
section_name => 'Molecular',
test_name => 'mlpa_quantification',
);
my $test_id = $self->model('LabTest')->get_section_lab_test(\%args)->id; # warn $test_id;
$self->query->param( lab_test_id => $test_id ); # used downstream
}
my %args = (
function => 'MLPA_quantification',
status => 'new', # required lab-test status
);
return $self->_molecular_worksheets(\%args);
}
# ------------------------------------------------------------------------------
sub mlpa_myeloma : Runmode {
my $self = shift; $self->_debug_path();
{ # get lab_test_id as query param for mlpa_myeloma (no point selecting
# sole test on form):
my %args = (
section_name => 'Multiplex Ligation-dependent Probe Amplification',
test_name => 'mlpa_myeloma',
);
my $test_id = $self->model('LabTest')->get_section_lab_test(\%args)->id; # warn $test_id;
$self->query->param( lab_test_id => $test_id ); # used downstream
}
my %args = (
function => 'MLPA_myeloma',
status => 'new', # required lab-test status
);
return $self->_molecular_worksheets(\%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,
function => 'Chimerism',
); # 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 _molecular_worksheets {
my $self = shift; $self->_debug_path();
my $args = shift;
my $function = $args->{function}; # warn $function;
my $status = $args->{status}; # warn $status;
my $vars = $self->query->Vars(); # warn Dumper $vars; # don't use for list-mode (eg test_ids)
# 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 %label_data;
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;
if ($function eq "Cell_selections") {
$label_data{request_specimen} = \@params;
}
}
my $o = $self->model('WorkList')->get_outstanding_investigations($args);
$self->tt_params( requests => $o );
if ($function eq "Cell_selections") {
$label_data{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 =~ /PCR|MLPA/ ) { # get dna/rna extraction, mlpa_quant or cd138_dna status:
my %args = (
request_id => \@request_ids,
lab_test_id => \@test_ids,
function => $function,
); # 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 ( $vars->{print_worksheet} ) {
my $template_file =
$function eq "Cell_selections"
? 'cell_selection'
: 'pcr_and_sequencing';
if ( $function eq "Cell_selections" and $vars->{print_labels} ) {
# do label printing
my $label = LIMS::Controller::Local::Labels->new;
$label->print_cell_selection_labels($self,\%label_data);
}
my $tt = "worklist/local/molecular/${template_file}_worksheet.tt";
$self->tt_name($tt);
}
}
else {
my $section = $function eq "Cell_selections"
? "Cell selections"
: 'Molecular';
my $lab_tests = $self->_get_section_lab_tests($section);
$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 $function = $args->{function}; # warn $function; # eg PCR, MLPA_quant, Chimerism
# only want d/rna extraction for PCR & Chimerism, cd138_dna for MLPA_quant:
my $test_name_re = ( $function eq 'MLPA_quantification' )
? 'cd138_dna' : ( $function eq 'MLPA_myeloma' )
? 'mlpa_quantification' : '[dr]na_extraction'; # warn $test_name_re;
my %h;
for my $req (@$o) {
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 d/rna extraction for PCR, cd138_dna for MLPA:
next TEST unless $test_name =~ /$test_name_re\Z/;
my %data = (
test_name => $test_name,
status => $_->status->description,
);
push @{ $h{$id} }, \%data;
};
} # warn Dumper \%h;
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;
