- HLOAPP ;ALB/CJM-HL7 -Application Registry ;02/23/2012
- ;;1.6;HEALTH LEVEL SEVEN;**126,132,137,139,158**;Oct 13, 1995;Build 14
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- GETIEN(NAME) ;given the application name, it finds the ien. Returns 0 on failure
- Q:'$L($G(NAME)) 0
- Q +$O(^HLD(779.2,"C",$E(NAME,1,60),0))
- ;
- 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.
- ;
- ;** do not implement the Pass Immediate parameter **
- ;ACTION(HEADER,ACTION,QUEUE,IMMEDIATE);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.
- ;
- ;Input:
- ; HEADER() subscripts are used: "RECEIVING APPLICATION","SEGMENT TYPE", "MESSAGE TYPE", "EVENT", "VERSION"
- ;Output:
- ; Function returns 1 on success, 0 on failure
- ; ACTION (pass by reference) <tag>^<rtn>
- ; QUEUE (pass by reference) returns the named queue if there is one, else "DEFAULT"
- ;
- ;** do not implement the Pass Immediate parameter **
- ; IMMEDIATE (pass by reference, optional) returns 1 if the application wants its messages passed to the incoming queue immediately, 0 otherwise
- ;
- N IEN
- S (ACTION,QUEUE)=""
- S IEN=$$GETIEN(HEADER("RECEIVING APPLICATION"))
- Q:'$G(IEN) 0
- I $G(HEADER("SEGMENT TYPE"))="BHS" D
- .S NODE=$G(^HLD(779.2,IEN,0))
- .I $P(NODE,"^",5)]"" D
- ..S ACTION=$P(NODE,"^",4,5)
- .E I $P(NODE,"^",7)]"" S ACTION=$P(NODE,"^",6,7)
- .I $P(NODE,"^",8)]"" D
- ..S QUEUE=$P(NODE,"^",8)
- .E I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3)
- E I HEADER("SEGMENT TYPE")="MSH" D
- .I HEADER("MESSAGE TYPE")'="",HEADER("EVENT")'="" D
- ..N SUBIEN,NODE
- ..;did the application specify an action for the particular version of this message?
- ..I HEADER("VERSION")'="" S SUBIEN=$O(^HLD(779.2,IEN,1,"D",HEADER("MESSAGE TYPE"),HEADER("EVENT"),HEADER("VERSION"),0))
- ..;if not, look on the "C" index
- ..S:'$G(SUBIEN) SUBIEN=$O(^HLD(779.2,IEN,1,"C",HEADER("MESSAGE TYPE"),HEADER("EVENT"),0))
- ..;
- ..I SUBIEN D
- ...S NODE=$G(^HLD(779.2,IEN,1,SUBIEN,0))
- ...I $P(NODE,"^",5)]"" S ACTION=$P(NODE,"^",4,5)
- ...I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3)
- ...;
- ...;** do not implement the Pass ImMediate parameter **
- ...;S IMMEDIATE=$P(NODE,"^",8)
- ...;
- ..I ACTION="" S NODE=$G(^HLD(779.2,IEN,0)) I $P(NODE,"^",7)]"" S ACTION=$P(NODE,"^",6,7)
- ..I QUEUE="" S NODE=$G(^HLD(779.2,IEN,0)) I $P(NODE,"^",3)]"" S QUEUE=$P(NODE,"^",3)
- I QUEUE="" S QUEUE="DEFAULT"
- ;
- ;** do not implement the Pass Immediate parameter **
- ;I $G(IMMEDIATE)'=1 S IMMEDIATE=0
- ;
- I ACTION="" Q 0
- Q 1
- ;
- RTRNLNK(APPNAME) ;
- ;given the name of a receiving application, this returns the return
- ;link for application acks if one is provided. Otherwise, return
- ;acks are routed based on the information provide in the message hdr
- ;
- Q:(APPNAME="") ""
- N IEN
- S IEN=$$GETIEN(APPNAME)
- Q:IEN $P($G(^HLD(779.2,IEN,0)),"^",2)
- Q ""
- ;
- RTRNPORT(APPNAME) ;
- ;Given the name of the sending application, IF the application has its
- ;own listener, its port # is returned. Application acks should be
- ;returned using that port
- Q:(APPNAME="") ""
- N IEN,LINK
- S IEN=$$GETIEN(APPNAME)
- Q:'IEN ""
- S LINK=$P($G(^HLD(779.2,IEN,0)),"^",9)
- Q:'LINK ""
- Q $$PORT^HLOTLNK(LINK)
- ;
- ACTIVE(APP,MSGTYPE,EVENT,VERSION) ;
- ;Returns 1 if the message's INACTIVE flag has NOT been set.
- ;
- ;Input:
- ; APP (required) the name of the sending application
- ; MSGTYPE (required) 3 character HL7 message type
- ; EVENT (required) 3 character HL7 event
- ; VERSION (optional) HL7 version ID as it appears in the message header
- ;Output:
- ; Function returns 1 if the message type specified by the input parameters has not been set to INACTIVE. It returns 0 otherwise.
- ;
- N IEN,ACTIVE,SUBIEN
- S ACTIVE=1
- S IEN=$$GETIEN($G(APP))
- Q:'$G(IEN) ACTIVE
- Q:$G(MSGTYPE)="" ACTIVE
- Q:$G(EVENT)="" ACTIVE
- ;did the application specify an action for the particular version of this message?
- I $G(VERSION)'="" S SUBIEN=$O(^HLD(779.2,IEN,1,"D",MSGTYPE,EVENT,VERSION,0))
- ;if not, look on the "C" index
- S:'$G(SUBIEN) SUBIEN=$O(^HLD(779.2,IEN,1,"C",MSGTYPE,EVENT,0))
- ;
- S:SUBIEN ACTIVE='(+$P($G(^HLD(779.2,IEN,1,SUBIEN,0)),"^",7))
- Q ACTIVE
- ;
- EXCEPT(APPNAME) ;
- ;returns the exception handler (tag^routine) that should be invoked
- ;when an applicaiton's messages are being sequenced and an app ack
- ;is not timely received
- ;
- N IEN,RTN
- S IEN=$$GETIEN($G(APPNAME))
- I IEN S RTN=$P($G(^HLD(779.2,IEN,0)),"^",10,11)
- I $L($G(RTN))>1 Q RTN
- Q "DEFAULT^HLOAPP"
- ;
- DEFAULT ;default exception handler if the app doesn't specify one
- S ^TMP("HLO SEQUENCING EXCEPTION",$J,$$NOW^XLFDT,+$G(HLMSGIEN))=""
- Q
- ;
- TIMEOUT(APPNAME) ;
- N IEN,TIME
- S IEN=$$GETIEN($G(APPNAME))
- I IEN S TIME=$P($G(^HLD(779.2,IEN,0)),"^",12)
- Q:'$G(TIME) 10
- Q TIME
- ;
- RTNTN(APP,MSGTYPE,EVENT,VERSION) ;
- ;Returns the retention time for this message, if specified.
- ;
- ;Input:
- ; APP (required) the name of the sending application
- ; MSGTYPE (required) 3 character HL7 message type
- ; EVENT (required) 3 character HL7 event
- ; VERSION (optional) HL7 version ID as it appears in the message header
- ;Output:
- ; Function returns retention time if spcified, 0 otherwise
- ;
- N IEN,RET,SUBIEN
- S RET=0
- S IEN=$$GETIEN($G(APP))
- Q:'$G(IEN) RET
- I $L($G(MSGTYPE)),$L($G(EVENT)) D
- .;did the application specify an action for the particular version of this message?
- .I $G(VERSION)'="" S SUBIEN=$O(^HLD(779.2,IEN,1,"D",MSGTYPE,EVENT,VERSION,0)) I SUBIEN S RET=$P($G(^HLD(779.2,IEN,1,SUBIEN,0)),"^",8)
- .;if not, look on the "C" index
- .S:'RET SUBIEN=$O(^HLD(779.2,IEN,1,"C",MSGTYPE,EVENT,0)) I SUBIEN S RET=$P($G(^HLD(779.2,IEN,1,SUBIEN,0)),"^",8)
- ;
- S:'RET RET=+$P($G(^HLD(779.2,IEN,0)),"^",13)
- Q RET
- ;
- ;
- ;
- ;
- ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOAPP 6003 printed Feb 18, 2025@23:24:56 Page 2
- HLOAPP ;ALB/CJM-HL7 -Application Registry ;02/23/2012
- +1 ;;1.6;HEALTH LEVEL SEVEN;**126,132,137,139,158**;Oct 13, 1995;Build 14
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- GETIEN(NAME) ;given the application name, it finds the ien. Returns 0 on failure
- +1 if '$LENGTH($GET(NAME))
- QUIT 0
- +2 QUIT +$ORDER(^HLD(779.2,"C",$EXTRACT(NAME,1,60),0))
- +3 ;
- 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.
- +1 ;
- +2 ;** do not implement the Pass Immediate parameter **
- +3 ;ACTION(HEADER,ACTION,QUEUE,IMMEDIATE);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.
- +4 ;
- +5 ;Input:
- +6 ; HEADER() subscripts are used: "RECEIVING APPLICATION","SEGMENT TYPE", "MESSAGE TYPE", "EVENT", "VERSION"
- +7 ;Output:
- +8 ; Function returns 1 on success, 0 on failure
- +9 ; ACTION (pass by reference) <tag>^<rtn>
- +10 ; QUEUE (pass by reference) returns the named queue if there is one, else "DEFAULT"
- +11 ;
- +12 ;** do not implement the Pass Immediate parameter **
- +13 ; IMMEDIATE (pass by reference, optional) returns 1 if the application wants its messages passed to the incoming queue immediately, 0 otherwise
- +14 ;
- +15 NEW IEN
- +16 SET (ACTION,QUEUE)=""
- +17 SET IEN=$$GETIEN(HEADER("RECEIVING APPLICATION"))
- +18 if '$GET(IEN)
- QUIT 0
- +19 IF $GET(HEADER("SEGMENT TYPE"))="BHS"
- Begin DoDot:1
- +20 SET NODE=$GET(^HLD(779.2,IEN,0))
- +21 IF $PIECE(NODE,"^",5)]""
- Begin DoDot:2
- +22 SET ACTION=$PIECE(NODE,"^",4,5)
- End DoDot:2
- +23 IF '$TEST
- IF $PIECE(NODE,"^",7)]""
- SET ACTION=$PIECE(NODE,"^",6,7)
- +24 IF $PIECE(NODE,"^",8)]""
- Begin DoDot:2
- +25 SET QUEUE=$PIECE(NODE,"^",8)
- End DoDot:2
- +26 IF '$TEST
- IF $PIECE(NODE,"^",3)]""
- SET QUEUE=$PIECE(NODE,"^",3)
- End DoDot:1
- +27 IF '$TEST
- IF HEADER("SEGMENT TYPE")="MSH"
- Begin DoDot:1
- +28 IF HEADER("MESSAGE TYPE")'=""
- IF HEADER("EVENT")'=""
- Begin DoDot:2
- +29 NEW SUBIEN,NODE
- +30 ;did the application specify an action for the particular version of this message?
- +31 IF HEADER("VERSION")'=""
- SET SUBIEN=$ORDER(^HLD(779.2,IEN,1,"D",HEADER("MESSAGE TYPE"),HEADER("EVENT"),HEADER("VERSION"),0))
- +32 ;if not, look on the "C" index
- +33 if '$GET(SUBIEN)
- SET SUBIEN=$ORDER(^HLD(779.2,IEN,1,"C",HEADER("MESSAGE TYPE"),HEADER("EVENT"),0))
- +34 ;
- +35 IF SUBIEN
- Begin DoDot:3
- +36 SET NODE=$GET(^HLD(779.2,IEN,1,SUBIEN,0))
- +37 IF $PIECE(NODE,"^",5)]""
- SET ACTION=$PIECE(NODE,"^",4,5)
- +38 IF $PIECE(NODE,"^",3)]""
- SET QUEUE=$PIECE(NODE,"^",3)
- +39 ;
- +40 ;** do not implement the Pass ImMediate parameter **
- +41 ;S IMMEDIATE=$P(NODE,"^",8)
- +42 ;
- End DoDot:3
- +43 IF ACTION=""
- SET NODE=$GET(^HLD(779.2,IEN,0))
- IF $PIECE(NODE,"^",7)]""
- SET ACTION=$PIECE(NODE,"^",6,7)
- +44 IF QUEUE=""
- SET NODE=$GET(^HLD(779.2,IEN,0))
- IF $PIECE(NODE,"^",3)]""
- SET QUEUE=$PIECE(NODE,"^",3)
- End DoDot:2
- End DoDot:1
- +45 IF QUEUE=""
- SET QUEUE="DEFAULT"
- +46 ;
- +47 ;** do not implement the Pass Immediate parameter **
- +48 ;I $G(IMMEDIATE)'=1 S IMMEDIATE=0
- +49 ;
- +50 IF ACTION=""
- QUIT 0
- +51 QUIT 1
- +52 ;
- RTRNLNK(APPNAME) ;
- +1 ;given the name of a receiving application, this returns the return
- +2 ;link for application acks if one is provided. Otherwise, return
- +3 ;acks are routed based on the information provide in the message hdr
- +4 ;
- +5 if (APPNAME="")
- QUIT ""
- +6 NEW IEN
- +7 SET IEN=$$GETIEN(APPNAME)
- +8 if IEN
- QUIT $PIECE($GET(^HLD(779.2,IEN,0)),"^",2)
- +9 QUIT ""
- +10 ;
- RTRNPORT(APPNAME) ;
- +1 ;Given the name of the sending application, IF the application has its
- +2 ;own listener, its port # is returned. Application acks should be
- +3 ;returned using that port
- +4 if (APPNAME="")
- QUIT ""
- +5 NEW IEN,LINK
- +6 SET IEN=$$GETIEN(APPNAME)
- +7 if 'IEN
- QUIT ""
- +8 SET LINK=$PIECE($GET(^HLD(779.2,IEN,0)),"^",9)
- +9 if 'LINK
- QUIT ""
- +10 QUIT $$PORT^HLOTLNK(LINK)
- +11 ;
- ACTIVE(APP,MSGTYPE,EVENT,VERSION) ;
- +1 ;Returns 1 if the message's INACTIVE flag has NOT been set.
- +2 ;
- +3 ;Input:
- +4 ; APP (required) the name of the sending application
- +5 ; MSGTYPE (required) 3 character HL7 message type
- +6 ; EVENT (required) 3 character HL7 event
- +7 ; VERSION (optional) HL7 version ID as it appears in the message header
- +8 ;Output:
- +9 ; Function returns 1 if the message type specified by the input parameters has not been set to INACTIVE. It returns 0 otherwise.
- +10 ;
- +11 NEW IEN,ACTIVE,SUBIEN
- +12 SET ACTIVE=1
- +13 SET IEN=$$GETIEN($GET(APP))
- +14 if '$GET(IEN)
- QUIT ACTIVE
- +15 if $GET(MSGTYPE)=""
- QUIT ACTIVE
- +16 if $GET(EVENT)=""
- QUIT ACTIVE
- +17 ;did the application specify an action for the particular version of this message?
- +18 IF $GET(VERSION)'=""
- SET SUBIEN=$ORDER(^HLD(779.2,IEN,1,"D",MSGTYPE,EVENT,VERSION,0))
- +19 ;if not, look on the "C" index
- +20 if '$GET(SUBIEN)
- SET SUBIEN=$ORDER(^HLD(779.2,IEN,1,"C",MSGTYPE,EVENT,0))
- +21 ;
- +22 if SUBIEN
- SET ACTIVE='(+$PIECE($GET(^HLD(779.2,IEN,1,SUBIEN,0)),"^",7))
- +23 QUIT ACTIVE
- +24 ;
- EXCEPT(APPNAME) ;
- +1 ;returns the exception handler (tag^routine) that should be invoked
- +2 ;when an applicaiton's messages are being sequenced and an app ack
- +3 ;is not timely received
- +4 ;
- +5 NEW IEN,RTN
- +6 SET IEN=$$GETIEN($GET(APPNAME))
- +7 IF IEN
- SET RTN=$PIECE($GET(^HLD(779.2,IEN,0)),"^",10,11)
- +8 IF $LENGTH($GET(RTN))>1
- QUIT RTN
- +9 QUIT "DEFAULT^HLOAPP"
- +10 ;
- DEFAULT ;default exception handler if the app doesn't specify one
- +1 SET ^TMP("HLO SEQUENCING EXCEPTION",$JOB,$$NOW^XLFDT,+$GET(HLMSGIEN))=""
- +2 QUIT
- +3 ;
- TIMEOUT(APPNAME) ;
- +1 NEW IEN,TIME
- +2 SET IEN=$$GETIEN($GET(APPNAME))
- +3 IF IEN
- SET TIME=$PIECE($GET(^HLD(779.2,IEN,0)),"^",12)
- +4 if '$GET(TIME)
- QUIT 10
- +5 QUIT TIME
- +6 ;
- RTNTN(APP,MSGTYPE,EVENT,VERSION) ;
- +1 ;Returns the retention time for this message, if specified.
- +2 ;
- +3 ;Input:
- +4 ; APP (required) the name of the sending application
- +5 ; MSGTYPE (required) 3 character HL7 message type
- +6 ; EVENT (required) 3 character HL7 event
- +7 ; VERSION (optional) HL7 version ID as it appears in the message header
- +8 ;Output:
- +9 ; Function returns retention time if spcified, 0 otherwise
- +10 ;
- +11 NEW IEN,RET,SUBIEN
- +12 SET RET=0
- +13 SET IEN=$$GETIEN($GET(APP))
- +14 if '$GET(IEN)
- QUIT RET
- +15 IF $LENGTH($GET(MSGTYPE))
- IF $LENGTH($GET(EVENT))
- Begin DoDot:1
- +16 ;did the application specify an action for the particular version of this message?
- +17 IF $GET(VERSION)'=""
- SET SUBIEN=$ORDER(^HLD(779.2,IEN,1,"D",MSGTYPE,EVENT,VERSION,0))
- IF SUBIEN
- SET RET=$PIECE($GET(^HLD(779.2,IEN,1,SUBIEN,0)),"^",8)
- +18 ;if not, look on the "C" index
- +19 if 'RET
- SET SUBIEN=$ORDER(^HLD(779.2,IEN,1,"C",MSGTYPE,EVENT,0))
- IF SUBIEN
- SET RET=$PIECE($GET(^HLD(779.2,IEN,1,SUBIEN,0)),"^",8)
- End DoDot:1
- +20 ;
- +21 if 'RET
- SET RET=+$PIECE($GET(^HLD(779.2,IEN,0)),"^",13)
- +22 QUIT RET
- +23 ;
- +24 ;
- +25 ;
- +26 ;
- +27 ;
- +28 ;