File Coverage

lib/Net/HL7/Messages/ACK.pm
Criterion Covered Total %
statement 46 47 97.8
branch 12 16 75.0
condition 5 6 83.3
subroutine 7 7 100.0
pod 2 2 100.0
total 72 78 92.3


line stmt bran cond sub pod time code
1             ################################################################################
2             #
3             # File : ACK.pm
4             # Author : Duco Dokter
5             # Created : Wed Mar 26 22:40:19 2003
6             # Version : $Id: ACK.pm,v 1.7 2004/02/10 14:31:54 wyldebeast Exp $
7             # Copyright : Wyldebeast & Wunderliebe
8             #
9             ################################################################################
10              
11              
12             package Net::HL7::Messages::ACK;
13              
14 4     4   1143 use strict;
  4         7  
  4         88  
15 4     4   13 use warnings;
  4         8  
  4         66  
16 4     4   16 use Net::HL7::Message;
  4         5  
  4         82  
17 4     4   14 use base qw(Net::HL7::Message);
  4         5  
  4         1323  
18              
19              
20             =pod
21              
22             =head1 NAME
23              
24             Net::HL7::Messages::ACK
25              
26             =head1 SYNOPSIS
27              
28             $ack = new Net::HL7::Messages::ACK($request);
29              
30              
31             =head1 DESCRIPTION
32              
33             Convenience module implementing an acknowledgement (ACK) message. This
34             can be used in HL7 servers to create an acknowledgement for an
35             incoming message.
36              
37              
38             =head1 METHODS
39              
40             =cut
41              
42             sub _init {
43              
44 6     6   8 my ($self, $req) = @_;
45              
46 6         18 $self->SUPER::_init();
47              
48 6         11 my ($reqMsh, $msh);
49              
50 6 50       23 $req && ($reqMsh = $req->getSegmentByIndex(0));
51              
52 6 50       14 if ($reqMsh) {
53              
54 6         9 my @flds = $req->getSegmentByIndex(0)->getFields(1);
55            
56 6         20 $msh = new Net::HL7::Segments::MSH(\@flds);
57             }
58             else {
59 0         0 $msh = new Net::HL7::Segments::MSH();
60             }
61              
62 6         18 my $msa = new Net::HL7::Segment("MSA");
63              
64             # Determine acknowledge mode: normal or enhanced
65             #
66 6 100 100     27 if ($reqMsh && ($reqMsh->getField(15) || $reqMsh->getField(16))) {
      66        
67 4         6 $self->{ACK_TYPE} = "E";
68 4         7 $msa->setField(1, "CA");
69             }
70             else {
71 2         7 $self->{ACK_TYPE} = "N";
72 2         4 $msa->setField(1, "AA");
73             }
74              
75 6         20 $self->addSegment($msh);
76 6         15 $self->addSegment($msa);
77              
78 6         12 $msh->setField(9, "ACK");
79              
80             # Construct an ACK based on the request
81 6 50       17 if ($req) {
82              
83 6 50       14 $reqMsh || last;
84              
85 6         13 $msh->setField(3, $reqMsh->getField(5));
86 6         13 $msh->setField(4, $reqMsh->getField(6));
87 6         13 $msh->setField(5, $reqMsh->getField(3));
88 6         13 $msh->setField(6, $reqMsh->getField(4));
89 6         12 $msa->setField(2, $reqMsh->getField(10));
90             }
91              
92 6         20 return 1;
93             }
94              
95             =pod
96              
97             =over 4
98              
99             =item B
100              
101             Set the acknowledgement code for the acknowledgement. Code should be
102             one of: A, E, R. Codes can be prepended with C or A, denoting enhanced
103             or normal acknowledge mode. This denotes: accept, general error and
104             reject respectively. The ACK module will determine the right answer
105             mode (normal or enhanced) based upon the request, if not provided.
106             The message provided in $msg will be set in MSA 3.
107              
108             =cut
109              
110             sub setAckCode {
111              
112 4     4 1 13 my ($self, $code, $msg) = @_;
113              
114 4         10 my $mode = "A";
115              
116             # Determine acknowledge mode: normal or enhanced
117             #
118 4 100       10 if ($self->{ACK_TYPE} eq "E") {
119 1         2 $mode = "C";
120             }
121              
122 4 100       7 if (length($code) == 1) {
123 2         5 $code = "$mode$code";
124             }
125              
126 4         8 $self->getSegmentByIndex(1)->setField(1, $code);
127 4 100       11 $msg && $self->getSegmentByIndex(1)->setField(3, $msg);
128             }
129              
130              
131             =pod
132              
133             =item B
134              
135             Set the error message for the acknowledgement. This will also set the
136             error code to either AE or CE, depending on the mode of the incoming
137             message.
138              
139             =cut
140              
141             sub setErrorMessage {
142              
143 1     1 1 7 my ($self, $msg) = @_;
144              
145 1         3 $self->setAckCode("E", $msg);
146             }
147              
148              
149             =pod
150              
151             =back
152              
153             =head1 AUTHOR
154              
155             D.A.Dokter
156              
157             =head1 LICENSE
158              
159             Copyright (c) 2002 D.A.Dokter. All rights reserved. This program is
160             free software; you can redistribute it and/or modify it under the same
161             terms as Perl itself.
162              
163             =cut
164              
165             1;