• Files
• Commits
• Log
• Graph
• Stats

package Outreach;

use Moose;
with qw(
	Role::RebuildTables
	Role::ReferralSource
);

use namespace::clean -except => 'meta';

use Data::Dumper;
use DateTime::Format::MySQL;

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

has log_file => ( is => 'ro', required => 1 );
has request_id_map => ( is => 'rw', isa => 'HashRef[Str]', default => sub { {} });

__PACKAGE__->meta->make_immutable;

$|++;

# abbr. for db name:
my $CM = 'community_monitoring';

# rebuilds:
# biochemistry, flow_cytometry, haematology, immunology, patient_alternate_address
# request_pack_dispatch, request_followup, questionnaire_*
# need to manually copy 'static' data tables:
# defaults_and_ranges, followup_options, menu_fields, non_participant_practices

sub convert { 
    my $self = shift;
	
    # retain case-sensitivity of cols (CHANGES $DB::dbix3 SO MUST REVERSE THIS AFTER):
    $self->db->{dbix3}->lc_columns = 0;

	$self->do_patient_details();
	$self->do_followup_decisions();
	$self->do_lab_params();
	$self->do_pack_dispatches();
	$self->do_questionnaires();
    $self->do_non_participant_practices();
	
	$self->db->{dbix3}->lc_columns = 1; # reset to default
}

sub do_patient_details {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	my $table = 'outreach.patient_dispatch_detail';
	
	$self->clear_table($table);
	
	# get organisation_codes like '[^BCY]____' from referral_sources:
	my $practices_map = $self->referral_source_practices;
	# get national_code like 'G%' from referrers:
	my $practitioners_map = $self->_get_practitioners_map;
	# get distinct community_monitoring.practice_id's (ie org_code):
	my $cm_practices = $dbix3->query(
        qq!select distinct(practice_id) from $CM.patient_details
        where practice_id is not null and practice_id <> 'B00000'!
    )->flat;
	# warn Dumper $cm_practices; 

	# get referrer.id for unknown gp:
	$dbix4->query(q!select id from referrers where national_code = 'G9999998'!)
		->into( my $unknown_gpid); # warn $unknown_gpid;
	# 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; 
	
	# ensure all practices in cm.patient_details exist in referral_sources:
	$self->add_new_practices_to_referral_sources($cm_practices);
    
    # ensure all practitioners in CM practices exist in referrer_department table:
    # $self->add_missing_practitioners_to_referrer_department(); # combined in Referrer now
    
	# check GP's from cm.patient_details exist in referrers - just prints warning:
	$self->_check_outreach_practitioners($practitioners_map); 

	my $sql = qq!select * from $CM.patient_details!; # don't need join
	
	my $query = $dbix3->query($sql);
	ROW: while ( my $vals = $query->hash ) { # warn $vals->{nhs_number};
		my $hilis4_patient_id = $dbix4->query(
			'select id from patients where nhs_number = ?', $vals->{nhs_number}
		)->list;
		
		if ($hilis4_patient_id) { # warn $hilis4_patient_id;
			$vals->{hilis4_patient_id} = $hilis4_patient_id; # add to vals
		}
		else {
			warn "cannot find patient_id for $vals->{nhs_number}";
			next ROW;
		} 

		{ # do dispatch_details
			my $sql = 'select id from patients where nhs_number = ?';
			$dbix4->query($sql, $vals->{nhs_number})->into(my $patient_id);
			my %data = (
				patient_id => $hilis4_patient_id,
				dispatch_to => $vals->{dispatch_to},
			);
			$dbix4->insert($table, \%data);			
		} 
		
		my $practice_code = $vals->{practice_id} || ''; # actually org code
		my $gp_code = $vals->{gp_id} || ''; # actually GMC number
        
		my $practitioner_id = $practitioners_map->{$gp_code} || $unknown_gpid;		
		my $practice_id = $practices_map->{$practice_code};
        
		if (! $practice_id) { #	warn "no practice_id for $practice_code";
			$practice_id = $unknown_practice_id; # warn "$practice_code:$practice_id";
		}
        else { # just check GP exists in practice:
            my $sql = q!select 1 from referrer_department rd join parent_organisations
                po on rd.parent_organisation_id = po.id where rd.referrer_id = ?
                and po.parent_code = ?!;
            unless (  
                    $practitioner_id == $unknown_gpid || # skip if already unknown GP
                    $dbix4->query($sql, $practitioner_id, $practice_code)->list
                ) {
                    warn "$gp_code not at practice $practice_code";
                    $practitioner_id = $unknown_gpid;                
            }
        }

		# replace gp_id & practice_id with real values:
		$vals->{gp_id} = $practitioner_id;
		$vals->{practice_id} = $practice_id;
		
		# now add to patient_demographics table (from YHHN conversion):
		$self->_do_patient_demographics($vals);
        # alternate addresses:
        $self->_do_alternate_addresses();
    }
    $self->convert_to_InnoDB($table);
}

