• Files
• Commits
• Log
• Graph
• Stats

package YHHN;

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

use Data::Dumper;

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

has log_file => ( is => 'ro', required => 1 );
has $_ => ( is => 'rw', isa => 'HashRef[Str]', default => sub { {} })
    foreach qw(nhs_numbers_map practice_ids);
has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
	foreach qw(location_id_map site_id_map patient_ids_map);
__PACKAGE__->meta->make_immutable;

$|++;

# rebuilds:

sub convert {
    my $self = shift;
    
# 	$self->do_demographics(); # *** must be run once to populate _patient_ids tbl
#	$self->do_treatments();
#	$self->do_antecedent();
#	$self->do_comment();
#	$self->do_acute();
#	$self->do_myeloid();
#	$self->do_lymphoid();
#	$self->do_plasmacell();
	$self->do_involvements();
#	$self->do_mdt();
}

sub do_demographics {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	for ( qw/hmrn.patient_events patient_demographics/ ) {
		$self->clear_table($_);
	}
	
	# get organisation_codes like '[^BCY]____' from referral_sources:
	my $practices_map = $self->referral_source_practices;

    # get distinct yhhn.gp_id's (ie org_code):
	my $yhhn_practices = $dbix3->query(
        q!select distinct(gp_id) from yhhn.demographics
        where gp_id is not null and gp_id <> 'B00000'!
    )->flat;

	# ensure all practices in yhhn.demographics exist in referral_sources:
	$self->add_new_practices_to_referral_sources($yhhn_practices); # return;

	# get referral_source.id for unknown practice:
	$dbix4->query(q!select id from referral_sources where organisation_code = 'V81999'!)
		->into( my $unknown_practice_id); # warn $unknown_practice_id; 

    # get demographics table data:
	my $query = $dbix3->query( q!select * from yhhn.demographics! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $hilis3_patient_id = $vals->{d_pid};
		
        my $nhs_number = $dbix3->query(
			'select NHSNo from PID where P_ID = ?', $vals->{d_pid}
		)->list || next DATA; # warn $nhs_number;
        
        # skip if already seen nhs number:
        next DATA if $self->nhs_numbers_map->{$nhs_number}++;
        
		my $hilis4_patient_id = $dbix4->query(
			'select id from patients where nhs_number = ?', $nhs_number
		)->list;
		
		# add to patient_id => nhs_number_map:
		$dbix4->insert('hmrn._patient_id',
			{ v3 => $hilis3_patient_id, v4 => $hilis4_patient_id }
		);
		# $self->patient_ids_map->{$hilis3_patient_id} = $hilis4_patient_id;
		
        my $gp_code = $vals->{gp_id} || '';
        $gp_code =~ s/\s//g; # trim blank spaces!!
        
        my $status = $vals->{dod} ? 'dead' : 'alive';
        
        my %data = (
            patient_id => $hilis4_patient_id,
            status     => $status,
			timestamp  => $vals->{timestamp},
        );
        # add address & post_code if exists:
        map {
            $data{$_} = $vals->{$_}
        } grep $vals->{$_}, qw(address post_code dod);
		
        # add practice_id if exists (document if not):
        if ( my $practice_id = $practices_map->{$gp_code} ) {
            $data{practice_id} = $practice_id;
        }
        else {
			$data{practice_id} = $unknown_practice_id;
            $self->practice_ids->{$gp_code}++; # next DATA unless $practice_id;
        }
        
        $dbix4->insert('patient_demographics', \%data);
		
		{ # patient dates:
			my %data = (
				first_appointment	=> $vals->{first_app_date},
				palliative_care 	=> $vals->{palliative_date},
				diagnosis			=> $vals->{diagnosed},
				deceased			=> $vals->{dod},
				patient_id 			=> $hilis4_patient_id,
			);
			$dbix4->insert('hmrn.patient_events', \%data);
		}
    }
	
    warn Dumper $self->practice_ids;
    while ( my ($nhs_number, $freq) = each %{ $self->nhs_numbers_map } ) {
        next unless $freq > 1;
        warn $nhs_number, "\n";
    }
	# warn Dumper $self->patient_id_nhs_number_map;
}

sub do_antecedent {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	for ( qw/antecedent_events prior_therapies/ ) {
		$self->clear_table('hmrn.'.$_);
	}
	
	my $cols = $self->_get_cols('antecedent');

	my $query = $dbix3->query( q!select * from yhhn.antecedent! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{an_pid};

		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		my %data = ( patient_id	=> $hilis4_patient_id );
		map $data{$_} = $vals->{$_}, @$cols;
		
		$dbix4->insert('hmrn.antecedent_events', \%data);
	
		# do radiotherapy/chemotherapy if either exist:
		next DATA unless grep $vals->{$_}, qw(radiotherapy chemotherapy);
		delete $data{event};
		
		for ( qw/radiotherapy chemotherapy/ ) {
			next unless $vals->{$_};
			$data{$_} = $vals->{$_};			
		}
		$dbix4->insert('hmrn.prior_therapies', \%data);
	}
}

sub do_comment {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.comments');
	
	my $cols = $self->_get_cols('comments'); 

	my $query = $dbix3->query( q!select * from yhhn.comment! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{c_pid};

		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		my %data = ( patient_id	=> $hilis4_patient_id );
		map $data{$_} = $vals->{$_}, @$cols;
		
		$dbix4->insert('hmrn.comments', \%data);
	}
}

