• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::Roles::RequestUpdate;

use Moose::Role;
with 'LIMS::Model::Roles::HistoryAction';

use Data::Dumper;

#-------------------------------------------------------------------------------
sub do_referrer_department_update {
    my $self = shift;
    my $data = shift; # form data

	my $frozen = $self->frozen_data; # original data

	my $new_referral_source_id = $data->{referral_source_id};

	my $new_location
		= LIMS::DB::ReferralSource->new(id => $new_referral_source_id)->load;

	my $new_parent_organisation_id = $new_location->parent_organisation_id;

	# no need to check referrer_department if parent_organisation hasn't changed:
	return unless $new_parent_organisation_id != $frozen->{parent_organisation_id};

	my $referrer_department;
	{ # get new referrer_department, compare to original referrer_department
		my %args = (
			referral_source_id => $new_referral_source_id,
			referrer_code	   => $frozen->{referrer_code},
		);

		$referrer_department = $self->_get_referrer_department(\%args);
	}

	# no need to update requests table if referrer_department_id unchanged:
	return unless $referrer_department->id != $frozen->{referrer_department_id};

	# ok, referrer_department has changed, so need to update
	# requests.referrer_department_id to new value:
	{
		my %params = (
			id => $data->{_request_id},
		);

		my $o = LIMS::DB::Request->new(%params)->load;
		$o->referrer_department_id($referrer_department->id);
		$o->save(changes_only => 1);
	}
}

#-------------------------------------------------------------------------------
sub do_patient_case_history {
	my ($self, $form_data) = @_;

	my $original_data = $self->frozen_data;

	my $original_location_name  = $original_data->{referral_source};
	my $submitted_location_name = $form_data->{_location_name};
	my $original_unit_number    = $original_data->{unit_number}; # never undef
	my $submitted_unit_number   = $form_data->{unit_number} || ''; # can be undef

	# location changed:
	if ( $original_location_name ne $submitted_location_name ) {
		my $change = qq!$original_location_name -> $submitted_location_name!;
		$self->add_to_actions( qq!amended referral source [$change]! );
	}
	# unit number changed:
	if ( $original_unit_number ne $submitted_unit_number ) {
		if ($original_unit_number && $submitted_unit_number) {
			my $change = qq!$original_unit_number -> $submitted_unit_number!;
			$self->add_to_actions( qq!amended unit number [$change]! );
		}
		elsif ($original_unit_number ne ! $submitted_unit_number) {
			$self->add_to_actions( qq!deleted unit number [$original_unit_number]! );
		}
		# don't need ! $original_unit_number - value set to 'unknown'
	}

	$self->do_request_error_code($form_data);
	# $self->do_request_history; # should use this
	$self->do_history_log($form_data);
}

#-------------------------------------------------------------------------------
sub do_referrer_update {
    my $self = shift;
    my $data = shift; # form data

    # get new referrer_department - need to supply original referral_source_id:
	$data->{referral_source_id} = $self->frozen_data->{referral_source_id};
	my $new_referrer_department = $self->_get_referrer_department($data);

	my $request = LIMS::DB::Request->new(
        id => $data->{_request_id},
    )->load;

	$request->referrer_department_id($new_referrer_department->id);
	$request->save(changes_only => 1);

    { # log change:
        my $original_referrer_name = $self->frozen_data->{referrer_name};

        $self->add_to_actions(
            qq!amended referrer ($original_referrer_name => $data->{_referrer})!
        );
    }
}

#-------------------------------------------------------------------------------
sub do_specimen_code_update {
    my $self = shift;
    my $data = shift; # form data

	# get specimens table iterator:
	my $specimen =
		LIMS::DB::Specimen::Manager->get_specimens_iterator(sort_by => 'sample_code');

	# extract specimens from $data->{specimen_code}:
    my $new_specimen_code = $data->{specimen_code};
    my $specimens = LIMS::Local::Utils::get_specimens($new_specimen_code); # DEBUG \$specimens;

    # first delete existing specimen_code data:
    {
        my %args = (
            where => [ request_id => $data->{_request_id} ],
        );
        LIMS::DB::RequestSpecimen::Manager->delete_request_specimens(%args);
    }

	# cycle specimens iterator, adding specimen_id to request_specimen table:
	my @specimen_ids;
	while ( my $o = $specimen->next ) {
		next unless grep { lc $o->sample_code eq lc $_ } @$specimens; # DEBUG $o->id;
		push @specimen_ids, $o->id;

		LIMS::DB::RequestSpecimen->new(
			request_id  => $data->{_request_id},
			specimen_id => $o->id,
		)->save;
	}
    {    # add new lab-tests if specimen requires:
        my %h = (
            request_id  => $data->{_request_id},
            specimen_id => \@specimen_ids,
        );
        $self->do_specimen_associated_lab_tests(\%h); # M::R::LabTestUpdate
    }

    { # log change:
        my $action = sprintf 'amended specimen (%s => %s)',
            uc $self->frozen_data->{specimen_code}, uc $new_specimen_code;
        $self->add_to_actions($action);
    }
}

