- HLOAPI3 ;ALB/CJM-HL7 - Developer API's for sending application acks ;09/13/2006
- ;;1.6;HEALTH LEVEL SEVEN;**126,133**;Oct 13, 1995;Build 13
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- BATCHACK(HLMSTATE,PARMS,ACK,ERROR) ;Starts a batch message that is the response to a batch message. Individual acks are placed in the batch by calling $$ADDACK.
- ;$$SENDACK^HLOAPI2 must be called when the batch of acks is complete. The return destination is determined automatically from the original message.
- ;
- ;Input:
- ; HLMSTATE (pass by reference, required) the array obtained by calling $$STARTMSG^HLOPRS when parsing the original message
- ; PARMS (optional, pass by reference) These subscripts may be defined:
- ; "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
- ; "ACCEPT ACK TYPE") = <AL,NE> (optional, defaults to AL)
- ; "COUNTRY") - a 3 character country code from the HL7 standard table (optional)
- ; "ENCODING CHARACTERS" - the 4 HL7 encoding characters (optional,defaults to "^~\&"
- ; "FAILURE RESPONSE" (optional) the <tag>^<routine> that the sending application routine should execute if the transmission of the message fails, i.e., the message can not be sent or a requested commit ack is not received.
- ; "FIELD SEPARATOR" - the field separator (optional, defaults to "|")
- ; "QUEUE" (optional) An application can name a private queue (a string under 20 characters, namespaced). The default is the name of the queue of the original message
- ; "SECURITY" - security information to include in the header segment, SEQ 8 (optional)
- ; "VERSION" - the HL7 Version ID (optional, defaults to 2.4)
- ;Output:
- ; Function returns 1 on success, 0 on failure
- ; PARMS - left undefined upon completion
- ; ACK (pass by reference, required) the batch acknowledgment message being built.
- ; ERROR (pass by reference) error message
- N I,TOLINK,SUCCESS
- S SUCCESS=0
- ;
- D
- .N PORT
- .I '$G(HLMSTATE("IEN")) S ERROR="ORIGINAL MESSAGE TO ACKNOWLEDGMENT IS NOT IDENTIFIED" Q
- .;if the return link can not be determined, the HL Logical Link file has a problem
- .S TOLINK=$$ACKLINK^HLOAPI2(.HLMSTATE)
- .I TOLINK="" S ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED" Q
- .S PORT=$P(HLMSTATE("HDR","SENDING FACILITY",2),":",2)
- .I 'PORT S PORT=$$PORT2^HLOTLNK(TOLINK)
- .;
- .I $$NEWBATCH^HLOAPI(.PARMS,.ACK) ;can't fail!
- .S ACK("STATUS","QUEUE")=$G(PARMS("QUEUE"),$G(HLMSTATE("STATUS","QUEUE")))
- .S ACK("STATUS","PORT")=PORT
- .S ACK("HDR","SECURITY")=$G(PARMS("SECURITY"))
- .S ACK("HDR","SENDING APPLICATION")=$G(HLMSTATE("HDR","RECEIVING APPLICATION"))
- .S ACK("HDR","RECEIVING APPLICATION")=$G(HLMSTATE("HDR","SENDING APPLICATION"))
- .F I=1:1:3 S ACK("HDR","RECEIVING FACILITY",I)=$G(HLMSTATE("HDR","SENDING FACILITY",I))
- .S ACK("HDR","APP ACK TYPE")="NE"
- .S ACK("HDR","ACCEPT ACK TYPE")=$G(PARMS("ACCEPT ACK TYPE"),"AL")
- .S ACK("ACK TO")=$G(HLMSTATE("HDR","BATCH CONTROL ID"))
- .S ACK("ACK TO","IEN")=HLMSTATE("IEN")
- .S ACK("ACK TO","BODY")=$G(HLMSTATE("BODY"))
- .S ACK("STATUS","LINK NAME")=TOLINK
- .S ACK("LINE COUNT")=0
- .S SUCCESS=1
- K PARMS
- Q SUCCESS
- ;
- ADDACK(ACK,PARMS,ERROR) ;This API adds an application acknowledgment to a batch
- ;of acknowledgments that was started by calling $$BATCHACK.
- ;The Default behavior is to return a general application ack.
- ;The application may optionally specify the message
- ;type and event and/or call $$ADDSEG^HLOAPI to add segments.
- ;A generic MSA segment (components 1-3) will be added automatically
- ;if the application doesn't call $$ADDSEG^HLOAPI to add an MSA segment
- ;as the FIRST segment following the MSH segment.
- ;$$SENDACK^HLOAPI2 must be called when the batch is complete.
- ;
- ;Input:
- ; ACK (pass by reference,required) the batch of acks that is being built
- ; PARMS (pass by reference) These subscripts may be defined:
- ; "ACK CODE" (required) MSA1[ {AA,AE,AR}
- ; "ERROR MESSAGE" (optional) MSA3, should be used only if AE or AR
- ; "EVENT" - 3 character event type (optional, defaults to the event code of the original message)
- ; "MESSAGE CONTROL ID" (required) this is the message control id of the original individual message within the batch which is being acknowledged
- ; "MESSAGE STRUCTURE" (optional)
- ; "MESSAGE TYPE" (optional, defaults to ACK)
- ; "SECURITY" (optional) security information to include in the header segment SEQ 8
- ;Output:
- ; Function returns 1 on success, 0 on failure
- ; ACK (pass by reference, required) The batch, updated with another ack
- ; PARMS - left undefined when this function returns
- ; ERROR (pass by reference) error msg
- ;
- N SUB,SUCCESS
- S SUCCESS=0
- D
- .I $G(PARMS("ACK CODE"))'="AA",$G(PARMS("ACK CODE"))'="AE",$G(PARMS("ACK CODE"))'="AR" S ERROR="INVALID ACK CODE" Q
- .;
- .I $G(PARMS("MESSAGE CONTROL ID"))="" S ERROR="MESSAGE CONTROL ID MUST EXIST TO RETURN AN APPLICATION ACK" Q
- .S SUB=""
- .F S SUB=$O(^HLB("AE",PARMS("MESSAGE CONTROL ID"),SUB)) Q:SUB="" I $P(SUB,"^")=ACK("ACK TO","IEN"),$P(SUB,"^",2) S PARMS("ACK TO","IEN")=SUB Q
- .S PARMS("MESSAGE TYPE")=$G(PARMS("MESSAGE TYPE"),"ACK")
- .S:PARMS("MESSAGE TYPE")="ACK" PARMS("MESSAGE STRUCTURE")="ACK"
- .S PARMS("EVENT")=$G(PARMS("EVENT"))
- .I PARMS("EVENT")="",ACK("ACK TO","BODY"),$P(SUB,"^",2) S PARMS("EVENT")=$P($G(^HLA(ACK("ACK TO","BODY"),2,$P(SUB,"^",2),0)),"^",3)
- .S PARMS("ACK TO")=PARMS("MESSAGE CONTROL ID")
- .S PARMS("ACK TO","STATUS")=$S(PARMS("ACK CODE")="AA":"SU",1:"AE")
- .Q:'$$ADDMSG^HLOAPI(.ACK,.PARMS,.ERROR)
- .S ACK("MSA")="MSA|"_PARMS("ACK CODE")_"|"_PARMS("MESSAGE CONTROL ID")_"|"_$G(PARMS("ERROR MESSAGE"))
- .S SUCCESS=1
- K PARMS
- Q SUCCESS
- ;
- RESEND(MSGIEN,ERROR) ;
- ;Description: This message will re-transmit an out-going message. It
- ;does this by making a copy of the message, reusing all the original
- ;parameters. Then the message is placed on the same out-going queue.
- ;
- ;Input:
- ; MSGIEN - the ien (file #778) of the message that is to be sent
- ;Output:
- ; Function returns the ien of the message in file 778 on success, 0 on failure
- ; ERROR (pass by reference, optional) - on failure, will contain an error message
- ;
- N MSG,SUB,HDR
- I '$$STARTMSG^HLOPRS(.MSG,MSGIEN) S ERROR="MESSAGE NOT FOUND" Q 0
- I MSG("DIRECTION")'="OUT" S ERROR="MESSAGE IS NOT OUTGOING" Q 0
- I MSG("STATUS","LINK NAME")="" S ERROR="LINK NOT DEFINED" Q 0
- F SUB="ID","IEN","DT/TM","ACK BY","STATUS" S MSG(SUB)=""
- F SUB="PURGE" K MSG("STATUS",SUB)
- D GETSYS^HLOAPI(.MSG)
- I $$SAVEMSG^HLOF778(.MSG) D OUTQUE^HLOQUE(MSG("STATUS","LINK NAME"),$G(MSG("STATUS","PORT")),MSG("STATUS","QUEUE"),MSG("IEN")) Q +MSG("IEN")
- Q 0
- ;
- SETPURGE(MSGIEN,TIME) ;
- ;Resets the purge date/time.
- ;Input:
- ; MSGIEN (required) ien of the message, file #778
- ; TIME (optional) dt/time to set the purge time to, defaults to NOW
- ;Output:
- ; Function returns 1 on success, 0 on failure
- N NODE,OLDTIME,HLDIR
- Q:'$G(MSGIEN) 0
- S NODE=$G(^HLB(MSGIEN,0))
- Q:NODE="" 0
- S OLDTIME=$P(NODE,"^",9)
- S:'$G(TIME) TIME=$$NOW^XLFDT
- S HLDIR=$S($E($P(NODE,"^",4))="I":"IN",1:"OUT")
- K:OLDTIME ^HLB("AD",HLDIR,OLDTIME,MSGIEN)
- S $P(^HLB(MSGIEN,0),"^",9)=TIME
- S ^HLB("AD",HLDIR,TIME,MSGIEN)=""
- Q 1
- ;
- REPROC(MSGIEN,ERROR) ;
- ;Description: This message will re-process an incoming message by placing it on the appropriate incoming queue. If successful the message is set to be purged.
- ;
- ;Input:
- ; MSGIEN - the ien (file #778) of the message that is to be processed
- ;Output:
- ; Function returns 1 on success, 0 on failure
- ; ERROR (pass by reference, optional) - on failure, will contain an error message
- ;
- N MSG,HDR,ACTION,QUEUE,FROM
- ;
- I '$$STARTMSG^HLOPRS(.MSG,MSGIEN) S ERROR="MESSAGE NOT FOUND" Q 0
- I MSG("DIRECTION")'="IN" S ERROR="MESSAGE IS NOT INCOMING" Q 0
- M HDR=MSG("HDR")
- I '$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE),$G(MSG("ACK TO"))="" S ERROR="RECEIVING APPLICATION NOT DEFINED"
- ;If this message references an earlier message, get the action specified by the original message
- I $G(MSG("ACK TO"))]"" D
- .N NODE,IEN
- .S IEN=$O(^HLB("B",$P(MSG("ACK TO"),"-"),0))
- .S:IEN NODE=$G(^HLB(IEN,0))
- .I ($P(NODE,"^",11)]"") S ACTION=$P(NODE,"^",10,11),QUEUE=$S($P(NODE,"^",6)]"":$P(NODE,"^",6),1:"DEFAULT")
- I ACTION="" S ERROR="ORIGINAL MESSAGE NOT FOUND" Q 0
- S FROM=$S(MSG("HDR","SENDING FACILITY",2)]"":MSG("HDR","SENDING FACILITY",2),1:MSG("HDR","SENDING FACILITY",1))
- D INQUE^HLOQUE(FROM,QUEUE,MSGIEN,ACTION,1)
- Q 1
- ;
- PROCNOW(MSGIEN,PURGE,ERROR) ;
- ;Description: This message will re-process an incoming message immediately.
- ;
- ;Input:
- ; MSGIEN - the ien (file #778) of the message that is to be processed
- ;Output:
- ; Function returns 1 on success, 0 on failure
- ; PURGE (optional) a date/time to purge the message
- ; ERROR (pass by reference, optional) - on failure, will contain an error message
- ;
- N MSG,HDR,ACTION,MCODE,HLMSGIEN
- ;
- S ERROR=""
- I '$$STARTMSG^HLOPRS(.MSG,MSGIEN) S ERROR="MESSAGE NOT FOUND" Q 0
- I MSG("DIRECTION")'="IN" S ERROR="MESSAGE IS NOT INCOMING" Q 0
- M HDR=MSG("HDR")
- I '$$ACTION^HLOAPP(.HDR,.ACTION),'$G(MSG("ACK TO IEN")) S ERROR="RECEIVING APPLICATION NOT DEFINED" Q 0
- ;If this msg is an ack to an earlier message, get the action specified by the original message
- I $G(ACTION)="",$G(MSG("ACK TO IEN")) S ACTION=$P($G(^HLB(+MSG("ACK TO IEN"),0)),"^",10,11) I $P(ACTION,"^",2)="" S ERROR="ORIGINAL MESSAGE NOT FOUND" Q 0
- D:$G(PURGE)
- .K:MSG("STATUS","PURGE") ^HLB("AD","IN",MSG("STATUS","PURGE"),MSGIEN)
- .S $P(^HLB(MSGIEN,0),"^",9)=PURGE
- .S ^HLB("AD","IN",PURGE,MSGIEN)=""
- .I $G(MSG("ACK TO IEN")),$D(^HLB(MSG("ACK TO IEN"),0)) K ^HLB("AD","OUT",MSG("STATUS","PURGE"),MSG("ACK TO IEN")) S $P(^HLB(MSG("ACK TO IEN"),0),"^",9)=PURGE,^HLB("AD","OUT",PURGE,MSG("ACK TO IEN"))=""
- S HLMSGIEN=MSGIEN
- S $P(^HLB(MSGIEN,0),"^",19)=1
- S MCODE="D "_ACTION
- X MCODE
- Q 1
- HLOAPI3 ;ALB/CJM-HL7 - Developer API's for sending application acks ;09/13/2006
- +1 ;;1.6;HEALTH LEVEL SEVEN;**126,133**;Oct 13, 1995;Build 13
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- BATCHACK(HLMSTATE,PARMS,ACK,ERROR) ;Starts a batch message that is the response to a batch message. Individual acks are placed in the batch by calling $$ADDACK.
- +1 ;$$SENDACK^HLOAPI2 must be called when the batch of acks is complete. The return destination is determined automatically from the original message.
- +2 ;
- +3 ;Input:
- +4 ; HLMSTATE (pass by reference, required) the array obtained by calling $$STARTMSG^HLOPRS when parsing the original message
- +5 ; PARMS (optional, pass by reference) These subscripts may be defined:
- +6 ; "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
- +7 ; "ACCEPT ACK TYPE") = <AL,NE> (optional, defaults to AL)
- +8 ; "COUNTRY") - a 3 character country code from the HL7 standard table (optional)
- +9 ; "ENCODING CHARACTERS" - the 4 HL7 encoding characters (optional,defaults to "^~\&"
- +10 ; "FAILURE RESPONSE" (optional) the <tag>^<routine> that the sending application routine should execute if the transmission of the message fails, i.e., the message can not be sent or a requested commit ack is not received.
- +11 ; "FIELD SEPARATOR" - the field separator (optional, defaults to "|")
- +12 ; "QUEUE" (optional) An application can name a private queue (a string under 20 characters, namespaced). The default is the name of the queue of the original message
- +13 ; "SECURITY" - security information to include in the header segment, SEQ 8 (optional)
- +14 ; "VERSION" - the HL7 Version ID (optional, defaults to 2.4)
- +15 ;Output:
- +16 ; Function returns 1 on success, 0 on failure
- +17 ; PARMS - left undefined upon completion
- +18 ; ACK (pass by reference, required) the batch acknowledgment message being built.
- +19 ; ERROR (pass by reference) error message
- +20 NEW I,TOLINK,SUCCESS
- +21 SET SUCCESS=0
- +22 ;
- +23 Begin DoDot:1
- +24 NEW PORT
- +25 IF '$GET(HLMSTATE("IEN"))
- SET ERROR="ORIGINAL MESSAGE TO ACKNOWLEDGMENT IS NOT IDENTIFIED"
- QUIT
- +26 ;if the return link can not be determined, the HL Logical Link file has a problem
- +27 SET TOLINK=$$ACKLINK^HLOAPI2(.HLMSTATE)
- +28 IF TOLINK=""
- SET ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED"
- QUIT
- +29 SET PORT=$PIECE(HLMSTATE("HDR","SENDING FACILITY",2),":",2)
- +30 IF 'PORT
- SET PORT=$$PORT2^HLOTLNK(TOLINK)
- +31 ;
- +32 ;can't fail!
- IF $$NEWBATCH^HLOAPI(.PARMS,.ACK)
- +33 SET ACK("STATUS","QUEUE")=$GET(PARMS("QUEUE"),$GET(HLMSTATE("STATUS","QUEUE")))
- +34 SET ACK("STATUS","PORT")=PORT
- +35 SET ACK("HDR","SECURITY")=$GET(PARMS("SECURITY"))
- +36 SET ACK("HDR","SENDING APPLICATION")=$GET(HLMSTATE("HDR","RECEIVING APPLICATION"))
- +37 SET ACK("HDR","RECEIVING APPLICATION")=$GET(HLMSTATE("HDR","SENDING APPLICATION"))
- +38 FOR I=1:1:3
- SET ACK("HDR","RECEIVING FACILITY",I)=$GET(HLMSTATE("HDR","SENDING FACILITY",I))
- +39 SET ACK("HDR","APP ACK TYPE")="NE"
- +40 SET ACK("HDR","ACCEPT ACK TYPE")=$GET(PARMS("ACCEPT ACK TYPE"),"AL")
- +41 SET ACK("ACK TO")=$GET(HLMSTATE("HDR","BATCH CONTROL ID"))
- +42 SET ACK("ACK TO","IEN")=HLMSTATE("IEN")
- +43 SET ACK("ACK TO","BODY")=$GET(HLMSTATE("BODY"))
- +44 SET ACK("STATUS","LINK NAME")=TOLINK
- +45 SET ACK("LINE COUNT")=0
- +46 SET SUCCESS=1
- End DoDot:1
- +47 KILL PARMS
- +48 QUIT SUCCESS
- +49 ;
- ADDACK(ACK,PARMS,ERROR) ;This API adds an application acknowledgment to a batch
- +1 ;of acknowledgments that was started by calling $$BATCHACK.
- +2 ;The Default behavior is to return a general application ack.
- +3 ;The application may optionally specify the message
- +4 ;type and event and/or call $$ADDSEG^HLOAPI to add segments.
- +5 ;A generic MSA segment (components 1-3) will be added automatically
- +6 ;if the application doesn't call $$ADDSEG^HLOAPI to add an MSA segment
- +7 ;as the FIRST segment following the MSH segment.
- +8 ;$$SENDACK^HLOAPI2 must be called when the batch is complete.
- +9 ;
- +10 ;Input:
- +11 ; ACK (pass by reference,required) the batch of acks that is being built
- +12 ; PARMS (pass by reference) These subscripts may be defined:
- +13 ; "ACK CODE" (required) MSA1[ {AA,AE,AR}
- +14 ; "ERROR MESSAGE" (optional) MSA3, should be used only if AE or AR
- +15 ; "EVENT" - 3 character event type (optional, defaults to the event code of the original message)
- +16 ; "MESSAGE CONTROL ID" (required) this is the message control id of the original individual message within the batch which is being acknowledged
- +17 ; "MESSAGE STRUCTURE" (optional)
- +18 ; "MESSAGE TYPE" (optional, defaults to ACK)
- +19 ; "SECURITY" (optional) security information to include in the header segment SEQ 8
- +20 ;Output:
- +21 ; Function returns 1 on success, 0 on failure
- +22 ; ACK (pass by reference, required) The batch, updated with another ack
- +23 ; PARMS - left undefined when this function returns
- +24 ; ERROR (pass by reference) error msg
- +25 ;
- +26 NEW SUB,SUCCESS
- +27 SET SUCCESS=0
- +28 Begin DoDot:1
- +29 IF $GET(PARMS("ACK CODE"))'="AA"
- IF $GET(PARMS("ACK CODE"))'="AE"
- IF $GET(PARMS("ACK CODE"))'="AR"
- SET ERROR="INVALID ACK CODE"
- QUIT
- +30 ;
- +31 IF $GET(PARMS("MESSAGE CONTROL ID"))=""
- SET ERROR="MESSAGE CONTROL ID MUST EXIST TO RETURN AN APPLICATION ACK"
- QUIT
- +32 SET SUB=""
- +33 FOR
- SET SUB=$ORDER(^HLB("AE",PARMS("MESSAGE CONTROL ID"),SUB))
- IF SUB=""
- QUIT
- IF $PIECE(SUB,"^")=ACK("ACK TO","IEN")
- IF $PIECE(SUB,"^",2)
- SET PARMS("ACK TO","IEN")=SUB
- QUIT
- +34 SET PARMS("MESSAGE TYPE")=$GET(PARMS("MESSAGE TYPE"),"ACK")
- +35 IF PARMS("MESSAGE TYPE")="ACK"
- SET PARMS("MESSAGE STRUCTURE")="ACK"
- +36 SET PARMS("EVENT")=$GET(PARMS("EVENT"))
- +37 IF PARMS("EVENT")=""
- IF ACK("ACK TO","BODY")
- IF $PIECE(SUB,"^",2)
- SET PARMS("EVENT")=$PIECE($GET(^HLA(ACK("ACK TO","BODY"),2,$PIECE(SUB,"^",2),0)),"^",3)
- +38 SET PARMS("ACK TO")=PARMS("MESSAGE CONTROL ID")
- +39 SET PARMS("ACK TO","STATUS")=$SELECT(PARMS("ACK CODE")="AA":"SU",1:"AE")
- +40 IF '$$ADDMSG^HLOAPI(.ACK,.PARMS,.ERROR)
- QUIT
- +41 SET ACK("MSA")="MSA|"_PARMS("ACK CODE")_"|"_PARMS("MESSAGE CONTROL ID")_"|"_$GET(PARMS("ERROR MESSAGE"))
- +42 SET SUCCESS=1
- End DoDot:1
- +43 KILL PARMS
- +44 QUIT SUCCESS
- +45 ;
- RESEND(MSGIEN,ERROR) ;
- +1 ;Description: This message will re-transmit an out-going message. It
- +2 ;does this by making a copy of the message, reusing all the original
- +3 ;parameters. Then the message is placed on the same out-going queue.
- +4 ;
- +5 ;Input:
- +6 ; MSGIEN - the ien (file #778) of the message that is to be sent
- +7 ;Output:
- +8 ; Function returns the ien of the message in file 778 on success, 0 on failure
- +9 ; ERROR (pass by reference, optional) - on failure, will contain an error message
- +10 ;
- +11 NEW MSG,SUB,HDR
- +12 IF '$$STARTMSG^HLOPRS(.MSG,MSGIEN)
- SET ERROR="MESSAGE NOT FOUND"
- QUIT 0
- +13 IF MSG("DIRECTION")'="OUT"
- SET ERROR="MESSAGE IS NOT OUTGOING"
- QUIT 0
- +14 IF MSG("STATUS","LINK NAME")=""
- SET ERROR="LINK NOT DEFINED"
- QUIT 0
- +15 FOR SUB="ID","IEN","DT/TM","ACK BY","STATUS"
- SET MSG(SUB)=""
- +16 FOR SUB="PURGE"
- KILL MSG("STATUS",SUB)
- +17 DO GETSYS^HLOAPI(.MSG)
- +18 IF $$SAVEMSG^HLOF778(.MSG)
- DO OUTQUE^HLOQUE(MSG("STATUS","LINK NAME"),$GET(MSG("STATUS","PORT")),MSG("STATUS","QUEUE"),MSG("IEN"))
- QUIT +MSG("IEN")
- +19 QUIT 0
- +20 ;
- SETPURGE(MSGIEN,TIME) ;
- +1 ;Resets the purge date/time.
- +2 ;Input:
- +3 ; MSGIEN (required) ien of the message, file #778
- +4 ; TIME (optional) dt/time to set the purge time to, defaults to NOW
- +5 ;Output:
- +6 ; Function returns 1 on success, 0 on failure
- +7 NEW NODE,OLDTIME,HLDIR
- +8 IF '$GET(MSGIEN)
- QUIT 0
- +9 SET NODE=$GET(^HLB(MSGIEN,0))
- +10 IF NODE=""
- QUIT 0
- +11 SET OLDTIME=$PIECE(NODE,"^",9)
- +12 IF '$GET(TIME)
- SET TIME=$$NOW^XLFDT
- +13 SET HLDIR=$SELECT($EXTRACT($PIECE(NODE,"^",4))="I":"IN",1:"OUT")
- +14 IF OLDTIME
- KILL ^HLB("AD",HLDIR,OLDTIME,MSGIEN)
- +15 SET $PIECE(^HLB(MSGIEN,0),"^",9)=TIME
- +16 SET ^HLB("AD",HLDIR,TIME,MSGIEN)=""
- +17 QUIT 1
- +18 ;
- REPROC(MSGIEN,ERROR) ;
- +1 ;Description: This message will re-process an incoming message by placing it on the appropriate incoming queue. If successful the message is set to be purged.
- +2 ;
- +3 ;Input:
- +4 ; MSGIEN - the ien (file #778) of the message that is to be processed
- +5 ;Output:
- +6 ; Function returns 1 on success, 0 on failure
- +7 ; ERROR (pass by reference, optional) - on failure, will contain an error message
- +8 ;
- +9 NEW MSG,HDR,ACTION,QUEUE,FROM
- +10 ;
- +11 IF '$$STARTMSG^HLOPRS(.MSG,MSGIEN)
- SET ERROR="MESSAGE NOT FOUND"
- QUIT 0
- +12 IF MSG("DIRECTION")'="IN"
- SET ERROR="MESSAGE IS NOT INCOMING"
- QUIT 0
- +13 MERGE HDR=MSG("HDR")
- +14 IF '$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE)
- IF $GET(MSG("ACK TO"))=""
- SET ERROR="RECEIVING APPLICATION NOT DEFINED"
- +15 ;If this message references an earlier message, get the action specified by the original message
- +16 IF $GET(MSG("ACK TO"))]""
- Begin DoDot:1
- +17 NEW NODE,IEN
- +18 SET IEN=$ORDER(^HLB("B",$PIECE(MSG("ACK TO"),"-"),0))
- +19 IF IEN
- SET NODE=$GET(^HLB(IEN,0))
- +20 IF ($PIECE(NODE,"^",11)]"")
- SET ACTION=$PIECE(NODE,"^",10,11)
- SET QUEUE=$SELECT($PIECE(NODE,"^",6)]"":$PIECE(NODE,"^",6),1:"DEFAULT")
- End DoDot:1
- +21 IF ACTION=""
- SET ERROR="ORIGINAL MESSAGE NOT FOUND"
- QUIT 0
- +22 SET FROM=$SELECT(MSG("HDR","SENDING FACILITY",2)]"":MSG("HDR","SENDING FACILITY",2),1:MSG("HDR","SENDING FACILITY",1))
- +23 DO INQUE^HLOQUE(FROM,QUEUE,MSGIEN,ACTION,1)
- +24 QUIT 1
- +25 ;
- PROCNOW(MSGIEN,PURGE,ERROR) ;
- +1 ;Description: This message will re-process an incoming message immediately.
- +2 ;
- +3 ;Input:
- +4 ; MSGIEN - the ien (file #778) of the message that is to be processed
- +5 ;Output:
- +6 ; Function returns 1 on success, 0 on failure
- +7 ; PURGE (optional) a date/time to purge the message
- +8 ; ERROR (pass by reference, optional) - on failure, will contain an error message
- +9 ;
- +10 NEW MSG,HDR,ACTION,MCODE,HLMSGIEN
- +11 ;
- +12 SET ERROR=""
- +13 IF '$$STARTMSG^HLOPRS(.MSG,MSGIEN)
- SET ERROR="MESSAGE NOT FOUND"
- QUIT 0
- +14 IF MSG("DIRECTION")'="IN"
- SET ERROR="MESSAGE IS NOT INCOMING"
- QUIT 0
- +15 MERGE HDR=MSG("HDR")
- +16 IF '$$ACTION^HLOAPP(.HDR,.ACTION)
- IF '$GET(MSG("ACK TO IEN"))
- SET ERROR="RECEIVING APPLICATION NOT DEFINED"
- QUIT 0
- +17 ;If this msg is an ack to an earlier message, get the action specified by the original message
- +18 IF $GET(ACTION)=""
- IF $GET(MSG("ACK TO IEN"))
- SET ACTION=$PIECE($GET(^HLB(+MSG("ACK TO IEN"),0)),"^",10,11)
- IF $PIECE(ACTION,"^",2)=""
- SET ERROR="ORIGINAL MESSAGE NOT FOUND"
- QUIT 0
- +19 IF $GET(PURGE)
- Begin DoDot:1
- +20 IF MSG("STATUS","PURGE")
- KILL ^HLB("AD","IN",MSG("STATUS","PURGE"),MSGIEN)
- +21 SET $PIECE(^HLB(MSGIEN,0),"^",9)=PURGE
- +22 SET ^HLB("AD","IN",PURGE,MSGIEN)=""
- +23 IF $GET(MSG("ACK TO IEN"))
- IF $DATA(^HLB(MSG("ACK TO IEN"),0))
- KILL ^HLB("AD","OUT",MSG("STATUS","PURGE"),MSG("ACK TO IEN"))
- SET $PIECE(^HLB(MSG("ACK TO IEN"),0),"^",9)=PURGE
- SET ^HLB("AD","OUT",PURGE,MSG("ACK TO IEN"))=""
- End DoDot:1
- +24 SET HLMSGIEN=MSGIEN
- +25 SET $PIECE(^HLB(MSGIEN,0),"^",19)=1
- +26 SET MCODE="D "_ACTION
- +27 XECUTE MCODE
- +28 QUIT 1