HLOAPI3 ;ALB/CJM-HL7 - Developer API's for sending application acks ;07/17/2012
;;1.6;HEALTH LEVEL SEVEN;**126,133,134,137,138,158**;Oct 13, 1995;Build 14
;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 "|")
;; "RETURN LINK NAME" (optional)
;; "RETURN LINK IEN" (optional)
;; "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
S TOLINK=""
;
D
.N PORT S 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
.I $G(PARMS("RETURN LINK IEN")) D
..S TOLINK=$P($G(^HLCS(870,PARMS("RETURN LINK IEN"),0)),"^")
..S PORT=$$PORT2^HLOTLNK(TOLINK)
.E I $L($G(PARMS("RETURN LINK NAME"))) D
..S TOLINK=PARMS("RETURN LINK NAME")
..S PORT=$$PORT2^HLOTLNK(TOLINK)
.E D
..S TOLINK=$$ACKLINK^HLOAPI2(.HLMSTATE,.PORT)
.I (TOLINK="")!('PORT) S ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED" Q
.;
.I $$NEWBATCH^HLOAPI(.PARMS,.ACK) ;can't fail!
.S ACK("STATUS","QUEUE")=$G(PARMS("QUEUE"),$G(HLMSTATE("STATUS","QUEUE")))
.I ACK("STATUS","QUEUE")="" S ACK("STATUS","QUEUE")="DEFAULT"
.;
.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:"ER")
.Q:'$$ADDMSG^HLOAPI(.ACK,.PARMS,.ERROR)
.;Next line modified for HL*1.6*138 - RBN
.;S ACK("MSA")="MSA|"_PARMS("ACK CODE")_"|"_PARMS("MESSAGE CONTROL ID")_"|"_$G(PARMS("ERROR MESSAGE"))
.S ACK("MSA")="MSA|"_PARMS("ACK CODE")_"|"_PARMS("MESSAGE CONTROL ID")_"|"_$$ESCAPE^HLOPBLD(.ACK,$G(PARMS("ERROR MESSAGE")))
.S SUCCESS=1
K PARMS
Q SUCCESS
;
RESEND(MSGIEN,ERROR) ;; Retransmit message
;;This message will re-transmit an out-going message. It copies a copy the message, reusing all the original parameters. Then the message is requeued.
;;
;;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)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
I MSG("BATCH") D
.N MSH
.D NEXTMSG^HLOPRS(.MSG,.MSH)
.S MSG("HDR","VERSION")=MSH("VERSION")
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) ;; Set message up for purging.
;;Resets the purge date/time.
;;Input:
;; MSGIEN (required) ien of the message, file #778
;; TIME (required) dt/time to set the purge time to
;;Output:
;; Function returns 1 on success, 0 on failure
;;
N NODE,OLDTIME,HLDIR,DAYS
Q:'$G(MSGIEN) 0
Q:'$G(TIME) 0
S NODE=$G(^HLB(MSGIEN,0))
Q:NODE="" 0
S OLDTIME=$P(NODE,"^",9)
;
;applications may delay the purge, but not purge sooner
I OLDTIME,OLDTIME>TIME Q 0
;
I OLDTIME D Q 1
.S HLDIR=$S($E($P(NODE,"^",4))="I":"IN",1:"OUT")
.K ^HLB("AD",HLDIR,OLDTIME,MSGIEN)
.S $P(^HLB(MSGIEN,0),"^",9)=TIME
.S ^HLB("AD",HLDIR,TIME,MSGIEN)=""
;
;if the message isn't yet scheduled for purge, use TIME to set the retention time
S DAYS=$$FMDIFF^XLFDT(TIME,$$NOW^XLFDT,3)+1
I DAYS>$P(NODE,"^",22) S $P(^HLB(MSGIEN,0),"^",22)=DAYS
Q 1
;
REPROC(MSGIEN,ERROR) ;; Reprocess message.
;;This message will re-process an incoming message by placing it on an incoming queue. If successful the message will 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) 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")
;** START HL*1.6*138 CJM
;I $G(MSG("ACK TO"))]"" S ACTION=MSG("STATUS","APP ACK RESPONSE")
S ACTION=MSG("STATUS","ACTION")
S QUEUE=MSG("STATUS","QUEUE")
;** END HL*1.6*138 CJM
I ACTION="",'$$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 ACTION="",$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="NO ACTION SPECIFIED FOR RECEIVING APPLICATION" 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) ;;
;;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) 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")
;** START HL*1.6*138 CJM
;I $G(MSG("ACK TO"))]"" S ACTION=MSG("STATUS","APP ACK RESPONSE")
S ACTION=MSG("STATUS","ACTION")
;** END HL*1.6*138 CJM
I ACTION="",'$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE),$G(MSG("ACK TO"))="" S ERROR="RECEIVING APPLICATION NOT DEFINED" Q 0
;If this message references 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="ACTION SPECIFIED BY ORIGINAL APPLICATION NOT FOUND" Q 0
I $P(ACTION,"^",2)="" S ERROR="ACTION SPECIFIED BY APPLICATION 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
;
;
;
;
;
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOAPI3 11424 printed Nov 22, 2024@17:08:35 Page 2
HLOAPI3 ;ALB/CJM-HL7 - Developer API's for sending application acks ;07/17/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,133,134,137,138,158**;Oct 13, 1995;Build 14
+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 ;; "RETURN LINK NAME" (optional)
+13 ;; "RETURN LINK IEN" (optional)
+14 ;; "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
+15 ;; "SECURITY" - security information to include in the header segment, SEQ 8 (optional)
+16 ;; "VERSION" - the HL7 Version ID (optional, defaults to 2.4)
+17 ;;Output:
+18 ;; Function returns 1 on success, 0 on failure
+19 ;; PARMS - left undefined upon completion
+20 ;; ACK (pass by reference, required) the batch acknowledgment message being built.
+21 ;; ERROR (pass by reference) error message
+22 ;;
+23 ;
+24 NEW I,TOLINK,SUCCESS
+25 SET SUCCESS=0
+26 SET TOLINK=""
+27 ;
+28 Begin DoDot:1
+29 NEW PORT
SET PORT=""
+30 IF '$GET(HLMSTATE("IEN"))
SET ERROR="ORIGINAL MESSAGE TO ACKNOWLEDGMENT IS NOT IDENTIFIED"
QUIT
+31 ;if the return link can not be determined, the HL Logical Link file has a problem
+32 IF $GET(PARMS("RETURN LINK IEN"))
Begin DoDot:2
+33 SET TOLINK=$PIECE($GET(^HLCS(870,PARMS("RETURN LINK IEN"),0)),"^")
+34 SET PORT=$$PORT2^HLOTLNK(TOLINK)
End DoDot:2
+35 IF '$TEST
IF $LENGTH($GET(PARMS("RETURN LINK NAME")))
Begin DoDot:2
+36 SET TOLINK=PARMS("RETURN LINK NAME")
+37 SET PORT=$$PORT2^HLOTLNK(TOLINK)
End DoDot:2
+38 IF '$TEST
Begin DoDot:2
+39 SET TOLINK=$$ACKLINK^HLOAPI2(.HLMSTATE,.PORT)
End DoDot:2
+40 IF (TOLINK="")!('PORT)
SET ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED"
QUIT
+41 ;
+42 ;can't fail!
IF $$NEWBATCH^HLOAPI(.PARMS,.ACK)
+43 SET ACK("STATUS","QUEUE")=$GET(PARMS("QUEUE"),$GET(HLMSTATE("STATUS","QUEUE")))
+44 IF ACK("STATUS","QUEUE")=""
SET ACK("STATUS","QUEUE")="DEFAULT"
+45 ;
+46 SET ACK("STATUS","PORT")=PORT
+47 SET ACK("HDR","SECURITY")=$GET(PARMS("SECURITY"))
+48 SET ACK("HDR","SENDING APPLICATION")=$GET(HLMSTATE("HDR","RECEIVING APPLICATION"))
+49 SET ACK("HDR","RECEIVING APPLICATION")=$GET(HLMSTATE("HDR","SENDING APPLICATION"))
+50 FOR I=1:1:3
SET ACK("HDR","RECEIVING FACILITY",I)=$GET(HLMSTATE("HDR","SENDING FACILITY",I))
+51 SET ACK("HDR","APP ACK TYPE")="NE"
+52 SET ACK("HDR","ACCEPT ACK TYPE")=$GET(PARMS("ACCEPT ACK TYPE"),"AL")
+53 SET ACK("ACK TO")=$GET(HLMSTATE("HDR","BATCH CONTROL ID"))
+54 SET ACK("ACK TO IEN")=HLMSTATE("IEN")
+55 SET ACK("ACK TO","BODY")=$GET(HLMSTATE("BODY"))
+56 SET ACK("STATUS","LINK NAME")=TOLINK
+57 SET ACK("LINE COUNT")=0
+58 SET SUCCESS=1
End DoDot:1
+59 KILL PARMS
+60 QUIT SUCCESS
+61 ;
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 ;
+27 NEW SUB,SUCCESS
+28 SET SUCCESS=0
+29 Begin DoDot:1
+30 IF $GET(PARMS("ACK CODE"))'="AA"
IF $GET(PARMS("ACK CODE"))'="AE"
IF $GET(PARMS("ACK CODE"))'="AR"
SET ERROR="INVALID ACK CODE"
QUIT
+31 ;
+32 IF $GET(PARMS("MESSAGE CONTROL ID"))=""
SET ERROR="MESSAGE CONTROL ID MUST EXIST TO RETURN AN APPLICATION ACK"
QUIT
+33 SET SUB=""
+34 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
+35 SET PARMS("MESSAGE TYPE")=$GET(PARMS("MESSAGE TYPE"),"ACK")
+36 if PARMS("MESSAGE TYPE")="ACK"
SET PARMS("MESSAGE STRUCTURE")="ACK"
+37 SET PARMS("EVENT")=$GET(PARMS("EVENT"))
+38 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)
+39 SET PARMS("ACK TO")=PARMS("MESSAGE CONTROL ID")
+40 SET PARMS("ACK TO","STATUS")=$SELECT(PARMS("ACK CODE")="AA":"SU",1:"ER")
+41 if '$$ADDMSG^HLOAPI(.ACK,.PARMS,.ERROR)
QUIT
+42 ;Next line modified for HL*1.6*138 - RBN
+43 ;S ACK("MSA")="MSA|"_PARMS("ACK CODE")_"|"_PARMS("MESSAGE CONTROL ID")_"|"_$G(PARMS("ERROR MESSAGE"))
+44 SET ACK("MSA")="MSA|"_PARMS("ACK CODE")_"|"_PARMS("MESSAGE CONTROL ID")_"|"_$$ESCAPE^HLOPBLD(.ACK,$GET(PARMS("ERROR MESSAGE")))
+45 SET SUCCESS=1
End DoDot:1
+46 KILL PARMS
+47 QUIT SUCCESS
+48 ;
RESEND(MSGIEN,ERROR) ;; Retransmit message
+1 ;;This message will re-transmit an out-going message. It copies a copy the message, reusing all the original parameters. Then the message is requeued.
+2 ;;
+3 ;;Input:
+4 ;; MSGIEN - the ien (file #778) of the message that is to be sent
+5 ;;Output:
+6 ;; Function returns the ien of the message in file 778 on success, 0 on failure
+7 ;; ERROR (pass by reference, optional)an error message
+8 ;;
+9 NEW MSG,SUB,HDR
+10 IF '$$STARTMSG^HLOPRS(.MSG,MSGIEN)
SET ERROR="MESSAGE NOT FOUND"
QUIT 0
+11 IF MSG("DIRECTION")'="OUT"
SET ERROR="MESSAGE IS NOT OUTGOING"
QUIT 0
+12 IF MSG("STATUS","LINK NAME")=""
SET ERROR="LINK NOT DEFINED"
QUIT 0
+13 IF MSG("BATCH")
Begin DoDot:1
+14 NEW MSH
+15 DO NEXTMSG^HLOPRS(.MSG,.MSH)
+16 SET MSG("HDR","VERSION")=MSH("VERSION")
End DoDot:1
+17 FOR SUB="ID","IEN","DT/TM","ACK BY","STATUS"
SET MSG(SUB)=""
+18 FOR SUB="PURGE"
KILL MSG("STATUS",SUB)
+19 DO GETSYS^HLOAPI(.MSG)
+20 IF $$SAVEMSG^HLOF778(.MSG)
DO OUTQUE^HLOQUE(MSG("STATUS","LINK NAME"),$GET(MSG("STATUS","PORT")),MSG("STATUS","QUEUE"),MSG("IEN"))
QUIT +MSG("IEN")
+21 QUIT 0
+22 ;
SETPURGE(MSGIEN,TIME) ;; Set message up for purging.
+1 ;;Resets the purge date/time.
+2 ;;Input:
+3 ;; MSGIEN (required) ien of the message, file #778
+4 ;; TIME (required) dt/time to set the purge time to
+5 ;;Output:
+6 ;; Function returns 1 on success, 0 on failure
+7 ;;
+8 NEW NODE,OLDTIME,HLDIR,DAYS
+9 if '$GET(MSGIEN)
QUIT 0
+10 if '$GET(TIME)
QUIT 0
+11 SET NODE=$GET(^HLB(MSGIEN,0))
+12 if NODE=""
QUIT 0
+13 SET OLDTIME=$PIECE(NODE,"^",9)
+14 ;
+15 ;applications may delay the purge, but not purge sooner
+16 IF OLDTIME
IF OLDTIME>TIME
QUIT 0
+17 ;
+18 IF OLDTIME
Begin DoDot:1
+19 SET HLDIR=$SELECT($EXTRACT($PIECE(NODE,"^",4))="I":"IN",1:"OUT")
+20 KILL ^HLB("AD",HLDIR,OLDTIME,MSGIEN)
+21 SET $PIECE(^HLB(MSGIEN,0),"^",9)=TIME
+22 SET ^HLB("AD",HLDIR,TIME,MSGIEN)=""
End DoDot:1
QUIT 1
+23 ;
+24 ;if the message isn't yet scheduled for purge, use TIME to set the retention time
+25 SET DAYS=$$FMDIFF^XLFDT(TIME,$$NOW^XLFDT,3)+1
+26 IF DAYS>$PIECE(NODE,"^",22)
SET $PIECE(^HLB(MSGIEN,0),"^",22)=DAYS
+27 QUIT 1
+28 ;
REPROC(MSGIEN,ERROR) ;; Reprocess message.
+1 ;;This message will re-process an incoming message by placing it on an incoming queue. If successful the message will 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) 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 ;** START HL*1.6*138 CJM
+15 ;I $G(MSG("ACK TO"))]"" S ACTION=MSG("STATUS","APP ACK RESPONSE")
+16 SET ACTION=MSG("STATUS","ACTION")
+17 SET QUEUE=MSG("STATUS","QUEUE")
+18 ;** END HL*1.6*138 CJM
+19 IF ACTION=""
IF '$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE)
IF $GET(MSG("ACK TO"))=""
SET ERROR="RECEIVING APPLICATION NOT DEFINED"
+20 ;If this message references an earlier message, get the action specified by the original message
+21 IF ACTION=""
IF $GET(MSG("ACK TO"))]""
Begin DoDot:1
+22 NEW NODE,IEN
+23 SET IEN=$ORDER(^HLB("B",$PIECE(MSG("ACK TO"),"-"),0))
+24 if IEN
SET NODE=$GET(^HLB(IEN,0))
+25 IF ($PIECE(NODE,"^",11)]"")
SET ACTION=$PIECE(NODE,"^",10,11)
SET QUEUE=$SELECT($PIECE(NODE,"^",6)]"":$PIECE(NODE,"^",6),1:"DEFAULT")
End DoDot:1
+26 IF ACTION=""
SET ERROR="NO ACTION SPECIFIED FOR RECEIVING APPLICATION"
QUIT 0
+27 SET FROM=$SELECT(MSG("HDR","SENDING FACILITY",2)]"":MSG("HDR","SENDING FACILITY",2),1:MSG("HDR","SENDING FACILITY",1))
+28 DO INQUE^HLOQUE(FROM,QUEUE,MSGIEN,ACTION,1)
+29 QUIT 1
+30 ;
PROCNOW(MSGIEN,PURGE,ERROR) ;;
+1 ;;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) 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 ;** START HL*1.6*138 CJM
+17 ;I $G(MSG("ACK TO"))]"" S ACTION=MSG("STATUS","APP ACK RESPONSE")
+18 SET ACTION=MSG("STATUS","ACTION")
+19 ;** END HL*1.6*138 CJM
+20 IF ACTION=""
IF '$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE)
IF $GET(MSG("ACK TO"))=""
SET ERROR="RECEIVING APPLICATION NOT DEFINED"
QUIT 0
+21 ;If this message references an earlier message, get the action specified by the original message
+22 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="ACTION SPECIFIED BY ORIGINAL APPLICATION NOT FOUND"
QUIT 0
+23 IF $PIECE(ACTION,"^",2)=""
SET ERROR="ACTION SPECIFIED BY APPLICATION NOT FOUND"
QUIT 0
+24 if $GET(PURGE)
Begin DoDot:1
+25 if MSG("STATUS","PURGE")
KILL ^HLB("AD","IN",MSG("STATUS","PURGE"),MSGIEN)
+26 SET $PIECE(^HLB(MSGIEN,0),"^",9)=PURGE
+27 SET ^HLB("AD","IN",PURGE,MSGIEN)=""
+28 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
+29 SET HLMSGIEN=MSGIEN
+30 SET $PIECE(^HLB(MSGIEN,0),"^",19)=1
+31 SET MCODE="D "_ACTION
+32 XECUTE MCODE
+33 QUIT 1
+34 ;
+35 ;
+36 ;
+37 ;
+38 ;
+39 ;
+40 ;
