package LIMS::Controller::Roles::RecordHandler; use Moose::Role; with 'LIMS::Controller::Roles::PDF'; # render_pdf() with 'LIMS::Controller::Roles::Barcode'; use LIMS::Local::Utils; has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1, ) for qw(status_options_map additional_options_map ); use Data::Dumper; # for callers not having access to get_single_request_data->{is_locked} var: sub is_record_complete { shift->_set_request_status(@_) } # true if complete < today # ------------------------------------------------------------------------------ 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'; # previous requests: my $previous_requests = $self->_get_previous_requests($request_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 (also looks for previous doi samples): my $request_options = $self->_get_request_options($request_data); #warn 'here'; # request_consent: my $request_consent = $self->_get_request_consent($request_id); #warn 'here'; my $request_errors = $self->_get_request_errors($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'; my $dispatch_log = $self->model('Request')->get_request_dispatch_logs($request_id); #warn 'here'; my $special_tmpl_formatting = $self->_get_special_formatting($request_data) || {}; # needs hashref # get outreach if required: my $outreach = $special_tmpl_formatting->{has_outreach} ? $self->model('Outreach')->get_all_data($request_id) : undef; #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); #warn 'here'; my $report_data_maps = $self->_get_report_data_maps; #warn 'here'; my $small_2d_barcode = $self->_render_small_2d_barcode(); $self->_debug_path('timer'); return { data => $request_data, history => $request_history, outreach => $outreach, is_locked => $is_locked, has_optional => $might_have, dispatch_log => $dispatch_log, has_phonelog => $has_phonelog, specimen_map => $specimen_map, status_options => $status_options, request_options => $request_options, request_errors => $request_errors, request_consent => $request_consent, result_summaries => $result_summaries, previous_requests => $previous_requests, report_data_maps => $report_data_maps, small_2d_barcode => $small_2d_barcode, 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, } } #------------------------------------------------------------------------------- # shared by print_record (via format_report) & print_run to process request-specific # data for tt params; returns hashref of data: =begin # all functions performed elsewhere now - can be deleted sub format_print_record_request_data { my ($self, $request_id) = @_; my $request_data = $self->get_single_request_data($request_id); # simplified print view - using same data/tt as guest view: # 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; } =cut #------------------------------------------------------------------------------- # 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 $r = $self->get_single_request_data($request_id); # warn Dumper $r->{has_optional}; my $request = $r->{data}; # warn Dumper $request; 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 $mname = $patient->middle_name ? ( substr $patient->middle_name, 0, 1 ) # 1st char : ''; my $patient_trial_id = do { # get possible patient trial ID: if ( $r->{has_optional}->{clinical_trial} ) { # don't trigger unnecessary lookup my @args = ($patient->id, $request->request_trial->trial_id ); $self->model('ClinicalTrial')->get_trial_number(@args); # get trial number } }; if ($patient_trial_id) { # set patient last-name = trial ID $patient->last_name($patient_trial_id); my $inits = uc ( join ',', grep $_, $lname, $fname, $mname ); # because tt uses ucfirst $patient->first_name($inits); # delete middle name if exists: $patient->middle_name(undef) if $mname; } else { # set patient name to initials: $patient->last_name($lname); $patient->first_name($fname); $patient->middle_name($mname) if $mname; } # 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: if ( my $nhs_no = $patient->nhs_number ) { $nhs_no =~ s/./*/g; # replace each char with asterisks $patient->nhs_number($nhs_no); } if ( my $unit_no = $request->patient_case->unit_number ) { $unit_no =~ s/./*/g; # replace each char with asterisks $request->patient_case->unit_number($unit_no); } # warn Dumper $request->as_tree; # anonymise address if outreach request: if ($r->{outreach}) { my $demographics = $r->{outreach}->{demographics}; # warn Dumper $demographics; $demographics->{$_} =~ s/./*/g for qw(address post_code); } # warn Dumper $r->{outreach}; # fully anomymise certain trials: elsif ( my $trials = $self->get_yaml_file('anonymised_trials') ) { # warn Dumper $trials; if ( $r->{has_optional}->{clinical_trial} ) { my $trial_name = $request->request_trial->trial->trial_name; # warn Dumper $trial_name; if ( grep $trial_name eq $_, @$trials ) { my $dob = $self->cfg('settings')->{default_unknown_date}; # warn $dob; $patient->dob($dob); # can't replace with asterisks or validation fails $patient->first_name('Trial ID:'); # last_name should already = trial_id, but: # ensure last_name removed if trial ID not supplied: $patient->last_name('NOT STATED') if (! $patient_trial_id); } } } # warn Dumper $patient->as_tree; return $self->_format_report($r); } #------------------------------------------------------------------------------- # 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->get_single_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; # add processed lab test data to $request_data: $self->process_raw_lab_test_data($request_data); # stash for mail_report.pl, also to save repeat lookup later: $self->stash( request_data => $request_data->{data} ); # 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}; my $tmpl = 'record/default.tt'; my $html = $self->render_view($tmpl, $request_data); # return $html; return $html if $ENV{REPORT_HTML}; # for lims_server and/or no PDF reader my %args = ( content => $html, session_id => $self->session->id, # for charts ); my $pdf = $self->render_pdf(\%args); 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; return 0; 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_report_data_maps { my $self = shift; # this is only needed once - return stashed data if print-run: return $self->stash->{report_data_maps} if $self->stash->{report_data_maps}; # get some data maps for report template: my %h; { # allowed report error_codes: my $report_error_codes = $self->report_error_codes_map; $h{report_error_codes} = $report_error_codes; } { # diagnosis_context_warnings: my $context_warning = $self->diagnosis_context_warning_map; $h{context_warning_map} = $context_warning; } { # categories exempt from 'use NHS number': my $nhs_number_exempt = $self->nhs_number_exempt; $h{nhs_number_exempt} = $nhs_number_exempt; } # stash in case it's a print request: $self->stash( report_data_maps => \%h ); return \%h; } #------------------------------------------------------------------------------- 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; } #------------------------------------------------------------------------------- sub _get_previous_requests { my ($self, $request_data) = @_; my $patient_case = $request_data->patient_case; my $patient = $patient_case->patient; my %args = ( # explicit table name to disambiguate authorised_reports_view cols 'requests.id' => { ne => $request_data->id }, # skip current request or => [ unit_number => $patient_case->unit_number, 'patients.dob' => $patient->dob, ], 'patients.last_name' => $patient->last_name, 'patients.first_name' => $patient->first_name, ); my $o = $self->model('Request')->get_previous_requests(\%args); my %matches; RECORD: for my $record( @$o ) { my $this_record_patient_id = $record->patient_case->patient_id; if ( $this_record_patient_id == $patient->id ) { push @{ $matches{this_id} }, $record; # same patient, different request } else { # patient cannot have same NHS number as current request or patient # id would match above, but 2 entries with same lname AND fname AND # (dob OR unit_number) can have 2 NHS numbers, normally different # patients, unless patient has both english & scottish NHS numbers: next RECORD if $patient->nhs_number && $record->patient_case->patient->nhs_number; push @{ $matches{others} }, $record; } } # warn Dumper \%matches; return \%matches; } #------------------------------------------------------------------------------- # 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; # warn Dumper \%data; 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 %$data ]); 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_specimen_detail} ) { $might_have{request_specimen_detail} = 1; } if ( $data->{request_initial_screen} ) { $might_have{initial_screen} = 1; } if ( $data->{request_report} ) { $might_have{report} = 1; } if (! $data->{request_trial}) { # check for previous clinical trials: # model needs request.id & patient.id: my %h = ( patient_id => $request_data->patient_case->patient_id, request_id => $request_data->id, ); my $trials = $self->model('ClinicalTrial')->get_patient_trials(\%h); $might_have{previous_clinical_trials} = $trials if %$trials; } 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; } } { # all previous lab tests & results on this patient identity: my $patient_id = $request->patient_case->patient_id; my $tests = $self->model('Result') ->get_all_previous_tests_and_results($patient_id); $lab_test_data{lab_test_history} = $tests; } return \%lab_test_data; } #------------------------------------------------------------------------------- sub _get_request_options { my ($self, $data) = @_; my $request_id = $data->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; { # any other doi samples (no need if current record is doi): my $doi = $request_options{doi}; # it's a hashref if exists if ( $doi && $doi->{is_active} eq 'yes' && not $doi->{is_selected} ) { $request_options{doi}{has_others} = $self->_get_other_doi($data); } # 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_errors { my ($self, $request_id) = @_; my $o = $self->model('Request')->get_request_errors($request_id); # warn Dumper $_->as_tree for @$o; return $o; } #------------------------------------------------------------------------------- sub _render_small_2d_barcode { my $self = shift; my $_self = $self; Scalar::Util::weaken $_self; # required or get cron failures return sub { my $text = shift || return undef; # warn $text; my $type = shift || die 'no barcode type specified'; # warn $type; my %args = ( $type =~ 'qrcode|data_matrix' ) ? ( css_class => 'hbc2d_small' ) : ( show_text => 1, bar_height => 25 ); my $barcode = 'barcode_' . $type; return $_self->$barcode($text, %args); }; } #------------------------------------------------------------------------------- sub _get_other_doi { my ($self, $data) = @_; my %args = ( request_id => $data->{id}, patient_id => $data->{patient_case}->{patient_id}, ); my $i = $self->model('Request')->count_biohazard_records(\%args); return $i; } #------------------------------------------------------------------------------- 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;