package LIMS::Controller::Report; use Moose; BEGIN { extends 'LIMS::Base' } with ( 'LIMS::Controller::Roles::Misc', 'LIMS::Controller::Roles::Aspell', 'LIMS::Controller::Roles::DataMap', 'LIMS::Controller::Roles::DataFile', 'LIMS::Controller::Roles::DataImport', 'LIMS::Controller::Roles::RecordHandler', 'LIMS::Controller::Roles::ResultHandler', ); use namespace::clean -except => 'meta'; __PACKAGE__->meta->make_immutable(inline_constructor => 0); use Data::Dumper; #------------------------------------------------------------------------------- sub default : Startrunmode { my $self = shift; # shouldn't be called here - redirect to / $self->redirect( $self->query->url ); } #------------------------------------------------------------------------------- sub load : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $errs = shift || {}; # $self->stash(errs => $errs ); # need permission to report, or to edit_outreach_data if outreach case: return $self->forbidden() unless $self->user_can('report') || ( $self->stash->{is_outreach} && $self->user_can([ qw/view_outreach_data edit_outreach_data/ ]) ); my $request_id = $self->param('id') || return $self->error('no id passed to ' . $self->get_current_runmode); my $request_data = $self->get_single_request_data($request_id); # warn Dumper $request_data; # check record is screened & not locked, and user allowed to report: unless ( $self->_check_request_status($request_data) ) { my $target = $self->stash->{redirection_target}; # set in check_request_status() return $self->redirect( $self->query->url . "/$target/=/$request_id" ); } { # diagnosis change options: my %args = ( sort_by => 'option_name' ); my $options = $self->model('Base')->get_objects('DiagnosisChangeOption', \%args); $self->tt_params( diagnosis_change_options => $options ); } { # do we want gross_description box loaded: my $flag = $self->_display_gross_description($request_data); $self->tt_params( want_gross_description => $flag ); } { # do we want biopsy_site box loaded: my $flag = $self->_display_biopsy_site($request_data); $self->tt_params( want_biopsy_site => $flag ); } { # is request self_authorisable: my $is_self_authorisable = $self->_is_self_authorisable($request_data); $self->tt_params( self_authorisable => $is_self_authorisable ); } { # do we have draft report? if ( $self->cfg('settings')->{have_draft_report} ) { my $data = $self->model('Report')->get_draft_reports($request_id); $self->tt_params( draft_reports => $data ); } } { # if it's an authorisation_request, load authorisation_check profile: my $validation_profile = $self->stash->{authorisation_request} ? 'pre_authorisation_check' : 'report'; $self->js_validation_profile($validation_profile); { # list of required fields from validation profile: my $profile = $self->validate($validation_profile); # warn Dumper $profile; my $required = $profile->{required}; # warn Dumper $required; my %h = map { $_ => 1 } @$required; # warn Dumper \%h; $self->tt_params( required_fields => \%h ); } } unless ( $self->stash->{is_outreach} ) { # some functions not required for Outreach: # send $request_data to process_raw_lab_test_data() for template; adds # 'all_results' to $request_data: $self->process_raw_lab_test_data($request_data); { # tests requested without results entered: my $unresulted = $self->_get_unresulted_tests($request_data); $request_data->{unresulted_tests} = $unresulted; } { # diagnoses list: my $diagnoses = $self->diagnoses_categories_map; $self->tt_params( diagnoses => $diagnoses ); } { # anatomical sites: my $sites = $self->model('Coding') ->get_anatomical_sites({ sort_by => 'snomed, site_name'}); $self->tt_params( anatomical_sites => $sites ); } } { # if request to import a draft report: if ( my $user_id = $self->query->param('import_user_id') ) { my %args = ( request_id => $request_id, user_id => $user_id, ); my $report_data = $self->model('Report')->get_draft_report(\%args); # cannot create a new request_report section of $request_data->{data} # RDBO object, so have to supply data separately: $self->tt_params( draft_report_data => $report_data->as_tree ); } } # combine $request_data & $errs into single hashref: return $self->render_view('report/default.tt', { %$errs, %$request_data }); } #------------------------------------------------------------------------------- sub outreach : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); return $self->forbidden() unless $self->cfg('settings')->{have_outreach} && $self->user_can([ qw/view_outreach_data edit_outreach_data report/ ]); my $request_id = $self->param('id') || return $self->error('no id passed to ' . $self->get_current_runmode); # load validation profiles into tt_params for all departments: my $profiles = $self->validate('outreach_lab_results'); # profiles for all depts my @departments = qw(haematology immunology biochemistry flow_cytometry); for my $dept( @departments ) { my $profile_name = 'outreach_'.$dept; # supply name + profile: $self->js_validation_profile($profile_name, $profiles->{$dept}); } # { # get outreach data - pointless because it's re-fetched downsteam in load(): # my $outreach_data = $self->model('Outreach')->get_all_data($request_id); # $self->tt_params( outreach => $outreach_data ); # warn Dumper $outreach_data; # } { # provide restricted diagnoses list for Outreach subset: my $all_diagnoses = $self->diagnoses_categories_map; # HoAoH # ids for Outreach diagnoses: my $outreach_diagnosis_ids = $self->model('Outreach')->get_diagnosis_ids; my %ids = map +($_ => 1), @$outreach_diagnosis_ids; # create hash from array my %diag = (); # new data structure while ( my($category, $d) = each %$all_diagnoses ) { # get hashrefs where diagnosis_id in $outreach_diagnosis_ids list my @required = grep $ids{ $_->{id} }, @$d; $diag{$category} = \@required if @required; } # warn Dumper \%diag; $self->tt_params( diagnoses => \%diag ); } # callbacks for template: my $_self = $self; weaken $_self; # or get circular refs inside the callbacks $self->tt_params( have_data_file => sub { my $data_files = $_self->get_result_data_file(@_); # warn Dumper $data_files; return ( grep { $_ =~ /CMP\.txt\Z/ } @$data_files ) ? 1 : 0; }, incomplete_dataset => sub { # receives section data (eg haem dataset) my $data = shift || return 1; # warn Dumper $data; my $has_incomplete = grep +(! defined $data->{$_}->{result}), keys %$data; return $has_incomplete; }, missing_fields => sub { # receives required fields + data hashref: my $required_fields = shift; my $data = shift || return 1; # warn Dumper [$required_fields, $data]; my $has_missing = grep +(! $data->{$_}), @$required_fields; return $has_missing; }, tube_type => sub { $_self->get_blood_tube_type(@_) }, ); # set flag & forward to load(): $self->stash( is_outreach => 1 ); return $self->forward('load'); } #------------------------------------------------------------------------------- sub authorise : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $errs = shift; # just set stash & tt flags, and forward to load(): $self->stash( authorisation_request => 1 ); $self->tt_params( authorisation_request => 1 ); return $self->forward('load', $errs); } #------------------------------------------------------------------------------- sub pre_authorisation_check : Runmode { # only used if status_option 'authorised' set to 'yes' my $self = shift; $self->_debug_path($self->get_current_runmode); return $self->forbidden() unless $self->user_can('report'); my $request_id = $self->param('id') || return $self->error('no id passed to ' . $self->get_current_runmode); my $dfv = $self->check_rm('authorise', $self->validate('pre_authorisation_check') ) || return $self->dfv_error_page; my $data = $dfv->valid; # $self->debug($data); $data->{_request_id} = $request_id; { # get original report data: my $report = $self->model('Report')->get_report_data($request_id); $self->tt_params( report => $report ); # add report.diagnosis_id to $data for authorisation_diagnosis(): $data->{_report_diagnosis_id} = $report->diagnosis_id; my $patient_case = $self->model('PatientCase') ->retrieve_patient_data($report->request->patient_case_id); $self->tt_params( patient_case => $patient_case ); my $history = $self->request_history_map($report->request_id); $self->tt_params( history => $history ); } { # pre-authorisation-check diagnosis: my $diagnosis = $self->model('Diagnosis') ->get_diagnosis($data->{diagnosis_id})->as_tree; $self->tt_params( authorisation_check_diagnosis => $diagnosis ); } { # diagnoses map: my $diagnoses_map = $self->diagnoses_map('id'); # send key $self->tt_params( diagnoses_map => $diagnoses_map ); } # log selected diagnosis_id (returns true value on success): $self->model('Report')->log_authorisation_diagnosis($data) || # just set flash warning - not serious enough to terminate with error: $self->flash( warning => $self->messages('report')->{no_auth_diagnosis} ); return $self->tt_process; } #------------------------------------------------------------------------------- sub preview_draft : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $request_id = $self->param('id') || return $self->error('no id passed to ' . $self->get_current_runmode); my $user_id = $self->param('Id') || return $self->error('no user_id passed to ' . $self->get_current_runmode); my $data = $self->model('Request') # 'as_tree' so we can add report_data href: ->get_patient_and_request_data($request_id)->as_tree( deflate => 0 ); { my %args = ( request_id => $request_id, user_id => $user_id, ); my $report_data = $self->model('Report') ->get_draft_report(\%args)->as_tree( deflate => 0 ); $data->{report} = $report_data; } my $specimen_map = $self->specimen_map([$request_id]); # requires arrayref $data->{specimen} = $specimen_map->{$request_id}; # warn Dumper $specimen_map; return $self->render_view( $self->tt_template_name, { data => $data } ); } #------------------------------------------------------------------------------- sub update_report : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); return $self->forbidden() unless $self->user_can('report'); my $request_id = $self->param('id') || return $self->error('no id passed to ' . $self->get_current_runmode); my $vars = $self->query->Vars(); # warn Dumper $vars; # delete secondary_diagnosis_id if deletion from imported draft report selected: if ( $vars->{imported_draft_report} && $vars->{delete_secondary_diagnosis} ) { delete $vars->{$_} for qw(_secondary_diagnosis secondary_diagnosis_id); } # warn Dumper $vars; my $dfv = $self->check_rm('load', $self->validate('report') ) || return $self->dfv_error_page; my $data = $dfv->valid; # warn Dumper $self->dfv_results; $data->{_request_id} = $request_id; # warn Dumper $data; # don't want additional tests if Outreach request: $data->{_is_outreach} = $self->query->param('is_outreach'); # biopsy site now drop-down - convert arrayref to text (can't use $vars for multi-param): if ( my @biopsy_sites = $self->query->param('biopsy_site') ) { # warn Dumper \@biopsy_sites; $data->{biopsy_site} = join '; ', @biopsy_sites; } # maybe save draft report: if ( my $action = $vars->{submit} ) { # only exists for 'preview' or 'save draft' if ( $action eq 'save_draft' ) { my $rtn = $self->model('Report')->save_draft_report($data); return $self->error($rtn) if ($rtn); $self->flash( info => $self->messages('action')->{create_success} ); return $self->redirect( $self->query->url.'/report/=/'.$request_id ); } } # if mandatory spell-checker enabled, require preview flag: if ( $self->cfg('settings')->{require_spell_check} eq 'yes' && ! $vars->{_spelling_checked} ) { return $self->forward('preview_report'); } # if reason given for update: if ( my $option_id = $data->{option_id} ) { # warn $option_id; # check diagnosis actually changed, or croak: if ( $data->{diagnosis_id} == $data->{_diagnosis_id} ) { # ie not changed: $self->flash( warning => $self->messages('report')->{no_diag_change} ); return $self->redirect( $self->query->url . '/report/=/' . $request_id ); } my $reason = $self->model('Diagnosis')->get_diagnosis_change_option($option_id); $data->{reason} = $reason->option_name; } my $rtn = $self->model('Report')->update_report($data); return $self->error($rtn) if ($rtn); # issue revised diagnosis alert if reason for revision =~ error: if ( $data->{reason} && $data->{reason} =~ /^error/ ) { # warn $data->{reason}; $self->issue_diagnosis_revision_alert($data); } $self->flash( info => $self->messages('action')->{edit_success} ); return $self->redirect( $self->query->url . '/search/=/' . $request_id ); } #------------------------------------------------------------------------------- sub issue_diagnosis_revision_alert { my ($self, $data) = @_; # warn Dumper $data; my $cfg = $self->cfg('settings'); return 0 unless $self->user_can('report') && $cfg->{have_revised_diagnosis_alert} && ! $ENV{HARNESS_ACTIVE}; my $request_id = $data->{_request_id}; # get original reporter: my $original_reporter = do { my $o = $self->request_history_map($request_id); $o->{reported}->{user}; }; # get original diagnosis: my $original_diagnosis = do { my $o = $self->model('History')->get_diagnosis_history($request_id); $o->[0]; # warn Dumper $o->as_tree; # original is 1st entry }; { # no need for email if original reporter records error, or user inactive: my $this_user = $self->user_profile; # warn Dumper $this_user; return 0 if ( $original_diagnosis->user->active ne 'yes' || $this_user->{id} == $original_reporter->{id} ); } # get current diagnosis, request_number & year: my $current_report = $self->model('Report')->get_report_data($request_id); my %data = ( # tt data original => $original_diagnosis, current => $current_report, ); # warn Dumper \%data; my $msg = $self->tt_process('report/diagnosis_revision.tt', \%data); my $message_body = LIMS::Local::Utils::deindent(${$msg}); # deref 1st my %mail = ( recipient => $original_reporter->{email}, config => $self->cfg('settings'), subject => 'Revised Diagnosis Alert', message => $message_body, ); # warn Dumper \%mail; return 0; my $result = $self->model('Email')->send_message(\%mail); # only warn if error - don't return error page: warn $result->string if $result->type ne 'success'; return 0; # not expected or used } #------------------------------------------------------------------------------- sub preview_report : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); # initialise id_generator (for unique div id's): $self->id_generator('a'); # check spelling on selected textfields (do it in order on page): my @text_fields = qw(gross_description morphology comment); # biopsy_site - dd now foreach my $field(@text_fields) { # warn $field; next unless $self->query->param($field); # warn $self->query->param($field); my $unrecognised = $self->do_spellcheck($field); # $self->debug($unrecognised); $self->tt_params( 'unrecognised_' . $field . '_words' => $unrecognised ); # colourise text in textarea field for display: my $highlighted_text = $self->colourise_text($field); $self->tt_params( 'highlighted_' . $field => $highlighted_text ); } # set previewed flag: $self->tt_params( spelling_checked => 1 ); # load unrecognised words flag: $self->tt_params( has_unrecognised => $self->words ); # fill_form preserves selected fields: my $html = $self->query->param('is_outreach') ? $self->forward('outreach') : $self->forward('load'); # warn Dumper $html; warn Dumper $self->query; return $self->fill_form($html); } #------------------------------------------------------------------------------- =begin # incorpotated into report validation # if _diagnosis_id passed as hidden field (eg at authorisation stage where diagnosis # re-submitted, but revision is optional) and is different to diagnosis_id, # set '_is_diagnosis_revision' query param to trigger validation failure in dfv # if not also 'revision' query param submitted: sub _check_revision_info_supplied { my $self = shift; my $q = $self->query; # return if no $q->param('_diagnosis_id') to compare to: my $original_diagnosis_id = $q->param('_diagnosis_id') || return; my $diagnosis_id = $q->param('diagnosis_id'); # if $diagnosis_id different to $original_diagnosis_id, set query param to # trigger 'revision' form param requirement in dfv validation: if ( $diagnosis_id != $original_diagnosis_id ) { # warn 'HERE'; # use Data::Dumper; my $p1 = $self->query->Vars; warn Dumper $p1; # manually set _is_diagnosis_revision query param if not already set: return if $q->param('_is_diagnosis_revision'); $q->param( _is_diagnosis_revision => 1 ); # my $p2 = $self->query->Vars; warn Dumper $p2; } } =cut #------------------------------------------------------------------------------- sub _display_gross_description { # wants 1 or 0 return: my ($self, $request_data) = @_; $self->_debug_path(); # don't make it mandatory if not configured to use field: return 0 unless $self->cfg('settings')->{have_gross_description}; my $request_id = $self->param('id'); # already checked for existence my $specimen_map = $request_data->{specimen_map}; my $specimen = $specimen_map->{$request_id}->{description}; # arrayref for my $description (@$specimen) { # warn $description; # required if description has 'fixed' or 'trephine' at end: return 1 if grep $description =~ /$_\Z/, qw(fixed trephine); } return 0; } #------------------------------------------------------------------------------- sub _display_biopsy_site { # wants 1 or 0 return: my ($self, $request_data) = @_; $self->_debug_path(); # don't make it mandatory if not configured to use field: return 0 unless $self->cfg('settings')->{have_biopsy_site}; my $request_id = $self->param('id'); # already checked for existence my $specimen_map = $request_data->{specimen_map}; my $specimen = $specimen_map->{$request_id}->{sample_code}; # arrayref my $re = qr{[DGLRX](A|[BS]L|F|U)|HS}; # histology tissue: (un)fixed, slide, block # '[DGLRX](A|[BS]L|F|U)|^H(S?)$' # includes 'H' sample type for UCLH for my $code (@$specimen) { # warn $description; return 1 if $code =~ /$re/; } return 0; } #------------------------------------------------------------------------------- sub _get_unresulted_tests { my ($self, $request_data) = @_; my $results = $request_data->{all_results}; my $requested_tests = $self->get_requested_tests($results); my %h; for my $section ( %$results ) { my $test_data = $results->{$section}->{test}; # warn Dumper $data; while ( my ($test, $d) = each %$test_data ) { # warn Dumper $d; my $required = $d->{has_results}; my $test_id = $d->{id}; my $result = $d->{result}; # increment section key if test requested, result required & not entered: $h{$section}++ if $requested_tests->{$test_id} && $required eq 'yes' && ! defined($result); } } return \%h; } #------------------------------------------------------------------------------- # determines whether request is self-authorisable (can report & authorise together, # or original reporter can authorise later), based on initial_screen & specimen; # needs to be not already authorised, require authorisation stage, initial_screen # matches an entry in config file, and any specimen restrictions complied with # returns 'true' if self-authorisable: sub _is_self_authorisable { my ($self, $request_data) = @_; $self->_debug_path(); # $self->debug([ keys %$request_data ]); # allow all requests to be reporter-authorised (introduced for UCLH): return 1 if $self->cfg('settings')->{all_reporter_authorisable}; # return 0 unless authorisation required: return 0 unless $request_data->{status_options}->{authorised} ->{is_active} eq 'yes'; # return 0 if already authorised: return 0 if $request_data->{history}->{authorised}; # get config info: my $yaml = $self->get_yaml_file('self_authorisable') || return 0; # get request initial screen, or return if not screened: my $request_initial_screen = $request_data->{data}->request_initial_screen || return 0; my $screened_as = $request_initial_screen->screen->description; # warn $screened_as; # return 0 unless initial_screen in self-authorisable list: my $yaml_entry = $yaml->{$screened_as} || return 0; # warn 'here'; # return 'OK' unless further restriction on specimen type: my $restriction_specimen = $yaml_entry->{specimen} || return 1; # warn 'here'; # get requests.id: my $request_id = $request_data->{data}->id; # get request specimen(s) (as arrayref): my $request_specimen = $request_data->{specimen_map}->{$request_id}->{sample_code}; # check request has only 1 specimen: return 0 unless scalar @$request_specimen == 1; # if $yaml_specimen_info is a list: if ( ref $restriction_specimen eq 'ARRAY' ) { # return 'ok' if request specimen matches any of required types: for my $specimen ( @$restriction_specimen ) { return 1 if $request_specimen->[0] eq $specimen; } } else { # restriction is on a single specimen type: # return 'ok' if request specimen matches the required specimen type: return 1 if $request_specimen->[0] eq $restriction_specimen; } # warn 'here'; # if we get this far, return default 'not_authorisable': return 0; } #------------------------------------------------------------------------------- sub _check_request_status { my ($self, $request_data) = @_; $self->_debug_path(); # fix for 5df98b856c46 [RAWSTRON] "Can't use string ("0") as a HASH ref ..." if ( ref $request_data ne 'HASH' ) { $self->stash( redirection_target => 'search' ); return 0; } # return to home page if record locked (direct url arrival) & not outreach: if ( $request_data->{is_locked} && ! $self->stash->{is_outreach} ) { $self->stash( redirection_target => 'search' ); return 0; } # check record is screened (and not called direct from url): if ( $request_data->{data}->status_option_id == 1 ) { # 1 = 'new' $self->flash( error => $self->messages('report')->{not_screened} ); $self->stash( redirection_target => 'screen' ); return 0; } # if authorisation request (from url via 'authorise'): if ( $self->stash->{authorisation_request} ) { # check it's been reported && current user != reporter (unless allowed): unless ( $self->_check_authorisation_requirements($request_data) ) { $self->stash( redirection_target => 'search' ); return 0; } } # return 'ok' flag: return 1; } #------------------------------------------------------------------------------- sub _check_authorisation_requirements { my ($self, $request_data) = @_; $self->_debug_path(); # check it's been reported: unless ( $request_data->{data}->request_report ) { $self->flash( error => $self->messages('report')->{not_reported} ); return 0; } # check current user not same as reporter (unless allowed): my $reporter = $request_data->{history}->{reported}->user; my $self_authorisable = $self->_is_self_authorisable($request_data); if ( lc $reporter->username eq lc $self->authen->username && ! $self_authorisable ) { $self->flash( error => $self->messages('report')->{no_self_auth} ); return 0; } # OK, return 1: return 1; } 1;