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;