HLOAPI1 ;;ALB/CJM-HL7 - Developer API's for sending & receiving messages(continued) ;03/12/2012
;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137,146,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
SENDONE(HLMSTATE,PARMS,WHOTO,ERROR) ;Sends the message to a single receiving application.
;;
;;Input:
;;HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message. The application MUST NOT touch it
;;PARMS( *pass by reference*
;; "APP ACK RESPONSE")=<tag^routine> to call when the app ack is received (optional)
;; (NOTE: For batch messages, HLO best supports returning application
;; acknowledgments via a batch response. However, non-VistA systems
;; may return individual messages as application acknowledgments to
;; messages within the original batch message, so for applications
;; sending batch messages might best code the "APP ACK RESPONSE"
;; routine to first check whether the response message is a batch.
;;
;; "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
;; "ACCEPT ACK TYPE") = <AL,NE> (optional, defaults to AL)
;; "APP ACK TYPE") = <AL,NE> (optional, defaults to NE)
;; "FAILURE RESPONSE" - <tag>^<routine> (optional) The sending application routine to execute when the transmission of the message fails, i.e., the message can not be sent or no commit ack is received.
;; "QUEUE" - (optional) An application can name its own private queue - just a string up to 20 characters, it should be namespaced.
;; "SECURITY")=security information to include in the header segment, SEQ 8 (optional)
;; "SEQUENCE QUEUE") (optional) sequence queue to use, up to 30 characters, shoud lbe namespaced. Requires that application acks be used.
;; "SENDING APPLICATION")=name of sending app (required, 60 maximum length)
;;
;; WHOTO (required,pass by reference) an array specifying a single recipient. These subscripts are allowed:
;;
;; "RECEIVING APPLICATION" - (string, 60 char max, required)
;;
;; EXACTLY ONE of these parameters must be provided to identify the Receiving Facility:
;;
;; "FACILITY LINK IEN" - ien of the logical link
;; "FACILITY LINK NAME" - name of the logical link
;; "INSTITUTION IEN" - ptr to the INSTITUTION file
;; "STATION NUMBER" - station # with suffix
;;
;; EXACTLY ONE of these MAY be provided - optionally - to identify the interface engine to route the message through:
;;
;; *"IE LINK IEN" (obsolete) ptr to a logical link for the interface engine
;; *"IE LINK NAME" (obsolete) name of the logical link for the interface engine
;; "MIDDLEWARE LINK IEN" - ptr to a logical link for the middleware
;; "MIDDLEWARE LINK NAME" - the name of the logical link for the middleware
;;
;;Output:
;; Function returns the ien of the message in file 778 on success, 0 on failure
;; HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message. The application MUST NOT touch it!
;; ERROR (pass by reference, optional) - on failure, will contain an error message
;; PARMS - left undefined when the function returns
;; WHOTO - left undefined when the function returns
;;
;;
N SUCCESS,ERR1,ERR2
S SUCCESS=0
D
.I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) S ERROR="MESSAGE NOT YET CREATED" Q
.;;
.I $$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERR1)&$$CHKWHO^HLOAPI2(.HLMSTATE,.WHOTO,.ERR2) D
..I $$SEND(.HLMSTATE,.ERROR) S SUCCESS=1
.E D
..S ERROR=$G(ERR1)_": "_$G(ERR2)
..D DONTSEND(.HLMSTATE,ERROR)
K PARMS,WHOTO
Q $S(SUCCESS:HLMSTATE("IEN"),1:0)
;;
SENDMANY(HLMSTATE,PARMS,WHOTO) ;;
;;Sends the message to a list of receiving applications
;;
;;Input: Same as for $$SENDONE, except WHOTO is a list.
;; WHOTO (pass by reference)
;; Specifies a list of recipients. Each recipient should be on the
;; list as WHOTO(i), where i=1,2,3,4, etc. for as many messages as to
;; send. At each subscript WHOTO(i), the same lower level subscripts
;; may be defined as in the $$SENDONE API. For example:
;;
;; WHOTO(1,"FACILITY LINK NAME")="VAALB"
;; WHOTO(1,"RECEIVING APPLICATION")="MPI"
;; WHOTO(2,"STATION NUMBER")=500
;; WHOTO(2,"RECEIVING APPLICATION")="MPI"
;;
;;
;;Output:
;; Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
;; PARMS - left undefined when the function returns
;; WHOTO (pass by reference) returns the status of each message to be sent in the format:
;; (<i>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
;; (<i>,"IEN")=<ien, file 778>
;; (<i>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
;;
;;
N ERROR,RETURN,WHO,STATE,I
S RETURN=1
I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) D K PARMS Q 0
.S ERROR="MESSAGE NOT YET CREATED"
.S I=0 F S I=$O(WHOTO(I)) Q:'I S WHOTO(I,"QUEUED")=0,WHOTO(I,"IEN")=0,WHOTO(I,"ERROR")=ERROR
;;
I '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR) D K PARMS Q 0
.S I=0 F S I=$O(WHOTO(I)) Q:'I D
..K WHO M WHO=WHOTO(I)
..K STATE M STATE=HLMSTATE S STATE("IEN")=""
..S WHOTO(I,"QUEUED")=0
..D DONTSEND(.STATE,$G(ERROR))
..S WHOTO(I,"IEN")=$G(STATE("IEN"))
..S WHOTO(I,"ERROR")=ERROR
;;
S I=0 F S I=$O(WHOTO(I)) Q:'I D
.K WHO M WHO=WHOTO(I)
.K STATE M STATE=HLMSTATE S STATE("IEN")=""
.S ERROR=""
.I $$CHKWHO^HLOAPI2(.STATE,.WHO,.ERROR) D
..I $$SEND(.STATE,.ERROR) D
...S WHOTO(I,"QUEUED")=1
...S WHOTO(I,"IEN")=STATE("IEN")
...S WHOTO(I,"ERROR")=""
..E D
...S WHOTO(I,"QUEUED")=0
...S WHOTO(I,"IEN")=$G(STATE("IEN"))
...S WHOTO(I,"ERROR")=$G(ERROR)
...S RETURN=0
.E D ;;who not adequately determined
..S WHOTO(I,"QUEUED")=0,RETURN=0
..D DONTSEND(.STATE,$G(ERROR))
..S WHOTO(I,"IEN")=$G(STATE("IEN")),WHOTO(I,"ERROR")=$G(ERROR)
K PARMS
Q RETURN
;;
SENDSUB(HLMSTATE,PARMS,MESSAGES) ;;
;;Sends the message to a list of receiving applications based on the HL7 Subscription Registry
;;
;;Input:
;; HLMSTATE (pass by reference, required) same as $$SENDMANY
;; PARMS (pass by reference, required) same as $$SENDMANY, with one additional subscript:
;; "SUBSCRIPTION IEN" - the ien of an entry in the HL7 Subscription Registry, defining the intended recipients of this message
;;
;;Output:
;; Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
;; PARMS - left undefined when the function returns
;; MESSAGES (pass by reference) returns the status of each message to be sent in this format, where subien is the ien of the recipient in the RECIPEINTS subfile of the HL7 Subscription Registry
;; (<subien>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
;; (<subien>,"IEN")=<ien, file 778>
;; (<subien>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
;;
;;
K MESSAGES
N ERROR,RETURN,STATE,SUBIEN,WHO
;;
S RETURN=1
;;
;;
I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) S ERROR="MESSAGE NOT YET CREATED" K PARMS Q 0
I '$G(PARMS("SUBSCRIPTION IEN")) S ERROR="SUBSCRIPTION REGISTRY IEN NOT PROVIDED" K PARMS Q 0
;;
I '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR) D K PARMS Q 0
.S SUBIEN=0 F S SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO) Q:'SUBIEN D
..N SARY,HARY
..S HARY="STATE(""HDR"")"
..S SARY="STATE(""STATUS"")"
..K STATE M STATE=HLMSTATE S STATE("IEN")=""
..;;move parameters into HLMSTATE
..S @SARY@("LINK IEN")=WHO("LINK IEN")
..S @SARY@("LINK NAME")=WHO("LINK NAME")
..S @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
..M @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
..D DONTSEND(.STATE,$G(ERROR))
..S MESSAGES(SUBIEN,"QUEUED")=0
..S MESSAGES(SUBIEN,"IEN")=$G(STATE("IEN"))
..S MESSAGES(SUBIEN,"ERROR")=$G(ERROR)
;;
F S SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO) Q:'SUBIEN D
.N SARY,HARY
.S HARY="STATE(""HDR"")"
.S SARY="STATE(""STATUS"")"
.K STATE M STATE=HLMSTATE S STATE("IEN")=""
.;;move parameters into HLMSTATE
.S @SARY@("LINK IEN")=WHO("LINK IEN")
.S @SARY@("LINK NAME")=WHO("LINK NAME")
.S @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
.M @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
.S ERROR=""
.I $$SEND(.STATE,.ERROR) D
..S MESSAGES(SUBIEN,"QUEUED")=1
.E D
..S MESSAGES(SUBIEN,"QUEUED")=0,RETURN=0
.S MESSAGES(SUBIEN,"IEN")=$G(STATE("IEN")),MESSAGES(SUBIEN,"ERROR")=$G(ERROR)
K PARMS
Q RETURN
;;
SEND(HLMSTATE,ERROR) ;
;;
K ERROR
I HLMSTATE("UNSTORED LINES"),'$$SAVEMSG^HLOF777(.HLMSTATE) S ERROR="$$SAVE^HLOF777 FAILED!" Q 0
;;
I '$$SAVEMSG^HLOF778(.HLMSTATE) S ERROR="$$SAVE^HLOF778 FAILED!" Q 0
I HLMSTATE("BATCH"),$L($G(HLMSTATE("STATUS","SEQUENCE QUEUE"))) S ERROR="SEQUENCE QUEUES NOT SUPPORTED FOR BATCH MESSAGES" Q 0
I $L($G(HLMSTATE("STATUS","SEQUENCE QUEUE"))) D
.S HLMSTATE("STATUS","MOVED TO OUT QUEUE")=$$SQUE^HLOQUE(HLMSTATE("STATUS","SEQUENCE QUEUE"),HLMSTATE("STATUS","LINK NAME"),$G(HLMSTATE("STATUS","PORT")),HLMSTATE("STATUS","QUEUE"),HLMSTATE("IEN")) D:HLMSTATE("STATUS","MOVED TO OUT QUEUE")
..S $P(^HLB(HLMSTATE("IEN"),5),"^",2)=1
E D
.D OUTQUE^HLOQUE(HLMSTATE("STATUS","LINK NAME"),$G(HLMSTATE("STATUS","PORT")),HLMSTATE("STATUS","QUEUE"),HLMSTATE("IEN"))
Q HLMSTATE("IEN")
;
DONTSEND(HLMSTATE,ERROR) ;
;;This procedure does NOT send a message. Rather, it creates an entry in file 778 with the status ER.
;;Input:
;; HLMSTATE - pass-by-reference
;; ERROR (optional, pass-by-value) error text to store with the message
;;Output: none
;;
D:HLMSTATE("UNSTORED LINES") SAVEMSG^HLOF777(.HLMSTATE)
;;
S HLMSTATE("STATUS")="ER"
;
S HLMSTATE("STATUS","ERROR TEXT")=$G(ERROR)
D SAVEMSG^HLOF778(.HLMSTATE)
D SETPURGE^HLOF778A($G(HLMSTATE("IEN")),"ER",$S($G(HLMSTATE("ACK TO IEN")):HLMSTATE("ACK TO IEN"),1:""))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOAPI1 10134 printed Oct 16, 2024@17:59:13 Page 2
HLOAPI1 ;;ALB/CJM-HL7 - Developer API's for sending & receiving messages(continued) ;03/12/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137,146,158**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
SENDONE(HLMSTATE,PARMS,WHOTO,ERROR) ;Sends the message to a single receiving application.
+1 ;;
+2 ;;Input:
+3 ;;HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message. The application MUST NOT touch it
+4 ;;PARMS( *pass by reference*
+5 ;; "APP ACK RESPONSE")=<tag^routine> to call when the app ack is received (optional)
+6 ;; (NOTE: For batch messages, HLO best supports returning application
+7 ;; acknowledgments via a batch response. However, non-VistA systems
+8 ;; may return individual messages as application acknowledgments to
+9 ;; messages within the original batch message, so for applications
+10 ;; sending batch messages might best code the "APP ACK RESPONSE"
+11 ;; routine to first check whether the response message is a batch.
+12 ;;
+13 ;; "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
+14 ;; "ACCEPT ACK TYPE") = <AL,NE> (optional, defaults to AL)
+15 ;; "APP ACK TYPE") = <AL,NE> (optional, defaults to NE)
+16 ;; "FAILURE RESPONSE" - <tag>^<routine> (optional) The sending application routine to execute when the transmission of the message fails, i.e., the message can not be sent or no commit ack is received.
+17 ;; "QUEUE" - (optional) An application can name its own private queue - just a string up to 20 characters, it should be namespaced.
+18 ;; "SECURITY")=security information to include in the header segment, SEQ 8 (optional)
+19 ;; "SEQUENCE QUEUE") (optional) sequence queue to use, up to 30 characters, shoud lbe namespaced. Requires that application acks be used.
+20 ;; "SENDING APPLICATION")=name of sending app (required, 60 maximum length)
+21 ;;
+22 ;; WHOTO (required,pass by reference) an array specifying a single recipient. These subscripts are allowed:
+23 ;;
+24 ;; "RECEIVING APPLICATION" - (string, 60 char max, required)
+25 ;;
+26 ;; EXACTLY ONE of these parameters must be provided to identify the Receiving Facility:
+27 ;;
+28 ;; "FACILITY LINK IEN" - ien of the logical link
+29 ;; "FACILITY LINK NAME" - name of the logical link
+30 ;; "INSTITUTION IEN" - ptr to the INSTITUTION file
+31 ;; "STATION NUMBER" - station # with suffix
+32 ;;
+33 ;; EXACTLY ONE of these MAY be provided - optionally - to identify the interface engine to route the message through:
+34 ;;
+35 ;; *"IE LINK IEN" (obsolete) ptr to a logical link for the interface engine
+36 ;; *"IE LINK NAME" (obsolete) name of the logical link for the interface engine
+37 ;; "MIDDLEWARE LINK IEN" - ptr to a logical link for the middleware
+38 ;; "MIDDLEWARE LINK NAME" - the name of the logical link for the middleware
+39 ;;
+40 ;;Output:
+41 ;; Function returns the ien of the message in file 778 on success, 0 on failure
+42 ;; HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message. The application MUST NOT touch it!
+43 ;; ERROR (pass by reference, optional) - on failure, will contain an error message
+44 ;; PARMS - left undefined when the function returns
+45 ;; WHOTO - left undefined when the function returns
+46 ;;
+47 ;;
+48 NEW SUCCESS,ERR1,ERR2
+49 SET SUCCESS=0
+50 Begin DoDot:1
+51 IF '$GET(HLMSTATE("BODY"))
IF '$GET(HLMSTATE("UNSTORED LINES"))
SET ERROR="MESSAGE NOT YET CREATED"
QUIT
+52 ;;
+53 IF $$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERR1)&$$CHKWHO^HLOAPI2(.HLMSTATE,.WHOTO,.ERR2)
Begin DoDot:2
+54 IF $$SEND(.HLMSTATE,.ERROR)
SET SUCCESS=1
End DoDot:2
+55 IF '$TEST
Begin DoDot:2
+56 SET ERROR=$GET(ERR1)_": "_$GET(ERR2)
+57 DO DONTSEND(.HLMSTATE,ERROR)
End DoDot:2
End DoDot:1
+58 KILL PARMS,WHOTO
+59 QUIT $SELECT(SUCCESS:HLMSTATE("IEN"),1:0)
+60 ;;
SENDMANY(HLMSTATE,PARMS,WHOTO) ;;
+1 ;;Sends the message to a list of receiving applications
+2 ;;
+3 ;;Input: Same as for $$SENDONE, except WHOTO is a list.
+4 ;; WHOTO (pass by reference)
+5 ;; Specifies a list of recipients. Each recipient should be on the
+6 ;; list as WHOTO(i), where i=1,2,3,4, etc. for as many messages as to
+7 ;; send. At each subscript WHOTO(i), the same lower level subscripts
+8 ;; may be defined as in the $$SENDONE API. For example:
+9 ;;
+10 ;; WHOTO(1,"FACILITY LINK NAME")="VAALB"
+11 ;; WHOTO(1,"RECEIVING APPLICATION")="MPI"
+12 ;; WHOTO(2,"STATION NUMBER")=500
+13 ;; WHOTO(2,"RECEIVING APPLICATION")="MPI"
+14 ;;
+15 ;;
+16 ;;Output:
+17 ;; Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
+18 ;; PARMS - left undefined when the function returns
+19 ;; WHOTO (pass by reference) returns the status of each message to be sent in the format:
+20 ;; (<i>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
+21 ;; (<i>,"IEN")=<ien, file 778>
+22 ;; (<i>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
+23 ;;
+24 ;;
+25 NEW ERROR,RETURN,WHO,STATE,I
+26 SET RETURN=1
+27 IF '$GET(HLMSTATE("BODY"))
IF '$GET(HLMSTATE("UNSTORED LINES"))
Begin DoDot:1
+28 SET ERROR="MESSAGE NOT YET CREATED"
+29 SET I=0
FOR
SET I=$ORDER(WHOTO(I))
if 'I
QUIT
SET WHOTO(I,"QUEUED")=0
SET WHOTO(I,"IEN")=0
SET WHOTO(I,"ERROR")=ERROR
End DoDot:1
KILL PARMS
QUIT 0
+30 ;;
+31 IF '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR)
Begin DoDot:1
+32 SET I=0
FOR
SET I=$ORDER(WHOTO(I))
if 'I
QUIT
Begin DoDot:2
+33 KILL WHO
MERGE WHO=WHOTO(I)
+34 KILL STATE
MERGE STATE=HLMSTATE
SET STATE("IEN")=""
+35 SET WHOTO(I,"QUEUED")=0
+36 DO DONTSEND(.STATE,$GET(ERROR))
+37 SET WHOTO(I,"IEN")=$GET(STATE("IEN"))
+38 SET WHOTO(I,"ERROR")=ERROR
End DoDot:2
End DoDot:1
KILL PARMS
QUIT 0
+39 ;;
+40 SET I=0
FOR
SET I=$ORDER(WHOTO(I))
if 'I
QUIT
Begin DoDot:1
+41 KILL WHO
MERGE WHO=WHOTO(I)
+42 KILL STATE
MERGE STATE=HLMSTATE
SET STATE("IEN")=""
+43 SET ERROR=""
+44 IF $$CHKWHO^HLOAPI2(.STATE,.WHO,.ERROR)
Begin DoDot:2
+45 IF $$SEND(.STATE,.ERROR)
Begin DoDot:3
+46 SET WHOTO(I,"QUEUED")=1
+47 SET WHOTO(I,"IEN")=STATE("IEN")
+48 SET WHOTO(I,"ERROR")=""
End DoDot:3
+49 IF '$TEST
Begin DoDot:3
+50 SET WHOTO(I,"QUEUED")=0
+51 SET WHOTO(I,"IEN")=$GET(STATE("IEN"))
+52 SET WHOTO(I,"ERROR")=$GET(ERROR)
+53 SET RETURN=0
End DoDot:3
End DoDot:2
+54 ;;who not adequately determined
IF '$TEST
Begin DoDot:2
+55 SET WHOTO(I,"QUEUED")=0
SET RETURN=0
+56 DO DONTSEND(.STATE,$GET(ERROR))
+57 SET WHOTO(I,"IEN")=$GET(STATE("IEN"))
SET WHOTO(I,"ERROR")=$GET(ERROR)
End DoDot:2
End DoDot:1
+58 KILL PARMS
+59 QUIT RETURN
+60 ;;
SENDSUB(HLMSTATE,PARMS,MESSAGES) ;;
+1 ;;Sends the message to a list of receiving applications based on the HL7 Subscription Registry
+2 ;;
+3 ;;Input:
+4 ;; HLMSTATE (pass by reference, required) same as $$SENDMANY
+5 ;; PARMS (pass by reference, required) same as $$SENDMANY, with one additional subscript:
+6 ;; "SUBSCRIPTION IEN" - the ien of an entry in the HL7 Subscription Registry, defining the intended recipients of this message
+7 ;;
+8 ;;Output:
+9 ;; Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
+10 ;; PARMS - left undefined when the function returns
+11 ;; MESSAGES (pass by reference) returns the status of each message to be sent in this format, where subien is the ien of the recipient in the RECIPEINTS subfile of the HL7 Subscription Registry
+12 ;; (<subien>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
+13 ;; (<subien>,"IEN")=<ien, file 778>
+14 ;; (<subien>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
+15 ;;
+16 ;;
+17 KILL MESSAGES
+18 NEW ERROR,RETURN,STATE,SUBIEN,WHO
+19 ;;
+20 SET RETURN=1
+21 ;;
+22 ;;
+23 IF '$GET(HLMSTATE("BODY"))
IF '$GET(HLMSTATE("UNSTORED LINES"))
SET ERROR="MESSAGE NOT YET CREATED"
KILL PARMS
QUIT 0
+24 IF '$GET(PARMS("SUBSCRIPTION IEN"))
SET ERROR="SUBSCRIPTION REGISTRY IEN NOT PROVIDED"
KILL PARMS
QUIT 0
+25 ;;
+26 IF '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR)
Begin DoDot:1
+27 SET SUBIEN=0
FOR
SET SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO)
if 'SUBIEN
QUIT
Begin DoDot:2
+28 NEW SARY,HARY
+29 SET HARY="STATE(""HDR"")"
+30 SET SARY="STATE(""STATUS"")"
+31 KILL STATE
MERGE STATE=HLMSTATE
SET STATE("IEN")=""
+32 ;;move parameters into HLMSTATE
+33 SET @SARY@("LINK IEN")=WHO("LINK IEN")
+34 SET @SARY@("LINK NAME")=WHO("LINK NAME")
+35 SET @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
+36 MERGE @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
+37 DO DONTSEND(.STATE,$GET(ERROR))
+38 SET MESSAGES(SUBIEN,"QUEUED")=0
+39 SET MESSAGES(SUBIEN,"IEN")=$GET(STATE("IEN"))
+40 SET MESSAGES(SUBIEN,"ERROR")=$GET(ERROR)
End DoDot:2
End DoDot:1
KILL PARMS
QUIT 0
+41 ;;
+42 FOR
SET SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO)
if 'SUBIEN
QUIT
Begin DoDot:1
+43 NEW SARY,HARY
+44 SET HARY="STATE(""HDR"")"
+45 SET SARY="STATE(""STATUS"")"
+46 KILL STATE
MERGE STATE=HLMSTATE
SET STATE("IEN")=""
+47 ;;move parameters into HLMSTATE
+48 SET @SARY@("LINK IEN")=WHO("LINK IEN")
+49 SET @SARY@("LINK NAME")=WHO("LINK NAME")
+50 SET @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
+51 MERGE @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
+52 SET ERROR=""
+53 IF $$SEND(.STATE,.ERROR)
Begin DoDot:2
+54 SET MESSAGES(SUBIEN,"QUEUED")=1
End DoDot:2
+55 IF '$TEST
Begin DoDot:2
+56 SET MESSAGES(SUBIEN,"QUEUED")=0
SET RETURN=0
End DoDot:2
+57 SET MESSAGES(SUBIEN,"IEN")=$GET(STATE("IEN"))
SET MESSAGES(SUBIEN,"ERROR")=$GET(ERROR)
End DoDot:1
+58 KILL PARMS
+59 QUIT RETURN
+60 ;;
SEND(HLMSTATE,ERROR) ;
+1 ;;
+2 KILL ERROR
+3 IF HLMSTATE("UNSTORED LINES")
IF '$$SAVEMSG^HLOF777(.HLMSTATE)
SET ERROR="$$SAVE^HLOF777 FAILED!"
QUIT 0
+4 ;;
+5 IF '$$SAVEMSG^HLOF778(.HLMSTATE)
SET ERROR="$$SAVE^HLOF778 FAILED!"
QUIT 0
+6 IF HLMSTATE("BATCH")
IF $LENGTH($GET(HLMSTATE("STATUS","SEQUENCE QUEUE")))
SET ERROR="SEQUENCE QUEUES NOT SUPPORTED FOR BATCH MESSAGES"
QUIT 0
+7 IF $LENGTH($GET(HLMSTATE("STATUS","SEQUENCE QUEUE")))
Begin DoDot:1
+8 SET HLMSTATE("STATUS","MOVED TO OUT QUEUE")=$$SQUE^HLOQUE(HLMSTATE("STATUS","SEQUENCE QUEUE"),HLMSTATE("STATUS","LINK NAME"),$GET(HLMSTATE("STATUS","PORT")),HLMSTATE("STATUS","QUEUE"),HLMSTATE("IEN"))
if HLMSTATE("STATUS","MOVED TO OUT QUEUE")
Begin DoDot:2
+9 SET $PIECE(^HLB(HLMSTATE("IEN"),5),"^",2)=1
End DoDot:2
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 DO OUTQUE^HLOQUE(HLMSTATE("STATUS","LINK NAME"),$GET(HLMSTATE("STATUS","PORT")),HLMSTATE("STATUS","QUEUE"),HLMSTATE("IEN"))
End DoDot:1
+12 QUIT HLMSTATE("IEN")
+13 ;
DONTSEND(HLMSTATE,ERROR) ;
+1 ;;This procedure does NOT send a message. Rather, it creates an entry in file 778 with the status ER.
+2 ;;Input:
+3 ;; HLMSTATE - pass-by-reference
+4 ;; ERROR (optional, pass-by-value) error text to store with the message
+5 ;;Output: none
+6 ;;
+7 if HLMSTATE("UNSTORED LINES")
DO SAVEMSG^HLOF777(.HLMSTATE)
+8 ;;
+9 SET HLMSTATE("STATUS")="ER"
+10 ;
+11 SET HLMSTATE("STATUS","ERROR TEXT")=$GET(ERROR)
+12 DO SAVEMSG^HLOF778(.HLMSTATE)
+13 DO SETPURGE^HLOF778A($GET(HLMSTATE("IEN")),"ER",$SELECT($GET(HLMSTATE("ACK TO IEN")):HLMSTATE("ACK TO IEN"),1:""))
+14 QUIT
