• Files
• Commits
• Log
• Graph
• Stats

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; # 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, $data) = @_; # 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();

	# 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):
	unless ( $request_data->{data}->status_option_id >= 2 ) { # 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;