source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCS.m@ 701

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

revised back to 6/30/08 version

File size: 7.8 KB
Line 
1HLCS ;ALB/RJS,MTC,JRP - COMMUNICATIONS SERVER - ;10/31/2006
2 ;;1.6;HEALTH LEVEL SEVEN;**2,9,14,19,43,57,109,132**;Oct 13, 1995;Build 6
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 .F S I=$O(HLP("EXCLUDE SUBSCRIBER",I)) Q:'I I $G(HLP("EXCLUDE SUBSCRIBER",I))=HLEIDS S EXCLUDE=1 Q
51 .Q:EXCLUDE
52 .;** 132 end **
53 .;
54 .;Get pointer to receiving application
55 .S HLCLIENT=+HLARY(HLEIDS),HL("EIDS")=HLEIDS,HLERROR=""
56 .Q:(HLCLIENT'>0)
57 .;Check and execute ROUTING LOGIC **CIRN**
58 .S HLX=$G(^ORD(101,HLEIDS,774))
59 .I HLX]"" D Q
60 ..N HLQUIT,HLNODE,HLNEXT
61 ..S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
62 ..X HLX I $D(HLL("LINKS")) D FWD^HLCS2 K HLL ;**CIRN**
63 .;Get pointer to logical link
64 .S HLOGLINK=$P(HLARY(HLEIDS),"^",2)
65 .;Determine if receiving application is internal or external
66 .; Logical link has a value for external applications
67 .; Logical link is NULL for internal applications
68 .I (HLOGLINK) D COTS Q
69 .;Create 'incoming' message based on 'outgoing' message (internal)
70 .D DHCP(HLMTIEN,HLEIDS,HLCLIENT)
71 .Q:(HLERROR)
72 .;Process the 'incoming' message
73 .S HLERROR=""
74 .D PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
75 .;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
76 .; or ERROR DURING TRANSMISSION
77 .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))
78 .I $D(HLL("LINKS")) D FWD^HLCS2 K HLL ;**CIRN**
79 D ADD^HLCS2 ;**CIRN**
80EXIT S HLRESULT=HLERROR
81 Q
82COTS ;Internal to external communication
83 ;Create child entry in Message Text file
84 N HLTCP,HLTCPI,HLTCPO
85 D SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
86 I ((+HLMTIENS)'>0) S HLERROR=HLMTIENS Q
87 ;'Pass' message to background filer by setting status of child
88 ; to PENDING TRANSMISSION
89 D STATUS^HLTF0(HLMTIENS,1)
90 Q
91DHCP(HLMTIEN,HLEIDS,HLCLIENT) ;Internal to internal communication
92 ;
93 ;Input : HLMTIEN - Pointer to parent outgoing message (file #772)
94 ; HLEIDS - Pointer to subscribing protocol (file #101)
95 ; HLCLIENT - Pointer to receiving application (file # 771)
96 ;
97 ;Output : HLMTIENS - Pointer to child outgoing message (file #772)
98 ; HLMSGPTR - Pointer to [parent] incoming message (file #772)
99 ; HLERROR - ErrorCode ^ ErrorText
100 ;
101 ;Notes : This module only copies the outgoing message into an incoming
102 ; message. Delivery of the message (i.e. processing of it)
103 ; must be done by the calling application.
104 ; : Message/batch header (MSH/BSH) is built and placed in the
105 ; incoming message
106 ; : HLMTIENS, HLMSGPTR, and HLERROR will be initialized
107 ; : Existance and validity of input is assumed
108 ;
109 ;Declare variables
110 N MSGID,MSGDT,MSGDTH,HDR2BLD,TMP,HLHDR,BHSHDR
111 S HLERROR=""
112 S HLMTIENS=0
113 S HLMSGPTR=0
114 ;Create child entry in Message Text file
115 D SEND^HLMA2(HLEIDS,HLMTIEN,HLCLIENT,"D",.HLMTIENS)
116 I ((+HLMTIENS)'>0) S HLERROR=HLMTIENS Q
117 ;'Receive' message by making an incoming message
118 ;Determine type of header to build
119 S TMP=$G(^HL(772,HLMTIEN,0))
120 S HDR2BLD=$P(TMP,"^",14)
121 ;Build message header (MSH)
122 I (HDR2BLD="M") D Q:(HLERROR)
123 .S TMP=""
124 .D HEADER^HLCSHDR(HLMTIENS,.TMP)
125 .Q:(TMP="")
126 .;Error building header
127 .S HLERROR="4^Unable to build message header => "_TMP
128 .D STATUS^HLTF0(HLMTIENS,4,0,$P(HLERROR,"^",2))
129 ;Build batch header (BHS or FHS)
130 I (HDR2BLD'="M") D Q:(HLERROR)
131 .S TMP=""
132 .D BHSHDR^HLCSHDR(HLMTIENS)
133 .S:($E(HLHDR(1),1)="-") TMP=$P(HLHDR(1),"^",2)
134 .Q:(TMP="")
135 .;Error building header
136 .S HLERROR="4^Unable to build batch header => "_TMP
137 .D STATUS^HLTF0(HLMTIENS,4,0,$P(HLERROR,"^",2))
138 ;Create entry for 'incoming' message
139 D CREATE^HLTF(.MSGID,.HLMSGPTR,.MSGDT,.MSGDTH)
140 ;Move header and rest of message into 'incoming' message
141 I (HDR2BLD="M") D
142 .;Use MSH as header
143 .D MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"HLHDR")
144 I (HDR2BLD'="M") D
145 .;Use BHS or FHS as header
146 .D MRGINT^HLTF1(HLMTIEN,HLMSGPTR,"BHSHDR")
147 ;Set status of outgoing message to AWAITING ACKNOWLEDGEMENT
148 D STATUS^HLTF0(HLMTIENS,$S($P(^HL(772,HLMTIEN,0),U,7):3,1:2))
149 ;Set status of 'incoming' message to AWAITING PROCESSING
150 D STATUS^HLTF0(HLMSGPTR,9)
151 Q
152SENDACK(HLMTIENA,HLEID,HLEIDS,HLRESULT) ;Send an HL7 acknowledgement/response
153 ;HLMTIENA=The IEN of the parent acknowledgment/response message in
154 ; file # 772
155 ;HLEIDS=The IEN of the Subscribing protocol in file # 101
156 ;HLEID=The IEN of the Event Driver protocol in file #101
157 ;HLRESULT=Variable for any error text (pass by reference)
158 ;
159 N HLERROR,HLOGLINK,HLCLIENT,HLMTIENS,HLMSGPTR,HLCLNODE
160 I $G(HLMTIENA)=""!($G(HLEID)="")!($G(HLEIDS)="") S HLERROR="0^7^"_$G(^HL(771.7,7,0))_"at SENDACK^HLCS entry point" G EXIT2
161 S HLCLNODE=$G(^ORD(101,HLEID,770))
162 ;Get pointers to Logical Link & receiving application
163 S HLOGLINK=$P($G(^ORD(101,HLEIDS,770)),U,7)
164 ;Application needed to dynamically address the ACK (tcp/ip)
165 ;(set HLL("LINKS") array before calling GENACK)
166 I $D(HLL("LINKS")) D Q:'HLOGLINK
167 .S HLOGLINK=$P(HLL("LINKS",1),"^",2) Q:HLOGLINK=""
168 .K HLL("LINKS")
169 .I +HLOGLINK'=HLOGLINK S HLOGLINK=$O(^HLCS(870,"B",HLOGLINK,0))
170 S HLCLIENT=$P(HLCLNODE,U,1)
171 Q:('HLCLIENT)
172 ;Determine if receiving application is internal or external
173 ; Logical link has a value for external applications
174 ; Logical link is NULL for internal applications
175 I (HLOGLINK) D COTSACK Q
176 ;Create 'incoming' message based on 'outgoing' message (internal)
177 D DHCP(HLMTIENA,HLEID,HLCLIENT)
178 ;Process the 'incoming' message
179 I (HLMSGPTR) D
180 .S HLERROR=""
181 .D PROCESS^HLTP0(HLMSGPTR,"DHCP","",.HLERROR)
182 ;Update Status of 'incoming' message to SUCCESSFULLY COMPLETED
183 ; or ERROR DURING TRANSMISSION
184 D STATUS^HLTF0(HLMSGPTR,$S(HLERROR:4,1:3),$S(HLERROR:+HLERROR,1:""),$S(HLERROR:$P(HLERROR,"^",2),1:""))
185EXIT2 ;
186 S HLRESULT=$G(HLERROR)
187 Q
188COTSACK ;Internal to external communication of acknowledgements/responses
189 ;Create child entry in Message Text file
190 D SEND^HLMA2(HLEID,HLMTIENA,HLCLIENT,"D",.HLMTIENS,HLOGLINK)
191 ;'Pass' message to background filer by setting status of child
192 ; to PENDING TRANSMISSION
193 D STATUS^HLTF0(HLMTIENS,1)
194 Q
Note: See TracBrowser for help on using the repository browser.