HLOAPP ;ALB/CJM-HL7 -Application Registry ;02/04/2004
;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
;
GETIEN(NAME) ;given the application name, it finds the ien. Returns 0 on failure
Q:'$L($G(NAME)) 0
N IEN,SUB
S SUB=$E(NAME,1,60)
S IEN=0
F S IEN=$O(^HLD(779.2,"B",SUB,IEN)) Q:'IEN Q:$P($G(^HLD(779.2,IEN,0)),"^")=NAME
Q +IEN
;
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.
;
;Input:
; HEADER() subscripts are used: "RECEIVING APPLICATION","SEGMENT TYPE", "MESSAGE TYPE", "EVENT"
;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"
;
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
..S 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)
..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"
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)
HLOAPP ;ALB/CJM-HL7 -Application Registry ;02/04/2004
+1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
+2 ;
GETIEN(NAME) ;given the application name, it finds the ien. Returns 0 on failure
+1 IF '$LENGTH($GET(NAME))
QUIT 0
+2 NEW IEN,SUB
+3 SET SUB=$EXTRACT(NAME,1,60)
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^HLD(779.2,"B",SUB,IEN))
IF 'IEN
QUIT
IF $PIECE($GET(^HLD(779.2,IEN,0)),"^")=NAME
QUIT
+6 QUIT +IEN
+7 ;
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 ;Input:
+3 ; HEADER() subscripts are used: "RECEIVING APPLICATION","SEGMENT TYPE", "MESSAGE TYPE", "EVENT"
+4 ;Output:
+5 ; Function returns 1 on success, 0 on failure
+6 ; ACTION (pass by reference) <tag>^<rtn>
+7 ; QUEUE (pass by reference) returns the named queue if there is one, else "DEFAULT"
+8 ;
+9 NEW IEN
+10 SET (ACTION,QUEUE)=""
+11 SET IEN=$$GETIEN(HEADER("RECEIVING APPLICATION"))
+12 IF '$GET(IEN)
QUIT 0
+13 IF $GET(HEADER("SEGMENT TYPE"))="BHS"
Begin DoDot:1
+14 SET NODE=$GET(^HLD(779.2,IEN,0))
+15 IF $PIECE(NODE,"^",5)]""
Begin DoDot:2
+16 SET ACTION=$PIECE(NODE,"^",4,5)
End DoDot:2
+17 IF '$TEST
IF $PIECE(NODE,"^",7)]""
SET ACTION=$PIECE(NODE,"^",6,7)
+18 IF $PIECE(NODE,"^",8)]""
Begin DoDot:2
+19 SET QUEUE=$PIECE(NODE,"^",8)
End DoDot:2
+20 IF '$TEST
IF $PIECE(NODE,"^",3)]""
SET QUEUE=$PIECE(NODE,"^",3)
End DoDot:1
+21 IF '$TEST
IF HEADER("SEGMENT TYPE")="MSH"
Begin DoDot:1
+22 IF HEADER("MESSAGE TYPE")'=""
IF HEADER("EVENT")'=""
Begin DoDot:2
+23 NEW SUBIEN,NODE
+24 SET SUBIEN=$ORDER(^HLD(779.2,IEN,1,"C",HEADER("MESSAGE TYPE"),HEADER("EVENT"),0))
+25 IF SUBIEN
Begin DoDot:3
+26 SET NODE=$GET(^HLD(779.2,IEN,1,SUBIEN,0))
+27 IF $PIECE(NODE,"^",5)]""
SET ACTION=$PIECE(NODE,"^",4,5)
+28 IF $PIECE(NODE,"^",3)]""
SET QUEUE=$PIECE(NODE,"^",3)
End DoDot:3
+29 IF ACTION=""
SET NODE=$GET(^HLD(779.2,IEN,0))
IF $PIECE(NODE,"^",7)]""
SET ACTION=$PIECE(NODE,"^",6,7)
+30 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
+31 IF QUEUE=""
SET QUEUE="DEFAULT"
+32 IF ACTION=""
QUIT 0
+33 QUIT 1
+34 ;
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)
