• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Model::ClinicalTrial;

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

use Data::Dumper;
use strict;

#-------------------------------------------------------------------------------
sub get_trial {
    my ($self, $trial_id) = @_; # DEBUG $trial_id;

    my $data = LIMS::DB::ClinicalTrial->new(id => $trial_id)->load;

    return $data;
}

#-------------------------------------------------------------------------------
sub get_patient_trials { # check req 158223, 118764, 
    my ($self, $data) = @_; # warn Dumper $data;

    my $patient_id = $data->{patient_id};

    my @query = ( 'patient_trial.patient_id' => $patient_id );
    # add request.id restriction if query derived from search (not registration):
    if ( my $request_id = $data->{request_id} ) { # not supplied at registration
        push @query, ( request_id => { lt => $request_id } ); # ie previous to this request
    }

    # direct_patient_trial links patient_case to patient_trial via direct 1-to-1 rel:
    my @rels = qw( trial request.patient_case.direct_patient_trial );

    my @args = (
        query => \@query,
        require_objects => \@rels,
        group_by => 'trial_name', # or t1.trial_id; only need 1 entry per trial
    );        
    # get any *previous* request_trial entries for this patient:
    my $request_trial
        = LIMS::DB::RequestTrial::Manager->get_request_trials(@args);
        # warn Dumper $_->as_tree for @$request_trial;
    
    my %h =  # map +($_->trial_id => $_->trial->trial_name), @$request_trial;
      map { 
        $_->trial_id => {
            trial_name => $_->trial->trial_name,            
            trial_number => # 'direct_patient_trial' rel. declared as 1-2-1 to avoid array:
                $_->request->patient_case->direct_patient_trial->trial_number,
        }
      } @$request_trial; # warn Dumper \%h;
    return \%h;
}

#-------------------------------------------------------------------------------
=begin # changed to using single query
sub _get_patient_trials {
    my ($self, $data) = @_; # warn Dumper $data;

    my $patient_id = $data->{patient_id};
    my $request_id = $data->{request_id};

    # get all trials this patient is in:
    my $trials = do {
        my @args = (
            query => [ patient_id => $patient_id ],
            require_objects => 'trial',
        );        
        LIMS::DB::PatientTrial::Manager->get_objects(@args);
    };
    
    my %h = ();
    TRIAL: for my $t(@$trials) {
        # get earliest request for this patient in this trial:
        my $o = do {
            my @args = (
                fetch_only  => 'request',
                query   => [
                    patient_id => $patient_id,
                    trial_id   => $t->trial_id,
                ],
                sort_by => 'request_id',
                limit   => 1, # ensures only 1st one ie array of 1
                require_objects => 'request.patient_case.patient',
            );
            LIMS::DB::RequestTrial::Manager->get_objects(@args);
        };
        # skip trial unless earliest date in THIS trial BEFORE current request id:
        next TRIAL unless $o->[0]->request_id < $request_id; # $o->[0] as it's an array of 1
        $h{$t->trial->trial_name} = $t->as_tree;
    } # warn Dumper \%h;
    
    # my %h = map +( $_->trial->trial_name => $_->as_tree ), @$trials;
    return \%h;
}
=cut

#-------------------------------------------------------------------------------
sub get_trials {
    my $self = shift;
    
    # get all rows as arrayref:
    my $data = LIMS::DB::ClinicalTrial::Manager
        ->get_clinical_trials(sort_by => 'trial_name'); # DEBUG $data;

    return $data;
}

#-------------------------------------------------------------------------------
sub get_trial_number {
    my ($self, $patient_id, $trial_id) = @_;
    
    my %data = (
        patient_id => $patient_id,
        trial_id   => $trial_id,
    );
    
    my $patient_trial
        = LIMS::DB::PatientTrial->new(%data)->load(speculative => 1);
    
    return $patient_trial ? $patient_trial->trial_number : undef;
}

#-------------------------------------------------------------------------------
sub update_trials {
    my $self = shift;
    my $data = shift; # DEBUG $trial; # return;

    my %args = ( class => 'ClinicalTrial', data  => $data );
    
    return $self->update_object(\%args);
}

1;