package Role::Report; use Moose::Role; =begin requires qw(screen_map signature_userid_map username_userid_map substitute_screening_terms substitute_user); =cut has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 ) foreach qw( status_map specimen_quality_map diagnosis_map ); use Data::Dumper; sub do_report { my $self = shift; my $vals = shift; # if not yet screened, will not exist in Report table: $vals->{rpt_id} || return 0; my $dbh = $self->db->{dbix4}; { # InitialDiag: my $initialdiag = $vals->{initialdiag}; my $screen_id = $self->screen_map->{$initialdiag} || $self->substitute_screening_terms->{$initialdiag} || die "no screen id for $initialdiag ($vals->{dbid})"; my %data = ( request_id => $vals->{_request_id}, screen_id => $screen_id, ); $dbh->insert('request_initial_screen', \%data); } # if reported, convert data for request_report table: if ( $vals->{reportby} ) { my $new_diagnosis = $vals->{newdiagnosis} || ''; my $quality = $vals->{specquality} || ''; my $status = $self->status_map->{$new_diagnosis} || 'default'; my $specimen_quality = $self->specimen_quality_map->{$quality} || 'adequate'; my $diagnosis_map = $self->diagnosis_map; my $diagnosis = $self->_process_diagnosis_data($vals); my $diagnosis_id = $diagnosis_map->{$diagnosis} || die "Cannot find diagnosis_id for $diagnosis"; my %data = ( request_id => $vals->{_request_id}, comment => $vals->{comment}, clinical_details => $vals->{clindetails}, specimen_quality => $specimen_quality, status => $status, diagnosis_id => $diagnosis_id, created_at => '0000-00-00 00:00:00', # will be updated in History updated_at => $vals->{reporttime}, ); $dbh->insert('request_report', \%data); } # gross description: if ( my $gross_description = $vals->{grossdesc} ) { my %data = ( request_id => $vals->{_request_id}, detail => $gross_description, ); unless ( grep $gross_description eq $_, ('-', 'N/A') ) { $dbh->insert('request_gross_description', \%data); } } } # updates request_diagnosis_history table with any ReviseDiag or Diagnosis # returns FinalDiag, ReviseDiag or Diagnosis: sub _process_diagnosis_data { my $self = shift; my $vals = shift; my $diagnosis; # first try FinalDiag, update request_diagnosis_history table: if ( $diagnosis = $vals->{finaldiag} ) { if ($vals->{revisediag}) { if ( $vals->{revisediag} ne $vals->{diagnosis} ) { # diagnosis-that-got-changed, who-changed-it, date, reason: my %data = ( diagnosis => $vals->{diagnosis}, username => $vals->{revisedby}, datetime => $vals->{revisedate}, request_id => $vals->{_request_id}, reason => 'error', ); $self->_do_diagnosis_history(\%data); } if ( $vals->{finaldiag} ne $vals->{revisediag} ) { # diagnosis-that-got-changed, who-changed-it, date, reason: my %data = ( diagnosis => $vals->{revisediag}, username => $vals->{finalby}, datetime => $vals->{finaldate}, request_id => $vals->{_request_id}, reason => 'update', ); $self->_do_diagnosis_history(\%data); } } elsif ( $vals->{finaldiag} ne $vals->{diagnosis} ) { # diagnosis-that-got-changed, who-changed-it, date, reason: my %data = ( diagnosis => $vals->{diagnosis}, username => $vals->{finalby}, datetime => $vals->{finaldate}, request_id => $vals->{_request_id}, reason => 'update', ); $self->_do_diagnosis_history(\%data); } } # next try ReviseDiag, update request_diagnosis_history table: elsif ( $diagnosis = $vals->{revisediag} ) { if ( $vals->{revisediag} ne $vals->{diagnosis} ) { # diagnosis-that-got-changed, who-changed-it, date, reason: my %data = ( diagnosis => $vals->{diagnosis}, username => $vals->{revisedby}, datetime => $vals->{revisedate}, request_id => $vals->{_request_id}, reason => 'error', ); $self->_do_diagnosis_history(\%data); } } # group of molecular samples from 2002/2003 with no diagnosis: elsif ( ! $vals->{diagnosis} ) { if ( $vals->{initialdiag} =~ /molecular|chimerism/i ) { $diagnosis = 'Not required'; } } else { $diagnosis = $vals->{diagnosis}; } return $diagnosis; } sub _do_diagnosis_history { my $self = shift; my $data = shift; my $dbh = $self->db->{dbix4}; my $diagnosis = $data->{diagnosis}; # original diagnosis my $signature = $data->{username}; # who changed it my $date = $data->{datetime} || '0000-00-00'; # early data didn't record date my $diagnosis_map = $self->diagnosis_map; my $user_id = $self->_get_user_id_from_sig($signature) || die "Cannot find users.id for $signature"; my $diagnosis_id = $diagnosis_map->{$diagnosis} || die "Cannot find diagnosis_id for $diagnosis"; my %data = ( request_id => $data->{request_id}, diagnosis_id => $diagnosis_id, user_id => $user_id, reason => $data->{reason}, time => join ' ', $date, '00:00:00', ); $dbh->insert('request_diagnosis_history', \%data); } =begin # these are wrong !! sub _do_history_for_revisediag { my $self = shift; my $vals = shift; my $dbh = $self->db->{dbix4}; my $diagnosis = $vals->{diagnosis}; # original diagnosis my $signature = $vals->{revisedby}; # who changed it my $date = $vals->{revisedate} || '0000-00-00'; # early data didn't record date my $diagnosis_map = $self->diagnosis_map; my $user_id = $self->_get_user_id_from_sig($signature) || die "Cannot find users.id for $signature"; my $diagnosis_id = $diagnosis_map->{$diagnosis} || die "Cannot find diagnosis_id for $diagnosis"; my %data = ( request_id => $vals->{_request_id}, diagnosis_id => $diagnosis_id, user_id => $user_id, reason => 'error', time => join ' ', $date, '00:00:00', ); $dbh->insert('request_diagnosis_history', \%data); } sub _do_history_for_finaldiag { my $self = shift; my $vals = shift; my $dbh = $self->db->{dbix4}; my $diagnosis = $vals->{diagnosis}; # original diagnosis my $signature = $vals->{finalby}; # who changed it my $date = $vals->{finaldate} || '0000-00-00'; # early data didn't record date my $diagnosis_map = $self->diagnosis_map; my $user_id = $self->_get_user_id_from_sig($signature) || die "Cannot find users.id for $signature"; my $diagnosis_id = $diagnosis_map->{$diagnosis} || die "Cannot find diagnosis_id for $diagnosis"; my %data = ( request_id => $vals->{_request_id}, diagnosis_id => $diagnosis_id, user_id => $user_id, reason => 'update', time => join ' ', $date, '00:00:00', ); $dbh->insert('request_diagnosis_history', \%data); } sub _update_request_diagnosis_with_diagnosis { # Diagnosis: my $self = shift; my $vals = shift; my $dbh = $self->db->{dbix4}; my $diagnosis = $vals->{diagnosis}; my $signature = $vals->{reportby}; my $diagnosis_map = $self->diagnosis_map; my $user_id = $self->_get_user_id_from_sig($signature) || die "Cannot find users.id for $signature"; my $diagnosis_id = $diagnosis_map->{$diagnosis} || die "Cannot find diagnosis_id for $diagnosis"; my $date = $vals->{reportdate} || '0000-00-00'; # early data didn't record date my %data = ( request_id => $vals->{_request_id}, diagnosis_id => $diagnosis_id, user_id => $user_id, time => join ' ', $date, '00:00:00', ); $dbh->insert('request_diagnosis_history', \%data); } sub _update_request_diagnosis_with_revised_diagnosis { my $self = shift; my $vals = shift; my $dbh = $self->db->{dbix4}; my $diagnosis_map = $self->diagnosis_map; my $diagnosis = $vals->{revisediag}; my $signature = $vals->{revisedby}; my $user_id = $self->_get_user_id_from_sig($signature) || die "Cannot find users.id for $signature"; my $diagnosis_id = $diagnosis_map->{$diagnosis} || die "Cannot find diagnosis_id for $diagnosis"; my $date = $vals->{revisedate} || '0000-00-00'; # early data didn't record date my %data = ( request_id => $vals->{_request_id}, diagnosis_id => $diagnosis_id, user_id => $user_id, time => join ' ', $date, '00:00:00', ); $dbh->insert('request_diagnosis_history', \%data); } =cut sub _build_status_map { my $self = shift; my %status_map = ( Y => 'new', # new_diagnosis = yes R => 'relapse', N => 'default', # new_diagnosis = no ); return \%status_map; } sub _build_specimen_quality_map { my $self = shift; my %specimen_quality_map = ( Adequate => 'adequate', Average => 'adequate', Good => 'good', Poor => 'poor', ); return \%specimen_quality_map; } sub _build_diagnosis_map { my $self = shift; my $dbh = $self->db->{dbix4}; my $map = $dbh->query( 'select name, id from diagnoses ')->map; return $map; } =begin # ? not used, was RequestHistory - function should be in Role::User: sub __get_user_id { my ($self, $function, $vals) = @_; # function = screener, reportby, authorisedby my $signature = $vals->{$function} || return; my $username = lc $self->signature_userid_map->{$signature}; my $user_id = $self->username_userid_map->{$username} || $self->substitute_user->{$signature} || warn "no user id for $signature ($vals->{dbid})"; # warn $user_id; } =cut sub _get_event_time { my ($self, $function, $date_field, $lab_no) = @_; my $sql; if ($function eq 'screened') { $sql = q!select Date, Time from History where HMDS = ? and Action = 'screened'!; } else { $sql = sprintf q!select Date, Time from History where HMDS = ? and Action in ('%s', 'reported and authorised')!, $function; } if ( my @date_time = $self->db->{dbix3}->query( $sql, $lab_no )->list ) { return join ' ', @date_time; # use Date/Time from History if available } elsif ($date_field) { return join ' ', $date_field, '00:00:00'; # time unknown } else { # should never happen ? warn Dumper [ $function, $date_field, $sql, $lab_no ]; return undef; } } 1;