sub do_non_participant_practices {
    my $self = shift;

    my $dbh4 = $self->db->{dbh4};

    my $table = 'outreach.non_participant_practice';	
    $self->clear_table($table);

    my $sql = qq!insert into $table (practice_id) select id from referral_sources
        where organisation_code in ('B86023')!; # Ave. Surgery, Alwoodley

    $dbh4->do($sql);
    $self->convert_to_InnoDB($table);
}

sub do_followup_decisions {
    my $self = shift;

    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
    my $dbh4 =  $self->db->{dbh4};
    
	my $table = 'outreach.request_followup';
	
	# need to remove FK first:
	$dbh4->do( qq!ALTER TABLE $table DROP FOREIGN KEY `request_followup_ibfk_1`! );
	
	$self->clear_table($table);

	# followup_decisions map:
	my $followup_decisions_map
		= $dbix3->query(qq!select `option`, `id` from $CM.followup_options!)->map;
	
	# followup_decisions table:
	my $sql = qq!select m.HMDS, year(m.Date) as 'YEAR', fd.*
		from $CM.followup_decisions fd left join Main m on fd.dbid = m.DBID!;
		
	my $query = $dbix3->query($sql);
	while ( my $vals = $query->hash ) {
		# get request_id or skip (will have warned to output):
		my $request_id = $self->_get_request_id($vals) || next;
		
		my $decision = $vals->{decision};
		
		my %data = (
			request_id => $request_id,
			followup_option_id => $followup_decisions_map->{$decision},
			time => $vals->{timestamp},
		);
		$dbix4->insert($table, \%data);
	}
    $self->convert_to_InnoDB($table);
	
	# restore FK:
	$dbh4->do( qq!ALTER TABLE $table ADD CONSTRAINT `request_followup_ibfk_1`
		FOREIGN KEY (`followup_option_id`) REFERENCES `followup_options` (`id`)! );
}
	
sub do_lab_params {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	my $table = 'outreach.request_results';
	
	$self->clear_table($table);

	my $params_map
		= $dbix4->query(q!select param_name, id from outreach.lab_params!)->map;
	# warn Dumper $params_map; exit;
		
	# create data structure for all departments:
	my %data = ();
	
	my @depts = qw(biochemistry immunology haematology flow_cytometry);
	
	foreach my $dept (@depts) {
		my $sql = qq!select m.HMDS, year(m.Date) as 'YEAR', tbl.*
			from $CM.$dept tbl left join Main m on tbl.dbid = m.DBID!;
		my $query = $dbix3->query($sql);
		
		while ( my $vals = $query->hash ) {
			# get request_id or skip (will have warned to output):
			my $request_id = $self->_get_request_id($vals) || next;

			while ( my ($param, $val) = each %$vals ) { # warn Dumper [ $param, $val ];
				next if grep $param eq $_, qw(dbid HMDS YEAR); # ie non-tests
				$val ||= undef if $param eq 'electrophoresis'; # some empty non-nulls
				next unless defined $val; # skip null cols (but include zeros)
                
				my $param_id = $params_map->{$param} or die "no param id for $param";
				$data{$request_id}{$param_id} = $val;
			}			
		}
	}
	
	while ( my ($request_id, $results) = each %data ) { # warn Dumper [ $request_id, $results ];
		while ( my ($param_id, $val) = each %$results ) {
			my %data = (
				request_id => $request_id,
				param_id   => $param_id,
				result     => $val,
			);
			$dbix4->insert($table, \%data);
		}
	}	
    $self->convert_to_InnoDB($table);
}

