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;