package LIMS::Model::Outreach;
use Moose;
with (
'LIMS::Model::Roles::DBIxSimple',
);
extends 'LIMS::Model::Base';
use namespace::clean -except => 'meta';
has actions => (
is => 'ro',
isa => 'ArrayRef[Str]',
default => sub { [] },
lazy => 1,
traits => ['Array'],
handles => {
add_to_actions => 'push',
all_actions => 'elements',
},
);
__PACKAGE__->meta->make_immutable;
use Data::Dumper;
#-------------------------------------------------------------------------------
sub get_all_data {
my ($self, $args) = @_; # warn $request_id;
my $request_id = $args->{request_id};
my $patient_id = $args->{patient_id}; # warn Dumper $patient_id;
my $dbix = $self->lims_dbix;
# get request object for request_date for data summary section:
my $request = LIMS::DB::Request->new(id => $request_id)->load;
my %data = ();
{ # first get list of all departments, lab_tests, defaults & ranges:
my $sql = $self->sql_lib->retr('outreach_lab_params');
my $query = $dbix->query($sql);
# get list of cols from defaults_and_ranges table:
my $meta = $self->get_meta('outreach.defaults_and_ranges'); # warn Dumper $meta;
my @cols = grep {
$meta->{$_}->{key} ne 'PRI' # skip primary key
} keys %$meta; # warn Dumper \@cols;
while ( my $vars = $query->hash ) {
my $param = $vars->{param_name};
my $dept = $vars->{description};
my %params = (
field_label => $vars->{field_label},
field_type => $vars->{field_type},
result => undef, # initialise placeholder
);
$data{$dept}{$param} = \%params;
# add any (optional) default & ranges cols:
map {
$data{$dept}{$param}{$_} = $vars->{$_};
} grep $vars->{$_}, @cols;
}
}
{ # add lab_test results:
my $sql = $self->sql_lib->retr('outreach_lab_results');
my $query = $dbix->query($sql, $request_id);
# get epoch value of current request for data summary:
my $epoch = $request->created_at->epoch;
while ( my $vals = $query->hash ) {
my $result = $vals->{result};
my $param = $vals->{param_name};
my $dept = $vals->{description};
# for individual sections (haem, immunol, etc):
$data{$dept}{$param}{result} = $result;
# for data summary:
$data{datasets}{$epoch}{$param}{result} = $result;
}
}
{ # add patient demographics data:
my $sql = $self->sql_lib->retr('outreach_patient_demographics');
my $demographics = $dbix->query($sql, $patient_id)->hash;
$data{demographics} = $demographics;
}
{ # questionnaire details:
# my $sql = $self->sql_lib->retr('outreach_patient_questionnaire');
# my $data = $dbix->query($sql, $request_id)->hash;
my $data = LIMS::DB::Outreach::QuestionnaireLocality->new(
request_id => $request_id
)->load();
$data{questionnaire} = $data;
}
{ # followup data:
my $follow_up = $self->get_followup_data($request_id);
$data{followup} = $follow_up;
}
{ # patient notes:
my $sql = $self->sql_lib->retr('outreach_patient_notes');
my $data = $dbix->query($sql, $patient_id)->list;
$data{demographics}{patient_notes} = $data;
}
# get GP's for practice:
if ( my $practice_id = $data{demographics}{practice_id} ) {
my $GPs = $self->_get_practitioners($practice_id);
$data{demographics}{practitioners} = $GPs;
}
{ # get unknown practitioner id:
my $o = LIMS::DB::ReferralType->new(description => 'practitioner')->load;
my $ref
= LIMS::DB::Referrer->new(national_code => $o->default_unknown)->load;
$data{demographics}{unknown_gp_id} = $ref->id;
}
{ # non-participating practices:
my $sql = 'select practice_id, 1 from outreach.non_participant_practice';
my $ids = $dbix->query($sql)->map;
$data{demographics}{non_participant_practices} = $ids;
}
{ # get menu options:
my $sql = $self->sql_lib->retr('outreach_menu_options');
my $query = $dbix->query($sql);
my %opts;
while ( my $vars = $query->array ) {
my ($field_name, $detail) = @$vars;
push @{ $opts{$field_name} }, $detail;
}
{ # add follow_up options:
my $followup_options = $self->get_followup_options;
$opts{followup_options} = $followup_options;
}
$data{menu_options} = \%opts; # warn Dumper \%opts;
}
return \%data;
}
#-------------------------------------------------------------------------------
sub update_followup {
my ($self, $data) = @_; warn Dumper $data;
return 0;
}
#-------------------------------------------------------------------------------
sub update_patient_notes {
my ($self, $args) = @_;
my $dbix = $self->lims_dbix;
my $tbl = 'outreach.patient_notes';
my $patient_id = $args->{patient_id};
my $form_param = $args->{detail};
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $update = sub {
my $sql = qq!select `detail` from $tbl where patient_id = ?!;
if ( $dbix->query($sql, $patient_id)->into(my $detail) ) { # update or delete:
if ($form_param) { # update:
return 0 if $form_param eq $detail; # skip if no change
$dbix->update($tbl,
{ detail => $form_param },
{ patient_id => $patient_id }
);
$self->add_to_actions('updated patient notes');
}
else { # delete:
$dbix->delete($tbl, { patient_id => $patient_id });
$self->add_to_actions('deleted patient notes');
}
}
else { # new insert:
$dbix->insert($tbl,
{ detail => $form_param, patient_id => $patient_id }
);
$self->add_to_actions('added new patient notes');
}
$self->do_history($patient_id);
};
my $ok = $db->do_transaction($update);
# don't need return value unless error:
return $ok ? 0 : 'update_patient_notes() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
# method shared by get_all_data & C::Outreach::edit_followup:
sub get_followup_data {
my ($self, $request_id) = @_;
my $dbix = $self->lims_dbix;
my $sql = $self->sql_lib->retr('outreach_followup_data');
my $data = $dbix->query($sql, $request_id)->hash;
my $meta = $self->get_meta('outreach.request_pack_dispatch'); # warn Dumper $meta;
my @date_fields = grep { $meta->{$_}->{type} eq 'date' } keys %$meta; # warn Dumper \@date_cols;
$self->inflate_mysql_dates_to_datetime($data, \@date_fields);
return $data;
}
#-------------------------------------------------------------------------------
# method shared by get_all_data & C::Outreach::edit_followup:
sub get_followup_options {
my $self = shift;
my $dbix = $self->lims_dbix;
my $sql = 'select `id`, `label`, `option` from outreach.followup_options';
my $options = $dbix->query($sql)->map_hashes('id');
return $options;
}
#-------------------------------------------------------------------------------
sub get_diagnosis_ids {
my $self = shift;
my $dbix = $self->lims_dbix;
my $ids = $dbix->query('select diagnosis_id from outreach.diagnoses')->flat;
return $ids;
}
#-------------------------------------------------------------------------------
sub do_history {
my ($self, $patient_id) = @_;
my @actions = $self->all_actions;
my $dbix = $self->lims_dbix;
my $user_id = $self->user_profile->{id};
for my $action(@actions) {
my %data = (
patient_id => $patient_id,
user_id => $user_id,
action => $action,
); # warn Dumper \%data;
$dbix->insert('some_table', \%data); # request_history
}
}
#-------------------------------------------------------------------------------
sub _get_practitioners { # from M::Referrer::get_referrers_by_source_id
my ($self, $source_id) = @_;
my @args = (
query => [ 'referral_sources.id' => $source_id ],
require_objects => [
'referrer',
'parent_organisation.referral_source'
],
);
# use ReferrerDepartment - easier to retrieve data from object:
my $referrers = LIMS::DB::ReferrerDepartment::Manager
->get_referrer_department(@args);
my @data = map { # warn Dumper $_->as_tree;
[ $_->referrer->id, $_->referrer->name ];
} sort { $a->referrer->name cmp $b->referrer->name } @$referrers;
return \@data;
}
1;