• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Request;

use base 'LIMS::Base';

use Config::Auto;

use Moose;
	with (
		'LIMS::Controller::Roles::Barcode',
		'LIMS::Controller::Roles::DataMap',
		'LIMS::Controller::Roles::History',
		'LIMS::Controller::Roles::RecordHandler',
		'LIMS::Controller::Roles::ResultHandler',
		'LIMS::Controller::Roles::SessionStore', # supplies session_store helpers
	);
__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use Data::Dumper;
use Scalar::Util 'looks_like_number';

#-------------------------------------------------------------------------------
sub default : Startrunmode {
    my $self = shift;

    # shouldn't be called here - redirect to /
    $self->redirect( $self->query->url );
}

#-------------------------------------------------------------------------------
sub add_new : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	my $errs = shift; # $self->stash( errs => $errs );

	return $self->forbidden() unless $self->user_can('register');

    my $case_id = $self->param('id')
        || return $self->error('no id passed to '.$self->get_current_runmode);

    $self->js_validation_profile('new_request');

	{ # patient_case:
		my $patient_case
			= $self->model('PatientCase')->retrieve_patient_data($case_id);
		$self->tt_params( case => $patient_case );

		my $referral_type = $patient_case->referral_source->referral_type;

		if ( $referral_type->description eq 'practice' ) {
            # add list of practitioners & default unknown code to tt_params:
			$self->_get_practitioners($patient_case);
		}

        { # doi previous record(s)?
            my %args = ( patient_id => $patient_case->patient_id );
            my $i = $self->model('Request')->count_biohazard_records(\%args);
            $self->tt_params( has_doi => $i );
        }
	}
	{ # consent options:
		my $consent_options = $self->model('Base')
			->get_objects( 'ConsentOption', { sort_by => 'consent_label' } );
		$self->tt_params( consent_options => $consent_options );
	}
	{ # additional_options:
		my $additional_options = $self->model('Base')
			->get_objects( 'AdditionalOption', { sort_by => 'option_label' });
		$self->tt_params( additional_options => $additional_options );
	}
	{ # clinical trials:
		my $trials  = $self->model('ClinicalTrial')->get_trials;
		$self->tt_params( trials => $trials );
	}
	{ # error codes:
		my $error_codes
			= $self->model('ErrorCode')->get_error_code_assignment('new_request');
		$self->tt_params(
			error_codes => $error_codes,
		);
	}

	$self->render_view('request/add_new.tt', $errs);
}

#-------------------------------------------------------------------------------
sub new_request : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('register');

    my $case_id = $self->param('id')
    || return $self->error('no id passed to '.$self->get_current_runmode);

	my $dfv = $self->check_rm('add_new', $self->validate('new_request') )
	|| return $self->dfv_error_page;

    my $data = $dfv->valid;
    $data->{patient_case_id} = $case_id; # $self->debug($data);

    # load auto-screen config:
	if ( my $cfg = $self->get_yaml_file('auto_screen') ) {
		$data->{auto_screen_config} = $cfg; # warn Dumper $cfg;
	}

    my $rtn = $self->model('Request')->new_request($data);

	if ($rtn) {
		return $self->error($rtn);
	}

	# ok, no error so now augment $data with 'missing' data for template:
	$self->_fill_data($data);

    $self->tt_params( data => $data );
	$self->tt_process;
}

#-------------------------------------------------------------------------------
sub edit : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	my $errs = shift; # $self->stash( errs => $errs );

	return $self->forbidden() unless $self->user_can('edit_pid');

    my $request_id = $self->param('id')
    || return $self->error('no id passed to '.$self->get_current_runmode);

    $self->js_validation_profile('update_request');

	# request data = hashref of objects & arrayrefs (eg data, history, specimen_map, etc)
	my $request_data = $self->get_single_request_data($request_id);

	# stuff original request params into session for later use in Model:
	$self->session_store_request_edit_data($request_data);

	# stuff request data into tt_params():
	$self->_prepare_data_for_template($request_data);

	return $self->render_view($self->tt_template_name, $errs);
}

