• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::LabTest;

use strict;
use parent 'LIMS::Model::Base';

use Data::Dumper;
use Rose::DB::Object::Metadata::UniqueKey;

#-------------------------------------------------------------------------------
sub get_all_active_lab_tests {
    my $self = shift;
    my $sort = shift; # optional

    my @sort_by = ('field_label'); # default
    unshift @sort_by, $sort if ( $sort && $sort ne 'field_label' );

    my %args = (
        require_objects => 'lab_section',
        sort_by         => \@sort_by,
    );

    # get all lab_tests rows as arrayref:
    my $data = LIMS::DB::LabTest::Manager->get_lab_tests_iterator(%args); # DEBUG $data;

    return $data;
}

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

    my %args = (
        query => [ request_id => $request_id ],
        require_objects => [ 'lab_test.lab_section', 'user', 'status' ],
        sort_by => 'lab_tests.field_label',
    );

#$self->set_rose_debug(1);
    my $lab_test_results = LIMS::DB::RequestLabTestStatus::Manager
        ->get_request_lab_test_status(%args);
#$self->set_rose_debug(0);

    return $lab_test_results;
}

#-------------------------------------------------------------------------------
sub get_incomplete_lab_tests {
    my $self = shift;

    my $o = do {
        my %args = (
            query => [ 'status.description' => { ne => 'complete' } ],
            require_objects => [ 'status', 'lab_test.lab_section' ],
        );
        LIMS::DB::RequestLabTestStatus::Manager->get_objects(%args);
    };

    my %data;
    for my $ref(@$o) {
        my $lab_test = $ref->lab_test->field_label; # warn $lab_test;
        my $section  = $ref->lab_test->lab_section->section_name; # warn $section;
        my $status   = $ref->status->description; # warn $status;
        $data{$section}{$lab_test}{$status}++;
    }
    return \%data;
}

#-------------------------------------------------------------------------------
sub get_incomplete_request_lab_tests_count {
    my $self = shift;
    my $args = shift; # href of status_option & lab_section

    my $status_option_id = $args->{status_option};
    my $lab_section_id   = $args->{lab_section};

    my @args = (
        query => [
            status_option_id => $status_option_id,
            'lab_test.lab_section_id' => $lab_section_id,
        ],
        require_objects => 'lab_test.lab_section',
    );
    my $n = LIMS::DB::RequestLabTestStatus::Manager->get_objects_count(@args);
    return $n;
}

#-------------------------------------------------------------------------------
sub get_incomplete_request_lab_tests {
    my $self = shift;
    my $args = shift;

    my $section_name = $args->{section_name};
    my $field_label  = $args->{field_label};

    my @query = (
        'request_lab_tests_status.status.description' => { ne => 'complete' },
        section_name => $section_name,
        field_label  => $field_label,
    );

    my @required = (
        'patient_case.patient',
        'patient_case.referral_source',
        'request_lab_tests_status.status',
        'request_lab_tests_status.lab_test.lab_section',
    );

    my $data = do {
        my %args = (
            query => \@query,
            require_objects => \@required,
            sort_by => [ qw(year request_number) ],
        );
        LIMS::DB::Request::Manager->get_objects(%args);
    };
    return $data;
}

#-------------------------------------------------------------------------------
sub get_request_lab_tests_status_for_section {
    my $self = shift;
    my $args = shift; # warn Dumper $args;

    my %args = (
        query => [
            section_name => $args->{section_name},
            request_id   => $args->{request_id},
            description  => $args->{description},
        ],
        require_objects => [ 'lab_test.lab_section', 'status' ],
    );

#$self->set_rose_debug(1);
    my $data = LIMS::DB::RequestLabTestStatus::Manager
        ->get_request_lab_test_status(%args);
#$self->set_rose_debug(0);

    return $data;
}

#-------------------------------------------------------------------------------
sub get_request_lab_tests_for_section {
    my $self = shift;
    my $args = shift; # warn Dumper $args;

    my %args = (
        query => [
            section_name => $args->{section_name},
            request_id   => $args->{request_id},
        ],
        require_objects => [ 'lab_test.lab_section', 'status' ],
    );

    my $data = LIMS::DB::RequestLabTestStatus::Manager
        ->get_request_lab_test_status(%args);

    return $data;
}

