Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOAPI3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOAPI3.m
r613 r623 1 HLOAPI3 ;ALB/CJM-HL7 - Developer API's for sending application acks ;07/10/20072 ;;1.6;HEALTH LEVEL SEVEN;**126,133,134,137**;Oct 13, 1995;Build 21 3 4 5 BATCHACK(HLMSTATE,PARMS,ACK,ERROR) 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 ADDACK(ACK,PARMS,ERROR) 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 .S PARMS("ACK TO","STATUS")=$S(PARMS("ACK CODE")="AA":"SU",1:"ER")95 96 97 98 99 100 101 RESEND(MSGIEN,ERROR) 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 SETPURGE(MSGIEN,TIME) 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 REPROC(MSGIEN,ERROR) 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 PROCNOW(MSGIEN,PURGE,ERROR) 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 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
Note:
See TracChangeset
for help on using the changeset viewer.