#-------------------------------------------------------------------------------
sub unlock_request : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->has_unlock_permission;

    my $request_id = $self->param('id')
    || return $self->error('no id passed to '.$self->get_current_runmode);


	if ( $self->query->param('confirm_unlock') ) {
		my $rtn = $self->model('Request')->unlock_request($request_id);

		if ($rtn) {
			$self->error($rtn);
		}
		else {
			$self->flash( info => $self->messages('request_edit')->{unlock_success} );
			$self->redirect( $self->query->url . '/search/=/' . $request_id );
		}
	}
	else {
        my $request = $self->model('Request')->get_single_request($request_id);
		$self->stash( request_id => $request_id );
		return $self->tt_process({ request => $request });
	}
}

#-------------------------------------------------------------------------------
sub barcodes : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $request_id = $self->param('id')
	|| return $self->error('no id param passed to '. $self->get_current_runmode);

    my $request = $self->model('Request')->get_single_request($request_id);
	$self->tt_params( data => $request ); # warn Dumper $data;

	my $_self = $self; weaken $_self; # or get circular refs inside the callbacks
	my $barcode = 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' )
            : ( show_text => 1, bar_height => 25 );
        my $barcode = 'barcode_' . $type;
		return $_self->$barcode($text, %args);
	};
	$self->tt_params( render_barcode => $barcode );
    return $self->tt_process();
}

#-------------------------------------------------------------------------------
sub patient_access_print_report : Runmode { # need keyword 'print' in rm
	my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $id = $self->param('id')	|| die 'ERROR: cannot decypher request';

	# decrypt param('id'):
	my $request_id = do {
		my $key = LIMS::Local::Utils::today->ymd;
		LIMS::Local::Utils::decrypt($id, $key);
	};
	# return error page unless looks_like_number:
	die 'ERROR: cannot decypher request' unless looks_like_number($request_id);

	# my $report = $self->anonymise_report($request_id); # for anonymising
	my $report = $self->format_report($request_id);

	# set header type to pdf (+ don't cache):
    unless ($ENV{REPORT_HTML}) { # ie lims_server and/or no PDF reader
        $self->header_add(-type => 'application/pdf', -expires => 'now');
    }
    return $report;
}

#-------------------------------------------------------------------------------
sub print_record : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('print_one');

    my $request_id = $self->param('id')
	|| return $self->error('no id param passed to '. $self->get_current_runmode);

	my $report = $self->format_report($request_id);

	# log event:
	$self->history_log_event({ request_id => $request_id, event => 'print' });

	# set header type to pdf (+ don't cache):
    unless ($ENV{REPORT_HTML}) { # ie lims_server and/or no PDF reader
        $self->header_add(-type => 'application/pdf', -expires => 'now');
    }

    return $report;
}

#-------------------------------------------------------------------------------
sub email_report : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	my $errs = shift; # $self->stash( errs => $errs );

	return $self->forbidden() unless $self->user_can('email_report');

    my $request_id = $self->param('id')
	|| return $self->error('no id param passed to '. $self->get_current_runmode);

    # check user has email address in contacts.lib 'secure' section:
    my $sender = $self->_get_secure_contact_email();
    unless ($sender) {
        $self->flash( error => $self->messages('report')->{no_secure_email} );
        return $self->redirect( $self->query->url . '/search/=/' . $request_id );
    }

    my $request = $self->model('Request')->get_single_request($request_id);

	$self->tt_params(
        request => $request,
        sender  => $sender,
    );
	return $self->tt_process('record/email_report.tt', $errs);
}

#-------------------------------------------------------------------------------
sub do_email_report : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('email_report');

    my $request_id = $self->param('id')
	|| return $self->error('no id param passed to '. $self->get_current_runmode);

	my $dfv = $self->check_rm('email_report', $self->validate('email_report') )
    || return $self->dfv_error_page; # just checks email address looks valid

	my $form_data = $dfv->valid; # $self->debug($form_data);
	my $recipient = $form_data->{mailto};
	my $sender    = $form_data->{sender};

    if ( $self->query->param('_delete_address') ) {
        my $rtn = $self->model('Email')->delete_email_address($recipient);
        return $self->error($rtn) if $rtn; # only returns on error
        my $url = $self->query->url . '/request/email_report/' . $request_id;
        return $self->redirect($url);
    }

#=begin # replace with next block when nhs.uk addresses permitted:
    my $is_valid_domain = $self->_check_valid_domain($recipient);
    { # does recipient have secure contact address - if not require confirmation:
        my $anon_report_ok = $self->query->param('anon_report_ok');
        unless ( $is_valid_domain || $anon_report_ok ) {
            $self->tt_params( require_anon_report_confirmation => 1 );
            return $self->forward('email_report');
        }
    }
