• 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 {
    my ($self, $data) = @_; # warn Dumper $data;

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

    # get all *previous* requests (ie r.id < $request_id) for this patient that
    # have patient_trial entries (join), with any request_trial (left join) entries:
    my $requests = do {
        my @args = (
            query => [
                'patient_trial.patient_id' => $patient_id,
                id => { lt => $request_id }, # previous to this request
            ],
            require_objects => [ 'patient_case.patient.patient_trial.trial' ],
            with_objects    => [ 'request_trial' ],
        );        
        LIMS::DB::Request::Manager->get_requests(@args);
    };
    
    my %h = (); 
    REQ: for my $r(@$requests) { # warn Dumper $r->as_tree;
        # skip unless entry in request_trial table; optional as it's a left-join tbl:
        next REQ unless $r->as_tree->{request_trial}; # as_tree to prevent db lookup

        my $data = $r->patient_case->patient->patient_trial->[0]; # ALWAYS ARRAYREF!!
        my $trial_name = $data->trial->trial_name; # warn Dumper $data->as_tree;
        next REQ if $h{$trial_name}; # may already have trial details from earlier request

        # add trial data to trial-name accessor:
        $h{$trial_name} = $data->as_tree; # $data has everything tt requires
    } # warn Dumper \%h;
    return \%h;
}

#-------------------------------------------------------------------------------
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;