#-------------------------------------------------------------------------------
sub do_specimen_date_update {
    my $self = shift;
    my $data = shift; # form data

    my $request_id = $data->{_request_id};

    my %h = map +($_ => $data->{$_}), qw(year month day);
	# add hr & min if provided:
	map { $h{$_} = $data->{$_} } grep $data->{$_}, qw(hour minute);

    my $o =	LIMS::DB::RequestSpecimenDetail->new( request_id => $request_id );

    my $action = $o->load_speculative ? 'updated' : 'new';

    $o->specimen_date( DateTime->new(%h) );  # warn Dumper $o->as_tree;
    $o->insert_or_update(changes_only => 1);

    $self->add_to_actions($action . ' specimen date');
}

#-------------------------------------------------------------------------------
sub do_external_ref_update {
    my $self = shift;
    my $data = shift; # $self->debug($data); # form data

	my $frozen = $self->frozen_data; # from Model::Request::_get_original_data

	my $original_ref_value  = $frozen->{external_reference};
	my $new_ref_value       = $data->{external_reference};

	my %params = (
		request_id => $data->{_request_id},
	);

    # need to delete if ! $data->{external_ref}, insert if ! $original, update if both:
	if ( $new_ref_value && $original_ref_value ) { # update:
		my $ref = LIMS::DB::RequestExternalRef->new(%params)->load;
		$ref->external_reference($data->{external_reference});
		$ref->save(changes_only => 1);
			# warn "updating external_ref from $original_ref_value to $new_ref_value";
		$self->add_to_actions(
			"changed external ref [$original_ref_value to $new_ref_value]"
		);
	}
	elsif ( $new_ref_value && ! $original_ref_value ) { # insert:
		$params{external_reference} = $data->{external_reference};
		LIMS::DB::RequestExternalRef->new(%params)->save;
			# warn "inserting new external_ref [$new_ref_value]";
		$self->add_to_actions( 'new external reference' );
	}
	elsif ( $original_ref_value && ! $new_ref_value ) { # delete:
		LIMS::DB::RequestExternalRef->new(%params)->delete;
			# warn "deleting external_ref [$original_ref_value]";
		$self->add_to_actions( 'deleted external reference' );
	}
}

#-------------------------------------------------------------------------------
sub do_clinical_trial_update {
    my $self = shift;
    my $data = shift; # $self->debug($data); # form data

    # need to delete if ! $data->{trial_id}, insert if ! $original, update if both:
	my $trial = $self->_get_trial_data($data); # warn Dumper $trial;

    my %params = (
        request_id => $data->{_request_id},
		trial_id   => $trial->{original_id},
    );

    # if trial_id exists in both form submission & db table, it's an update:
    if ( $trial->{new_id} && $trial->{original_id} ) {
		# but as primary_key = request_id & trial_id, need to delete & re-insert:
        LIMS::DB::RequestTrial->new(%params)->delete;
		$params{trial_id} = $trial->{new_id};
		LIMS::DB::RequestTrial->new(%params)->save;
			# warn "updating trial from $trial->{original_name} to $trial->{new_name}";
        $self->add_to_actions(
			"changed clinical trial ($trial->{original_name} -> $trial->{new_name})"
		);
    }
    # if trial_id in form submission but not db table, it's a new request so insert it:
    elsif ( $trial->{new_id} && ! $trial->{original_id} ) {
        $params{trial_id} = $trial->{new_id};
        LIMS::DB::RequestTrial->new(%params)->save;
			# warn "inserting new trial [$trial->{new_name}]";
        $self->add_to_actions( "new clinical trial $trial->{new_name}" );
    }
    # if trial_id exists in db table but not form param, it's a removal so delete it:
    elsif ( $trial->{original_id} && ! $trial->{new_id} ) {
        LIMS::DB::RequestTrial->new(%params)->delete;
			# warn "deleting trial [$trial->{original_name}]";
        $self->add_to_actions( "deleted clinical trial $trial->{original_name}" );
    }
}

