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 trial_store_plasma { 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/store_plasma_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 store_plasma_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 or session: my @params = $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); } { # 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 ); my $tt = 'worklist/local/trials/store_plasma.tt'; return $self->render_view($tt); } # ------------------------------------------------------------------------------ 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 _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;