Connecting the database to the outside world with Perl and Database Events

patient_event_A01.pl

##Author:Nikos Vaggalis
##Licensed under Artistic License 1.0
##Accompanying code of the "Connecting the database to the outside world with Perl and Database Events" 
##article on i-programmer.info
##https://www.i-programmer.info/programming/perl/12299-connecting-the-database-to-the-outside-world-with-perl-and-database-events.html

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);

$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);
};

print $msg->toString();

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');