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::Misc', 'LIMS::Controller::Roles::History', 'LIMS::Controller::Roles::DataMap', 'LIMS::Controller::Roles::DataFile', ); use Data::Dumper; __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' ); # 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: my $tmpl = 'worklist/local/'.$function_name.'.tt'; return $self->render_view($tmpl, {}); } # ------------------------------------------------------------------------------ # 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($self->get_current_runmode); # optional list of lab-tests my @param = $self->query->param('param'); # warn Dumper \@param; { # get data for flow screen panels: # need to supply list of lab_test id's to model: my $lab_test_names = @param ? \@param : $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 = { 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_ids($flow_screen_data); { # get specimen_map for template: my $map = $self->specimen_map($unique_ids); $self->tt_params( specimen_map => $map ); } { # get section notes for flow cytometry section: # stash section object for request_section_notes_map(): my $lab_section = $self->model('LabSection') ->get_lab_section_by_name('Flow cytometry'); $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 gross_description : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $id = $self->param('id'); if ($id) { # update request_gross_description table & redirect back to worklist: my $vars = $self->query->Vars; # warn Dumper $vars; $vars->{request_id} = $id; # warn Dumper $vars; my $rtn = $vars->{detail} # 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($self->get_current_runmode); # 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($self->get_current_runmode); 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_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 ); } return 1; } # ------------------------------------------------------------------------------ sub histology_staining : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); # 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($self->get_current_runmode); # 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_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 ); } { # 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($self->get_current_runmode); # 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_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 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_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 _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_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 ); } { # 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; } # ------------------------------------------------------------------------------ # 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, ); } 1;