#-------------------------------------------------------------------------------
sub get_status_option {
    my $self = shift;
    my $id   = shift;

    my $option = LIMS::DB::LabTestStatusOption->new(id => $id)->load; # DEBUG $test;

    return $option;
}

#-------------------------------------------------------------------------------
sub get_status_options {
    my $self = shift;

    my $options = LIMS::DB::LabTestStatusOption::Manager
        ->get_lab_test_status_options;

    return $options;
}

#-------------------------------------------------------------------------------
sub update_status_options {
    my $self = shift;
    my $data = shift; # DEBUG $section; return;

    my %args = ( class => 'LabTestStatusOption', data  => $data );

    return $self->update_object(\%args);
}

#-------------------------------------------------------------------------------
=begin # not in use ?
# need to return 1 if it's unique:
sub check_lab_test_unique {
    my $self = shift;
    my $data = shift;

    my %args = (
        query => [
            test_name => $data->{test_name},
            lab_section_id => $data->{lab_section_id},
        ],
    );

#$self->set_rose_debug(1);
     my $count = LIMS::DB::LabTest::Manager->get_lab_tests_count(%args);
#$self->set_rose_debug(0);

    # if $count exists, it's not unique so return inverse:
    return ! $count;
}
=cut

#-------------------------------------------------------------------------------
sub get_lab_test {
    my $self = shift;
    my $id   = shift;

    my $test = LIMS::DB::LabTest->new(id => $id)->load; # DEBUG $test;

    return $test;
}

#-------------------------------------------------------------------------------
sub get_lab_test_by_name {
    my ($self, $params) = @_;

    my $test = LIMS::DB::LabTest->new(%$params)->load; # DEBUG $test;

    return $test;
}

#-------------------------------------------------------------------------------
sub get_lab_section_for_test_name {
    my ($self, $test_name) = @_;

    my %query = (
        query => [ test_name => $test_name ],
        require_objects => 'lab_section',
    );
    my $test = LIMS::DB::LabTest::Manager->get_lab_tests(%query);
    return $test;
}

#-------------------------------------------------------------------------------
sub get_lab_tests_count {
    my $self = shift;
    my $args = shift || {}; # optional query params (lab_Section_id)

    # restrict by lab_section_id if supplied:
    if ( my $lab_section_id = $args->{lab_section_id} ) {
        # put 'lab_section_id' into $args->{query} so it's preserved for later:
        push @{ $args->{query} }, ( lab_section_id => $lab_section_id );
        # delete 'lab_section_id' entry in original data structure:
        delete $args->{lab_section_id}; # $args gets passed to get_lab_tests()
    }

    # get all lab_tests count (restricted by lab_section_id if supplied):
    my $count = LIMS::DB::LabTest::Manager->get_lab_tests_count(%$args);

    return $count;
}

#-------------------------------------------------------------------------------
sub get_lab_tests {
    my $self   = shift;
    my $params = shift || {};

    $params->{require_objects} = 'lab_section';
    $params->{sort_by} ||= 'field_label'; # $self->debug($params);

    # get all lab_tests as arrayref - restrict by lab_section_id if supplied
    # by get_lab_tests_count() method:
    my $data = LIMS::DB::LabTest::Manager->get_lab_tests(%$params);

    return $data;
}

#-------------------------------------------------------------------------------
sub get_panel_lab_tests {
    my ($self, $lab_section) = @_;

    my @args = (
        require_objects => [ qw(lab_test panel_test.lab_section) ],
        query => [
            section_name => $lab_section,
        ],
        sort_by => 'lab_test.field_label',
    );

    my $o = LIMS::DB::PanelLabTest::Manager->get_panel_lab_tests(@args);
    return $o;
}

