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;