package Referrer; use LIMS::Local::ExcelHandler; use Moose; with 'Role::RebuildTables'; use namespace::clean -except => 'meta'; use Data::Dumper; has $_ => ( is => 'ro', isa => 'HashRef', required => 1 ) for qw(db sql); has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 ) for qw( parent_organisation_id_map custom_parent_organisation_id_map unknown_referrer_unknown_parent_org_id_map ); has unknown_org_codes => ( is => 'rw', isa => 'HashRef', default => sub { {} }, ); __PACKAGE__->meta->make_immutable; my @tables = qw(referrers referrer_department); sub convert { my $self = shift; my $dbh4 = $self->db->{dbh4}; my $dbix3 = $self->db->{dbix3}; my $dbix4 = $self->db->{dbix4}; #=begin my %SQL = ( clinician_id => q!SELECT `id` FROM `referrers` WHERE `national_code` = ?!, referrer_organisation_combination_exists => q!SELECT 1 FROM `referrer_department` WHERE `referrer_id` = ? AND `parent_organisation_id` = ?!, hilis3_clinicians => q! SELECT `cons_code`, `last_name`, `initials`, `speciality_code`, `org_code` FROM `hilis3`.`Clinician` WHERE `c_id` > 643 and `org_code` like '%00'!, ); $self->rebuild_tables(\@tables); my $parent_org_id_map = $self->parent_organisation_id_map; CLINICIAN: for my $ref ($dbix3->query( $SQL{hilis3_clinicians} )->arrays) { my ($cons_code, $last_name, $inits, $speciality_code, $org_code) = @{ $ref }; $org_code = uc $org_code; # a few are lc in src table my $clinician_id = $dbix4->query( $SQL{clinician_id}, $cons_code)->list; # if no referrers.id, create new clinician: if (! $clinician_id ) { # join with space for consistency with GP's: my $name = join ' ', $last_name, $inits; my $data = { national_code => $cons_code, name => $name, referral_type_id => 1, # clinician }; # print Dumper $data; $dbix4->insert('referrers', $data) or die $dbix4->error; $clinician_id = $dbix4->last_insert_id( undef, undef, qw/referrers id/ ) || die 'no last_insert_id'; } { # changed Notts. City Hospital org_code to match current etrust file: no warnings 'uninitialized'; $org_code =~ s/^(RCS)/RHA/; } # only need 1st 3 chars of org_code (eg SEK00, X60000, RR800, ): my ($org_code_prefix) = $org_code =~ /\A(...)/; # look for prefix in parent_organisation_id_map: my $parent_organisation_id = $parent_org_id_map->{$org_code_prefix}; if (! $parent_organisation_id) { # try to match 1st 3 chars of parent_code from restricted list: my $custom_parent_organisation_id_map = $self->custom_parent_organisation_id_map; $parent_organisation_id = $custom_parent_organisation_id_map->{$org_code_prefix}; } # if still no $parent_organisation_id: if (! $parent_organisation_id) { $self->unknown_org_codes->{$org_code_prefix} += 1; #warn "Cannot find parent_organisation_id for $org_code" #. " (clinician = $cons_code)"; next CLINICIAN; } next CLINICIAN if $dbix4->query( $SQL{referrer_organisation_combination_exists}, $clinician_id, $parent_organisation_id )->list; my $data = { referrer_id => $clinician_id, parent_organisation_id => $parent_organisation_id, hospital_department_code => $speciality_code, }; # print Dumper $data; $dbix4->insert('referrer_department', $data) or die $dbix4->error; # next CLINICIAN if $clinician_id % 1000; print $clinician_id, "\n"; } { # unknown referrers: my $unknown_parent_org_id_map = $self->unknown_referrer_unknown_parent_org_id_map; foreach my $referrer_type (qw/clinician practitioner/) { my $sql = qq!select id, default_unknown from referral_types where description = '$referrer_type'!; my ($referral_type_id, $default_unknown) = $dbix4->query($sql)->list; { # referrers: my %data = ( name => "Unknown $referrer_type", national_code => $default_unknown, referral_type_id => $referral_type_id, ); $dbix4->insert('referrers', \%data) or die $dbix4->error; } { # referrer_department: my $referrer_id = $dbix4->last_insert_id( undef, undef, qw/referrers id/ ) || die 'no last_insert_id'; my $parent_organisation_id = $unknown_parent_org_id_map->{$referrer_type}; my %data = ( referrer_id => $referrer_id, parent_organisation_id => $parent_organisation_id, hospital_department_code => 999, # unknown/other ); $dbix4->insert('referrer_department', \%data) or die $dbix4->error; } } } #=cut { # GP's (based on Admin::Config::GeneralPractitioners::regenerate(): # get map of all practice_codes => parent_organisation.id: my $parent_organisation_id_map = $self->parent_organisation_id_map; # list of parent_codes from $parent_organisation_id_map keys: my @parent_codes = keys %$parent_organisation_id_map; my $xl = LIMS::Local::ExcelHandler->new(); # $self->debug($xl); $xl->source('GP'); # get ref to array of all rows in egpcur.csv: my $general_practitioners = $xl->fetch_all; GP: foreach my $row (@$general_practitioners) { # warn Dumper $row; next; # skip row unless $row->{practice_code} matches entry in @practice_codes: next GP unless grep { $row->{practice_code} eq $_ } @parent_codes; my $practice_code = $row->{practice_code}; { # referrers table: my %data = ( name => $row->{name}, national_code => $row->{code}, referral_type_id => 3, # practitioner ); $dbix4->insert('referrers', \%data) or die $dbix4->error; } { # referrer_department table: my $referrer_id = $dbix4->last_insert_id( undef, undef, qw/referrers id/ ) || die 'no last_insert_id'; my %data = ( referrer_id => $referrer_id, hospital_department_code => 600, parent_organisation_id => $parent_organisation_id_map->{$practice_code}, ); $dbix4->insert('referrer_department', \%data) or die $dbix4->error; } } } #=cut { # known missing GP's in referrers table (not in egpcur): my @missing_gps = ( [ 'MCEWAN A', 'S3299276', 'S78024' ], [ 'ALEXANDER CM', 'G3381913', 'B86052' ], [ 'TAYLOR PF', 'G3333109', 'B86044' ], # [ 'SMITH DA', 'G8908649', 'B87029' ], # now at B87001 in 26/2/2010 egpcur.csv [ 'DOWSON DG', 'G8202185', 'B86054' ], # [ 'SMITH ML', 'G9501098', 'B83009' ], # now at B84007 in 4/10/2010 egpcur.csv # missing from Nov 2009 egpcur update: [ 'EISNER MC', 'G3356694', 'B83063' ], [ 'JARVIS EH', 'G3391855', 'B86071' ], [ 'BAILEY S', 'G8142056', 'B83058' ], [ 'HARRIS AL', 'G3363492', 'B82026' ], [ 'CARPENTER RM', 'G3371088', 'B82026' ], # [ 'CAMERON AW', 'G8209508', 'B86014' ], # now at Y02002 in 4/10/2010 egpcur.csv [ 'SHERWOOD GJ', 'G8105910', 'B86052' ], # missing from Oct 2010 egpcur update: [ 'FURNESS F', 'G3301072', 'B87031' ], [ 'ANTROBUS RD', 'G3314728', 'B83042' ], [ 'MACFIE AJ', 'G3390328', 'B82026' ], [ 'FITZGERALD TA','G9608294', 'B86041' ], # now at B81014 in 4/10/2010 egpcur.csv # outreach GP's moved to new practice: [ 'WACHSMUTH CW', 'G8135258', 'B86058' ], [ 'HAYES G', 'G9406564', 'B82056' ], [ 'GRIFFITHS SH', 'G8532350', 'B86054' ], [ 'DAVIES RL', 'G8334095', 'B86050' ], [ 'GOODMAN HE', 'G8440431', 'B86057' ], ); my $parent_organisation_id_map = $self->parent_organisation_id_map; foreach (@missing_gps) { my %data = ( name => $_->[0], national_code => $_->[1], referral_type_id => 3, # GP active => 'no', # assume retired ); $dbix4->insert('referrers', \%data) or die $dbix4->error; my $referrer_id = $dbix4->last_insert_id( undef, undef, qw/referrers id/ ) || die 'no last_insert_id'; { my $parent_organisation_id = $parent_organisation_id_map->{$_->[2]} || die "Cannot find parent_organisation_id for GP $_->[0] ($_->[1])"; my %data = ( referrer_id => $referrer_id, hospital_department_code => 600, parent_organisation_id => $parent_organisation_id, ); $dbix4->insert('referrer_department', \%data) or die $dbix4->error; } } } # now check all clinicians & gp's from hilis3 are in referrers table: { # clinicians: my $sql = q!select distinct(c.cons_code) from Main m left join Clinician c on m.Clinician = c.c_id where c.cons_code is not null!; my $hili3_clinicians = $dbix3->query( $sql )->flat; { my $sql = 'select 1 from referrers where national_code = ?'; foreach (@$hili3_clinicians) { warn "Cannot find $_ in referrers table" unless $dbix4->query($sql, $_)->list; } } } { # GP's: my $sql = q!select distinct(g.gp_code) from Main m left join GP g on m.Clinician = g.g_id where g.gp_code is not null!; my $hili3_gps = $dbix3->query( $sql )->flat; { my $sql = 'select 1 from referrers where national_code = ?'; foreach (@$hili3_gps) { warn "Cannot find $_ in referrers table" unless $dbix4->query($sql, $_)->list; } } } $self->convert_to_InnoDB($_) for @tables; =begin { # dump unknown organisation codes to stdout: my $unknown_org_codes = $self->unknown_org_codes; print "$_: $unknown_org_codes->{$_}\n" foreach sort { $unknown_org_codes->{$b} <=> $unknown_org_codes->{$a} } keys %$unknown_org_codes; } =cut } # returns hash of parent_org_id for unknown practice & hospital: sub _build_unknown_referrer_unknown_parent_org_id_map { my $self = shift; my $dbh = $self->db->{dbix4}; my $sql = q!select parent_organisation_id from referral_sources where display_name = ?!; my %referrer_org_code_id = ( clinician => $dbh->query( $sql, 'Hospital (unknown/other)' )->list, practitioner => $dbh->query( $sql, 'Practice (unknown/other)' )->list, ); return \%referrer_org_code_id; } sub _build_parent_organisation_id_map { my $self = shift; my $dbh = $self->db->{dbix4}; my $map = $dbh->query( 'select parent_code, id from parent_organisations' )->map; return $map; } # parent_organisation prefix -> id map for non-gp_practice org_codes > 3 chars: sub _build_custom_parent_organisation_id_map { my $self = shift; my $dbh = $self->db->{dbix4}; my $sql = q!select left(parent_code,3), id from parent_organisations where parent_code not like 'B_____' and length(parent_code) > 3!; my $map = $dbh->query( $sql )->map; return $map; } 1;