package ReferralSource;
use Moose;
with 'Role::RebuildTables';
use namespace::clean -except => 'meta';
use FindBin qw($Bin);
use Data::Dumper;
use IO::All;
has $_ => ( is => 'ro', isa => 'HashRef', required => 1 )
for qw( db sql );
has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
for qw( local_hospitals_map parent_organisation_id_map other_hospitals_map );
has other_hospitals => ( is => 'ro', isa => 'ArrayRef', lazy_build => 1 );
has path_to_app => ( is => 'ro', isa => 'Str', required => 1 );
__PACKAGE__->meta->make_immutable;
my @tables = qw(referral_sources parent_organisations);
sub convert {
my $self = shift;
my $dbh4 = $self->db->{dbh4};
my $dbix3 = $self->db->{dbix3};
my $dbix4 = $self->db->{dbix4};
$self->rebuild_tables(\@tables);
$self->populate_parent_organisations_table;
my $parent_org_id_map = $self->parent_organisation_id_map;
# warn Dumper $parent_org_id_map;
{ # unknowns & resolved duplicates:
my $other_hospitals = $self->other_hospitals; # warn Dumper $other_hospitals;
foreach my $other (@$other_hospitals) { # warn $other->[0];
my $parent_organisation_id = $parent_org_id_map->{$other->[2]}
|| die "Cannot find parent_org_id for $other->[0]";
my %data = (
display_name => $other->[0],
organisation_code => $other->[1],
referral_type_id => 4, # hospital
parent_organisation_id => $parent_organisation_id,
);
$dbix4->insert( 'referral_sources', \%data);
}
}
{ # hospitals:
my @hospital_ids =
$dbix3->query( q!select distinct(Source) from Main!)->flat;
HOSPITAL:
foreach my $hospital_id (@hospital_ids) {
# skip Other, Surgery/Med Centre, Notts. City Hospital, Hudds. Nuffield (closed):
next if grep $hospital_id == $_, qw(54 56 57 78 271);
# get Location & OrgCode from Source:
$dbix3->query(
q!select Location, OrgCode from Source where Src_ID = ?!, $hospital_id
)->into( my ($location, $org_code) );
if (! $org_code) {
my $sql = 'select 1 from referral_sources where display_name = ?';
unless ( $dbix4->query( $sql, $location )->list ) {
warn "no entry for $hospital_id";
}
next HOSPITAL;
}
# duplicate OrgCodes, resolved by direct entry in @other_hospitals above:
# next if grep $org_code eq $_, qw(STC01 RCD35 RTGFA RWDDA RTD02 SGA07 RCSLB);
next if $self->other_hospitals_map->{$org_code};
my $parent_organisation_id = 0;
{ # get parent_organisation_id:
my $parent_org_id_map = $self->parent_organisation_id_map;
my $local_hospitals_map = $self->local_hospitals_map;
if (
$org_code =~ /\A([RYZ]..)..\Z/ || # England, Ireland, HMP
$org_code =~ /\A(S..)\d{2}\Z/ # Scottish sources
) { # warn $org_code;
$parent_organisation_id = $parent_org_id_map->{$1};
}
if (! $parent_organisation_id) {
if (my $mapped_code = $local_hospitals_map->{$org_code}) {
# warn $org_code; warn $mapped_code;
$parent_organisation_id = $parent_org_id_map->{$mapped_code};
# warn $parent_organisation_id;
}
else { # warn $org_code;
$parent_organisation_id = $parent_org_id_map->{$org_code}
|| die "Cannot find parent_organisation_id for $org_code";
}
}
}
# warn Dumper ($org_code, $parent_organisation_id);
my %data = (
display_name => $location,
organisation_code => $org_code,
referral_type_id => 4, # hospital
parent_organisation_id => $parent_organisation_id,
);
$dbix4->insert( 'referral_sources', \%data);
}
}
{ # unlisted/unknown referral sources:
my @other_sources = (
[ 'Practice (unknown/other)', 'UNKNOWN PRACTICE', 'V81999', 5 ],
[ 'Hospital (unknown/other)', 'UNKNOWN HOSPITAL', 'X99999', 4 ],
[
'East Calder Health Centre, 147 Main Street, West Lothian, EH53 0EW',
'EAST CALDER HC, EH53 0EW',
'S78024',
5,
],
);
foreach my $other (@other_sources) {
{
my %data = (
description => $other->[1],
parent_code => $other->[2],
referral_type_id => $other->[3],
);
$dbix4->insert('parent_organisations', \%data);
}
my $parent_organisation_id
= $dbix4->last_insert_id(undef, undef, 'parent_organisations', 'id')
|| die "Cannot retrieve parent_organisation_id for $other->[2]";
my %data = (
display_name => $other->[0],
organisation_code => $other->[2],
referral_type_id => $other->[3],
parent_organisation_id => $parent_organisation_id,
);
$dbix4->insert( 'referral_sources', \%data);
}
}
{ # general practices:
my @hilis_practices = $dbix3->query(
q!select DISTINCT(practice_code) from Main m, GP g
where m.Clinician = g.G_ID and m.Clinician like 'G%'
and Clinician <> 'G1'!
)->flat; # warn scalar @hilis_practices;
# add community_monitoring practices:
my @outreach_practices = $dbix3->query(
q!select DISTINCT(practice_id) FROM community_monitoring.patient_details
where practice_id <> ?!, 'B00000'
)->flat; # warn scalar @outreach_practices;
# combine into unique practices array:
my %seen = ();
my @practice_codes
= grep { ! $seen{$_}++ } (@hilis_practices, @outreach_practices);
# warn scalar @practice_codes; warn Dumper \%seen; exit;
PRACTICE:
foreach my $practice_code (@practice_codes) {
$dbix3->query(
q!select address, post_code from community_monitoring.gp_practices
where practice_id = ?!, $practice_code
)->into( my ($address, $post_code) );
if (! $address) {
my $sql = 'select 1 from referral_sources where organisation_code = ?';
unless ( $dbix4->query( $sql, $practice_code )->list ) {
warn "no address details for $practice_code";
}
next PRACTICE;
}
{ # add practice to parent_organisations & retrieve new id:
my @address = split ', ', $address;
my $description = join ', ', uc $address[0], $post_code;
my %data = (
parent_code => $practice_code,
description => $description,
referral_type_id => 5,
);
$dbix4->insert('parent_organisations', \%data);
}
my $parent_organisation_id
= $dbix4->last_insert_id(undef, undef, 'parent_organisations', 'id')
|| die "Cannot retrieve parent_organisation_id for $practice_code";
# warn Dumper ($practice_code, $parent_organisation_id);
my %data = (
display_name => (join ', ', $address, $post_code),
organisation_code => $practice_code,
referral_type_id => 5, # practice
parent_organisation_id => $parent_organisation_id,
);
$dbix4->insert( 'referral_sources', \%data);
}
}
# now check all Sources & GP practices from hilis3 are in referral_sources table:
{
my $sql = q!select distinct(s.OrgCode) from Main m left join
Source s on m.Source = s.Src_ID where s.OrgCode is not null!;
my $hilis3_locations = $dbix3->query( $sql )->flat;
{
my $sql = 'select 1 from referral_sources where organisation_code = ?';
foreach (@$hilis3_locations) {
next if $_ eq 'RCSLB'; # Notts. City Hospital -> RHALB
warn "Cannot find $_ in referral_sources table"
unless $dbix4->query($sql, $_)->list;
}
}
}
{
my $sql = q!select distinct(g.practice_code) from Main m left join GP g
on g.g_id = m.Clinician where m.Clinician like 'G%' and m.Clinician <> 'G1'!;
my $hilis3_practices = $dbix3->query( $sql )->flat;
{
my $sql = 'select 1 from referral_sources where organisation_code = ?';
foreach (@$hilis3_practices) {
warn "Cannot find $_ in referral_sources table"
unless $dbix4->query($sql, $_)->list;
}
}
}
$self->convert_to_InnoDB($_) for @tables;
}
sub populate_parent_organisations_table {
my $self = shift;
my $path_to_app = $self->path_to_app;
my $path_to_src_file
= "$path_to_app/setup/schema/parent_organisations_updated.sql";
my @data = io($path_to_src_file)->slurp;
my $dbh = $self->db->{dbh4};
foreach (@data) {
next unless /\A(INSERT INTO)/;
$dbh->do($_);
}
}
sub _build_other_hospitals {
my $self = shift;
my @other_hospitals = (
[ 'Ghana (Kumasi)', 'GHANA', 'GHANA' ],
[ 'Ninewells / Tayside, Dundee', 'STC01', 'STC', ],
[ 'Harrogate & District', 'RCD35', 'RCD', ],
[ 'Derby Royal Infirmary', 'RTGFA', 'RTG', ],
[ 'Lincoln County', 'RWDDA', 'RWD', ],
[ 'PathLinks (Lincoln)', 'RWD00', 'RWD', ],
[ 'Royal Victoria Infirmary, Newcastle', 'RTD02', 'RTD', ],
[ 'University of Newcastle (RVI)', 'RTD00', 'RTD', ],
[ 'Western / Gartnavel, Glasgow', 'SGA07', 'SGA', ],
[ 'Nottingham City Hospital', 'RHALB', 'RHA', ],
# [ 'Mid Yorks Nuffield', '8AV07' ], # = NT225
# [ 'Hospital (unknown/other)', 'X99999' ],
);
return \@other_hospitals;
}
sub _build_other_hospitals_map {
my $self = shift;
my %duplicates;
my $other_hospitals = $self->other_hospitals;
map { $duplicates{ $_->[1] }++ } @$other_hospitals;
return \%duplicates;
}
sub _build_local_hospitals_map {
my $self = shift;
my %local_hospitals_map = (
NT217 => 'RCD', # Harrogate
# NT220 => 'RWY', # Huddersfield (Nuffield taken over by NT448)
NT221 => 'RWA', # Hull
NT225 => 'RR8', # Leeds
NT226 => 'RWE', # Leicester
NT239 => 'RWF', # Tunbridge Wells
NT242 => 'RL4', # Wolverhampton
NT243 => 'RCB', # York
NT308 => 'RTP', # East Surrey
NT320 => 'RR1', # Parkway (Solihull)
NT321 => 'RR1', # Little Aston (Sutton Coldfield)
NT322 => 'RWE', # Leicester
NT327 => 'RM2', # Spire, Manchester TODO: check RM2
NT328 => 'RAE', # Elland
NT330 => 'RXF', # Methley Park (Wakefield)
NT331 => 'RWA', # Hull
NT332 => 'RR8', # Leeds
NT339 => 'RJN', # Macclesfield
NT401 => 'RM2', # Univ. South Manchester - TODO: check this
NT408 => 'RVV', # Kent & Canterbury
NT409 => 'RGZ', # Chelsfield Park (Kent)
NT438 => 'RWF', # Maidstone
NT448 => 'RWY', # Huddersfield
NT818 => 'RAE', # Yorkshire clinic (Bradford)
NTY65 => 'RAX', # Kingston (upon Thames)
NV106 => 'RWF', # Blackheath (Maidstone)
69390 => 'RJE', # North Staffs pathology lab
S314H => 'SSC', # Edinburgh Royal Infirmary
RCSLB => 'RHA', # Nottingham City Hospital
L308H => 'SLC', # Wishaw -> North Lanarkshire
);
return \%local_hospitals_map;
}
sub _build_parent_organisation_id_map {
my $self = shift;
my $dbh = $self->db->{dbix4};
my $parent_organisation_id_map
= $dbh->query( 'select parent_code, id from parent_organisations' )->map;
return $parent_organisation_id_map;
}
1;