#=cut
=begin
	# rules are: secure recipient = OK; permitted recipient = anonymise report;
	# anything else rejected:
    my $is_valid_domain = $self->_check_valid_domain($recipient);
    my $anon_report_ok = $self->query->param('anon_report_ok');

	unless ( $is_valid_domain || $anon_report_ok ) {
		my $permitted
			= $self->get_yaml_file('anonymised_report_recipients') || []; warn Dumper $permitted;
		# if permitted, require confirmation of anonymisation:
		if ( grep $recipient eq $_, @$permitted ) {
			$self->tt_params( require_anon_report_confirmation => 1 );
		}
		else { # reject - not allowed:
			$self->flash( error => $self->messages('report')->{invalid_domain} );
		}
		return $self->forward('email_report');
	}
=cut

    # set flag for tt:
    $self->tt_params( is_print_request => 1 );

	# get report in pdf format:
	my $report = $is_valid_domain
        ? $self->format_report($request_id)
        : $self->anonymise_report($request_id); # return $self->dump_html;

	my %args = (
		attachment => $report,
		request_id => $request_id,
		recipient  => $recipient,
        sender     => $sender,
	);
	my $mail_msg = $self->_get_email_message(\%args); # return Dumper $mail_msg;
	# email report - returns hashref of 'success' & 'message':
	my $result = $self->model('Email')->send_message($mail_msg); # Return::Value object

	# log action if success:
	if ( $result->type eq 'success' ) { # can't do it in M::Email - uses generic methods:
		my %data = (
			request_id => $request_id,
			action     => "emailed report to $recipient",
		);
		$self->model('History')->do_log_action('RequestHistory', \%data);
		# add address to email_addresses:
		$self->model('Email')->add_new_address($recipient);

		# set flash msg for success:
		my $msg = $self->messages('report')->{email_success};
		$self->flash( info => sprintf $msg, $recipient );
	}
	else { # set flash msg for failure:
		my $msg = $self->messages('report')->{email_failure};
		$self->flash( error => sprintf $msg, $result->string );
	}

	return $self->redirect( $self->query->url . '/search/=/'. $request_id );
}

#-------------------------------------------------------------------------------
sub print_draft : 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 param passed to '. $self->get_current_runmode);

	my $request_data = $self->get_single_request_data($request_id);
	$self->process_raw_lab_test_data($request_data);

	$self->tt_params( request => $request_data );

	return $self->render_view('record/print_draft.tt');
}

#-------------------------------------------------------------------------------
sub email_alert : 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 param passed to '. $self->get_current_runmode);

	my $request_data = $self->get_single_request_data($request_id);

	my $mdt_centre = $self->query->param('mdt_centre');

	# require mdt centre param:
	unless ($mdt_centre) {
		my %saw; # get unique and active email_contact display_names:
		my $o = $self->model('ReferralSource')->get_mdt_email_contacts;
		my @mdt_centres = grep { ! $saw{$_->display_name}++ } @$o;

		$self->tt_params(
			centres => \@mdt_centres,
			data    => $request_data->{data},
		);
		return $self->tt_process;
	}

	# stash request_data for send_email_alert():
	$self->stash(request_data => $request_data);

	my $rtn = $self->send_email_alert($mdt_centre); # C::Roles::RecordHandler method

	if ($rtn) {
		return $self->error($rtn);
	}
	else {
		$self->tt_params( recipients => $self->stash->{recipients} );
		return $self->tt_process('request/message/success.tt', $request_data);
	}
}

#-------------------------------------------------------------------------------
sub delete_request : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	my $errs = shift;

	return $self->forbidden() unless $self->user_can('delete_record');

    my $request_id = $self->param('id')
    || return $self->error('no id passed to '.$self->get_current_runmode);

	my $request
		= $self->model('Request')->get_patient_and_request_data($request_id);

	my $report = $self->model('Report')->get_report($request_id);

	$self->tt_params(
		request => $request,
		is_reported => $report ? 1 : 0,
	);

    # get js validation foo_onsubmit & foo_dfv_js vars into tt_params:
    $self->js_validation_profile('delete_request');

	return $self->tt_process($errs);
}

