RSS Git Download  Clone
Raw Blame History
package PatientTrial;

use Moose;
    with qw(
        Role::RebuildTables
    );
use namespace::clean -except => 'meta';

has db  => (is => 'ro', isa => 'HashRef', required => 1);
has sql => (is => 'ro', isa => 'HashRef', required => 1);

__PACKAGE__->meta->make_immutable;

use Data::Dumper;

my @tables = qw(
    patient_trial
);

$|++;

sub convert {
    my $self = shift; # warn Dumper $self;

    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};

    $self->rebuild_tables(\@tables);

    # get all hilis4 records with trial_name not unknown:    
    my $sql = q!select request_number, year, patient_id, trial_name, c.id
        as 'trial_id' from requests r left join request_trial t on t.request_id
        = r.id left join clinical_trials c on c.id = t.trial_id left join
        patient_case pc on r.patient_case_id = pc.id where trial_name <> 'Unknown/other'!;
    
    my $hilis4_trial_cases = $dbix4->query( $sql );
    
    my $trial_case_sql = 'select trial_number,TrialName from Main m left join
        TrialPatients p on p.patient_id = m.Pat_ID left join Trials t on p.trial_id
        = t.id where HMDS= ? and year(Date) = ?';
        
    TRIAL:
    while ( my $vals = $hilis4_trial_cases->hash ) {
        # get trial_number from hilis3 for same record if matching trial:
        my $trial
            = $dbix3->query( $trial_case_sql, $vals->{request_number}, $vals->{year} )->hash
        || next TRIAL;
        
        next unless $trial->{trial_number};
        
        next unless $vals->{trial_name} eq $trial->{trialname};
        
        # OK, hili3 & hilis4 record have same trial name:
        my %data = (
            patient_id => $vals->{patient_id},
            trial_id => $vals->{trial_id},
            trial_number => $trial->{trial_number},
        );
        next if $dbix4->query( q!select 1 from patient_trial where patient_id = ?
            and trial_id = ?!, $vals->{patient_id}, $vals->{trial_id} )->list;
        $dbix4->insert( 'patient_trial', \%data );
        
        # warn Dumper [$vals->{trial_name},$trial->{trial_number},$trial->{trialname}];
    }
    $self->convert_to_InnoDB($_) for @tables;
}

1;