• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::Specimen;

use base 'LIMS::Model::Base';

use strict;

use Data::Dumper;

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

    my $specimen = LIMS::DB::Specimen->new(id => $id)->load;

    return $specimen;
}

#-------------------------------------------------------------------------------
sub get_specimen_id {
    my $self = shift;
    my $code = shift; # warn Dumper $code;

    my $specimen = LIMS::DB::Specimen->new(sample_code => $code)->load;

    return $specimen->id;
}

#-------------------------------------------------------------------------------
sub get_specimen_by_code {
    my $self = shift;
    my $code = shift;

    my $specimen
        = LIMS::DB::Specimen->new(sample_code => $code)->load(speculative => 1);

    return $specimen;
}

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

    my $specimens = LIMS::DB::Specimen::Manager->get_specimens(%$args);

    return $specimens;
}

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

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

    # get specimen data from $data - will be same thing if sample_type_id not used:
    my %specimen_data = map {
        $_ => $data->{$_};
    } grep $_ ne 'sample_type_id', keys %$data; # warn Dumper \%lspecimen_data;

    my $update = sub {
        my %args = ( class => 'Specimen', data => \%specimen_data );
        $self->update_object(\%args);

        # sample_type_id data if configured:
        if ( defined $data->{sample_type_id} ) { # in case '0' - to clear in edit()
            my $sample_type_id = $data->{sample_type_id};
            
            # $sample_type_id will be str if singular, or arrayref if multiple:
            $sample_type_id = [ $sample_type_id ]
                unless ref $sample_type_id eq 'ARRAY'; # warn Dumper $sample_type_id;

            my $specimen_id = $data->{_record_id}; # only exists if not new entry
            
            if ($specimen_id) { # not new specimen so clear any existing data:
                LIMS::DB::SpecimenSampleType::Manager->delete_specimen_sample_types(
                    where => [ specimen_id => $specimen_id ],
                );
            }
            else { # get new specimen id:
                my $dbh = $self->lims_db->dbh; # warn Dumper $dbh;
                $specimen_id
                    = $dbh->last_insert_id(undef, undef, 'specimens', 'id');
            } # warn $specimen_id;
            
            my %data = ( specimen_id => $specimen_id );
            map { 
                $data{sample_type_id} = $_;
                LIMS::DB::SpecimenSampleType->new(%data)->save;
            } grep $_, @$sample_type_id; # in case array is/contains '0'
        }
    };

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

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

#-------------------------------------------------------------------------------
sub validate_specimen {
    my $self = shift;
    my $specimen = shift || return; # warn $specimen;

    my $i = LIMS::DB::Specimen::Manager->get_specimens_count(
        query => [ sample_code => $specimen, active => 'yes' ],
    );
    return $i;
}

#-------------------------------------------------------------------------------
# gets specimen objects for supplied request_id(s):
sub get_request_specimens {
    my ($self, $request_id) = @_; # scalar or arrayref

    # get request_specimen object, ie:
    # SELECT .. FROM request_specimen, specimens WHERE request_id IN (@request_ids)
    my $rs = LIMS::DB::RequestSpecimen::Manager->get_request_specimens(
        query        => [ request_id => $request_id ], # arrayref -> 'IN'
        with_objects => 'specimen',
        sort_by      => 'specimen.sample_code'
    );
}

#-------------------------------------------------------------------------------
sub get_specimen_lab_test {
    my ($self, $specimen_id) = @_;

    my $specimen_lab_test = LIMS::DB::LabTest->new(id => $specimen_id)
        ->load(with => ['lab_section', 'specimen_lab_test']);
    return $specimen_lab_test;
}

#-------------------------------------------------------------------------------
sub get_specimen_lab_tests {
    my $self = shift;
    
    my %args = (
        require_objects => [ 'lab_test', 'specimen' ],     
    );
    
    my $specimen_lab_tests
        = LIMS::DB::SpecimenLabTest::Manager->get_specimen_lab_test_iterator(%args);
        
    return $specimen_lab_tests;
}

#-------------------------------------------------------------------------------
sub get_specimen_sample_types {
    my ($self, $specimen_id) = @_; 
    
    my %args = ( query => [ specimen_id => $specimen_id ] );
    my $o = LIMS::DB::SpecimenSampleType::Manager
        ->get_specimen_sample_types(%args);
    return $o;    
}

#-------------------------------------------------------------------------------
sub update_specimen_lab_tests {
    my $self = shift;
    my $data = shift; # warn Dumper $data;
    
    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    # specimen_id can be supplied as single (string) or multiple (arrayref)
    my @specimen_ids = ref $data->{specimen_id} eq 'ARRAY'
        ? @{ $data->{specimen_id} } # allow empty array if clearing all specimens:
        : $data->{specimen_id} || (); # warn Dumper \@specimen_ids;
    
    my $update = sub {
        # first clear existing data:
        LIMS::DB::SpecimenLabTest::Manager->delete_specimen_lab_test(
            where => [ lab_test_id => $data->{lab_test_id} ],
        );      
        
        for my $id(@specimen_ids) {            
            LIMS::DB::SpecimenLabTest->new(
                specimen_id => $id,
                lab_test_id => $data->{lab_test_id},
            )->save;
        };
    };
    
    my $ok = $db->do_transaction($update);

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

1;