#-------------------------------------------------------------------------------
sub do_delete : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('delete_record');

    my $request_id = $self->param('id')
    || return $self->error('no id passed to '.$self->get_current_runmode);

	my $dfv = $self->check_rm('delete_request', $self->validate('delete_request') )
	|| return $self->dfv_error_page;

	my $data = $dfv->valid;

	# add request_id:
	$data->{request_id} = $request_id;

	my $rtn = $self->model('Request')->delete_request($data);

	if ($rtn) {
		$self->error($rtn);
	}
	else {
		$self->flash( info => $self->messages('request_edit')->{delete_success} );
		$self->redirect( $self->query->url ); # can't go back to record !!!
	}
}

#-------------------------------------------------------------------------------
# just sets flag for template & forwards to edit():
sub edit_request : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

    $self->tt_params( want_request_data => 1 ); # flag for tmpl
	return $self->forward('edit'); # use forward() so tt_template_name() works
}

#-------------------------------------------------------------------------------
# update request or patient_case data:
sub update : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('edit_pid');

	my $q = $self->query();

    my $request_id = $self->param('id')
    || return $self->error('no id passed to '.$self->get_current_runmode);

	my $dfv = $self->check_rm('edit', $self->validate('update_request') );

	# need to (re)set template flag first if validation failed:
	if (! $dfv) {
		my ($is_request_data) = $q->param('_request_data');
		$self->tt_params( want_request_data => $is_request_data );
		return $self->dfv_error_page;
	}

	my $data = $dfv->valid; # warn Dumper $data; # $self->debug($data);
	$data->{_request_id} = $request_id; # aslo passed in 'frozen' data

	my $rtn = {};

	# if param->('scope') submitted, it's a patient_case edit:
	if ( my $scope = $q->param('scope') ) {
		$data->{scope} = $scope; # apply change to 1 record or all
		$rtn = $self->model('Request')->update_patient_case($data);
	}
	else {
		$rtn = $self->model('Request')->update_request($data);
	}

	# $rtn = { error => $db->error (if any); success => number of rows updated }
	if ($rtn->{error}) {
		return $self->error($rtn->{error});
	}
	else { # update succeeded:
		my $messages = $self->messages('request_edit');
		my $i = $rtn->{success}; # number of rows updated

		my @flash = $i # success can be 0, or an INT
			? ( info => sprintf $messages->{edit_success}, $i )
			: ( warning =>  $messages->{edit_failed} );

		$self->flash( @flash );
		return $self->redirect( $q->url . '/search/=/' . $request_id );
	}
}

#-------------------------------------------------------------------------------
# PRIVATE METHODS
#-------------------------------------------------------------------------------

# sub _send_email_alert {} # moved to C::Roles::RecordHandler

#-------------------------------------------------------------------------------
sub _get_email_message {
	my $self = shift; $self->_debug_path();
	my $args = shift;

	my $request_id = $args->{request_id};
	my $attachment = $args->{attachment};
	my $recipient  = $args->{recipient};
	my $sender     = $args->{sender};

	my $request_data = $self->stash->{request_data}; # from anomymise_report()
	#	= $self->model('Request')->get_patient_and_request_data($request_id);

	my $config = $self->cfg('settings');

	my $subject   = $config->{lab_name_abbreviation} . ' Report';

	my $filename  = join '_',
		$config->{lab_number_prefix} . $request_data->request_number,
		sprintf '%02d', $request_data->year - 2000; # $self->debug($filename);

	my $message  = do {
		$self->tt_process('record/email_message.tt', { data => $request_data });
	}; # $self->debug($message);

	my %mail = (
		recipient  => $recipient,
		attachment => $attachment,
		filename   => $filename . '.pdf',
		message    => ${$message}, # deref. scalarref
		config     => $config,
		subject    => $subject,
        sender     => $sender,
	);

	return \%mail;
}

#-------------------------------------------------------------------------------
sub _check_valid_domain {
	my ($self, $recipient) = @_;

	my $settings = $self->cfg('settings');

	my @valid_domains = map {
		LIMS::Local::Utils::trim($_);
	} split /\,/, $settings->{valid_recipient_domains}; # warn Dumper \@valid_domains;

	return ( grep $recipient =~ /$_\Z/, @valid_domains );
}

