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', ); has 'tt_name' => (is => 'rw', isa => 'Str'); 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 (unless supplied in rm): $self->tt_name || $self->tt_name('worklist/local/'.$function_name.'.tt'); return $self->render_view($self->tt_name, {}); } # ------------------------------------------------------------------------------ # 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_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(): $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_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_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(); # 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_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 xna_stabilisation_worksheet : Runmode { my $self = shift; $self->_debug_path(); # not called directly # DNA & RNA extraction: my %args = ( lab_test => [ qw(dna_extraction rna_extraction) ], status => 'new', # status to get ); return $self->_xna_extraction(\%args); } # ------------------------------------------------------------------------------ sub dna_extraction_worksheet : Runmode { my $self = shift; $self->_debug_path(); # not called directly my %args = ( lab_test => [ qw(dna_extraction) ], status => 'stabilised', # status to get ); $self->tt_params( extraction_type => 'DNA' ); return $self->_xna_extraction(\%args); } # ------------------------------------------------------------------------------ sub rna_extraction_worksheet : Runmode { my $self = shift; $self->_debug_path(); # not called directly my %args = ( lab_test => [ qw(rna_extraction) ], status => 'stabilised', # status to get ); $self->tt_params( extraction_type => 'RNA' ); return $self->_xna_extraction(\%args); } # ------------------------------------------------------------------------------ # 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 $status = $args->{status}; # get lab-test id's corresponding to lab_test arrayref entries: my @lab_test_ids = do { my %args = ( section_name => 'Molecular' ); 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_ids($data); # arrayref of request_ids return 1 unless @$unique_ids; # or next 2 blocks throw error: { # 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 ); } { # Molecular section lab-tests my %args = ( section_name => 'Molecular', 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 ); } } } return 1; } # ------------------------------------------------------------------------------ sub xna_extraction_worksheet : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $extraction_type = lc $self->query->param('extraction_type'); # DNA or RNA # get request_id's from request_specimen form param: my $request_id = $self->_extract_request_specimen(); # 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_extraction_worksheet', $self->query->url(), $extraction_type; 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; } { # specimen map: my $specimen_map = $self->specimen_map($request_id); $self->tt_params( specimen_map => $specimen_map ); } { # 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; } my $tt = "worklist/local/molecular/${extraction_type}_extraction.tt"; return $self->render_view($tt); } # ------------------------------------------------------------------------------ sub pcr_worksheet : Runmode { my $self = shift; $self->_debug_path(); # 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'); $map->{new}->{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 ( $self->query->param('request_specimen') ) { # extract request_id's from request_specimen form param: my $request_id = $self->_extract_request_specimen(); # 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 ); } { # 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 ); # load printable worksheet template if print_worksheet flag passed: if ( $self->query->param('print_worksheet') ) { $self->tt_name('worklist/local/molecular/pcr_worksheet.tt'); } } else { my $lab_tests = $self->_get_section_lab_tests('Molecular'); $self->tt_params( lab_tests => $lab_tests ); } return 1; } # ------------------------------------------------------------------------------ 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 ); } } # ------------------------------------------------------------------------------ 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; } # ------------------------------------------------------------------------------ # 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 %args = ( section_name => $section_name, test_type => 'test', is_active => 'yes', ); # warn Dumper \%args; my $data = $self->model('LabTest')->get_section_lab_tests(\%args); 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 = shift; my %map; # form data in "request_id~specimen" format (request_specimen lacks 'id'): my @params = $self->query->param('request_specimen'); for (@params) { my ($request_id, $specimen) = split '~'; $map{$request_id}{$specimen}++; } # warn Dumper \%map; $self->tt_params( request_specimen_map => \%map ); # extract (unique) request_id's: my @request_ids = keys %map; return \@request_ids; } 1;