package LIMS::Controller::Roles::RecordHandler; use Moose::Role; use LIMS::Local::Utils; has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1, ) for qw(status_options_map additional_options_map ); use Data::Dumper; use IO::All; # ------------------------------------------------------------------------------ sub get_single_request_data { my ($self, $request_id) = @_; $self->_debug_path('timer'); # warn $request_id; #warn 'here'; # get 'horizontal' data (from tables returning single row joined on request_id): my $request_data = $self->model('Request')->get_single_request($request_id) || return 0; # in case request_id manually input into url and doesn't exist #warn 'here'; # request history data: my $request_history = $self->_parse_request_history($request_data); #warn 'here'; # request.id => [ specimen_code(s) ] map - needs arrayref of request.id's: my $specimen_map = $self->specimen_map([ $request_data->id ]); #warn 'here'; # get unprocessed lab_test data (all lab tests, this requests' lab_tests, # result_summaries, lab_sections, etc): my $raw_lab_test_data = $self->_get_lab_test_data($request_data); #warn 'here'; my $outstanding_tests = $self->_get_outstanding_tests($raw_lab_test_data); #warn 'here'; # format result summaries for template: my $result_summaries = $self->_format_result_summaries($raw_lab_test_data); #warn 'here'; # format remote system numbers my $remote_system_ids = $self->_format_remote_system_ids($raw_lab_test_data); #warn 'here'; # diagnosis history my $previous_diagnoses = $self->model('Request')->get_previous_diagnoses($request_id); #warn 'here'; # request status_options: my $status_options = $self->status_options_map; #warn 'here'; # request_options: my $request_options = $self->_get_request_options($request_id); #warn 'here'; # request_consent: my $request_consent = $self->_get_request_consent($request_id); #warn 'here'; # lab section notes map: my $lab_section_notes = $self->section_notes_map($request_id); #warn 'here'; my $has_phonelog = $self->model('PhoneLog')->get_phonelog_count($request_id); #warn 'here'; # to save template-derived db queries (or use as_tree): my $might_have = $self->_get_might_have_data($request_data); #warn 'here'; # any special formatting for template? my $special_tmpl_formatting = $self->_get_special_formatting($request_data) || {}; # needs hashref #warn 'here'; # has, or is elegible for, clinical data: my $clinical_data_link = $self->_format_clinical_data_link($request_data); #warn 'here'; my $is_locked = $self->_set_request_status($request_data); $self->_debug_path('timer'); return { data => $request_data, history => $request_history, is_locked => $is_locked, has_optional => $might_have, has_phonelog => $has_phonelog, specimen_map => $specimen_map, status_options => $status_options, request_options => $request_options, request_consent => $request_consent, result_summaries => $result_summaries, outstanding_tests => $outstanding_tests, raw_lab_test_data => $raw_lab_test_data, lab_section_notes => $lab_section_notes, remote_system_ids => $remote_system_ids, clinical_data_link => $clinical_data_link, previous_diagnoses => $previous_diagnoses, special_formatting => $special_tmpl_formatting, } } #------------------------------------------------------------------------------- sub get_previous_cases { my ($self, $request_data) = @_; my $patient_case = $request_data->{data}->patient_case; my $patient = $patient_case->patient; my %matches; my %args = ( last_name => $patient_case->patient->last_name, first_name => $patient_case->patient->first_name, or => [ unit_number => $patient_case->unit_number, dob => $patient_case->patient->dob, ], ); my $o = $self->model('Request')->get_previous_requests(\%args); while ( my $record = $o->next ) { # skip current request: next if $record->id == $request_data->{data}->id; if ( $record->patient_case->patient_id == $patient_case->patient_id ) { push @{ $matches{this_id} }, $record; # same patient, different request } else { # patient cannot have same nhs_number as current request or would # match above, and same patient cannot have a different nhs_number: next if $patient->nhs_number && $record->patient_case->patient->nhs_number; push @{ $matches{others} }, $record; } } # skip current request: # my @records = grep { $_->id != $request_data->{data}->id } @$o; # $matches{nhs_number} = \@records; return \%matches; } #------------------------------------------------------------------------------- # shared by print_record (via format_report) & print_run to process request-specific # data for tt params; returns hashref of data: sub format_print_record_request_data { my ($self, $request_id) = @_; my $request_data = $self->get_single_request_data($request_id); # format lab_test data for print template: if ($request_data->{special_formatting}->{has_outreach}) { my $data = $self->model('Outreach')->get_all_data($request_data->{data}->{id}); $request_data->{outreach} = $data; $self->stash( css_required => 1 ); # for format_report() - uses wkhtmltopdf } else { $self->process_raw_lab_test_data($request_data); { # request_dispatch_logs: my $dispatch_log = $self->model('Request')->get_request_dispatch_logs($request_id); $self->tt_params( dispatch_log => $dispatch_log ); } { # request_error_codes: my $errors = $self->model('Request')->get_request_errors($request_id); $self->tt_params( request_errors => $errors ); } } return $request_data; } #------------------------------------------------------------------------------- # used by Request::do_email_report() to remove patient identifiers for non-secure addr sub anonymise_report { my ($self, $request_id) = @_; # process request-specific data for template & return hashref of data: my $data = $self->format_print_record_request_data($request_id); my $request = $data->{data}; # warn Dumper $data->{has_optional}; my $patient = $request->patient_case->patient; # warn Dumper $patient->as_tree; my $fname = ( substr $patient->first_name, 0, 1 ); # 1st char my $lname = ( substr $patient->last_name, 0, 1 ); # 1st char my $trial_id; # get possible patient trial ID: if ( $data->{has_optional}->{clinical_trial} ) { # don't trigger unnecessary lookup # get trial number: my @args = ($patient->id, $request->request_trial->trial_id ); $trial_id = $self->model('ClinicalTrial')->get_trial_number(@args); } if ($trial_id) { # set patient last-name = trial ID $patient->last_name($trial_id); my $inits = uc ( join ',', $lname, $fname ); # because tt uses ucfirst $patient->first_name($inits); } else { # set patient name to initials: $patient->last_name($lname); $patient->first_name($fname); } # partly anonymise dob: if ($patient->dob) { # _has_ to be valid date: # $patient->dob->truncate(to => 'year'); # warn Dumper $patient->dob; } # anonymise unit_number & nhs_number: $patient->nhs_number('**********'); # warn Dumper $request->as_tree; $request->patient_case->unit_number('****'); # warn Dumper $request->as_tree; if ($data->{outreach}) { # anonymise address if outreach request: my $demographics = $data->{outreach}->{demographics}; # warn Dumper $demographics; $demographics->{post_code} = '*****'; $demographics->{address} = '**********'; } # warn Dumper $data->{outreach}; return $self->_format_report($data); } #------------------------------------------------------------------------------- # shared by print_record(), email_record() & mail_reports.pl to return formatted # report as pdf: sub format_report { my ($self, $request_id) = @_; # process request-specific data for template & return hashref of data: my $data = $self->format_print_record_request_data($request_id); return $self->_format_report($data); } #------------------------------------------------------------------------------- # shared by format_report() & anonymise_report(): sub _format_report { my ($self, $request_data) = @_; # warn Dumper $request_data; $self->tt_params( request => $request_data ); # stash for mail_report.pl, also to save repeat lookup later: $self->stash( request_data => $request_data->{data} ); # get some data maps for template: { # allowed report error_codes: my $report_error_codes = $self->report_error_codes_map; $self->tt_params( report_error_codes => $report_error_codes ); } { # diagnosis_context_warnings: my $context_warning = $self->diagnosis_context_warning_map; $self->tt_params( context_warning_map => $context_warning ); } { # categories exempt from 'use NHS number': my $nhs_number_exempt = $self->nhs_number_exempt; $self->tt_params( nhs_number_exempt => $nhs_number_exempt ); } # for tt to pass USE_FILE_SESSIONS flag to chart if called via cron: $self->tt_params( use_file_sessions => $ENV{USE_FILE_SESSIONS} ); # warn Dumper \%ENV; # set flag for template to pass CGISESSID in url in case img called in tmpl: # (uncomment here & in tmpl to activate url-based session param) # $self->tt_params( url_session_id_required => 1 ) unless $ENV{REPORT_HTML}; # template depends on whether it's outreach data: my $tmpl = $request_data->{outreach} ? 'outreach/report.tt' : 'record/print_pdf.tt'; # warn $tmpl; my $html = $self->render_view($tmpl); # return $html; return $html if $ENV{REPORT_HTML}; # for lims_server and/or no PDF reader my $o = LIMS::Local::PDF->new( config => $self->cfg ); my $pdf; if ($self->stash->{css_required}) { # if we need to create intermediate temp files: my $tmp_file = sprintf '%s/%s.html', $self->cfg->{tmpdir}, $request_data->{data}->id; io($tmp_file)->print(${$html}); # save file to disk # $pdf = $o->make_pdf({ file => $tmp_file }); # HTMLDOC method my %args = ( file => $tmp_file, session_id => $self->session->id, # for charts ); $pdf = $o->make_pdf_with_css(\%args); io($tmp_file)->unlink; # delete temp file } else { my %args = ( html => $html, session => $self->session, ); $pdf = $o->make_pdf(\%args); # html in memory } return $pdf; } #------------------------------------------------------------------------------- # shared by C::Request::email_alert() & L::Local::EmailAlert::email_alert() sub send_email_alert { my ($self, $mdt_centre) = @_; $self->_debug_path(); # request data: my $request_data = $self->stash->{request_data}; my $email_contacts = $self->model('ReferralSource')->get_email_contacts; # get all active addresses listed for location mdt: my @recipients = map { $_->contact_address } grep { $_->display_name eq $mdt_centre && $_->type eq 'mdt' && $_->is_active eq 'yes'; } @$email_contacts; return 0 if ! @recipients; # stash for later: $self->stash( recipients => \@recipients ); my $config = $self->cfg('settings'); # add $cfg to $request_data so tmpl doesn't have to use c.cfg('settings') # so it can be shared with stand-alone scripts: $request_data->{config} = $config; my $subject = $config->{lab_name_abbreviation} . ' Diagnosis Status Notice'; my $message_body = do { # turn off POST_CHOMP to retain formatting in .tt: local $self->cfg('tt_config')->{TEMPLATE_OPTIONS}->{POST_CHOMP} = undef; $self->tt_process('request/message/body.tt', $request_data); }; $self->model('Email')->set_request_id($request_data->{data}->id); my %data = ( all_recipients => \@recipients, message => ${$message_body}, # dereference scalar ref 1st config => $config, subject => $subject, ); # warn Dumper \%data; my $rtn = $self->model('Email')->diagnosis_status_alert(\%data); # return error, or false value to avoid triggering error page: return $rtn || 0; } # ------------------------------------------------------------------------------- sub nhs_number_exempt { my $self = shift; my $cfg = $self->get_yaml_file('nhs_number_exempt') || return {}; my %data; while ( my ($category, $d) = each %$cfg ) { $data{$category}{$_} = 1 for @$d; } # warn Dumper \%data; return \%data; } #------------------------------------------------------------------------------- sub _get_outstanding_tests { my ($self, $data) = @_; $self->_debug_path(); my $lab_tests = $data->{lab_tests_status}; # arrayref my %outstanding; for my $test ( @$lab_tests ) { # warn Dumper $_->as_tree; next if $test->status->description eq 'complete'; my $section_name = $test->lab_test->lab_section->section_name; my $field_label = $test->lab_test->field_label; push @{ $outstanding{$section_name} }, $field_label; } return \%outstanding; } #------------------------------------------------------------------------------- # set record to locked ? sub _set_request_status { my ($self, $request) = @_; { # return if request.updated_at is today: # DateTime->compare() returns true if dates not equal - need to truncate # timestamp field so compare() works at day level (not hr, min, sec): my $last_modified = $request->updated_at->truncate(to => 'day'); # warn $last_modified; return 0 unless DateTime->compare( $last_modified, DateTime->today() ); } # for devel/test: return 0 if $ENV{OVERRIDE_LOCK}; # $self->authen->username eq 'raj'; # return 'true' if status = complete: return ( $request->status_option->description eq 'complete' ); } =begin # not in use - using requests.created_at now #------------------------------------------------------------------------------- # maps request to its registration time via request.id => request_history.time sub get_request_histories { my $self = shift; my $requests = shift; # arrayref # get list of request.id's from requests arrayref: my @request_ids = map { $_->id } @$requests; # DEBUG \@record_ids; # get histories object, ie: # SELECT .. FROM request_history WHERE request_id IN (@request_ids) and action = 'foo' my $histories = $self->model('History') ->get_request_histories_for_action('registered', \@request_ids); # create history_map of keys = request_id, vals = registration time: my %history_map = map { $_->request_id => $_->time; } @$histories; return \%history_map; } =cut #--------------------- PRIVATE SUBS -------------------------------------------- #------------------------------------------------------------------------------- # extracts register, screen, report & authorise data from request_history array(ref): sub _parse_request_history { my ($self, $data) = @_; # get array(ref) of history actions (register, screen, etc): my $history = $self->model('History')->get_request_history($data->id); # create hash with keys = action & values = associated history object: my %data = map { $_->action => $_ } @$history; return \%data; } #------------------------------------------------------------------------------- # left outer join rels with no data don't get accessor in data object, so testing # for presence of data in template causes db query; returns hashref sub _get_might_have_data { my ($self, $request_data) = @_; my $data = $request_data->as_tree; # $self->debug( [ keys %$rd ]); my %might_have = (); if ( $data->{request_trial} ) { $might_have{clinical_trial} = 1; } if ( $data->{request_external_ref} ) { $might_have{external_ref} = 1; } if ( $data->{request_initial_screen} ) { $might_have{initial_screen} = 1; } if ( $data->{request_report} ) { $might_have{report} = 1; } return \%might_have; } #------------------------------------------------------------------------------- # overrides default report format for special cases - needs to be screened & have # screen entry in .local/special_formatting.yml file: sub _get_special_formatting { my $self = shift; my $data = shift; # don't try to call methods on request_initial_screen unless exists: $data->request_initial_screen || return 0; my $request_initial_screen = $data->request_initial_screen->screen->description; my $yaml = $self->get_yaml_file('special_formatting') || return 0; # return 0 unless initial_screen in special_formatting list: my $yaml_entry = $yaml->{$request_initial_screen} || return 0; return $yaml_entry; } #------------------------------------------------------------------------------- # get various lab_test data (all lab tests, all lab sections, this requests' lab_tests, # this requests' result_summaries, etc); return a hashref for use in methods & templates sub _get_lab_test_data { my ($self, $request) = @_; my $request_id = $request->id; #warn 'here'; # get list of all lab sections: my $all_lab_sections = $self->model('LabSection')->get_lab_sections; #warn 'here'; # get list of all lab_tests: my $all_lab_tests = $self->model('LabTest')->get_lab_tests; #warn 'here'; my $lab_tests_status = $self->model('LabTest')->get_request_lab_tests_status($request_id); #warn 'here'; # get test results for this request: my $lab_test_results = $self->model('Result')->get_request_lab_test_results($request_id); # get result summaries for this request: my $result_summaries = $self->model('LabSection')->get_section_result_summaries($request_id); #warn 'here'; # get remote system identifiers: my $remote_system_ids = $self->model('LabSection')->get_labsection_remote_system_ids($request_id); # create data structure to hold info: my %lab_test_data = ( all_lab_tests => $all_lab_tests, all_lab_sections => $all_lab_sections, result_summaries => $result_summaries, lab_test_results => $lab_test_results, lab_tests_status => $lab_tests_status, remote_system_ids => $remote_system_ids, ); # haematology data: if ( $self->cfg('settings')->{have_haematology_data} ) { # warn 'here'; my %args = ( request_number => $request->request_number, year => $request->year, ); if ( my $data = $self->model('Result')->get_haematology_data(\%args) ) { $lab_test_data{haematology_data} = $data; } } return \%lab_test_data; } #------------------------------------------------------------------------------- sub _get_request_options { my ($self, $request_id) = @_; # get active options for this request: my $active_options = $self->model('Request')->get_request_options($request_id); # get list of all available request options: my $additional_options = $self->additional_options_map; # warn Dumper $additional_options; # copy $additional_options to avoid altering $self->additional_options_map: my %request_options = %{$additional_options}; # warn Dumper \%request_options; # add $active_options data to %request_options: for (@$active_options) { my $option_name = $_->option->option_name; # warn Dumper $option_name; # replace existing $request_options{$option_name} hashref data: $request_options{$option_name} = { # create new hashref: %{ $request_options{$option_name} }, # preserve existing data is_selected => 1, # add new 'is_selected' key }; =begin # alternative way of doing it: my %copy_opts = %{ $request_options{$option_name} }; $copy_opts{is_selected} = 1; # add new 'is_selected' key $request_options{$option_name} = \%copy_opts; # replace existing with new # wrong way of doing it - too shallow (only copies the top level hashref, # not the second level ones): $request_options{$option_name}{is_selected} = 1; =cut } # warn Dumper \%request_options; return \%request_options; } #------------------------------------------------------------------------------- sub _build_additional_options_map { my $self = shift; # get list of all available request options: my $all_options = $self->model('RequestOption')->get_request_options; # create hash of option_name => is_active: my %options = map { $_->option_name => { is_active => $_->is_active, } } @$all_options; # warn Dumper \%options; return \%options; } #------------------------------------------------------------------------------- sub _build_status_options_map { my $self = shift; my $status_options = $self->model('Option')->get_status_options; my %map = map { $_->description => $_->as_tree; } @$status_options; return \%map; } #------------------------------------------------------------------------------- sub _get_request_consent { my ($self, $request_id) = @_; my $request_consent = $self->model('Request')->get_request_consent($request_id); # hash map of selected request_consent: my %active_consent = map { $_->consent->consent_name => $_->status; } @$request_consent; # $self->debug(\%active_consent); return \%active_consent; } #------------------------------------------------------------------------------- # returns hashref of section_name => result_summary for all results summaries for # current request: sub _format_result_summaries { my ($self, $lab_test_data) = @_; my $result_summaries = $lab_test_data->{result_summaries}; my %data; foreach my $result (@$result_summaries) { my $section_name = $result->lab_section->section_name; $data{$section_name} = $result->as_tree(deflate => 0); } return \%data; } #------------------------------------------------------------------------------- sub _format_clinical_data_link { my ($self, $request_data) = @_; return 0 unless $self->cfg('settings')->{have_hmrn}; # no point if no db # does request.patient_case.patient_id already have data (ie in hmrn.mdt or # hmrn.chronologies table)? my $patient_id = $request_data->patient_case->patient_id; my $has_data = $self->model('HMRN')->has_data($patient_id); # warn Dumper $has_data; # request is elegible if referred from network location and has ICDO3 diagnosis, # or already has data (so no need to do unnecessary db lookup): my $is_elegible = $has_data || $self->_is_request_elegible($request_data); return { is_elegible => $is_elegible, has_data => $has_data, }; } #------------------------------------------------------------------------------- sub _is_request_elegible { # for HMRN data: my ($self, $request_data) = @_; # warn Dumper $request_data->as_tree; { # does request come from the local network: my $parent_organisation_id = $request_data->patient_case->referral_source->parent_organisation_id; my $locations = $self->model('Base')->get_objects('LocalNetworkLocation'); my @parent_ids = map $_->parent_id, @$locations; return 0 unless grep $parent_organisation_id == $_, @parent_ids; } { # is diagnosis ICDO3: return 0 unless $request_data->request_report; my $icdo3 = $request_data->request_report->diagnosis->icdo3; return ( $icdo3 && $icdo3 =~ /[13]\Z/ ); # ICDO3 ends in 1 or 3 } } #------------------------------------------------------------------------------- # returns hashref of section_name => remote_system_id for current request: sub _format_remote_system_ids { my ($self, $lab_test_data) = @_; my $remote_system_ids = $lab_test_data->{remote_system_ids}; my %data; foreach my $id (@$remote_system_ids) { my $section_name = $id->lab_section->section_name; $data{$section_name} = $id->as_tree(deflate => 0); } return \%data; } 1;