use strict; use warnings; =begin to use: config in /usr/local/hl7/hl7d.conf plugins /usr/local/hl7/plugins start hl7d: cd /usr/local/hl7d; sudo perl -T hl7d.pl --nodetach --debug run hl7.pl (uses HILIS), or: t/report_status.t, then perl hl7.pl 2 (uses lims_test) =cut use lib '/home/raj/apps/HILIS4/lib'; use FindBin qw($Bin); # warn $Bin; exit; use LIMS::Local::ScriptHelpers; use LIMS::Local::Stuff; use LIMS::Local::Utils; use LIMS::Local::HL7; use Data::Dumper; # ============================================================================== my $hl7d_addr = '127.0.0.1'; # '163.160.104.248' # TIE my $hl7d_port = 12002; # 7210; my $request_id = $ARGV[0] || 101111; # anon hiv # ============================================================================== open my $hl7_log, '>', $Bin . '/hl7_log.txt' or die $!; open my $hl7_ice, '>', $Bin . '/hl7_ice.txt' or die $!; my $tools = LIMS::Local::ScriptHelpers->new(); my $now = LIMS::Local::Utils::time_now(); my $cfg_file = "$Bin/crons/lib/settings.cfg"; my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings; exit; # add HL7d to settings - TODO: hard-code to cfg_file $settings->{hl7d_addr} = $hl7d_addr; $settings->{hl7d_port} = $hl7d_port; # get tools from LIMS::Local::ScriptHelpers: my $sql_lib = $tools->sql_lib(); # warn Dumper $sql_lib->elements; my $config = $tools->config(); my $dbix = $tools->dbix(); $dbix->dbh->do('use lims_test') if $request_id == 2; # increase max length of group_concat; permitted range (32-bit system) 4 .. 4294967295 $dbix->dbh->do('SET group_concat_max_len = 3072'); redo_summary(); # get sql statments: my $sql = _get_sql(); my $result = $dbix->query($sql, $request_id); # warn $request_id; while ( my $vars = $result->hash ) { # warn Dumper $vars; next; my $hl7 = LIMS::Local::HL7->new(settings => $settings); # build message: $hl7->build_msh_segment(); $hl7->build_pid_segment($vars); $hl7->build_nte_segment($vars); # $hl7->build_pv1_segment($vars); # not using # $hl7->build_orc_segment($vars); # not using $hl7->build_obr_segment($vars); # $hl7->build_obx_segment($vars); # using _build_report_segment() # add report (comment, diagnosis, etc) to hl7 message: _build_report($hl7, $vars); # message should now be complete, send it my $response = $hl7->send_message($vars); # warn $response; my $msg = $hl7->msg(); # Net::HL7::Request object; warn $msg->toString(1) dump_msg($vars, $msg, $response); } sub _build_report { my ($hl7, $vars) = @_; } # ------------------------------------------------------------------------------ sub dump_msg { # write to interface logs my ($vars, $msg, $response) = @_; # my $dow = $now->day_name; # warn $dow; my $request_number = _get_request_number($vars); printf $hl7_log "%s: %s\n\n", $request_number, $response; print $hl7_log $msg->toString(1)."\n"; print $hl7_log Dumper $msg; printf $hl7_ice "H%s %s\n", $request_number, '=' x 100; while ( my ($field, $value) = each %$vars ) { printf $hl7_ice "%s: %s\n", $field, $value || 'NULL'; } } sub redo_summary { my $line = LIMS::Local::Stuff::silly_werder(10,20); # warn length $line; # add some chars for escaping: $line .= ' and & and ^ and \ and | and ~ end.'; $dbix->update('request_result_summaries', { results_summary => $line }, { request_id => 2 }); } # ------------------------------------------------------------------------------ sub mail_admin { my $msg = shift; # warn $msg; $tools->mail_admin({ script => $0, msg => $msg }); exit; } # ------------------------------------------------------------------------------ sub _get_request_number { my $vars = shift; return join '/', $vars->{request_number}, $vars->{year} - 2000; } # ------------------------------------------------------------------------------ sub _get_sql { return q! SELECT p.last_name, p.first_name, p.middle_name, p.dob, p.nhs_number, p.gender, pc.unit_number, rs.display_name as 'location', rs.organisation_code, rf.name as 'referrer_name', rf.national_code as 'referrer_code', req.id as 'request_id', req.request_number, req.year, req.created_at, req.updated_at, rr.status, rr.comment, group_concat(distinct sp.description) as 'specimen', d.name as 'diagnosis', d.icdo3, group_concat( distinct ls.section_name,':',rrs.results_summary,'|') as 'summaries' FROM requests req join patient_case pc on req.patient_case_id = pc.id join patients p on pc.patient_id = p.id join referral_sources rs on pc.referral_source_id = rs.id join referrer_department rd on req.referrer_department_id = rd.id join referrers rf on rd.referrer_id = rf.id join request_history h on h.request_id = req.id join request_report rr on rr.request_id = req.id join diagnoses d on rr.diagnosis_id = d.id join request_result_summaries rrs on rrs.`request_id` = req.id join lab_sections ls on rrs.`lab_section_id` = ls.id join request_specimen rsp on rsp.`request_id` = req.id join specimens sp on rsp.`specimen_id` = sp.id WHERE /* rs.organisation_code like '%' and h.action = 'authorised' and date(h.time) = DATE_SUB(CURRENT_DATE(), INTERVAL ? DAY) */ req.id = ? group by req.id !; }