| [623] | 1 | HLOAPI3 ;ALB/CJM-HL7 - Developer API's for sending application acks ;03/13/2007
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**126,133,134**;Oct 13, 1995;Build 30
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | 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.
|
|---|
| 6 | ;$$SENDACK^HLOAPI2 must be called when the batch of acks is complete. The return destination is determined automatically from the original message.
|
|---|
| 7 | ;
|
|---|
| 8 | ;Input:
|
|---|
| 9 | ; HLMSTATE (pass by reference, required) the array obtained by calling $$STARTMSG^HLOPRS when parsing the original message
|
|---|
| 10 | ; PARMS (optional, pass by reference) These subscripts may be defined:
|
|---|
| 11 | ; "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
|
|---|
| 12 | ; "ACCEPT ACK TYPE") = <AL,NE> (optional, defaults to AL)
|
|---|
| 13 | ; "COUNTRY") - a 3 character country code from the HL7 standard table (optional)
|
|---|
| 14 | ; "ENCODING CHARACTERS" - the 4 HL7 encoding characters (optional,defaults to "^~\&"
|
|---|
| 15 | ; "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.
|
|---|
| 16 | ; "FIELD SEPARATOR" - the field separator (optional, defaults to "|")
|
|---|
| 17 | ; "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
|
|---|
| 18 | ; "SECURITY" - security information to include in the header segment, SEQ 8 (optional)
|
|---|
| 19 | ; "VERSION" - the HL7 Version ID (optional, defaults to 2.4)
|
|---|
| 20 | ;Output:
|
|---|
| 21 | ; Function returns 1 on success, 0 on failure
|
|---|
| 22 | ; PARMS - left undefined upon completion
|
|---|
| 23 | ; ACK (pass by reference, required) the batch acknowledgment message being built.
|
|---|
| 24 | ; ERROR (pass by reference) error message
|
|---|
| 25 | N I,TOLINK,SUCCESS
|
|---|
| 26 | S SUCCESS=0
|
|---|
| 27 | ;
|
|---|
| 28 | D
|
|---|
| 29 | .N PORT
|
|---|
| 30 | .I '$G(HLMSTATE("IEN")) S ERROR="ORIGINAL MESSAGE TO ACKNOWLEDGMENT IS NOT IDENTIFIED" Q
|
|---|
| 31 | .;if the return link can not be determined, the HL Logical Link file has a problem
|
|---|
| 32 | .S TOLINK=$$ACKLINK^HLOAPI2(.HLMSTATE)
|
|---|
| 33 | .I TOLINK="" S ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED" Q
|
|---|
| 34 | .S PORT=$P(HLMSTATE("HDR","SENDING FACILITY",2),":",2)
|
|---|
| 35 | .I 'PORT S PORT=$$PORT2^HLOTLNK(TOLINK)
|
|---|
| 36 | .;
|
|---|
| 37 | .I $$NEWBATCH^HLOAPI(.PARMS,.ACK) ;can't fail!
|
|---|
| 38 | .S ACK("STATUS","QUEUE")=$G(PARMS("QUEUE"),$G(HLMSTATE("STATUS","QUEUE")))
|
|---|
| 39 | .S ACK("STATUS","PORT")=PORT
|
|---|
| 40 | .S ACK("HDR","SECURITY")=$G(PARMS("SECURITY"))
|
|---|
| 41 | .S ACK("HDR","SENDING APPLICATION")=$G(HLMSTATE("HDR","RECEIVING APPLICATION"))
|
|---|
| 42 | .S ACK("HDR","RECEIVING APPLICATION")=$G(HLMSTATE("HDR","SENDING APPLICATION"))
|
|---|
| 43 | .F I=1:1:3 S ACK("HDR","RECEIVING FACILITY",I)=$G(HLMSTATE("HDR","SENDING FACILITY",I))
|
|---|
| 44 | .S ACK("HDR","APP ACK TYPE")="NE"
|
|---|
| 45 | .S ACK("HDR","ACCEPT ACK TYPE")=$G(PARMS("ACCEPT ACK TYPE"),"AL")
|
|---|
| 46 | .S ACK("ACK TO")=$G(HLMSTATE("HDR","BATCH CONTROL ID"))
|
|---|
| 47 | .S ACK("ACK TO","IEN")=HLMSTATE("IEN")
|
|---|
| 48 | .S ACK("ACK TO","BODY")=$G(HLMSTATE("BODY"))
|
|---|
| 49 | .S ACK("STATUS","LINK NAME")=TOLINK
|
|---|
| 50 | .S ACK("LINE COUNT")=0
|
|---|
| 51 | .S SUCCESS=1
|
|---|
| 52 | K PARMS
|
|---|
| 53 | Q SUCCESS
|
|---|
| 54 | ;
|
|---|
| 55 | ADDACK(ACK,PARMS,ERROR) ;This API adds an application acknowledgment to a batch
|
|---|
| 56 | ;of acknowledgments that was started by calling $$BATCHACK.
|
|---|
| 57 | ;The Default behavior is to return a general application ack.
|
|---|
| 58 | ;The application may optionally specify the message
|
|---|
| 59 | ;type and event and/or call $$ADDSEG^HLOAPI to add segments.
|
|---|
| 60 | ;A generic MSA segment (components 1-3) will be added automatically
|
|---|
| 61 | ;if the application doesn't call $$ADDSEG^HLOAPI to add an MSA segment
|
|---|
| 62 | ;as the FIRST segment following the MSH segment.
|
|---|
| 63 | ;$$SENDACK^HLOAPI2 must be called when the batch is complete.
|
|---|
| 64 | ;
|
|---|
| 65 | ;Input:
|
|---|
| 66 | ; ACK (pass by reference,required) the batch of acks that is being built
|
|---|
| 67 | ; PARMS (pass by reference) These subscripts may be defined:
|
|---|
| 68 | ; "ACK CODE" (required) MSA1[ {AA,AE,AR}
|
|---|
| 69 | ; "ERROR MESSAGE" (optional) MSA3, should be used only if AE or AR
|
|---|
| 70 | ; "EVENT" - 3 character event type (optional, defaults to the event code of the original message)
|
|---|
| 71 | ; "MESSAGE CONTROL ID" (required) this is the message control id of the original individual message within the batch which is being acknowledged
|
|---|
| 72 | ; "MESSAGE STRUCTURE" (optional)
|
|---|
| 73 | ; "MESSAGE TYPE" (optional, defaults to ACK)
|
|---|
| 74 | ; "SECURITY" (optional) security information to include in the header segment SEQ 8
|
|---|
| 75 | ;Output:
|
|---|
| 76 | ; Function returns 1 on success, 0 on failure
|
|---|
| 77 | ; ACK (pass by reference, required) The batch, updated with another ack
|
|---|
| 78 | ; PARMS - left undefined when this function returns
|
|---|
| 79 | ; ERROR (pass by reference) error msg
|
|---|
| 80 | ;
|
|---|
| 81 | N SUB,SUCCESS
|
|---|
| 82 | S SUCCESS=0
|
|---|
| 83 | D
|
|---|
| 84 | .I $G(PARMS("ACK CODE"))'="AA",$G(PARMS("ACK CODE"))'="AE",$G(PARMS("ACK CODE"))'="AR" S ERROR="INVALID ACK CODE" Q
|
|---|
| 85 | .;
|
|---|
| 86 | .I $G(PARMS("MESSAGE CONTROL ID"))="" S ERROR="MESSAGE CONTROL ID MUST EXIST TO RETURN AN APPLICATION ACK" Q
|
|---|
| 87 | .S SUB=""
|
|---|
| 88 | .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
|
|---|
| 89 | .S PARMS("MESSAGE TYPE")=$G(PARMS("MESSAGE TYPE"),"ACK")
|
|---|
| 90 | .S:PARMS("MESSAGE TYPE")="ACK" PARMS("MESSAGE STRUCTURE")="ACK"
|
|---|
| 91 | .S PARMS("EVENT")=$G(PARMS("EVENT"))
|
|---|
| 92 | .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)
|
|---|
| 93 | .S PARMS("ACK TO")=PARMS("MESSAGE CONTROL ID")
|
|---|
| 94 | .S PARMS("ACK TO","STATUS")=$S(PARMS("ACK CODE")="AA":"SU",1:"AE")
|
|---|
| 95 | .Q:'$$ADDMSG^HLOAPI(.ACK,.PARMS,.ERROR)
|
|---|
| 96 | .S ACK("MSA")="MSA|"_PARMS("ACK CODE")_"|"_PARMS("MESSAGE CONTROL ID")_"|"_$G(PARMS("ERROR MESSAGE"))
|
|---|
| 97 | .S SUCCESS=1
|
|---|
| 98 | K PARMS
|
|---|
| 99 | Q SUCCESS
|
|---|
| 100 | ;
|
|---|
| 101 | RESEND(MSGIEN,ERROR) ;
|
|---|
| 102 | ;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.
|
|---|
| 103 | ;
|
|---|
| 104 | ;Input:
|
|---|
| 105 | ; MSGIEN - the ien (file #778) of the message that is to be sent
|
|---|
| 106 | ;Output:
|
|---|
| 107 | ; Function returns the ien of the message in file 778 on success, 0 on failure
|
|---|
| 108 | ; ERROR (pass by reference, optional)an error message
|
|---|
| 109 | ;
|
|---|
| 110 | N MSG,SUB,HDR
|
|---|
| 111 | I '$$STARTMSG^HLOPRS(.MSG,MSGIEN) S ERROR="MESSAGE NOT FOUND" Q 0
|
|---|
| 112 | I MSG("DIRECTION")'="OUT" S ERROR="MESSAGE IS NOT OUTGOING" Q 0
|
|---|
| 113 | I MSG("STATUS","LINK NAME")="" S ERROR="LINK NOT DEFINED" Q 0
|
|---|
| 114 | F SUB="ID","IEN","DT/TM","ACK BY","STATUS" S MSG(SUB)=""
|
|---|
| 115 | F SUB="PURGE" K MSG("STATUS",SUB)
|
|---|
| 116 | D GETSYS^HLOAPI(.MSG)
|
|---|
| 117 | I $$SAVEMSG^HLOF778(.MSG) D OUTQUE^HLOQUE(MSG("STATUS","LINK NAME"),$G(MSG("STATUS","PORT")),MSG("STATUS","QUEUE"),MSG("IEN")) Q +MSG("IEN")
|
|---|
| 118 | Q 0
|
|---|
| 119 | ;
|
|---|
| 120 | SETPURGE(MSGIEN,TIME) ;
|
|---|
| 121 | ;Resets the purge date/time.
|
|---|
| 122 | ;Input:
|
|---|
| 123 | ; MSGIEN (required) ien of the message, file #778
|
|---|
| 124 | ; TIME (optional) dt/time to set the purge time to, defaults to NOW
|
|---|
| 125 | ;Output:
|
|---|
| 126 | ; Function returns 1 on success, 0 on failure
|
|---|
| 127 | N NODE,OLDTIME,HLDIR
|
|---|
| 128 | Q:'$G(MSGIEN) 0
|
|---|
| 129 | S NODE=$G(^HLB(MSGIEN,0))
|
|---|
| 130 | Q:NODE="" 0
|
|---|
| 131 | S OLDTIME=$P(NODE,"^",9)
|
|---|
| 132 | S:'$G(TIME) TIME=$$NOW^XLFDT
|
|---|
| 133 | S HLDIR=$S($E($P(NODE,"^",4))="I":"IN",1:"OUT")
|
|---|
| 134 | K:OLDTIME ^HLB("AD",HLDIR,OLDTIME,MSGIEN)
|
|---|
| 135 | S $P(^HLB(MSGIEN,0),"^",9)=TIME
|
|---|
| 136 | S ^HLB("AD",HLDIR,TIME,MSGIEN)=""
|
|---|
| 137 | Q 1
|
|---|
| 138 | ;
|
|---|
| 139 | REPROC(MSGIEN,ERROR) ;
|
|---|
| 140 | ;This message will re-process an incoming message by placing it on an incoming queue. If successful the message will be purged.
|
|---|
| 141 | ;
|
|---|
| 142 | ;Input:
|
|---|
| 143 | ; MSGIEN - the ien (file #778) of the message that is to be processed
|
|---|
| 144 | ;Output:
|
|---|
| 145 | ; Function returns 1 on success, 0 on failure
|
|---|
| 146 | ; ERROR (pass by reference, optional) an error message
|
|---|
| 147 | ;
|
|---|
| 148 | N MSG,HDR,ACTION,QUEUE,FROM
|
|---|
| 149 | ;
|
|---|
| 150 | I '$$STARTMSG^HLOPRS(.MSG,MSGIEN) S ERROR="MESSAGE NOT FOUND" Q 0
|
|---|
| 151 | I MSG("DIRECTION")'="IN" S ERROR="MESSAGE IS NOT INCOMING" Q 0
|
|---|
| 152 | M HDR=MSG("HDR")
|
|---|
| 153 | I $G(MSG("ACK TO"))]"" S ACTION=MSG("STATUS","APP ACK RESPONSE")
|
|---|
| 154 | I ACTION="",'$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE),$G(MSG("ACK TO"))="" S ERROR="RECEIVING APPLICATION NOT DEFINED"
|
|---|
| 155 | ;If this message references an earlier message, get the action specified by the original message
|
|---|
| 156 | I ACTION="",$G(MSG("ACK TO"))]"" D
|
|---|
| 157 | .N NODE,IEN
|
|---|
| 158 | .S IEN=$O(^HLB("B",$P(MSG("ACK TO"),"-"),0))
|
|---|
| 159 | .S:IEN NODE=$G(^HLB(IEN,0))
|
|---|
| 160 | .I ($P(NODE,"^",11)]"") S ACTION=$P(NODE,"^",10,11),QUEUE=$S($P(NODE,"^",6)]"":$P(NODE,"^",6),1:"DEFAULT")
|
|---|
| 161 | I ACTION="" S ERROR="ORIGINAL MESSAGE NOT FOUND" Q 0
|
|---|
| 162 | S FROM=$S(MSG("HDR","SENDING FACILITY",2)]"":MSG("HDR","SENDING FACILITY",2),1:MSG("HDR","SENDING FACILITY",1))
|
|---|
| 163 | D INQUE^HLOQUE(FROM,QUEUE,MSGIEN,ACTION,1)
|
|---|
| 164 | Q 1
|
|---|
| 165 | ;
|
|---|
| 166 | PROCNOW(MSGIEN,PURGE,ERROR) ;
|
|---|
| 167 | ;This message will re-process an incoming message immediately.
|
|---|
| 168 | ;
|
|---|
| 169 | ;Input:
|
|---|
| 170 | ; MSGIEN - the ien (file #778) of the message that is to be processed
|
|---|
| 171 | ;Output:
|
|---|
| 172 | ; Function returns 1 on success, 0 on failure
|
|---|
| 173 | ; PURGE (optional) a date/time to purge the message
|
|---|
| 174 | ; ERROR (pass by reference, optional) an error message
|
|---|
| 175 | ;
|
|---|
| 176 | N MSG,HDR,ACTION,MCODE,HLMSGIEN
|
|---|
| 177 | ;
|
|---|
| 178 | S ERROR=""
|
|---|
| 179 | I '$$STARTMSG^HLOPRS(.MSG,MSGIEN) S ERROR="MESSAGE NOT FOUND" Q 0
|
|---|
| 180 | I MSG("DIRECTION")'="IN" S ERROR="MESSAGE IS NOT INCOMING" Q 0
|
|---|
| 181 | M HDR=MSG("HDR")
|
|---|
| 182 | I $G(MSG("ACK TO"))]"" S ACTION=MSG("STATUS","APP ACK RESPONSE")
|
|---|
| 183 | I ACTION="",'$$ACTION^HLOAPP(.HDR,.ACTION,.QUEUE),$G(MSG("ACK TO"))="" S ERROR="RECEIVING APPLICATION NOT DEFINED" Q 0
|
|---|
| 184 | ;If this message references an earlier message, get the action specified by the original message
|
|---|
| 185 | 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
|
|---|
| 186 | D:$G(PURGE)
|
|---|
| 187 | .K:MSG("STATUS","PURGE") ^HLB("AD","IN",MSG("STATUS","PURGE"),MSGIEN)
|
|---|
| 188 | .S $P(^HLB(MSGIEN,0),"^",9)=PURGE
|
|---|
| 189 | .S ^HLB("AD","IN",PURGE,MSGIEN)=""
|
|---|
| 190 | .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"))=""
|
|---|
| 191 | S HLMSGIEN=MSGIEN
|
|---|
| 192 | S $P(^HLB(MSGIEN,0),"^",19)=1
|
|---|
| 193 | S MCODE="D "_ACTION
|
|---|
| 194 | X MCODE
|
|---|
| 195 | Q 1
|
|---|