#-------------------------------------------------------------------------------
sub _get_secure_contact_email {
    my $self = shift;

    my $profile = $self->user_profile;

    # ok if user.email is secure (TODO: review anonymised reports policy)
    # return $profile->{email} if $profile->{email} =~ /nhs\.net\Z/;

    my $path_to_app_root = $self->cfg('path_to_app_root');
    my $settings         = $self->cfg('settings'); # warn Dumper $settings;

    my $src_file = $path_to_app_root . '/src/lib/contacts.lib';
    my $contacts = Config::Auto::parse($src_file);
    my $user = join '.', $profile->{first_name}, $profile->{last_name}, 'secure';

    my $from_address = $contacts->{$user};
    if (! $from_address && $settings->{allow_generic_email_from} ) {
        $from_address = $settings->{email_from};
    }

    return $from_address || 0;
}

#-------------------------------------------------------------------------------
sub _get_practitioners {
    my ($self, $patient_case) = @_; $self->_debug_path();

    my $source_id = $patient_case->referral_source->id;

    my $practitioners
        = $self->model('Referrer')->get_referrers_by_source_id($source_id);

	my %GPs = map {
		$_->referrer->name => $_->referrer->national_code;
	} @$practitioners;

    # add default unknown practitioner code:
    my $referral_type = $self->model('Referrer')->get_referral_type('practitioner');

    $self->tt_params (
        practitioners => \%GPs,
        default_code  => $referral_type->default_unknown,
    );
}

#-------------------------------------------------------------------------------
# puts $request_data & related data into tt_params:
sub _prepare_data_for_template {
	my ($self, $request_data) = @_; $self->_debug_path();

	$self->tt_params( request_data => $request_data );

	{ # get any other patient cases belonging to this patient:
		my $patient_cases = $self->_get_other_patient_cases($request_data);
		$self->tt_params( patient_cases => $patient_cases );
	}
	{ # error_codes:
		my $error_codes
			= $self->model('ErrorCode')->get_error_code_assignment('request_edit');
		$self->tt_params(
			error_codes => $error_codes,
		);
	}
	{ # clinical_trials:
		my $trials = $self->model('ClinicalTrial')->get_trials;
		$self->tt_params( trials => $trials );
	}
    { # consent_options:
		my $consent_options = $self->model('Base')
			->get_objects( 'ConsentOption', { sort_by => 'consent_label' } );
		$self->tt_params( consent_options => $consent_options );
	}
	{ # additional_options:
		my $additional_options = $self->model('Base')
			->get_objects( 'AdditionalOption', { sort_by => 'option_label' });
		$self->tt_params( additional_options => $additional_options );
	}
    { # how many records does patient_case belong to:
		my $case_id = $request_data->{data}->{patient_case_id}
		|| return $self->error('cannot retrieve case_id in '.$self->get_current_runmode);
		my $requests_count = $self->model('Request')
			->get_patient_case_requests_count($case_id) || 0;
		$self->tt_params( record_count => $requests_count );
	}
}

#-------------------------------------------------------------------------------
# get other patient_case's for this patient_id:
sub _get_other_patient_cases {
	my ($self, $request_data) = @_; $self->_debug_path();

	my $data = $request_data->{data};

	my $patient_id = $data->patient_case->patient_id;

	my $patient_cases
		= $self->model('PatientCase')->get_cases_by_patient_id($patient_id);

	my @other_patient_cases = map { $_ }
		grep { $_->id != $data->patient_case->id }
			@$patient_cases; # $self->debug(\@other_patient_cases);

	return \@other_patient_cases;
}

#-------------------------------------------------------------------------------
sub _fill_data {
	my $self = shift; $self->_debug_path();
	my $data = shift; # $self->debug($data);

	my $referral_source = $self->model('ReferralSource')
		->get_referral_source($data->{referral_source_id});

	# get referral source from referral_source_id:
	$data->{referral_source} = $referral_source->display_name;

	if ( $referral_source->referral_type->description eq 'practice' ) {
		$data->{referrer_name} = $self->model('Referrer')
			->get_practitioner_by_code($data->{referrer_code})->name;
	}
	else { # referrer name passed as hidden field:
		$data->{referrer_name} = $self->query->param('_referrer');
	}
	# get patient from patient_case_id:
	$data->{case} = $self->model('PatientCase')
		->retrieve_patient_data($data->{patient_case_id});
    # get trial name if trial_id submitted:
    if (my $trial_id = $data->{trial_id}) {
        $data->{trial_name} = $self->model('ClinicalTrial')
            ->get_trial($trial_id)->trial_name;
    }

	$data->{lab_number} =
		join '/', $data->{request_number}, DateTime->now->strftime('%y');
}

1;