- 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)
