Connecting To The Outside World with Perl and Database Events
Written by Nikos Vaggalis   
Monday, 19 November 2018
Article Index
Connecting To The Outside World with Perl and Database Events
The Internals
The Perl
Conclusion

The Perl

All the code is available on GitHubGist - see links at end of the article.

 patient_event_gateway.pl

use strict;
use DBI;

my $dbh = DBI->connect ('DBI:IngresII:vnode::database')
                          || die "$DBI::errstr";
$dbh->do('REGISTER DBEVENT evn_insert_patientvisit');
$dbh->{RaiseError}=1;
$|=1;

my $data;
while (1) {
  my $event_ref = $dbh->func( 'get_dbevent');
  my $data=$event_ref->{text};
  print "\n###CAUGHT EVENT #####\n";
  print "With Data: ", $data,"\n";
  my ($patient_id,$event_type,$event_id)=split ' ',$data;

  if ($event_type eq 'A01') {
   system("perl","patient_event_A01.pl",
                    $patient_id,$event_type,$event_id);
  }
  elsif ($event_type eq 'A02') {
   system("perl","./patient_event_A02.pl",
                    $patient_id,$event_type,$event_id);
  }
}

$dbh->disconnect();

So since the event type is A01, patient_event_A01.pl is called.patient_event_A01 receives the values into its @ARGV array so that it can manipulate them as it pleases.In this case it uses them to query a number of tables in order to collect and shape the information needed to construct the HL7 message.All these tables host a composite PK  based on the combination of fields  patient_id,event_type,event_id and that is the reason that we've been carrying the respective values meticulously all along.

Thus patient_event_A01.pl opens a DBI connection and uses the PK to query the tables PatientRegistry, PatientEvent,PatientDiagnosis and PatientVisit to extract the wanted fields.

  • From PatientRegistry we get, Family Name,Given Name,DOB,Sex and SSN, Assignor

  • From PatientEvent we get Event Date, Sending Organization

  • From PatientDiagnosis we get the Diagnosis

  • From PatientVisit we get the rest of the information

Also note that all the sensitive information such as the patient's id or SSN are anonymized by hashing them with SHA256 before sending them over the wire. The names of the patients should be treated in the same way, but I needed some example data to show.

patient_event_A01.pl

use DBI;
use Encode qw(:all);
use Net::HL7::Message;
use Net::HL7::Segment;
use Net::HL7::Segments::MSH;
use Digest::SHA qw(sha256 sha256_base64);
use XML::Compile::SOAP::Trace;
use XML::Compile::WSDL11;
use XML::Compile::SOAP11;
use XML::Compile::Transport::SOAPHTTP;
use XML::Compile::SOAP::Trace ;
use XML::LibXML;
use strict;
use Data::Dumper;

my ($patient_id, $event_type, $event_id)=@ARGV;

my $dbh = DBI->connect ('DBI:IngresII:syntag::psnodb')
                                  || die "$DBI::errstr";
$dbh->{AutoCommit}=1;
$dbh->{RaiseError}=0;

my $data;
my @detail_data;

my $sth=$dbh->prepare(q{
select
key=concat(
concat(varchar(pe.patient_id),
            varchar(pe.event_id)),pe.event_type),
            pr.family_name,
            pr.given_name,
            pr.dob,
            pr.sex,
            pr.ssn,
            pa.universal_id,
            pa.namespace_id,
           pa.universal_id_type,
           pe.sending_org,
           pd.diagnosis_id,
           pv.referring_doctor_id,
           pv.patient_class
           from PatientRegistry pr,
                      PatientEvent pe,PatientDiagnosis pd,
                      PatientVisit pv,PatientAssignor pa
           where
           pr.patient_id=pe.patient_id and
           pe.patient_id=pd.patient_id and
           pe.event_id=pd.event_id and
           pe.event_type=pd.event_type and
           pe.patient_id=pv.patient_id and
           pe.event_id=pv.event_id and
           pe.event_type=pv.event_type and
           pr.assignors_id=pa.universal_id and
           pe.patient_id=? and
           pe.event_type=? and
           pe.event_id = ?
});

$sth->execute($patient_id, $event_type, $event_id);

while ($data= $sth->fetchrow_hashref() ) {
  push @detail_data,$data;
};

if (scalar @detail_data==0) {
   $dbh->disconnect();
   die "SQL RETURNED 0 ROWS ";
};

#print Data::Dumper->Dump(\@detail_data);

