package LIMS::Controller::Roles::DataImport; use Moose::Role; use Data::Dumper; use LIMS::Local::Utils; has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1) for qw( datafile_field_map datafiles_config ); has param_mismatch => ( is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] }, lazy => 1, traits => ['Array'], handles => { has_param_mismatch => 'count', add_param_mismatch => 'push', all_mismatches => 'elements', }, ); has datafile_params => ( is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] }, lazy => 1, traits => ['Array'], handles => { add_datafile_param => 'push', }, ); use Data::Dumper; #------------------------------------------------------------------------------- sub get_result_data_file { my ($self, $request_id) = @_; my $request = $self->model('Request')->get_request($request_id); # get list of all files in requests' images dir: my $contents = $self->load_image_files($request); # hashref my $files = $contents->{files}; # $self->debug($files); # arrayref # get list of permitted file type definition (eg PB_HIV, PB_RIT, etc) my $cfg = $self->get_yaml_file('datafiles') || return []; # expects arrayref my @file_types = map { $cfg->{$_}->{file_id}; } keys %$cfg; # warn Dumper \@file_types; my @data_files; # should only be 1 data file but capture any and test for in caller: for my $file(@$files) { # warn $file; next unless grep { # requested format eg: 09_00123_PB_HIV.txt $file =~ /\d{2}_\d{5}_($_)\.txt\Z/; } @file_types; push @data_files, $file; } return \@data_files; } #------------------------------------------------------------------------------- sub get_datafile_contents { my ($self, $data_file) = @_; # warn $data_file; # capture component of filename before .txt: my ($data_file_id) = $data_file =~ /(.*)\.txt/; # warn $file_id; # capture 1st 2 blocks of digits into $yr & $request_number vars, and last # block of chars into $type var: my ($yr, $req_number, $type) = $data_file_id =~ /\A(\d{2})_(\d{5})_\w+_(\w+)\Z/; # store request_type and data_file_id for later: $self->stash( request_type => $type, data_file_id => $data_file_id, ); # create hashref for Role::DataFile::slurp_file_contents(): my %request = ( request_number => int($req_number), # get rid of leading zeros year => 2000 + $yr, ); # $self->debug(\%request); # get file contents from data file (as arrayref of rows): my $file_contents = $self->slurp_file_contents(\%request, $data_file); # $self->debug($file_contents); return $file_contents; } #------------------------------------------------------------------------------- sub parse_data_file { my ($self, $file_contents) = @_; # capture content after 1st tab: my @data = map { s/\"|\r|\n//g; # remove quote marks & line-endings (win & unix) /^.*\t(.*)$/; # capture content after 1st tab } @$file_contents; # $self->debug(\@data); # add to $self->datafile_params: $self->add_datafile_param($_) for @data; } #------------------------------------------------------------------------------- # checks datafile params match expected values, sets 'param_mismatch()' on error: sub check_datafile_integrity { my $self = shift; # get datafile params: my $data = $self->datafile_params; # warn Dumper $data; # get request_type (eg HIV or RIT): my $request_type = $self->stash->{request_type}; # set in parse_data_file() my $request_id = $self->param('id'); # also available in stash->{id}; # get patient object: my $patient = $self->model('Patient')->get_patient_from_request_id($request_id); { # check datafile filename matches its internal filename ref: # get array index position for 'filename' field: my $array_index = $self->_get_array_index_for_param('filename'); # get value of 'filename' field: my $internal_file_id = $data->[$array_index]; # warn $internal_file_id; unless ($internal_file_id) { $self->add_param_mismatch('missing_filename'); } else { # get datafile name (set in parse_data_file()): my $data_file_id = $self->stash->{data_file_id}; # warn $data_file_id; # check internal_file_id matches data_file_id: unless ( $internal_file_id eq $data_file_id ) { $self->add_param_mismatch('filename_error'); } } } { # check datafile 'surname' field matches patient last_name: # get array index position for 'surname' field: my $array_index = $self->_get_array_index_for_param('last_name'); # get value of 'last_name' field: my $val = $data->[$array_index]; unless ($val) { $self->add_param_mismatch('missing_name'); } else { # warn $val; warn $patient->last_name; # check datafile surname val matches patient last_name: if ( lc $val ne $patient->last_name ) { $self->add_param_mismatch('surname_error'); } } } { # check datafile 'dob' field matches patient dob: # get array index position for 'dob' field: my $array_index = $self->_get_array_index_for_param('dob'); # warn $array_index; # get value of 'dob' field: my $val = $data->[$array_index]; unless ($val) { $self->add_param_mismatch('missing_dob'); } else { # warn $val; warn $patient->dob; # get day, month & year vals from 'dob' field: my ($d,$m,$y) = $val =~ /(\d{2})(\d{2})(\d{4})/; # eg 01121974 unless ($d && $m && $y) { # will get DateTime error unless all 3 exist: $self->add_param_mismatch('invalid_date'); } else { # create DateTime object from dob val: my $dob = DateTime->new(year => $y, month => $m, day => $d); # check datafile dob matches patient dob: unless ( $dob eq $patient->dob ) { $self->add_param_mismatch('dob_error'); } } } } if ( $self->has_param_mismatch ) { my @error_names = $self->all_mismatches; return \@error_names; } } #------------------------------------------------------------------------------- sub get_datafile_results { my $self = shift; # get datafile params: my $data = $self->datafile_params; # warn Dumper $data; # get array indexes for first and last result: my $array_index_start = $self->_get_array_index_for_param('result_first'); my $array_index_end = $self->_get_array_index_for_param('result_last'); my @results = map { $data->[$_]; } ($array_index_start .. $array_index_end); # warn $results; return \@results; } #------------------------------------------------------------------------------- sub get_date_acquired { my $self = shift; # get datafile params: my $data = $self->datafile_params; # get array index for 'date_acquired' field: my $array_index = $self->_get_array_index_for_param('date_acquired'); # get 'date_acquired' val: my $val = $data->[$array_index]; # warn $val; # eg 21-Jul-2009 10:59:09 # check format or parsedate() will probably throw fatal error: $val =~ /\d{2}-\w{3}-\d{4} \d{2}:\d{2}:\d{2}/ || return 0; # create DateTime object using Time::ParseDate::parsedate(): my $dt = LIMS::Local::Utils::to_datetime_using_parsedate($val); # warn $dt; return $dt; } #------------------------------------------------------------------------------- sub get_analysis_user { my $self = shift; # get datafile params: my $data = $self->datafile_params; # get array index for 'acquired_by' field: my $array_index = $self->_get_array_index_for_param('acquired_by'); # get 'acquired_by' username: my $username = $data->[$array_index]; # warn $username; return $username; } #------------------------------------------------------------------------------- sub get_analysis_user_id { my ($self, $username) = @_; # warn Dumper $username; # get map of ( username => id ) for all users: my $users_map = $self->_get_users_map; # warn Dumper $users_map; # get user_id from users_map: my $user_id = $users_map->{lc $username}; return $user_id; } #------------------------------------------------------------------------------- sub get_lab_test_data { my $self = shift; # get request_type (eg HIV or RIT): my $request_type = $self->stash->{request_type}; # set in parse_data_file() # get datafile settings as hashref (or return if no settings): my $datafile_cfg = $self->datafiles_config || return 0; # get lab_test data from datafile cfg: my $lab_test = $datafile_cfg->{$request_type}->{lab_test}; # return empty unless sign-off required: return $lab_test->{sign_off} ? $lab_test : 0; } #------------------------------------------------------------------------------- sub get_report_params { my $self = shift; # get datafile params: my $data = $self->datafile_params; # get request_type (eg HIV or RIT): my $request_type = $self->stash->{request_type}; # set in parse_data_file() # get datafile settings as hashref: my $datafile_cfg = $self->datafiles_config; my $cfg_data = $datafile_cfg->{$request_type}->{report}; my %params; # get data from datafile fields, or from datafile config: my @fields = qw(comment clinical_details specimen_quality status diagnosis); foreach my $field(@fields) { # get array index for field: my $array_index = $self->_get_array_index_for_param($field); # if array index, get data from datafile, else from config file: my $param = $array_index ? $data->[$array_index] # load param from datafile : $cfg_data->{$field}; # load param from config file $params{$field} = $param; } return \%params; } #------------------------------------------------------------------------------- sub get_lab_section { my $self = shift; # get request_type (eg HIV or RIT): my $request_type = $self->stash->{request_type}; # set in parse_data_file() # get datafile settings as hashref: my $datafile_cfg = $self->datafiles_config; # get result_section from datafile cfg: my $lab_section = $datafile_cfg->{$request_type}->{result_section}; # return lab_section: return $lab_section; } #------------------------------------------------------------------------------- sub _get_array_index_for_param { my ($self, $param) = @_; # get request_type (eg HIV or RIT): my $request_type = $self->stash->{request_type}; # set in parse_data_file() # get map of ( field name => array position ) for datafiles: my $field_map = $self->datafile_field_map; # warn Dumper $field_map; # return array index for field: return $field_map->{$request_type}->{$param}; } #------------------------------------------------------------------------------- sub _get_users_map { my $self = shift; my $users = $self->model('Base')->get_objects('User'); my %map = map { $_->username => $_->id } @$users; return \%map; } #------------------------------------------------------------------------------- sub _build_datafile_field_map { my $self = shift; # get settings as hashref: my $settings = $self->datafiles_config; my %map = (); while ( my($type, $data) = each %$settings ) { my $i = 0; # reset counter my $fields = $data->{fields}; map { $map{$type}{$_} = $i++ } @$fields; } # $self->debug(\%map); return \%map; } #------------------------------------------------------------------------------- sub _build_datafiles_config { my $self = shift; my $yaml = $self->get_yaml_file('datafiles') || return 0; return $yaml; } 1;