• Files
• Commits
• Log
• Graph
• Stats

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;