package LIMS::Model::Diagnosis;
use Moose;
extends 'LIMS::Model::Base';
with ( 'LIMS::Model::Roles::Query' );
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable;
use Data::Dumper;
# ------------------------------------------------------------------------------
sub get_all_diagnoses {
my $self = shift;
my $args = shift || {}; # $self->debug($args);
$args->{require_objects} = 'diagnostic_category';
$args->{sort_by} ||= [ 'diagnostic_category.description', 'diagnoses.name' ];
my $diagnoses = LIMS::DB::Diagnosis::Manager->get_diagnoses(%$args);
return $diagnoses;
}
# ------------------------------------------------------------------------------
sub get_diagnosis_frequency {
my ($self, $diagnosis_id) = @_;
my %args = (
query => [ diagnosis_id => $diagnosis_id ],
);
my $request_report_count
= LIMS::DB::RequestReport::Manager->get_request_report_count(%args);
my $diagnosis_history_count = LIMS::DB::RequestDiagnosisHistory::Manager
->get_request_diagnosis_histories_count(%args);
return $request_report_count + $diagnosis_history_count;
}
# ------------------------------------------------------------------------------
sub get_diagnosis {
my ($self, $diagnosis_id) = @_;
my $diagnosis = LIMS::DB::Diagnosis->new( id => $diagnosis_id )->load;
return $diagnosis;
}
# ------------------------------------------------------------------------------
sub get_diagnoses_for_category {
my ($self, $category_id) = @_;
my @args = (
query => [ diagnostic_category_id => $category_id ],
sort_by => 'name',
);
my $o = LIMS::DB::Diagnosis::Manager->get_objects(@args);
return $o;
}
# ------------------------------------------------------------------------------
sub get_diagnosis_context_warnings {
my $self = shift;
my @objects = qw(diagnosis context_warning);
my $context_warnings = LIMS::DB::ContextWarningDiagnosis::Manager
->get_context_warning_diagnosis(require_objects => \@objects);
return $context_warnings;
}
# ------------------------------------------------------------------------------
sub get_diagnosis_change_options {
my $self = shift;
my $options
= LIMS::DB::DiagnosisChangeOption::Manager->get_diagnosis_change_options;
return $options;
}
# ------------------------------------------------------------------------------
sub get_diagnosis_change_option {
my ($self, $option_id) = @_;
my $option = LIMS::DB::DiagnosisChangeOption->new( id => $option_id )->load;
return $option;
}
# ------------------------------------------------------------------------------
sub get_all_context_warnings {
my $self = shift;
my $args = shift || {};
my $context_warnings = LIMS::DB::DiagnosisContextWarning::Manager
->get_diagnosis_context_warnings(%$args);
return $context_warnings;
}
# ------------------------------------------------------------------------------
sub get_context_warning {
my $self = shift;
my $id = shift;
my $context_warning
= LIMS::DB::DiagnosisContextWarning->new(id => $id)->load;
return $context_warning;
}
# ------------------------------------------------------------------------------
sub update_context_warning {
my $self = shift;
my $data = shift; # $self->debug( $data );
my %args = ( class => 'DiagnosisContextWarning', data => $data );
return $self->update_object(\%args);
}
# ------------------------------------------------------------------------------
sub get_request_diagnosis {
my ($self, $request_id) = @_; # warn Dumper $request_id;
my $relationship = $self->get_relationships(['diagnoses']); # warn Dumper $relationship;
#$self->set_rose_debug(1);
my $diagnosis
= LIMS::DB::Request->new( id => $request_id )->load( with => $relationship );
#$self->set_rose_debug(0);
return $diagnosis;
}
# ------------------------------------------------------------------------------
sub get_diagnostic_categories {
my $self = shift;
my %args = (
sort_by => ['category_type, description'],
);
my $categories
= LIMS::DB::DiagnosticCategory::Manager->get_diagnostic_categories(%args);
return $categories;
}
# ------------------------------------------------------------------------------
sub get_diagnostic_category {
my ($self, $category_id) = @_;
my $category = LIMS::DB::DiagnosticCategory->new( id => $category_id )->load;
return $category;
}
# ------------------------------------------------------------------------------
sub get_diagnosis_context_warning {
my $self = shift;
my $id = shift;
my $context_warning = LIMS::DB::ContextWarningDiagnosis->new(id => $id)
->load(with => ['diagnosis', 'context_warning']);
return $context_warning;
}
# ------------------------------------------------------------------------------
sub delete_diagnosis_context_warning {
my ($self, $id) = @_;
eval {
LIMS::DB::ContextWarningDiagnosis->new( id => $id )->delete;
};
return @$ if @$;
}
# ------------------------------------------------------------------------------
sub update_diagnosis_context_warning {
my $self = shift;
my $data = shift; # $self->debug( $data );
my %args = ( class => 'ContextWarningDiagnosis', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub update_diagnosis {
my $self = shift;
my $data = shift; # $self->debug( $data );
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $update = sub {
# update diagnoses table data:
$self->update_object({ class => 'Diagnosis', data => $data });
{ # delete any existing ICDO3 entry for a sub-category:
my $o = LIMS::DB::DiagnosticCategory::Manager
->get_diagnostic_categories( query => [category_type => 'sub']);
if ( my @diagnostic_category_ids = map { $_->id } @$o ) {
my %args = (
where => [
diagnostic_category_id => \@diagnostic_category_ids,
icdo3 => $data->{icdo3},
],
);
LIMS::DB::ICDOCategory::Manager->delete_icdo_category(%args);
}
}
# create new icdo_category entry if required:
if ( my $sub_category_id = $data->{sub_category_id} ) {
LIMS::DB::ICDOCategory->new(
diagnostic_category_id => $sub_category_id,
icdo3 => $data->{icdo3},
)->save;
} # die 'rollback now';
};
my $ok = $db->do_transaction($update);
# don't need return value unless error:
return $ok ? 0 : 'update_diagnosis() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub update_diagnostic_categories {
my $self = shift;
my $data = shift; # $self->debug( $data );
my %args = ( class => 'DiagnosticCategory', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub update_icdo3_category {
my $self = shift;
my $data = shift; # $self->debug( $data );
my $diagnostic_category_id = $data->{diagnostic_category_id};
my $icdo3 = $data->{icdo3}; # warn Dumper $icdo3;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $update = sub {
LIMS::DB::ICDOCategory::Manager->delete_icdo_category(
where => [ diagnostic_category_id => $diagnostic_category_id ]
);
for (@$icdo3) {
LIMS::DB::ICDOCategory->new(
diagnostic_category_id => $diagnostic_category_id,
icdo3 => $_,
)->save;
}
};
my $ok = $db->do_transaction($update);
# don't need return value unless error:
return $ok ? 0 : 'update_icdo3_category() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub update_diagnosis_change_options {
my $self = shift;
my $data = shift; # $self->debug( $data );
my %args = ( class => 'DiagnosisChangeOption', data => $data );
return $self->update_object(\%args);
}
1;