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;