source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCS.m@ 1076

Last change on this file since 1076 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1HLCS ;ALB/RJS,MTC,JRP - COMMUNICATIONS SERVER - ;10/04/2007 14:34
2 ;;1.6;HEALTH LEVEL SEVEN;**2,9,14,19,43,57,109,132,122**;Oct 13, 1995;Build 14
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;The SEND function is invoked by the transaction processor.
6 ;It's function is to $O through the ITEM multiple of the Event Driver
7 ;Protocol and create child entries in the Message Text file (#772)
8 ;for the message at HLMTIEN. These child messages point back
9 ;to the parent message so that message text does not need to
10 ;be duplicated when a message is sent to multiple applications.
11 ;
12 ;The SENDACK function is also invoked by the transaction processor.
13 ;It's function is to create a child entry in the Message Text file
14 ;for the message at HLMTIENA and deliver the message to the
15 ;application the requested/sent information.
16 ;
17 ;For DHCP to DHCP messaging (i.e. internal to internal), an incoming
18 ;message is created in the Message Text file which is a duplication
19 ;of the outgoing message. The incoming message is then processed by
20 ;calling the transaction processor.
21 ;
22 ;For DHCP to COTS messaging (i.e. internal to external), the message
23 ;is filed in the Message Text file with the Logical Link defined and
24 ;a status of PENDING TRANSMISSION. These entries are picked up by
25 ;the background filer and transmitted to the appropriate COTS system.
26 ;
27SEND(HLMTIEN,HLEID,HLRESULT) ;Send an HL7 message
28 ;HLMTIEN=The IEN of the parent message in file # 772
29 ;HLEID=The IEN of the Event Driver protocol in file #101
30 ;HLRESULT=Variable for any error text (pass by reference)
31 ;
32 ;Declare variables
33 N HLARY,HLERROR,HLEIDS,HLCLIENT,HLOGLINK,HLMTIENS,HLMSGPTR
34 S HLERROR=""
35 ;Direct connect
36 I HLPRIO="I" D Q
37 . D DC^HLMA2
38 . S HLRESULT=HLERROR
39 ;Get all subscribers to the message
40 D ITEM^HLUTIL2(HLEID,"PTR")
41 ;Quit if no subscribers (considered successful delivery)
42 G:($G(HLARY(0))'>0) EXIT
43 ;Deliver message to each subscriber
44 S HLEIDS=0
45 F S HLEIDS=$O(HLARY(HLEIDS)) Q:(HLEIDS'>0) D
46 .;
47 .;**132 excluded subscribers **
48 .N I,EXCLUDE
49 .S (EXCLUDE,I)=0
50 . ;
51 . ; patch HL*1.6*122
52 . ; F S I=$O(HLP("EXCLUDE SUBSCRIBER",I)) Q:'I I $G(HLP("EXCLUDE SUBSCRIBER",I))=HLEIDS S EXCLUDE=1 Q
53 . F S I=$O(HLP("EXCLUDE SUBSCRIBER",I)) Q:'I D Q:EXCLUDE
54 .. N TEMP
55 .. S TEMP=HLP("EXCLUDE SUBSCRIBER",I)
56 .. I 'TEMP,TEMP]"" S TEMP=$O(^ORD(101,"B",TEMP,0))
57 .. I TEMP=HLEIDS S EXCLUDE=1
58 . ; patch HL*1.6*122
59 . ;
60 .Q:EXCLUDE
61 .;** 132 end **
62 .;
63 .;Get pointer to receiving application
64 .S HLCLIENT=+HLARY(HLEIDS),HL("EIDS")=HLEIDS,HLERROR=""
65 .Q:(HLCLIENT'>0)
66 .;Check and execute ROUTING LOGIC **CIRN**
67 .S HLX=$G(^ORD(101,HLEIDS,774))
68 .I HLX]"" D Q
69 ..N HLQUIT,HLNODE,HLNEXT
70 ..S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
71 ..X HLX I $D(HLL("LINKS")) D FWD^HLCS2 K HLL ;**CIRN**
72 .;Get pointer to logical link
73 .S HLOGLINK=$P(HLARY(HLEIDS),"^",2)
74 .;Determine if receiving application is internal or external
75 .; Logical link has a value for external applications
76 .; Logical link is NULL for internal applications
77 .I (HLOGLINK) D COTS Q
78 .;Create 'incoming' message based on 'outgoing' message (internal)
79 .D DHCP(HLMTIEN,HLEIDS,HLCLIENT)
80 .Q:(HLERROR)
81 .;Process the 'incoming' message
82 .S HLERROR=""
83 .D PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
84 .;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
85 .; or ERROR DURING TRANSMISSION
86 .D STATUS^HLTF0(HLMSGPTR,$S(HLERROR:4,1:3),$S(HLERROR:+HLERROR,1:""),$S(HLERROR:$P(HLERROR,"^",2),1:""),,$S($G(HLERR("SKIP_EVENT"))=1:1,1:0))
87 .I $D(HLL("LINKS")) D FWD^HLCS2 K HLL ;**CIRN**
88 D ADD^HLCS2 ;**CIRN**
89EXIT S HLRESULT=HLERROR
90 Q
91COTS ;Internal to external communication
92 ;Create child entry in Message Text file
93 N HLTCP,HLTCPI,HLTCPO
94 D SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
95 I ((+HLMTIENS)'>0) S HLERROR=HLMTIENS Q
96 ;'Pass' message to background filer by setting status of child
97 ; to PENDING TRANSMISSION
98 D STATUS^HLTF0(HLMTIENS,1)
99 Q
100DHCP(HLMTIEN,HLEIDS,HLCLIENT) ;Internal to internal communication
101 ;
102 ;Input : HLMTIEN - Pointer to parent outgoing message (file #772)
103 ; HLEIDS - Pointer to subscribing protocol (file #101)
104 ; HLCLIENT - Pointer to receiving application (file # 771)
105 ;
106 ;Output : HLMTIENS - Pointer to child outgoing message (file #772)
107 ; HLMSGPTR - Pointer to [parent] incoming message (file #772)
108 ; HLERROR - ErrorCode ^ ErrorText
109 ;
110 ;Notes : This module only copies the outgoing message into an incoming
111 ; message. Delivery of the message (i.e. processing of it)
112 ; must be done by the calling application.
113 ; : Message/batch header (MSH/BSH) is built and placed in the
114 ; incoming message
115 ; : HLMTIENS, HLMSGPTR, and HLERROR will be initialized
116 ; : Existance and validity of input is assumed
117 ;
118 ;Declare variables
119 N MSGID,MSGDT,MSGDTH,HDR2BLD,TMP,HLHDR,BHSHDR
120 S HLERROR=""
121 S HLMTIENS=0
122 S HLMSGPTR=0
123 ;Create child entry in Message Text file
124 D SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS)
125 I ((+HLMTIENS)'>0) S HLERROR=HLMTIENS Q
126 ;'Receive' message by making an incoming message
127 ;Determine type of header to build
128 S TMP=$G(^HL(772,HLMTIEN,0))
129 S HDR2BLD=$P(TMP,"^",14)
130 ;Build message header (MSH)
131 I (HDR2BLD="M") D Q:(HLERROR)
132 .S TMP=""
133 .D HEADER^HLCSHDR(HLMTIENS,.TMP)
134 .Q:(TMP="")
135 .;Error building header
136 .S HLERROR="4^Unable to build message header => "_TMP
137 .D STATUS^HLTF0(HLMTIENS,4,0,$P(HLERROR,"^",2))
138 ;Build batch header (BHS or FHS)
139 I (HDR2BLD'="M") D Q:(HLERROR)
140 .S TMP=""
141 .D BHSHDR^HLCSHDR(HLMTIENS)
142 .S:($E(HLHDR(1),1)="-") TMP=$P(HLHDR(1),"^",2)
143 .Q:(TMP="")
144 .;Error building header
145 .S HLERROR="4^Unable to build batch header => "_TMP
146 .D STATUS^HLTF0(HLMTIENS,4,0,$P(HLERROR,"^",2))
147 ;Create entry for 'incoming' message
148 D CREATE^HLTF(.MSGID,.HLMSGPTR,.MSGDT,.MSGDTH)
149 ;Move header and rest of message into 'incoming' message
150 I (HDR2BLD="M") D
151 .;Use MSH as header
152 .D MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"HLHDR")
153 I (HDR2BLD'="M") D
154 .;Use BHS or FHS as header
155 .D MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"BHSHDR")
156 ;Set status of outgoing message to AWAITING ACKNOWLEDGEMENT
157 D STATUS^HLTF0(HLMTIENS,$S($P(^HL(772,HLMTIEN,0),U,7):3,1:2))
158 ;Set status of 'incoming' message to AWAITING PROCESSING
159 D STATUS^HLTF0(HLMSGPTR,9)
160 Q
161SENDACK(HLMTIENA,HLEID,HLEIDS,HLRESULT) ;Send an HL7 acknowledgement/response
162 ;HLMTIENA=The IEN of the parent acknowledgment/response message in
163 ; file # 772
164 ;HLEIDS=The IEN of the Subscribing protocol in file # 101
165 ;HLEID=The IEN of the Event Driver protocol in file #101
166 ;HLRESULT=Variable for any error text (pass by reference)
167 ;
168 N HLERROR,HLOGLINK,HLCLIENT,HLMTIENS,HLMSGPTR,HLCLNODE
169 I $G(HLMTIENA)=""!($G(HLEID)="")!($G(HLEIDS)="") S HLERROR="0^7^"_$G(^HL(771.7,7,0))_"at SENDACK^HLCS entry point" G EXIT2
170 S HLCLNODE=$G(^ORD(101,HLEID,770))
171 ;Get pointers to Logical Link & receiving application
172 S HLOGLINK=$P($G(^ORD(101,HLEIDS,770)),U,7)
173 ;Application needed to dynamically address the ACK (tcp/ip)
174 ;(set HLL("LINKS") array before calling GENACK)
175 I $D(HLL("LINKS")) D Q:'HLOGLINK
176 .S HLOGLINK=$P(HLL("LINKS",1),"^",2) Q:HLOGLINK=""
177 .K HLL("LINKS")
178 .I +HLOGLINK'=HLOGLINK S HLOGLINK=$O(^HLCS(870,"B",HLOGLINK,0))
179 S HLCLIENT=$P(HLCLNODE,U,1)
180 Q:('HLCLIENT)
181 ;Determine if receiving application is internal or external
182 ; Logical link has a value for external applications
183 ; Logical link is NULL for internal applications
184 I (HLOGLINK) D COTSACK Q
185 ;Create 'incoming' message based on 'outgoing' message (internal)
186 D DHCP(HLMTIENA,HLEID,HLCLIENT)
187 ;Process the 'incoming' message
188 I (HLMSGPTR) D
189 .S HLERROR=""
190 .D PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
191 ;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
192 ; or ERROR DURING TRANSMISSION
193 D STATUS^HLTF0(HLMSGPTR,$S(HLERROR:4,1:3),$S(HLERROR:+HLERROR,1:""),$S(HLERROR:$P(HLERROR,"^",2),1:""))
194EXIT2 ;
195 S HLRESULT=$G(HLERROR)
196 Q
197COTSACK ;Internal to external communication of acknowledgements/responses
198 ;Create child entry in Message Text file
199 D SEND^HLMA2(HLEID,HLMTIENA,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
200 ;'Pass' message to background filer by setting status of child
201 ; to PENDING TRANSMISSION
202 D STATUS^HLTF0(HLMTIENS,1)
203 Q
Note: See TracBrowser for help on using the repository browser.