#-------------------------------------------------------------------------------
# find lab-test for lab-section with (test name or label) + (section name or id)
# generates tempoarary unique key for query:
sub get_section_lab_test {
    my ($self, $args) = @_; # warn Dumper $args;

    my @args = ();
    my @cols = ('lab_section_id'); # need this, plus test_name or field_label

    # test name or field label:
    if ( my $field_label = $args->{lab_test} ) { # warn $field_label;
        push @args, ( field_label => $field_label );
        push @cols, 'field_label';
    }
    elsif ( my $test_name = $args->{test_name} ) { # warn $test_name;
        push @args, ( test_name => $test_name );
        push @cols, ( 'test_name' );
    }
    else { die 'require test_name or field_label' }
    # section name or id:
    if ( my $section_name = $args->{section_name} ) { # warn $section_name;
        # push @args, ( section_name => $section_name ); # doesn't work
        my $lab_section = LIMS::DB::LabSection
            ->new(section_name => $section_name)->load;
        push @args, ( lab_section_id => $lab_section->id );
    }
    elsif ( my $section_id = $args->{lab_section_id} ) { # warn $section_id;
        push @args, ( lab_section_id => $section_id );
    }
    else { die 'require lab_section_id or section_name' } # warn Dumper \@cols;

    my $o = LIMS::DB::LabTest->new(@args);
    { # create unique key to allow lab_section_id & field_label/test_name query:
        my $uk = Rose::DB::Object::Metadata::UniqueKey->new(columns =>\@cols);
        $o->meta->add_unique_key($uk);
    }
    my $test = $o->load(); # warn Dumper $test->as_tree;
    return $test;
}

#-------------------------------------------------------------------------------
sub get_section_lab_tests {
    my ($self, $query_args, $sort_by) = @_; # sort_by optional

    my @args = (
        query => [ %$query_args ],
        require_objects => 'lab_section',
    );
    push @args, ( sort_by => $sort_by ) if $sort_by; # warn Dumper \@args;
    my $lab_tests = LIMS::DB::LabTest::Manager->get_lab_tests(@args);
    return $lab_tests;
}

#-------------------------------------------------------------------------------
# gets row count for number of lab_tests with has_results = 'yes', preserves query
# params for later use in get_resultable_lab_tests():
sub get_resultable_lab_tests_count {
    my $self = shift;
    my $args = shift || {};

    $args->{query} = [ has_results => 'yes' ];

    # restrict by lab_section_id if supplied:
    if ( my $lab_section_id = $args->{lab_section_id} ) {
        # put 'lab_section_id ' into query params:
        push @{ $args->{query} }, ( lab_section_id => $lab_section_id );
        # delete 'lab_section_id' entry in original data structure:
        delete $args->{lab_section_id}; # $args gets passed to get_resultable_lab_tests()
    }

    my $count = LIMS::DB::LabTest::Manager->get_lab_tests_count(%$args);

    return $count;
}

#-------------------------------------------------------------------------------
sub get_resultable_lab_tests {
    my $self = shift;
    my $args = shift || {}; # query params set in get_resultable_lab_tests_count()

    # add require_objects for Manager get_lab_tests() method:
    $args->{require_objects} = 'lab_section'; # $self->debug($args);

    my $data = LIMS::DB::LabTest::Manager->get_lab_tests(%$args);

    return $data;
}

# ------------------------------------------------------------------------------
sub get_lab_test_result_options {
    my $self = shift;
    my $args = shift || {};

    $args->{require_objects} = 'data_type';
    $args->{sort_by} ||= [ 'data_type.description', 'value' ];

    my $options = LIMS::DB::LabTestResultOption::Manager
        ->get_lab_test_result_options(%$args);

    return $options;
}

# ------------------------------------------------------------------------------
sub get_lab_test_result_option {
    my ($self, $result_option_id) = @_;

    my $option = LIMS::DB::LabTestResultOption->new(id => $result_option_id)
        ->load(with => 'data_type');

    return $option;
}

#-------------------------------------------------------------------------------
sub get_lab_test_data_types {
    my $self = shift;

    my %args = (
        require_objects => ['lab_test.lab_section','data_type'],
    );

    my $data = LIMS::DB::LabTestDataType::Manager->get_lab_test_data_type(%args);

    return $data;
}

