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;