Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCS.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCS.m
r613 r623 1 HLCS ;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 ; 27 SEND(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** 89 EXIT S HLRESULT=HLERROR 90 Q 91 COTS ;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 100 DHCP(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 161 SENDACK(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:"")) 194 EXIT2 ; 195 S HLRESULT=$G(HLERROR) 196 Q 197 COTSACK ;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 1 HLCS ;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 ; 27 SEND(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** 80 EXIT S HLRESULT=HLERROR 81 Q 82 COTS ;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 91 DHCP(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 152 SENDACK(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:"")) 185 EXIT2 ; 186 S HLRESULT=$G(HLERROR) 187 Q 188 COTSACK ;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 TracChangeset
for help on using the changeset viewer.
