Perl and  Net::HL7

So how are we going to get at this structure programmatically? We'll use Perl and Net::HL7 of course.

Let's begin by importing the Net::HL7 library  into our program and initializing the structure of the message:

use Net::HL7::Message;
use Net::HL7::Segment;
use Net::HL7::Segments::MSH;

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

Mapping MSH

from Hl7:

MSH|^~\&|||||20160526110214||ADT^A01^ADT_A01|
                      id201|P|2.6||||||||||DD015|

to Perl :

#values coming out of the database

my $msh_9=["ADT","A01","ADT_A01"];
my $msh_10=201;
my $msh_22="DD015";

The values that fill the structure would probably be the result of calling into a database. For brevity we skip that step and work directly with the values.

First we construct the MSH() Segment and set its fields:

my $msh = new Net::HL7::Segments::MSH();
$msh->setField(7, $msh->getField(7)."+0200");

$msh->setField(7, $msh->getField(7)."+0200")
is a small hack. For field 7, we need the current date and time. As seen from the module's source code,  field 7 is automatically filled with the current date time when the MSH segment is initialized

sub _init {
my ($self, $fieldsRef) = @_;
$self->SUPER::_init("MSH", $fieldsRef);
	# Only fill default fields if no fields ref is given #
	if (! $fieldsRef) {
	$self->setField(1, $Net::HL7::FIELD_SEPARATOR);
	$self->setField(
	2, 
 $Net::HL7::COMPONENT_SEPARATOR . 

        $Net::HL7::REPETITION_SEPARATOR .
	$Net::HL7::ESCAPE_CHARACTER .
	$Net::HL7::SUBCOMPONENT_SEPARATOR
 );

	$self->setField(7, strftime("%Y%m%d%H%M%S", localtime));

	# Set ID field
	#
	my $ext = rand(1);
	$ext =~ s/[^0-9]//g;
	$ext = "." . substr($ext, 1, 5);
	$self->setField(10, $self->getField(7) . $ext);
	$self->setField(12, $Net::HL7::HL7_VERSION);
	}
return $self;
}

calling into the POSIX module's strftime function:
$self->setField(7, strftime("%Y%m%d%H%M%S", localtime))

We wouldn't have to touch anything if we didn't need to add the GMT offset "+0200" to it. So we take advantage of the fact that the module already uses the current date time, retrieve it with getField and simply add "+0200" to it. 

$msh->setField(9, $msh_9); 
$msh->setField(10, "id".$msh_10); 
$msh->setField(11, "P");
$msh->setField(22, $msh_22);

$msg->addSegment($msh);

Then for field 9, $msh->setField(9, $msh_9) maps  ["ADT","A01","ADT_A01"] to "ADT^A01^ADT_A01" since when enclosing a set of values into an array reference [ ], Net::HL7 maps them into a field delimited by ^.
We also set the rest of the fields 10,11,22 and finally add the complete MSH segment to our main Message structure.

That's it for the MSH segment. Now let's focus on the more elaborate PID segment.

Mapping PID

from HL7:

PID|||100660325^^^NationalPN&2.16.840.1.113883.19.3
    &ISO^0~80253^^^^1||GREENING^WAYNE^^^^^L||
    19610130|M|||||||||||303603715||||LONDON|

to Perl:

my $pid_3= [
 "100660325",["NationalPN","2.16.840.1.113883.19.3","ISO"],"0"
 ."~".
 "80253",'','','','',1
 ];
my $pid_5=["GREENING","WAYNE",'','','','',"L"];
my $pid_7="30/01/1961";
my $pid_8="M";
my $pid_19=303603715;
my $pid_23="LONDON";

my $pid = new Net::HL7::Segment("PID");

$pid->setField(3, $pid_3);
$pid->setField(5, $pid_5);
$pid->setField(7, $pid_7);
$pid->setField(8, $pid_8);
$pid->setField(19, $pid_19);
$pid->setField(23, $pid_23);

$msg->addSegment($pid);

Here we have to use a nested data structure:

The first array reference  $pid_3=[ ]  groups and delimits with ^ the first level components:

    100660325^NationalPN&2.16.840.1.113883.19.3&ISO^0~80253^^^^1

The second array reference 
my $pid_3= [
                           [

                           ]
                    ]

groups and delimits the second level components with &:
    NationalPN&2.16.840.1.113883.19.3&ISO

Because it is a repeated field we use ~ to denote that the field's structure can be replicated into a second instance, each instance having different data:
    ~80253^^^^1

The problem here is that, according to the documentation, we cannot use another level of array references to represent the Repeated fields:

This means we have to resort to another hack, that of concatenating the character ~ with the field's second repition values:
   ."~".
    "80253",'','','','',1

Then for field PID.7

my $time = Time::Piece->strptime($pid_7,'%d/%m/%Y'); 
$time= $time->strftime('%Y%m%d');
$pid->setField(7, $time);

we have to transform the birth date from format dd/mm/yyyy to yyyymmdd.
This can be done with the Time::Piece module. You first have to create a  Time::Piece object and feed it an initial value with its format:

Time::Piece->strptime($pid_7,'%d/%m/%Y'),     interpolated  Time::Piece->strptime("30/01/1961",'%d/%m/%Y')
 
Then you set the Time::Piece object to the new format and let the module do the internal structure reordering with $time->strftime('%Y%m%d'), which gets you the desired date 19610130 

Mapping PV1
PV1 is straight forward, so we jump into DG1's construction.

Mapping DG1
DG1 is special in that it can be repeated. So in going from HL7:

DG1|||S42.1|

DG1|||S42.2|

to Perl, an array is an appropriate structure for storing the two DG1 instances, grouping them in array reference that enclose their fields:

my @dg1data=([1,"S42.1"],[2,"S42.2"]);

with a for loop with iterate through the array, pop the values and set the fields. At the end of each iteration we also add the DG1 segments to the main message:

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