# hl7_conv
use strict;
use warnings;
my $input = q(AB\T\F\S\CD\E\E\E\R\R\R);
my $gen_out = '';
my $exp_out = q(AB&F^CD\\E\\R~R);
my %convs = (
E => '\\',
F => '|',
R => '~',
S => '^',
T => '&',
);
$gen_out = hl7_replace($input);
print "INPUT: $input\n";
print "GEN_OUT: $gen_out\n";
print "EXP_OUT: $exp_out\n";
print $0, ': ', $gen_out eq $exp_out ? 'SUCCESS!' : ' Z z . c8o, ', "\n";
exit 0;
sub hl7_replace
{
my $in = shift;
my @input = split //, $in;
my @output = ();
for (my $i = 0; $i <= $#input; ++$i)
{
if ($input[$i] eq "\\" && ($i + 2) <= $#input
&& $convs{$input[$i + 1]} && $input[$i + 2] eq "\\")
{
push @output, $convs{$input[$i + 1]};
$i += 2;
}
else
{
push @output, $input[$i];
}
}
return join '', @output;
}
####
[ ~/tmp ] $ perl hl7_conv
INPUT: AB\T\F\S\CD\E\E\E\R\R\R
GEN_OUT: AB&F^CD\E\E~R\R
EXP_OUT: AB&F^CD\E\R~R
hl7_conv: Z z . c8o,
[ ~/tmp ] $ perl hl7_conv
INPUT: AB\T\F\S\CD\E\E\E\R\R\R
GEN_OUT: AB&F^CD\E\R~R
EXP_OUT: AB&F^CD\E\R~R
hl7_conv: SUCCESS!
####
# hl7_conv
use strict;
use warnings;
my $input = q(AB\T\F\S\CD\E\E\E\R\R\R);
my $gen_out = '';
my $exp_out = q(AB&F^CD\\E\\R~R);
my $rx_hl7_ctrl_chars = qr/\\([EFRST])\\/;
my %convs = (
E => '\\',
F => '|',
R => '~',
S => '^',
T => '&',
);
$gen_out = hl7_replace($input);
print "INPUT: $input\n";
print "GEN_OUT: $gen_out\n";
print "EXP_OUT: $exp_out\n";
print $0, ': ', $gen_out eq $exp_out ? 'SUCCESS!' : ' Z z . c8o, ', "\n";
exit 0;
sub hl7_replace
{
my $in = shift;
$in =~ s/$rx_hl7_ctrl_chars/$convs{$1}/g;
return $in;
}
####
# hl7_conv
use strict;
use warnings;
my $input = q(AB\T\F\S\CD);
my $gen_out = '';
my $exp_out = q(AB&F^CD);
my %convs = (
'|' => qr/\\F\\/,
'^' => qr/\\S\\/,
'&' => qr/\\T\\/,
'~' => qr/\\R\\/,
'\\' => qr/\\E\\/,
);
$gen_out = hl7_replace($input);
print "INPUT: $input\n";
print "GEN_OUT: $gen_out\n";
print "EXP_OUT: $exp_out\n";
print $0, ': ', $gen_out eq $exp_out ? 'SUCCESS!' : ' Z z . c8o, ', "\n";
exit 0;
sub hl7_replace
{
my $in = shift;
foreach my $key (keys %convs)
{
$in =~ s/$convs{$key}/$key/g;
}
return $in;
}
####
[ ~/tmp ] $ perl hl7_conv
INPUT: AB\T\F\S\CD
GEN_OUT: AB&F^CD
EXP_OUT: AB&F^CD
hl7_conv: SUCCESS!
[ ~/tmp ] $