#-------------------------------------------------------------------------------
sub do_trial_number_update {
	my $self = shift;
	my $data = shift; # form data

	my $frozen = $self->frozen_data; # from Model::Request::_get_original_data

	my $original_trial_number = $frozen->{trial_number};
	my $new_trial_number = $data->{trial_number};

	my %params = (
		patient_id => $frozen->{patient_id},
		trial_id   => $data->{trial_id}, # must be submitted with form
	);

	if ( $original_trial_number && $new_trial_number ) { # update:
        my $o = LIMS::DB::PatientTrial->new(%params)->load;
		$o->trial_number($data->{trial_number});
		$o->save(changes_only => 1);
			# warn "updating trial number from $original_trial_number to $new_trial_number";
        $self->add_to_actions(
			"changed trial number ($original_trial_number -> $new_trial_number)"
		);
	}
	elsif ( $new_trial_number && ! $original_trial_number ) { # insert:
		my $o = LIMS::DB::PatientTrial->new(%params);
        unless ($o->load_speculative) { # skip if already have patient/trial
            $o->trial_number($new_trial_number);
            $o->save;
			# warn "inserting new trial number [$new_trial_number]";
            $self->add_to_actions( "new trial number $new_trial_number" );
        }
	}
	elsif ( $original_trial_number && ! $new_trial_number ) { # delete:
        # trial_id will be absent from $data/$params if trial co-deletion request:
        $params{trial_id} ||= $frozen->{trial_id};

		LIMS::DB::PatientTrial->new(%params)->delete;
			# warn "deleting trial number [$original_trial_number]";
		$self->add_to_actions( "deleted trial number $original_trial_number" );
	}
}

#-------------------------------------------------------------------------------
sub do_request_options_update {
	my ($self, $data, $opts) = @_; # $self->debug([$data, $opts]); # form data

	{ # delete existing request_options:
		my %args = (
			where => [ request_id => $data->{_request_id} ],
		);
		LIMS::DB::RequestOption::Manager->delete_request_options(%args);
	}

	my %params = (
		request_id => $data->{_request_id},
	);

	# insert new (if any):
	OPTION:
	while ( my($option_id, $vals) = each %$opts ) { # warn Dumper $vals;
		$vals->{new} || next OPTION; # skip if $vals->{new} undef
		$params{option_id} = $option_id;
		LIMS::DB::RequestOption->new(%params)->save;
	}
	# cycle again for history log (can't do it in OPTION block due to 'next'):
	while ( my($id, $vals) = each %$opts ) { # warn Dumper $vals;
		# don't log unless changed:
		next if ( $vals->{new} && $vals->{old} )
			|| ( ! $vals->{new} && ! $vals->{old} );

		my $edit_action = $vals->{new} ? 'new' : 'deleted';

		$self->add_to_actions( qq!$edit_action request option '$vals->{name}'! );
	}
}

#-------------------------------------------------------------------------------
sub do_request_consent_update {
	my ($self, $data, $consent) = @_; # $self->debug([$data, $consent]);

	{ # delete existing request_consent - might have yes/no -> null:
		my %args = (
			where => [ request_id => $data->{_request_id} ],
		);
		LIMS::DB::RequestConsent::Manager->delete_request_consents(%args);
	}

    { # if setting all previous opts from yes/no (str) to '?' (undef):
        my @old = grep defined $consent->{$_}->{old}, keys %$consent;
        my @new = grep defined $consent->{$_}->{new}, keys %$consent;
            # warn Dumper [ \@old, \@new ];
    	if ( @old && ! @new ) {
            $self->add_to_actions('deleted consent data');
            return;
        }
	}

	my %params = (
		request_id => $data->{_request_id},
	);

	CONSENT:
	while ( my($consent_id, $vals) = each %$consent ) {
		my $status = $vals->{new} || next CONSENT; # in case param changed to '?'

		$params{consent_id} = $consent_id;
		$params{status}     = $status;

		LIMS::DB::RequestConsent->new(%params)->save;
	}
	# cycle again for history log (can't do it in CONSENT block due to 'next'):
	while ( my($id, $vals) = each %$consent ) {
		map { $vals->{$_} ||= '?' } qw(new old);
		next if $vals->{new} eq $vals->{old}; # don't log unless changed

		$self->add_to_actions(
			"updated $vals->{name} consent data [$vals->{old} -> $vals->{new}]"
		);
	}
}

#-------------------------------------------------------------------------------
# set is_screened to 'yes' in pre_registration table if exists:
sub do_pre_registration_update {
	my ($self, $request) = @_;

	# construct pre_registration.labno from $request object:
	my $labno = sprintf '%02d_%05d',
		$request->year - 2000,
		$request->request_number; # warn Dumper $labno;

	my $o  = LIMS::DB::PreRegistration->new(labno => $labno);

	if ($o->load_speculative) {
		$o->is_screened('yes');
		$o->save(changes_only => 1);
	}
}

