package LIMS::Model::Screen;
use Moose;
extends 'LIMS::Model::Base';
with (
'LIMS::Model::Roles::SessionData', # provides $self->user_profile
'LIMS::Model::Roles::ScreenUpdate',
'LIMS::Model::Roles::RequestUpdate',
'LIMS::Model::Roles::ReportUpdate',
);
has form_data => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable;
use Data::Dumper;
use Rose::DateTime::Util qw(:all);
#-------------------------------------------------------------------------------
sub get_screen {
my $self = shift;
my $id = shift;
my $screen = LIMS::DB::Screen->new(id => $id)->load(with => 'category');
return $screen;
}
#-------------------------------------------------------------------------------
sub get_screen_category {
my $self = shift;
my $id = shift;
my $category = LIMS::DB::ScreenCategory->new(id => $id)->load;
return $category;
}
#-------------------------------------------------------------------------------
sub get_screening_terms_count {
my $self = shift;
my $args = shift || {}; # optional query params (lab_Section_id)
# restrict by lab_section_id if supplied:
if ( my $category_id = $args->{category_id} ) {
# put 'category_id' into $args->{query} so it's preserved for later:
push @{ $args->{query} }, ( category_id => $category_id );
# delete 'category_id' entry in original data structure:
delete $args->{category_id}; # $args gets passed to get_all_screens()
}
# get all screen terms count (restricted by category_id if supplied):
my $count = LIMS::DB::Screen::Manager->get_screens_count(%$args);
return $count;
}
#-------------------------------------------------------------------------------
sub get_all_screens {
my $self = shift;
my $params = shift || {};
$params->{require_objects} = 'category';
# get all screen rows as arrayref:
my $data = LIMS::DB::Screen::Manager->get_screens(%$params); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_screens_for_category {
my ($self, $category_id) = @_;
my %args = (
query => [ 'category_id' => $category_id ],
sort_by => 'description',
);
# get all screens rows for submitted $category_id as arrayref:
my $data = LIMS::DB::Screen::Manager->get_screens(%args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_assigned_tests {
my $self = shift;
my $screen_id = shift;
my %args = (
query => [ 'screen_id' => $screen_id ],
);
# get all screen_lab_test rows for submitted $screen_id as arrayref:
my $data = LIMS::DB::ScreenLabTest::Manager->get_screen_lab_tests(%args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_all_assigned_tests {
my $self = shift;
my %args = (
require_objects => [ qw(screen.category lab_test.lab_section) ],
sort_by => 'lab_test.field_label',
);
my $o = LIMS::DB::ScreenLabTest::Manager->get_screen_lab_tests_iterator(%args);
return $o;
}
#-------------------------------------------------------------------------------
sub get_assigned_test_details {
my $self = shift;
my $screen_id = shift;
my %args = (
query => [ 'screen_id' => $screen_id ],
);
# get all screen_lab_test rows for submitted $screen_id as arrayref:
my $data = LIMS::DB::ScreenLabTestDetail::Manager->get_screen_lab_test_details(%args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub update_lab_tests {
my $self = shift;
my $args = shift; # DEBUG $args;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $screen_id = $args->{screen_id}
|| die 'No screen_id value passed to update_lab_tests()';
# update lab_tests & section_details in a single transaction:
my $update = sub {
# first clear existing entries for this screen_id:
LIMS::DB::ScreenLabTest::Manager->delete_screen_lab_tests(
where => [ screen_id => $screen_id ],
);
# insert any new tests:
my $test_ids = $args->{test_ids}; # arrayref
foreach my $id ( @{ $test_ids } ) {
LIMS::DB::ScreenLabTest->new(
lab_test_id => $id,
screen_id => $screen_id,
)->save;
}
# first clear existing entries for this screen_id:
LIMS::DB::ScreenLabTestDetail::Manager->delete_screen_lab_test_details(
where => [ screen_id => $screen_id ]
);
# insert any new section details:
my $lab_section_details = $args->{details}; # $self->debug($section_notes)
while ( my ($lab_section_id, $value) = each %$lab_section_details ) {
next unless $value; # skip empty fields
LIMS::DB::ScreenLabTestDetail->new(
lab_section_id => $lab_section_id,
test_details => $value,
screen_id => $screen_id,
)->save;
}
};
my $ok = $db->do_transaction($update);
# don't need return value unless error:
return $ok ? 0 : 'update_lab_tests() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub update_screening_terms {
my $self = shift;
my $data = shift || return; # DEBUG $data; # shouldn't receive empty data from controller
my %args = ( class => 'Screen', data => $data ); # warn Dumper \%args;
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub update_screen_categories {
my $self = shift;
my $data = shift || return; # DEBUG $data; # shouldn't receive empty data from controller
my %args = ( class => 'ScreenCategory', data => $data ); # warn Dumper \%args;
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub do_initial_screen {
my $self = shift;
my $data = shift; # $self->debug($data);
# put $dfv->valid into $self:
$self->form_data($data);
# update request_lab_test, request_audit & report tables in a single transaction:
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $initial_screen = sub {
# set request status first:
$self->update_request_status('screened', $data->{_request_id});
# auto-report (if required) before lab-tests (would prevent auto_reporting):
if ( $data->{auto_reportable_config} ) {
$self->do_auto_report();
}
# additional options (eg screened as HIV sets DoI flag):
if ( $data->{additional_options_config} ) {
$self->additional_options('screen');
}
# lab tests:
$self->do_lab_tests($data);
# lab test details:
$self->do_lab_test_details($data);
LIMS::DB::RequestInitialScreen->new(
request_id => $data->{_request_id},
screen_id => $data->{screen_id},
)->save;
LIMS::DB::RequestHistory->new(
request_id => $data->{_request_id},
user_id => $self->user_profile->{id},
action => 'screened'
)->save;
if ( my $option_id = $data->{option_id} ) { # only if config'd in settings
LIMS::DB::RequestAudit->new(
request_id => $data->{_request_id},
audit_request_option_id => $option_id,
)->save;
}
};
# do_transaction() returns true if succeeds; sets $db->error on failure:
#$self->set_rose_debug(1);
my $ok = $db->do_transaction($initial_screen);
#$self->set_rose_debug(0);
# need to lookup each lab-test / screen category for each:
return {
updates => {
added => $self->added_lab_tests,
skipped => $self->skipped_lab_tests,
},
success => $ok,
error => $db->error,
};
#return $ok ? 0 : 'do_initial_screen() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub update_screen {
my $self = shift;
my $args = shift; # DEBUG $args;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $screen_id = $args->{screen_id}
|| die 'No screen_id value passed to update_screen()';
my $request_id = $args->{request_id}
|| die 'No request_id value passed to update_screen()';
my %args = (
request_id => $request_id,
);
# get original screen object:
my $original_screen = $self->get_initial_screen($request_id)->screen;
# check it's changed:
return unless $screen_id != $original_screen->id;
my $action = 'updated initial screen from ' . $original_screen->description;
my $update = sub {
{ # RequestInitialScreen:
my $o = LIMS::DB::RequestInitialScreen->new(%args)->load;
$o->screen_id($screen_id);
$o->save(changes_only => 1);
}
{ # RequestHistory:
$args{user_id} = $self->user_profile->{id};
$args{action} = $action;
LIMS::DB::RequestHistory->new(%args)->save;
}
{ # update lab tests & lab test details:
my %data = ( # requires screen_id & request_id:
screen_id => $screen_id,
_request_id => $request_id, # methods require underscored var
);
$self->do_lab_tests(\%data);
$self->do_lab_test_details(\%data);
}
};
my $ok = $db->do_transaction($update);
# don't need return value unless error:
return $ok ? 0 : 'update_screen() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub get_initial_screen {
my $self = shift;
my $request_id = shift;
# load speculative => 1 in case not yet screened:
my $screen = LIMS::DB::RequestInitialScreen->new(request_id => $request_id)
->load(speculative => 1, with => 'screen' );
return $screen;
}
1;