#-------------------------------------------------------------------------------
sub get_lab_test_data_type {
    my ($self, $lab_test_id) = @_;

    my $data = LIMS::DB::LabTest->new(id => $lab_test_id)
        ->load(with => ['lab_section', 'lab_test_data_type']);

    return $data;
}

#-------------------------------------------------------------------------------
sub get_lab_test_sample_types {
    my ($self, $lab_test_id) = @_;

    my $query = [ lab_test_id => $lab_test_id ];
    my $o = LIMS::DB::LabTestSampleType::Manager
        ->get_lab_test_sample_types(query => $query);
    return $o;
}

#-------------------------------------------------------------------------------
sub get_unaccredited_lab_tests {
    my ($self, $registration_date) = @_;
    # set future_date to 1 day after $registration_date for IFNULL in query:
    my $future_date = $registration_date->clone->add(days => 1)->ymd;
    # need dbix for this - uses complex query (IFNULL):
    my $dbix  = $self->lims_dbix;
    my $query = qq!SELECT t1.lab_test_id, 1 FROM lab_test_accreditation t1
        WHERE IFNULL(t1.accreditation_date,"$future_date") > ?!;
    my $map = $dbix->query($query, $registration_date->ymd)->map;
    return $map;
}

#-------------------------------------------------------------------------------
sub get_lab_test_accreditation {
    my ($self, $lab_test_id) = @_;

    my $o = LIMS::DB::LabTest->new(id => $lab_test_id)
        ->load( with => 'accreditation' );
    return $o;
}

#-------------------------------------------------------------------------------
sub update_accreditation_date {
    my $self = shift;
    my $data = shift; # warn Dumper $data;
    # convert empty accreditation_date '' from DatePicker to undef for RDBO:
    $data->{accreditation_date} ||= undef;
    eval {
        LIMS::DB::LabTestAccreditation->new(%$data)->insert_or_update;
    };
    return $@ if $@;
}

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

    eval {
        LIMS::DB::LabTestDataType->new(%$data)->insert_or_update;
    };
    return $@ if $@;
}