#-------------------------------------------------------------------------------
# shared between M::Request::request_error_code(), M::Request::update_request &
# $self->do_patient_case_history():
sub do_request_error_code {
	my $self = shift;
	my $data = shift; # form data

	my $error_code_id = $data->{error_code_id};
	# get error_code object:
	my $error_code = LIMS::DB::ErrorCode->new(id => $error_code_id)->load;

	my %params = (
		request_id    => $data->{_request_id},
		error_code_id => $data->{error_code_id},
		user_id 	  => $self->user_profile->{id},
	);

	# is error_code required to be unique and already in use:
	if ( $error_code->is_unique eq 'yes' ) {
		my $query = [
			error_code_id => $error_code_id,
			request_id    => $data->{_request_id},
		];
		# skip request_error_code stage if error_code in use:
		return if LIMS::DB::RequestErrorCode::Manager
			->get_request_error_codes_count(query => $query);
	}

	# create new request_error_code entry:
	LIMS::DB::RequestErrorCode->new(%params)->save;
	# add to actions for history log:
	$self->add_to_actions('recorded error code '. uc $error_code->code);
}

#-------------------------------------------------------------------------------
sub do_history_log {
    my $self = shift;
    my $data = shift; # form data

    foreach my $action ($self->all_actions) { # warn $action;
        $action = substr($action, 0, 255) if length $action > 255;
		LIMS::DB::RequestHistory->new(
			request_id => $data->{_request_id},
			user_id    => $self->user_profile->{id},
			action     => $action,
		)->save;
	}
}

#-------------------------------------------------------------------------------
# finds existing patient_case matching form_data params, or creates new:
sub get_patient_case {
	my ($self, $form_data) = @_;

	my $frozen_data = $self->frozen_data; # from Model::Request::_get_original_data

	my $referral_source_id # ref_src_id only submitted in form if location changed:
		= $form_data->{referral_source_id} || $frozen_data->{referral_source_id};
	# will automatically default to 'UNKNOWN' if undef:
	my $unit_number = $form_data->{unit_number};
	my $patient_id  = $frozen_data->{patient_id};

	my %params = (
		referral_source_id => $referral_source_id,
		unit_number        => $unit_number,
		patient_id         => $patient_id,
	);
	my $new_patient_case
		= LIMS::DB::PatientCase->new(%params)->load_or_insert();

	return $new_patient_case;
}

#-------------------------------------------------------------------------------
sub update_request_status {
	my ($self, $status, $request_id) = @_;

    my $status_option
        = LIMS::DB::StatusOption->new(description => $status)->load;

    my $request = LIMS::DB::Request->new( id => $request_id )->load;

    # update status_option_id col:
    $request->status_option($status_option);
	# can also do this, but updates status_option table in process:
	# $request->status_option(description => $status);
    $request->save(changes_only => 1);
    # log request status change if complete:
    $self->add_to_actions('auto-set request status to complete')
        if $status eq 'complete';

	# maybe update pre_registration table:
	if ($status eq 'screened') {
		$self->do_pre_registration_update($request);
	}
}

#-------------------------------------------------------------------------------
sub update_general_notes {
	my $self = shift;
	my $data = shift;

	my $general_notes = $data->{general_notes};
	my $request_id    = $data->{_request_id};

	my $request_notes = LIMS::DB::RequestGeneralNote->new(
		request_id => $request_id,
	);

    my $action;
	if ($request_notes->load_speculative) {
		no warnings 'uninitialized'; # in case either empty
		return if $general_notes eq $request_notes->detail;

		if ($general_notes) { # update:
			$request_notes->detail($general_notes);
			$request_notes->save;
			$action = 'updated';
		}
		else { # delete:
			$request_notes->delete;
			$action = 'deleted';
		}
	}
	elsif ($general_notes) { # create new:
		$request_notes->detail($general_notes);
		$request_notes->save;
		$action = 'new';
	}
	$self->add_to_actions($action . ' request notes') if $action;
}

#-------------------------------------------------------------------------------
# *** method of similar name in Model::Request
sub _get_trial_data {
	my $self = shift;
	my $data = shift; # form data

	my %trial_data = (
		original_name => $self->frozen_data->{trial_name},
		original_id   => $self->frozen_data->{trial_id},

		new_name => undef, # determined below
		new_id   => $data->{trial_id},
	);

	# if $data->{trial_id}, get new trial name from clinical_trials table:
	if ( my $id = $data->{trial_id} ) {
		my $trial = LIMS::DB::ClinicalTrial->new(id => $id)->load;
		$trial_data{new_name} = $trial->trial_name;
	}

	return \%trial_data;
}

1;