sub do_pack_dispatches {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	my $table = 'outreach.request_pack_dispatch';
	
	$self->clear_table($table);

	my $sql = qq!select m.HMDS, year(m.Date) as 'YEAR', pd.*
		from $CM.pack_dispatches pd left join Main m on pd.dbid = m.DBID!;
		
	my $query = $dbix3->query($sql);
	while ( my $vals = $query->hash ) {
		# get request_id or skip (will have warned to output):
		my $request_id = $self->_get_request_id($vals) || next;

		my %data = (
			request_id => $request_id,
			pack_due   => $vals->{date_due},
			time 	   => $vals->{timestamp},
		);
        
        if ( my $pack_sent = $vals->{date_sent} ) {
            $data{pack_sent} = $pack_sent;
            
            my $dt = DateTime::Format::MySQL->parse_date($pack_sent);

            $data{return_due} = $dt->add(months => 1)->ymd;
        }
        
		$dbix4->insert($table, \%data);
	}	
    $self->convert_to_InnoDB($table);
}

sub do_questionnaires {
	my $self = shift;
	
    my $dbix3 = $self->db->{dbix3};
    my $dbix4 = $self->db->{dbix4};
	
	my @tables = qw(
		questionnaire_pain
		questionnaire_details
		questionnaire_service
		questionnaire_symptoms
		questionnaire_adenopathy
		questionnaire_treatment );
	
	for my $table (@tables) {
		$self->clear_table("outreach.$table");
		
		my $sql = qq!select m.HMDS, year(m.Date) as 'YEAR', tbl.*
			from $CM.$table tbl left join Main m on tbl.dbid = m.DBID!;
        if ($table eq 'questionnaire_service') { # use  HILIS3 name:
            $sql =~ s/questionnaire_service/questionnaire_locality/;
        }
        
		my $query = $dbix3->query($sql);
	
		while ( my $vals = $query->hash ) {
			# get request_id or skip (will have warned to output):
			my $request_id = $self->_get_request_id($vals) || next;

			# remove unwanted vals, add $vals->{request_id}:
			$vals->{request_id} = $request_id;
			map delete $vals->{$_}, qw(dbid HMDS YEAR);
			
			$dbix4->insert("outreach.$table", $vals);
		}
        $self->convert_to_InnoDB("outreach.$table");
	}
}

sub _get_request_id {
	my ($self, $vals) = @_;	
	
	my $dbid = $vals->{dbid};
	
	if ( my $request_id = $self->request_id_map->{$dbid} ) {
		return $request_id;
	}
	
	my $dbix4 = $self->db->{dbix4};
	my $request_id = $dbix4->query( q!select id from requests where request_number
		= ? and year = ?!, $vals->{HMDS}, $vals->{YEAR} )->list;
	
	if (! $request_id) {
        return 0 if grep $dbid == $_, (126018, 149397); # known deleted requests
		warn "no request_id for $dbid [" . $vals->{HMDS} . '/' . $vals->{YEAR} . ']';
		return 0; 
	}
	
	# stash it for next time:
	$self->request_id_map->{$dbid} = $request_id;
	return $request_id;
}

sub _get_practitioners_map {
	my $self = shift;
	
	my $sql = q!select national_code, id from referrers
		where national_code like 'G%'!;
	
	return $self->db->{dbix4}->query($sql)->map;
}