#-------------------------------------------------------------------------------
sub update_lab_tests {
    my $self = shift;
    my $data = shift || return; # warn Dumper $data; return; # shouldn't receive empty data from controller

    my %args = ( class => 'LabTest', data => $data ); # warn Dumper \%args;
    # update LabTest object, returns only on error:
    if ( my $err = $self->update_object(\%args) ) { # warn Dumper $err; # only exists if error
        return $err;
    }

    # now do supported sample types (should really be part of previous update!!):
    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $sample_type_id = $data->{sample_type_id}; # optional, use defaults if empty
    if (! $sample_type_id) { # get defaults for lab_section:
        my $query = [ lab_section_id => $data->{lab_section_id} ];
        my $o = LIMS::DB::LabSectionSampleType::Manager->
            get_lab_section_sample_types( query => $query );
        $sample_type_id = [ map $_->sample_type_id, @$o ]; # arrayref
    }
    # ensure $sample_type_id is arrayref - will be int if singular form param:
    $sample_type_id = [ $sample_type_id ] unless ref $sample_type_id eq 'ARRAY';

    my $lab_test_id = $data->{_record_id}; # only if edit existing entry
    if (! $lab_test_id) { # get new lab_test id:
        my @args = (undef, undef, 'lab_tests', 'id');
        $lab_test_id = $db->dbh->last_insert_id(@args); # warn $lab_test_id;
    }
    my $data_type_id = $data->{data_type_id}; # optional - for type = test only

    my $tx = sub {
        # clear existing lab test sample types:
        LIMS::DB::LabTestSampleType::Manager->delete_lab_test_sample_types(
            where => [ lab_test_id => $lab_test_id ],
        );
        for (@$sample_type_id) { # warn $_;
            my %h = ( lab_test_id => $lab_test_id, sample_type_id => $_ );
            LIMS::DB::LabTestSampleType->new(%h)->save;
        }
        if ($data_type_id) {
            LIMS::DB::LabTestDataType::Manager->delete_objects(
                where => [ lab_test_id => $lab_test_id ],
            );
            my %h = (
                data_type_id => $data_type_id,
                lab_test_id  => $lab_test_id,
                is_active    => 'yes',
            );
            LIMS::DB::LabTestDataType->new(%h)->save;
        }
    };
    my $ok = $db->do_transaction($tx);
    return $ok ? 0 : 'update_lab_tests() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_linked_lab_tests {
    my ($self, $data) = @_; # warn Dumper $data;

    my $parent_test_id = $data->{parent_test_id}; # integer
    my $linked_test_id = $data->{linked_test_id}; # arrayref

    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $tx = sub {
        # clear existing lab test sample types:
        LIMS::DB::LinkedLabTest::Manager->delete_objects(
            where => [ parent_test_id => $parent_test_id ],
        );
        for (@$linked_test_id) { # warn $_;
            my %h = ( parent_test_id => $parent_test_id, linked_test_id => $_ );
            LIMS::DB::LinkedLabTest->new(%h)->save;
        }
    };
    my $ok = $db->do_transaction($tx);
    return $ok ? 0 : 'update_linked_lab_tests() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_panel_lab_tests {
    my $self = shift;
    my $data = shift || return; # DEBUG $data;

    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $panel_test_id = $data->{panel_test_id}
    || die 'No panel_test_id value passed to update_panel_lab_tests()';

    # clear existing and add new in a single transaction:
    my $update = sub {
        # first clear existing entries for this panel_test_id:
        LIMS::DB::PanelLabTest::Manager->delete_panel_lab_tests(
            where => [ panel_test_id => $panel_test_id ],
        );
        # insert any new tests:
        my $test_ids = $data->{lab_test_id}; # arrayref
        foreach my $id ( @{ $test_ids } ) {
            LIMS::DB::PanelLabTest->new(
                panel_test_id => $panel_test_id,
                lab_test_id   => $id,
            )->save;
        }
    };

    my $ok = $db->do_transaction($update);

    # don't need return value unless error:
    return $ok ? 0 : 'update_panel_lab_tests() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_diagnosis_lab_tests {
    my $self = shift;
    my $data = shift || return; # warn Dumper $data;

    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $diagnosis_id = $data->{diagnosis_id}
    || die 'No diagnosis_id value passed to update_diagnosis_lab_tests()';

    # clear existing and add new in a single transaction:
    my $ok = $db->do_transaction( sub {
        # first clear existing entries for this diagnosis_id:
        LIMS::DB::DiagnosisLabTest::Manager->delete_objects(
            where => [ diagnosis_id => $diagnosis_id ],
        );
        # insert any new tests:
        my $test_ids = $data->{lab_test_id}; # arrayref
        for my $id ( @{ $test_ids } ) {
            LIMS::DB::DiagnosisLabTest->new(
                diagnosis_id => $diagnosis_id,
                lab_test_id  => $id,
            )->save;
        }
    });

    # don't need return value unless error:
    return $ok ? 0 : 'update_diagnosis_lab_tests() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_results_summary_lab_tests {
    my $self = shift;
    my $data = shift || return; # warn Dumper $data;

    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $summary_id = $data->{summary_id}
    || die 'No results_summary_id passed to update_results_summary_lab_tests()';

    # clear existing and add new in a single transaction:
    my $ok = $db->do_transaction( sub {
        # first clear existing entries for this diagnosis_id:
        LIMS::DB::ResultSummaryLabTest::Manager->delete_objects(
            where => [ result_summary_id => $summary_id ],
        );
        # insert any new tests:
        my $test_ids = $data->{lab_test_id}; # arrayref
        for my $id ( @{ $test_ids } ) {
            LIMS::DB::ResultSummaryLabTest->new(
                result_summary_id => $summary_id,
                lab_test_id       => $id,
            )->save;
        }
    });

    # don't need return value unless error:
    return $ok ? 0 : 'update_results_summary_lab_tests() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_lab_test_result_option {
    my $self = shift;
    my $data = shift || return; # DEBUG $data;

    my %args = ( class => 'LabTestResultOption', data  => $data );

    return $self->update_object(\%args);
}

1;