sub do_acute {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.acute');
	
	my $cols = $self->_get_cols('acute'); 

	my $query = $dbix3->query( q!select * from yhhn.acute! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{a_pid};

		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		my %data = ( patient_id	=> $hilis4_patient_id );
		map $data{$_} = $vals->{$_}, @$cols;
		
		$dbix4->insert('hmrn.acute', \%data);
	}
}

sub do_myeloid {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.myeloid');
	
	my $cols = $self->_get_cols('myeloid'); 

	my $query = $dbix3->query( q!select * from yhhn.myeloid! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{m_pid};

		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		my %data = ( patient_id	=> $hilis4_patient_id );
		map $data{$_} = $vals->{$_}, @$cols;
		
		# correct errors/omissions:
		map $data{$_} ||= 'U', qw(splenomegaly hepatomegaly transfusion); # default
		$data{cd34} = '777.0' if $data{cd34} && $data{cd34} > 999;
		
		$dbix4->insert('hmrn.myeloid', \%data);
	}
}

sub do_plasmacell {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.plasmacell');
	
	my $cols = $self->_get_cols('plasmacell'); 

	my $query = $dbix3->query( q!select * from yhhn.plasmacell! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{p_pid};

		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		my %data = ( patient_id	=> $hilis4_patient_id );
		map $data{$_} = $vals->{$_}, @$cols;
		
		# correct errors/omissions:
		map { $data{$_} = 99.9 if $data{$_} && $data{$_} > 99.9 } qw(hb b2m); 
		$data{bj_level} =~ s/\d(\d{3})/$1/; # 4 digits to 3

		$dbix4->insert('hmrn.plasmacell', \%data);
	}
}

sub do_lymphoid {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.lymphoid');
	
	my $cols = $self->_get_cols('lymphoid');
	
	my $query = $dbix3->query( q!select * from yhhn.lymphoid! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{l_pid};

		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		my %data = ( patient_id	=> $hilis4_patient_id );		
		map $data{$_} = $vals->{$_}, @$cols;
		
		# correct errors/omissions:
		map $data{$_} ||= 'U', qw(ct bm sweats fever wt_loss); # default
		map { $data{$_} = 99.9 if $data{$_} && $data{$_} > 99.9 } qw(hb b2m); 

		$dbix4->insert('hmrn.lymphoid', \%data);
	}
}

sub do_involvements {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.treatment');
	
	my $site_id_map = $self->site_id_map; # warn Dumper $site_id_map;
	
}

sub do_treatments {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.treatments'); # warn Dumper $self->patient_ids_map;
	
	my $location_id_map = $self->location_id_map; # warn Dumper $location_id_map;

	my $query = $dbix3->query( q!select * from yhhn.treatment! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{tx_pid};

		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		my $location = $vals->{hospital}; # warn Dumper $location;
		my $location_id = $location_id_map->{$location}
		|| warn "no location id for $location";
		
		my %data = (
			patient_id	=> $hilis4_patient_id,
			location_id => $location_id,
			type 		=> $vals->{type},
			detail 		=> $vals->{regimen},
			start_date	=> $vals->{tx_start_date},
			end_date	=> $vals->{tx_end_date},
			response	=> $vals->{response}, 
			timestamp	=> $vals->{timestamp}, 
		);
		$dbix4->insert('hmrn.treatments', \%data);
	}
}

sub do_mdt {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	$self->clear_table('hmrn.mdt'); # warn Dumper $self->patient_ids_map;
	
	my $query = $dbix3->query( q!select * from yhhn.mdt! );
    DATA:
	while ( my $vals = $query->hash ) {
		my $pat_id = $vals->{mdt_pid};
		
		my $hilis4_patient_id = $self->patient_ids_map->{$pat_id};
		unless ($hilis4_patient_id) {
			warn "no patient_id for $pat_id";
			next DATA;
		}
		
		my %data = (
			patient_id	=> $hilis4_patient_id,
			date		=> $vals->{m_date},
			# decision	=> $vals->{decision}, # not recording anymore
			timestamp	=> $vals->{timestamp}, # do we need this ?
		);
		$dbix4->insert('hmrn.mdt', \%data);
	}
}

sub _build_patient_ids_map {
	my $self = shift;
	
	my $dbh = $self->db->{dbix4};
	
	my $map	= $dbh->query('select * from hmrn._patient_id')->map;
	return $map;	
}

sub _build_site_id_map {
	my $self = shift;
	
	my $dbh = $self->db->{dbix4};
	
	my $map	= $dbh->query('select description,id from hmrn.anatomical_sites')->map;
	
	my %h = (
		left  => 'L',
		right => 'R',
	);
	# substitutions:
	while ( my ($description,$id) = each %$map ) {
		next unless $description =~ /_(left|right)\Z/;
		delete $map->{$description};
		$description =~ s/(.*)_(left|right)/$1_$h{$2}/;
		$map->{$description} = $id;
	} # warn Dumper $map;
	return $map;	
}

sub _build_location_id_map {
	my $self = shift;
	
	my $dbh = $self->db->{dbix4};
	
	my $map	= $dbh->query('select location, id from hmrn.locations')->map;
	return $map;
}

sub _get_cols {
	my ($self, $table) = @_;
	
	my $dbh = $self->db->{dbix3};
	
	my $t = $dbh->query("show columns from hmrn.$table")->arrays;
	# warn Dumper $t; 
	my @cols = grep { $_ ne 'patient_id' } map $_->[0], @$t;
	# warn Dumper \@cols;
	return \@cols;
}
1;