package LIMS::Model::HMRN; use Moose; extends 'LIMS::Model::Base'; use namespace::clean -except => 'meta'; use DateTime::Format::MySQL; use Data::Dumper; # ------------------------------------------------------------------------------ sub has_data { my ($self, $patient_id) = @_; # warn $patient_id; my $dbix = $self->lims_dbix; # minimum data set for hmrn is mdt or chronology: for ( qw/chronologies mdt_dates/ ) { my $tbl = 'hmrn.patient_' . $_; return 1 if $dbix->query( "SELECT 1 FROM $tbl WHERE patient_id = ?", $patient_id )->list; } return 0; } # ------------------------------------------------------------------------------ sub get_all_hmrn_data { my ($self, $patient_id) = @_; # warn $patient_id; my $dbix = $self->lims_dbix; # switch db: # $dbix->dbh->do('use hmrn'); # needs reversing or get fatal error downstream my $hmrn_data = {}; { # chronologies: my $sql = q!select * from hmrn.patient_chronologies where patient_id = ?!; my $dates = $dbix->query($sql, $patient_id)->hash; # warn Dumper $dates; my $cols = $self->_get_cols('patient_chronologies'); # warn Dumper $cols; # convert MySQL dates to dt objects: my %data = map { $_ => DateTime::Format::MySQL->parse_date($dates->{$_}) } grep $dates->{$_}, @$cols; # warn Dumper \%data; # provide an age calculation callback: $data{calculate_age} = sub { LIMS::Local::Utils::calculate_age(@_); }; $hmrn_data->{chronology} = \%data; } { # add mdt data to chronologies: 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 ) { my $dt = DateTime::Format::MySQL->parse_date($vals->{date}); my $data = { id => $vals->{id}, date => $dt }; push @{ $hmrn_data->{chronology}->{mdt_dates} }, $data; } } return $hmrn_data; } # ------------------------------------------------------------------------------ sub get_patient_demographics { my ($self, $patient_id) = @_; my $data = LIMS::DB::PatientDemographic->new(patient_id => $patient_id) ->load( with => [ 'referrer', 'practice' ] ); return $data; } # ------------------------------------------------------------------------------ sub is_in_outreach { my ($self, $patient_id) = @_; my $dbix = $self->lims_dbix; my $sql = 'select 1 from outreach.dispatch_details where patient_id = ?'; return $dbix->query( $sql, $patient_id )->list; } sub _get_cols { my ($self, $table) = @_; my $dbh = $self->lims_dbix; my $t = $dbh->query("show columns from hmrn.$table")->arrays; # warn Dumper $t; my @cols = grep { $_ ne 'patient_id' } map $_->[0], @$t; # warn Dumper \@cols; return \@cols; } 1;