• Files
• Commits
• Log
• Graph
• Stats

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 {
        # 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 = sprintf 'updated initial screen (%s)', $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;