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 { # modified to include screens with no configured lab-tests my $self = shift; my %args = ( require_objects => [ qw( category ) ], with_objects => [ qw( screen_lab_test.lab_test.lab_section ) ], sort_by => [ qw( lab_test.field_label ) ], ); my $o = LIMS::DB::Screen::Manager->get_objects_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 { # do this 1st so auto-report can load RequestInitialScreen object: 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; # set request status to screened: $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); 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); my %rtn = (success => $ok); $rtn{error} = 'do_initial_screen() error - ' . $db->error if (! $ok); $rtn{outcome} = $self->_format_screen_outcome(); return \%rtn; } #------------------------------------------------------------------------------- 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_to_new = ( 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 entry ' . $original_screen->description; my $update = sub { { # RequestInitialScreen: my $o = LIMS::DB::RequestInitialScreen->new(@args_to_new)->load; $o->screen_id($screen_id); $o->save(changes_only => 1); } { # RequestHistory: push @args_to_new, ( user_id => $self->user_profile->{id}, action => $action, ); LIMS::DB::RequestHistory->new(@args_to_new)->save; } # update lab tests & lab test details: unless ( $args->{_skip_new_tests} ) { # but not after request reported my %h = ( # requires screen_id & request_id: screen_id => $screen_id, _request_id => $request_id, # methods require underscored var ); $self->do_lab_tests(\%h); $self->do_lab_test_details(\%h); } }; my $ok = $db->do_transaction($update); my %rtn = (success => $ok); $rtn{error} = 'update_screen() error - ' . $db->error if (! $ok); $rtn{outcome} = $self->_format_screen_outcome(); return \%rtn; } #------------------------------------------------------------------------------- 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; } #------------------------------------------------------------------------------- sub get_initial_screens { my ($self, $request_id) = @_; # arrayref my @args = ( query => [ request_id => $request_id ], require_objects => 'screen', ); my $o = LIMS::DB::RequestInitialScreen::Manager->get_objects(@args); return $o; } # shared by do_initial_screen() & update_screen() - formats return info for .tt sub _format_screen_outcome { my $self = shift; # need to lookup each lab-test / screen category for skipped & requested tests: my %args = ( # allow_empty_lists => 1, # to avoid fatal error if empty - don't want now require_objects => 'lab_section', ); my $requested = do { $args{query} = [ id => $self->requested_lab_tests ]; $self->have_requested_lab_tests ? LIMS::DB::LabTest::Manager->get_lab_tests(%args) : []; # only execute if have array, or will get all lab_tests tbl! }; my $skipped = do { $args{query} = [ id => $self->skipped_lab_tests ]; $self->have_skipped_lab_tests ? LIMS::DB::LabTest::Manager->get_lab_tests(%args) : []; # only execute if have array, or will get all lab_tests tbl! }; my %outcome = ( requested => $requested, skipped => $skipped, ); return \%outcome; } 1;