source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOAPP.m@ 619

HLOAPP  ;ALB/CJM-HL7 -Application Registry ;07/09/2007
        ;;1.6;HEALTH LEVEL SEVEN;**126,132,137**;Oct 13, 1995;Build 21
        ;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.
        ;
        ;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"
        ;
        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)
        ..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)
        ;
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