package LIMS::Model::History;
use LIMS::Local::Debug;
use Moose;
extends 'LIMS::Model::Base';
with 'LIMS::Model::Roles::SessionData'; # provides $self->user_profile
use MooseX::AttributeHelpers;
use namespace::clean -except => 'meta';
has edits => (
is => 'ro',
isa => 'ArrayRef[HashRef]',
default => sub { [] },
metaclass => 'Collection::Array',
provides => {
push => 'add_to_edits',
count => 'have_edits',
}, # MooseX::AttributeHelpers
);
has patient_id => (
is => 'rw',
isa => 'Int',
);
has current_patient => (
is => 'rw',
isa => 'LIMS::DB::Patient',
lazy_build => 1, # not needed unless have_patient_history = true
);
has patient_history => (
is => 'rw',
isa => 'ArrayRef[LIMS::DB::PatientEdit]',
default => sub { [] },
metaclass => 'Collection::Array',
provides => {
push => 'add_to_patient_history',
count => 'have_patient_history',
},
);
has request_history => (
is => 'ro',
isa => 'ArrayRef',
default => sub { [] },
metaclass => 'Collection::Array',
provides => {
push => 'add_to_request_history',
},
);
__PACKAGE__->meta->make_immutable;
# ------------------------------------------------------------------------------
sub do_log_action {
my $self = shift;
my $class = shift;
my $data = shift; # hashref of (at least) request_id & action
# add user_id to $data:
$data->{user_id} = $self->user_profile->{id};
my $o = "LIMS::DB::$class";
$o->new(%$data)->save;
}
# ------------------------------------------------------------------------------
sub do_log_event {
my ($self, $args) = @_;
my $request_id = $args->{request_id};
my $event = $args->{event};
my %data = (
request_id => $request_id,
user_id => $self->user_profile->{id},
time => $self->time_now,
);
eval {
if ($event eq 'view') {
my $session = $args->{session}; # only required for viewlog
$data{ip_address} = $session->dataref->{_SESSION_REMOTE_ADDR};
LIMS::DB::RequestViewLog->new(%data)->save;
}
elsif ($event eq 'print') {
LIMS::DB::RequestPrintLog->new(%data)->save;
}
};
return $@ if $@;
}
# ------------------------------------------------------------------------------
sub get_request_history {
my ($self, $request_id) = @_;
my %args = (
query => [ request_id => $request_id ],
with_objects => 'user',
sort_by => [ qw(time id) ],
);
my $request_history
= LIMS::DB::RequestHistory::Manager->get_request_histories(%args);
return $request_history;
}
# ------------------------------------------------------------------------------
sub get_diagnosis_history {
my ($self, $request_id) = @_;
my %args = (
query => [ request_id => $request_id ],
with_objects => [ 'user', 'diagnosis', 'option' ],
sort_by => 'time',
);
my $history = LIMS::DB::RequestDiagnosisHistory::Manager
->get_request_diagnosis_histories(%args);
return $history;
}
# ------------------------------------------------------------------------------
sub get_lab_test_history {
my ($self, $request_id) = @_;
my %args = (
query => [ request_id => $request_id ],
require_objects => 'user',
sort_by => 'time',
);
my $lab_test_history = LIMS::DB::RequestLabTestHistory::Manager
->get_request_lab_test_histories(%args);
return $lab_test_history;
}
# ------------------------------------------------------------------------------
sub get_comment_history {
my ($self, $request_id) = @_;
my %args = (
query => [
request_id => $request_id,
field => 'comment', # only archiving 'comment' field .. so far
],
require_objects => 'user',
sort_by => 'time',
);
my $comment_history = LIMS::DB::RequestReportHistory::Manager
->get_request_report_histories(%args);
return $comment_history;
}
# ------------------------------------------------------------------------------
sub get_view_history {
my ($self, $request_id) = @_;
my %args = (
query => [
request_id => $request_id,
],
require_objects => 'user',
sort_by => 'time',
);
my $history
= LIMS::DB::RequestViewLog::Manager->get_request_view_logs(%args);
return $history;
}
# ------------------------------------------------------------------------------
sub get_print_history {
my ($self, $request_id) = @_;
my %args = (
query => [
request_id => $request_id,
],
require_objects => 'user',
sort_by => 'time',
);
my $history
= LIMS::DB::RequestPrintLog::Manager->get_request_print_logs(%args);
return $history;
}
=begin # replaced by requests.created_at col instead:
# ------------------------------------------------------------------------------
sub get_request_histories_for_action {
my ($self, $action, $request_ids) = @_;
my $histories = LIMS::DB::RequestHistory::Manager->get_request_histories(
query => [
request_id => $request_ids, # arrayref -> 'IN'
action => $action,
],
);
return $histories;
}
=cut
# ------------------------------------------------------------------------------
sub get_patient_history {
my $self = shift;
my $patient_id = shift; # warn $patient_id;
my %args = (
query => [ patient_id => $patient_id ],
require_objects => [ qw(error_code user) ],
sort_by => 'time',
);
my $history = LIMS::DB::PatientEdit::Manager
->get_patient_edits_iterator(%args);
while (my $edit = $history->next) {
$self->add_to_patient_history($edit);
}
# no need to proceed if no $patient_history object:
return 0 unless $self->have_patient_history;
# grep changes made in each edit, into $self->edits:
$self->_parse_patient_history_for_changes($patient_id);
if ($self->have_edits) { # DEBUG $self->edits;
return $self->edits;
}
}
# ------------------------------------------------------------------------------
sub _parse_patient_history_for_changes {
my ($self, $patient_id) = @_;
# $self->_build_current_patient needs patient.id:
$self->patient_id($patient_id);
my $patient_history = $self->patient_history;
my $current_patient = $self->current_patient;
# get fields from patients table (except id & timestamps):
my @patient_demographics = grep {
$current_patient->meta->column($_)->type !~ /serial|timestamp/;
} $current_patient->meta->column_names; # $self-debug(@patient_demographics);
my $no_of_entries = @$patient_history; # DEBUG $i;
{
no warnings 'uninitialized'; # poss null cols in 'foreach' block
# cycle through dereferenced $patient_history array:
for my $i(1 .. $no_of_entries) { # DEBUG $patient_history;
# archived entry will be at list position $i minus 1:
my $original = $patient_history->[$i - 1];
# updated entry will be at list position $i, or if undef, current_patient:
my $changed = $patient_history->[$i] || $current_patient;
# now find diffs between original & changed entries:
foreach my $col( @patient_demographics ) {
next if $original->$col eq $changed->$col;
my $original_field
= $original->meta->column($col)->type eq 'date' && $original->$col
? $original->$col->dmy # check exists before calling dmy method
: $original->$col;
my $changed_field
= $changed->meta->column($col)->type eq 'date' && $changed->$col
? $changed->$col->dmy # check exists before calling dmy method
: $changed->$col;
my %details = (
field_name => $col,
changed_from => $original_field,
changed_to => $changed_field,
changed_by => $original->user->username,
changed_on => $original->time,
error_code => $original->error_code->code,
);
$self->add_to_edits(\%details);
}
}
}
}
# ------------------------------------------------------------------------------
sub _build_current_patient {
my $self = shift;
my $current_patient
= LIMS::DB::Patient->new(id => $self->patient_id)->load;
return $current_patient;
}
1;
