package LIMS::Model::HMRN::Data; use Moose::Role; requires 'patient_id'; use Data::Dumper; # ------------------------------------------------------------------------------ # all diagnoses (with ICDO3 designation): sub all_diagnoses { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my @tables = qw( patients diagnoses ); my $relationships = $self->get_relationships(\@tables); my %args = ( query => [ patient_id => $patient_id ], require_objects => $relationships, ); my $o = LIMS::DB::Request::Manager->get_requests(%args); my %diagnoses = map { $_->request_report->diagnosis->name => 1 } grep { $_->request_report->diagnosis->icdo3 } @$o; $data->{all_diagnoses} = \%diagnoses; # warn Dumper \%diagnoses; } # ------------------------------------------------------------------------------ sub chronologies { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; my $sql = q!select * from hmrn.patient_chronologies where patient_id = ?!; my $dates = $dbix->query($sql, $patient_id)->hash; # warn Dumper $dates; my $meta = $self->get_meta('hmrn.patient_chronologies'); # warn Dumper $meta; my @date_cols = grep { $meta->{$_}->{type} eq 'date' } keys %$meta; # warn Dumper \@date_cols; # convert MySQL dates to dt objects: $self->inflate_mysql_dates_to_datetime($dates, \@date_cols); $data->{chronology} = $dates; } # ------------------------------------------------------------------------------ # add mdt data to chronologies: sub mdt_dates { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; my $sql = q!select id, date from hmrn.patient_mdt_dates where patient_id = ? order by date!; my $dates = $dbix->query($sql, $patient_id); while ( my $vals = $dates->hash ) { # inflate 'date' val to DT object: $self->inflate_mysql_dates_to_datetime($vals, ['date']); push @{ $data->{chronology}->{mdt_dates} }, $vals; } } # ------------------------------------------------------------------------------ sub antecedent_events { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; { # antecedent_events: my $sql = q!select event_id from hmrn.patient_antecedent where patient_id = ?!; my $event_id = $dbix->query($sql, $patient_id)->list; $data->{antecedent}{event_id} = $event_id; } { # previous radio- & chemo-therapies: my $sql = q!select therapy from hmrn.patient_prior_therapies where patient_id = ?!; my $tx = $dbix->query($sql, $patient_id)->flat; # warn Dumper $tx; my %data = map { $_ => 1 } @$tx; # warn Dumper \%data; $data->{antecedent}{prior_tx} = \%data; # part of antecedent/prior tx set } } # ------------------------------------------------------------------------------ sub treatment { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; my $sql = $self->sql_lib->retr('hmrn_patient_treatment_data'); my $tx = $dbix->query($sql, $patient_id); while ( my $vals = $tx->hash ) { # warn Dumper $vals; # dates to datetime: $self->inflate_mysql_dates_to_datetime($vals, [ qw(start_date end_date) ]); push @{ $data->{treatments} }, $vals; # add to treaments array } } # ------------------------------------------------------------------------------ sub data_params { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; my $sql = $self->sql_lib->retr('hmrn_all_patient_params'); my $query = $dbix->query($sql, $patient_id); while ( my $vals = $query->hash ) { my $param_name = $vals->{param_name}; my $category = $vals->{category}; $data->{params}{$category}{$param_name} = $vals->{result}; } } # ------------------------------------------------------------------------------ # which dataset(s) do we have - skip 'promiscuous' params & autoincrement category counter: sub dataset_type { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; my $sql = $self->sql_lib->retr('hmrn_non_unique_params'); my @non_unique_params = $dbix->query($sql)->flat; my $param_data = $data->{params}; CATEGORY: # for each category (precursor, myeloid, etc): while ( my($category, $ref) = each %$param_data ) { PARAM: # for each data param (albumin, Hb, etc): while ( my ($param, $result) = each %$ref ) { # skip any params shared by >1 category: next PARAM if grep $param eq $_, @non_unique_params; # increment category_has_data count for category: $data->{category_has_data}{$category}++; } } # warn Dumper \%data_type; } # ------------------------------------------------------------------------------ sub staging_data { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; my $sql = $self->sql_lib->retr('hmrn_patient_staging'); my $list = $dbix->query($sql, $patient_id)->flat; $data->{params}{staging}{$_}++ for @$list; { # add 'staging other' text data: my $sql = 'select detail from hmrn.patient_staging_other where patient_id = ?'; my $list = $dbix->query($sql, $patient_id)->flat; $data->{params}{staging}{$_}++ for @$list; } { # other (free-text) sites: my $sql = q!select details from hmrn.patient_sites_other where patient_id = ?!; if ( $dbix->query($sql, $patient_id)->into(my $other) ) { $data->{params}{staging}{details} = $other; } } } # ------------------------------------------------------------------------------ sub comments { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my $dbix = $self->lims_dbix; my $sql = 'select * from hmrn.patient_comments where patient_id = ?'; my $comment = $dbix->query($sql, $patient_id)->hash; $self->inflate_mysql_timestamp_to_datetime($comment, ['timestamp']); $data->{params}{comment} = $comment; } # ------------------------------------------------------------------------------ # calculated indices (IPI, FLIPI, HIPI, etc): sub calculated_indices { my $self = shift; my $data = shift; my $patient_id = $self->patient_id; my %args = ( patient_id => $patient_id, params_data => $data->{params}, ); # warn Dumper $data->{params}; # all calculations handled by Model::HMRN::PrognosticIndicator: my $indices = $self->prognostic_indicators(\%args); $data->{params}{indices} = $indices; # warn Dumper $indices; } 1;