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; 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; 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; 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} } : $data->{specimen_id}; my $update = sub { # first clear existing data: LIMS::DB::SpecimenLabTest::Manager->delete_specimen_lab_test( # db => $db, where => [ lab_test_id => $data->{lab_test_id} ], ); for (@specimen_ids) { LIMS::DB::SpecimenLabTest->new( # db => $db, specimen_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;