Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOAPP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOAPP.m
r613 r623 1 HLOAPP ;ALB/CJM-HL7 -Application Registry ;07/09/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,132,137**;Oct 13, 1995;Build 21 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 GETIEN(NAME) ;given the application name, it finds the ien. Returns 0 on failure 6 Q:'$L($G(NAME)) 0 7 Q +$O(^HLD(779.2,"C",$E(NAME,1,60),0)) 8 ; 9 ACTION(HEADER,ACTION,QUEUE) ;Given the parsed header of a message it returns both the action that should be performed in response to the message and the incoming queue that it should be placed on. 10 ; 11 ;Input: 12 ; HEADER() subscripts are used: "RECEIVING APPLICATION","SEGMENT TYPE", "MESSAGE TYPE", "EVENT", "VERSION" 13 ;Output: 14 ; Function returns 1 on success, 0 on failure 15 ; ACTION (pass by reference) <tag>^<rtn> 16 ; QUEUE (pass by reference) returns the named queue if there is one, else "DEFAULT" 17 ; 18 N IEN 19 S (ACTION,QUEUE)="" 20 S IEN=$$GETIEN(HEADER("RECEIVING APPLICATION")) 21 Q:'$G(IEN) 0 22 I $G(HEADER("SEGMENT TYPE"))="BHS" D 23 .S NODE=$G(^HLD(779.2,IEN,0)) 24 .I $P(NODE,"^",5)]"" D 25 ..S ACTION=$P(NODE,"^",4,5) 26 .E I $P(NODE,"^",7)]"" S ACTION=$P(NODE,"^",6,7) 27 .I $P(NODE,"^",8)]"" D 28 ..S QUEUE=$P(NODE,"^",8) 29 .E I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3) 30 E I HEADER("SEGMENT TYPE")="MSH" D 31 .I HEADER("MESSAGE TYPE")'="",HEADER("EVENT")'="" D 32 ..N SUBIEN,NODE 33 ..;did the application specify an action for the particular version of this message? 34 ..I HEADER("VERSION")'="" S SUBIEN=$O(^HLD(779.2,IEN,1,"D",HEADER("MESSAGE TYPE"),HEADER("EVENT"),HEADER("VERSION"),0)) 35 ..;if not, look on the "C" index 36 ..S:'$G(SUBIEN) SUBIEN=$O(^HLD(779.2,IEN,1,"C",HEADER("MESSAGE TYPE"),HEADER("EVENT"),0)) 37 ..; 38 ..I SUBIEN D 39 ...S NODE=$G(^HLD(779.2,IEN,1,SUBIEN,0)) 40 ...I $P(NODE,"^",5)]"" S ACTION=$P(NODE,"^",4,5) 41 ...I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3) 42 ..I ACTION="" S NODE=$G(^HLD(779.2,IEN,0)) I $P(NODE,"^",7)]"" S ACTION=$P(NODE,"^",6,7) 43 ..I QUEUE="" S NODE=$G(^HLD(779.2,IEN,0)) I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3) 44 I QUEUE="" S QUEUE="DEFAULT" 45 I ACTION="" Q 0 46 Q 1 47 ; 48 RTRNLNK(APPNAME) ; 49 ;given the name of a receiving application, this returns the return 50 ;link for application acks if one is provided. Otherwise, return 51 ;acks are routed based on the information provide in the message hdr 52 ; 53 Q:(APPNAME="") "" 54 N IEN 55 S IEN=$$GETIEN(APPNAME) 56 Q:IEN $P($G(^HLD(779.2,IEN,0)),"^",2) 57 Q "" 58 ; 59 RTRNPORT(APPNAME) ; 60 ;Given the name of the sending application, IF the application has its 61 ;own listener, its port # is returned. Application acks should be 62 ;returned using that port 63 Q:(APPNAME="") "" 64 N IEN,LINK 65 S IEN=$$GETIEN(APPNAME) 66 Q:'IEN "" 67 S LINK=$P($G(^HLD(779.2,IEN,0)),"^",9) 68 Q:'LINK "" 69 Q $$PORT^HLOTLNK(LINK) 70 ; 71 ACTIVE(APP,MSGTYPE,EVENT,VERSION) ; 72 ;Returns 1 if the message's INACTIVE flag has NOT been set. 73 ; 74 ;Input: 75 ; APP (required) the name of the sending application 76 ; MSGTYPE (required) 3 character HL7 message type 77 ; EVENT (required) 3 character HL7 event 78 ; VERSION (optional) HL7 version ID as it appears in the message header 79 ;Output: 80 ; Function returns 1 if the message type specified by the input parameters has not been set to INACTIVE. It returns 0 otherwise. 81 ; 82 N IEN,ACTIVE,SUBIEN 83 S ACTIVE=1 84 S IEN=$$GETIEN($G(APP)) 85 Q:'$G(IEN) ACTIVE 86 Q:$G(MSGTYPE)="" ACTIVE 87 Q:$G(EVENT)="" ACTIVE 88 ;did the application specify an action for the particular version of this message? 89 I $G(VERSION)'="" S SUBIEN=$O(^HLD(779.2,IEN,1,"D",MSGTYPE,EVENT,VERSION,0)) 90 ;if not, look on the "C" index 91 S:'$G(SUBIEN) SUBIEN=$O(^HLD(779.2,IEN,1,"C",MSGTYPE,EVENT,0)) 92 ; 93 S:SUBIEN ACTIVE='(+$P($G(^HLD(779.2,IEN,1,SUBIEN,0)),"^",7)) 94 Q ACTIVE 95 ; 96 EXCEPT(APPNAME) ; 97 ;returns the exception handler (tag^routine) that should be invoked 98 ;when an applicaiton's messages are being sequenced and an app ack 99 ;is not timely received 100 ; 101 N IEN,RTN 102 S IEN=$$GETIEN($G(APPNAME)) 103 I IEN S RTN=$P($G(^HLD(779.2,IEN,0)),"^",10,11) 104 I $L($G(RTN))>1 Q RTN 105 Q "DEFAULT^HLOAPP" 106 ; 107 DEFAULT ;default exception handler if the app doesn't specify one 108 S ^TMP("HLO SEQUENCING EXCEPTION",$J,$$NOW^XLFDT,+$G(HLMSGIEN))="" 109 Q 110 ; 111 TIMEOUT(APPNAME) ; 112 N IEN,TIME 113 S IEN=$$GETIEN($G(APPNAME)) 114 I IEN S TIME=$P($G(^HLD(779.2,IEN,0)),"^",12) 115 Q:'$G(TIME) 10 116 Q TIME 1 HLOAPP ;ALB/CJM-HL7 -Application Registry ;10/31/2006 2 ;;1.6;HEALTH LEVEL SEVEN;**126,132**;Oct 13, 1995;Build 6 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 GETIEN(NAME) ;given the application name, it finds the ien. Returns 0 on failure 6 Q:'$L($G(NAME)) 0 7 N IEN,SUB 8 S SUB=$E(NAME,1,60) 9 S IEN=0 10 F S IEN=$O(^HLD(779.2,"B",SUB,IEN)) Q:'IEN Q:$P($G(^HLD(779.2,IEN,0)),"^")=NAME 11 Q +IEN 12 ; 13 ACTION(HEADER,ACTION,QUEUE) ;Given the parsed header of a message it returns both the action that should be performed in response to the message and the incoming queue that it should be placed on. 14 ; 15 ;Input: 16 ; HEADER() subscripts are used: "RECEIVING APPLICATION","SEGMENT TYPE", "MESSAGE TYPE", "EVENT", "VERSION" 17 ;Output: 18 ; Function returns 1 on success, 0 on failure 19 ; ACTION (pass by reference) <tag>^<rtn> 20 ; QUEUE (pass by reference) returns the named queue if there is one, else "DEFAULT" 21 ; 22 N IEN 23 S (ACTION,QUEUE)="" 24 S IEN=$$GETIEN(HEADER("RECEIVING APPLICATION")) 25 Q:'$G(IEN) 0 26 I $G(HEADER("SEGMENT TYPE"))="BHS" D 27 .S NODE=$G(^HLD(779.2,IEN,0)) 28 .I $P(NODE,"^",5)]"" D 29 ..S ACTION=$P(NODE,"^",4,5) 30 .E I $P(NODE,"^",7)]"" S ACTION=$P(NODE,"^",6,7) 31 .I $P(NODE,"^",8)]"" D 32 ..S QUEUE=$P(NODE,"^",8) 33 .E I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3) 34 E I HEADER("SEGMENT TYPE")="MSH" D 35 .I HEADER("MESSAGE TYPE")'="",HEADER("EVENT")'="" D 36 ..N SUBIEN,NODE 37 ..;did the application specify an action for the particular version of this message? 38 ..I HEADER("VERSION")'="" S SUBIEN=$O(^HLD(779.2,IEN,1,"D",HEADER("MESSAGE TYPE"),HEADER("EVENT"),HEADER("VERSION"),0)) 39 ..;if not, look on the "C" index 40 ..S:'$G(SUBIEN) SUBIEN=$O(^HLD(779.2,IEN,1,"C",HEADER("MESSAGE TYPE"),HEADER("EVENT"),0)) 41 ..; 42 ..I SUBIEN D 43 ...S NODE=$G(^HLD(779.2,IEN,1,SUBIEN,0)) 44 ...I $P(NODE,"^",5)]"" S ACTION=$P(NODE,"^",4,5) 45 ...I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3) 46 ..I ACTION="" S NODE=$G(^HLD(779.2,IEN,0)) I $P(NODE,"^",7)]"" S ACTION=$P(NODE,"^",6,7) 47 ..I QUEUE="" S NODE=$G(^HLD(779.2,IEN,0)) I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3) 48 I QUEUE="" S QUEUE="DEFAULT" 49 I ACTION="" Q 0 50 Q 1 51 ; 52 RTRNLNK(APPNAME) ; 53 ;given the name of a receiving application, this returns the return 54 ;link for application acks if one is provided. Otherwise, return 55 ;acks are routed based on the information provide in the message hdr 56 ; 57 Q:(APPNAME="") "" 58 N IEN 59 S IEN=$$GETIEN(APPNAME) 60 Q:IEN $P($G(^HLD(779.2,IEN,0)),"^",2) 61 Q "" 62 ; 63 RTRNPORT(APPNAME) ; 64 ;Given the name of the sending application, IF the application has its 65 ;own listener, its port # is returned. Application acks should be 66 ;returned using that port 67 Q:(APPNAME="") "" 68 N IEN,LINK 69 S IEN=$$GETIEN(APPNAME) 70 Q:'IEN "" 71 S LINK=$P($G(^HLD(779.2,IEN,0)),"^",9) 72 Q:'LINK "" 73 Q $$PORT^HLOTLNK(LINK) 74 ; 75 ACTIVE(APP,MSGTYPE,EVENT,VERSION) ; 76 ;Returns 1 if the message's INACTIVE flag has NOT been set. 77 ; 78 ;Input: 79 ; APP (required) the name of the sending application 80 ; MSGTYPE (required) 3 character HL7 message type 81 ; EVENT (required) 3 character HL7 event 82 ; VERSION (optional) HL7 version ID as it appears in the message header 83 ;Output: 84 ; Function returns 1 if the message type specified by the input parameters has not been set to INACTIVE. It returns 0 otherwise. 85 ; 86 N IEN,ACTIVE,SUBIEN 87 S ACTIVE=1 88 S IEN=$$GETIEN($G(APP)) 89 Q:'$G(IEN) ACTIVE 90 Q:$G(MSGTYPE)="" ACTIVE 91 Q:$G(EVENT)="" ACTIVE 92 ;did the application specify an action for the particular version of this message? 93 I $G(VERSION)'="" S SUBIEN=$O(^HLD(779.2,IEN,1,"D",MSGTYPE,EVENT,VERSION,0)) 94 ;if not, look on the "C" index 95 S:'$G(SUBIEN) SUBIEN=$O(^HLD(779.2,IEN,1,"C",MSGTYPE,EVENT,0)) 96 ; 97 S:SUBIEN ACTIVE='(+$P($G(^HLD(779.2,IEN,1,SUBIEN,0)),"^",7)) 98 Q ACTIVE
Note:
See TracChangeset
for help on using the changeset viewer.