After fetching and massaging the data, the program continues with constructing the HL7 message:

$Net::HL7::HL7_VERSION='2.6';
my $msg = new Net::HL7::Message();

my $msh = new Net::HL7::Segments::MSH();
$msh->setField(7, $msh->getField(7)."+0200");
$msh->setField(10, sha256_base64($detail_data[0]->{key}));
$msh->setField(11, "P");
$msh->setField(15, "0");
$msh->setField(9, "ADT^A01^ADT_A01");
$msh->setField(10, $detail_data[0]->{event_id});
$msh->setField(22, $detail_data[0]->{sending_org});
$msg->addSegment($msh);

my $pid = new Net::HL7::Segment("PID");
$pid->setField(3, [sha256_base64($detail_data[0]->
  {patient_id}),
   [$detail_data[0]->{namespace_id},
    $detail_data[0]->{universal_id},
    $detail_data[0]->{universal_id_type}]] );
    $pid->setField(5,[$detail_data[0]->  
       {family_name},$detail_data[0]->{given_name}]);
$pid->setField(7,$detail_data[0]->{dob});
$pid->setField(8,$detail_data[0]->{sex});
$pid->setField(19,sha256_base64($detail_data[0]->{ssn}));
$msg->addSegment($pid);

my $pv1 = new Net::HL7::Segment("PV1");
$pv1->setField(2, $detail_data[0]->{patient_class});
$pv1->setField(8, sha256_base64($detail_data[0]->
                            {referring_doctor_id}));
$msg->addSegment($pv1);

for (my $i=0;$i<=$#detail_data;$i++) {
   my $dg = new Net::HL7::Segment("DG1");
   $dg->setField(3, $detail_data[$i]->{diagnosis_id});
   $msg->addSegment($dg);
};

In order to check the message, I stringnify the $msg structure into the desired HL7 message using $msg->toString() which produces:
MSH|^~\&|||||20160526110214||ADT^A01^ADT_A01|201|P|
                              2.6||||||||||DD015
PID|||100660325^^^NationalPN&2.16.840.1.113883.19.3&ISO
          ||GREENING^WAYNE||19610130|M|||
          ||||||||303603715||||
          DG1|||S42.1
          DG1|||S42.2
          PV1||E|||||||12345678901|||||||||||""|""|0

The final step is wrapping it up in an XML SOAP envelope required by the IHE Gazelle HL7 Validator Service:


my $wsdl = XML::Compile::WSDL11->new("gazelleHL7v2ValidationWS.wsdl");
$wsdl->importDefinitions("ValidationContext.xsd");

my $validate=
{ # sequence of choice, ValidationOptions,
                          CharacterEncoding
# choice of ProfileOID, Profile
# is a xs:string
ProfileOID => "1.3.6.1.4.12559.11.1.1.60",
# is an unnamed complex
# is optional
ValidationOptions =>
{ # sequence of MessageStructure, Length,
                                DataType, DataValue

# is a xs:string
# defaults to 'ERROR'
# Enum: ERROR IGNORE WARNING
MessageStructure => "ERROR",

# is a xs:string
# defaults to 'WARNING'
# Enum: ERROR IGNORE WARNING
Length => "WARNING",

# is a xs:string
# defaults to 'ERROR'
# Enum: ERROR IGNORE WARNING
DataType => "ERROR",

# is a xs:string
# defaults to 'WARNING'
# Enum: ERROR IGNORE WARNING
DataValue => "WARNING", },

# is a xs:string
# is optional
CharacterEncoding => "UTF-8",
};

my $schema = XML::Compile::Schema->new("ValidationContext.xsd");
my $doc = XML::LibXML::Document->new('1.0', 'UTF-8');
my $write = $schema->compile(WRITER =>'ValidationContext');
my $xml = $write->($doc, $validate);

$doc->setDocumentElement($xml);

my $finalstuct ={
xmlValidationMetadata=>'',
xmlValidationContext=>"$doc",
messageToValidate=>$msg->toString();
};

my $call = $wsdl->compileClient('validateMessage');
my ($response, $trace) = $call->($final,'UTF-8');

The message isn't going to pass validation, and if you're curious about the why, you'll find the answer in my previous post "Health Level 7 (HL7) with Perl " which goes about constructing and validating a HL7 message.As such the validation failing is not important here as calling the web service just used to prove the power of this technique and what can be achieved under it.



Last Updated ( Monday, 19 November 2018 )