sub _do_patient_demographics {
	my $self = shift;
	my $vals = shift;
	
    my $dbix4 = $self->db->{dbix4};

	my $hilis4_patient_id = $vals->{hilis4_patient_id};
	
	my $sql = 'select * from patient_demographics where patient_id = ?';
	# skip if we already have data from YHHN:
	if ( my $data = $dbix4->query($sql, $hilis4_patient_id)->hash ) {
		# warn "have data on $hilis4_patient_id";
		my $have_diffs = $self->_parse_data($data, $vals);

		# update patient_demographics with outreach details (tel no & referrer id):
		my %new = (
			contact_number 	=> $vals->{telephone_no},
			gp_id 			=> $vals->{gp_id},
			status 			=> $vals->{status}, # do this anyway in case diff
		);
		
		# also update address, post_code & practice_id if have diffs:
		if ($have_diffs) {
			map $new{$_} = $vals->{$_}, qw(address post_code practice_id);
		}
		$dbix4->update(
			'patient_demographics', \%new, { patient_id => $hilis4_patient_id }
		);
	}
	else { # warn "no data";
		my %data = (
			contact_number 	=> $vals->{telephone_no},
			practice_id 	=> $vals->{practice_id},
			patient_id 		=> $hilis4_patient_id,
			post_code 		=> $vals->{post_code},
			address 		=> $vals->{address},
			status			=> $vals->{status},
			gp_id 			=> $vals->{gp_id},			
		); # warn Dumper \%data;
		$dbix4->insert('patient_demographics', \%data);
	}
}	

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

	my $table = 'outreach.patient_alternate_address';
	
	$self->clear_table($table);

	my $sql = qq!select * from $CM.alternate_address!;
	
	my $query = $dbix3->query($sql);
	ROW: while ( my $vals = $query->hash ) { # warn $vals->{nhs_number};
		my $hilis4_patient_id = $dbix4->query(
			'select id from patients where nhs_number = ?', $vals->{nhs_number}
		)->list;
		
		if ($hilis4_patient_id) { # warn $hilis4_patient_id;
			$vals->{hilis4_patient_id} = $hilis4_patient_id; # add to vals
		}
		else {
			warn "cannot find patient_id for $vals->{nhs_number}";
			next ROW;
		}
        
        my %data = (
            patient_id => $hilis4_patient_id,
            address    => $vals->{alternate_address},
            post_code  => $vals->{alternate_post_code},
        );
        $dbix4->insert($table, \%data);
    }
}


sub _check_outreach_practitioners {
	my ($self, $practitioners_map) = @_; # warn Dumper $practitioners_map; 
	
    my $dbix3 = $self->db->{dbix3};

	my $log_file = $self->log_file;

	my $cm_practitioners
		= $dbix3->query(qq!select distinct(gp_id) from $CM.patient_details
			where gp_id is not null!)->flat;
	# warn Dumper $cm_practitioners;
	
	my @unknown_gps;
	
	for my $gp_code (@$cm_practitioners) {
		push @unknown_gps, $gp_code unless $practitioners_map->{$gp_code};
	}
	
	if (@unknown_gps) {
		print $log_file "outreach GP's not in referrers table:\n";
		print $log_file Dumper \@unknown_gps;
	}
}

sub _parse_data {
	my ($self, $data, $vals) = @_;
	
	my $log_file = $self->log_file;
	my @flds = qw(address post_code practice_id);
	
	# don't log if data identical, retunrn 0 - no diffs:
	return 0 unless grep $data->{$_} ne $vals->{$_}, @flds;

	my $yhhn = 'yhhn';
	my $outr = 'outr';
	
	if ($data->{post_code} ne $vals->{post_code}) {
		$yhhn = uc $yhhn;
		$outr = uc $outr;
	}
	
	printf $log_file "$yhhn: %s\n", join ' :: ', map $data->{$_}, @flds;
	printf $log_file "$outr: %s\n", join ' :: ', map $vals->{$_}, @flds;
	
	return 1; # have diffs
}	

1;