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_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;