package LIMS::Model::History; use Moose; extends 'LIMS::Model::Base'; with 'LIMS::Model::Roles::SessionData'; # provides $self->user_profile use namespace::clean -except => 'meta'; use LIMS::Local::Debug; has edits => ( is => 'ro', isa => 'ArrayRef[HashRef]', default => sub { [] }, traits => ['Array'], handles => { add_to_edits => 'push', have_edits => 'count', }, ); 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 { [] }, traits => ['Array'], handles => { add_to_patient_history => 'push', have_patient_history => 'count', }, ); has request_history => ( is => 'ro', isa => 'ArrayRef', default => sub { [] }, traits => ['Array'], handles => { add_to_request_history => 'push', }, ); __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_demographic_history { my $self = shift; my $patient_id = shift; # warn $patient_id; my @args = ( require_objects => 'user', query => [ patient_id => $patient_id ], sort_by => 'time', ); my $history = LIMS::DB::PatientDemographicHistory::Manager ->get_patient_demographic_histories(@args); return $history; } # ------------------------------------------------------------------------------ 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;