Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLOAPI2

HLOAPI2.m

Go to the documentation of this file. 
  1. HLOAPI2 ;ALB/CJM/OAK/RBN-HL7 - Developer API's for sending application acks ;07/12/2012
  1.  ;;1.6;HEALTH LEVEL SEVEN;**126,131,133,134,137,138,146,158**;Oct 13, 1995;Build 14
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. ACK(HLMSTATE,PARMS,ACK,ERROR) ;; Default behavior is to return a general
  1.  ;;application ack. The application may optionally specify the message
  1.  ;;type and event or call $$ADDSEG^HLOAPI to add segments.
  1.  ;;A generic MSA segment (components 1-3) is added automatically IF the
  1.  ;;application doesn't call $$ADDSEG^HLOAPI to add an MSA segment as the
  1.  ;;FIRST segment following the header.
  1.  ;;$$SENDACK must be called when the ack is completed. The return
  1.  ;;destination is determined automatically from the original message
  1.  ;;
  1.  ;;This API should NOT be called for batch messages, use $$BATCHACK instead.
  1.  ;;Input:
  1.  ;;  HLMSTATE (pass by reference, required) the array obtained by calling $$STARTMSG^HLOPRS when parsing the original message 
  1.  ;;  PARMS (pass by reference) These subscripts may be defined:
  1.  ;;    "ACK CODE" (required) MSA1[ {AA,AE,AR}
  1.  ;;    "ERROR MESSAGE" - MSA3, should be used only if AE or AR
  1.  ;;    "ACCEPT ACK RESPONSE" - the <tag^routine> to call when the commit ack is received (optional)
  1.  ;;    "ACCEPT ACK TYPE" - {AL,NE} (optional, defaults to AL)
  1.  ;;    "CONTINUATION POINTER" (optional)indicates a fragmented message
  1.  ;;    "COUNTRY" - the 3 character country code (optional)
  1.  ;;    "EVENT" - the 3 character event type (optional, defaults to the event code of the original message)
  1.  ;;    "ENCODING CHARACTERS" - the four HL7 encoding characters (optional,defaults to "^~\&"
  1.  ;;    "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.
  1.  ;;    "FIELD SEPARATOR" - field separator (optional, defaults to "|")
  1.  ;;    "MESSAGE TYPE" - if not defined, ACK is used
  1.  ;;    "MESSAGE STRUCTURE" (optional)
  1.  ;;    "RETURN LINK NAME" (optional)
  1.  ;;    "RETURN LINK IEN" (optional)
  1.  ;;    "QUEUE" - (optional) An application can name its own private queue (a string under 20 characters,namespaced). The default is the name of the queue of the original message
  1.  ;;    "SECURITY" (optional) security information to include in the header segment, SEQ 8 (optional)
  1.  ;;    "VERSION" - the HL7 Version ID (optional, defaults to 2.4)
  1.  ;;Output:
  1.  ;;  Function returns 1 on success, 0 on failure
  1.  ;;  PARMS - left undefined when the function returns
  1.  ;;  ACK (pass by reference, required) the acknowledgment message being built.
  1.  ;;  ERROR (pass by reference) error msg
  1.  ;;  
  1.  N I,SEG,TOLINK,SUCCESS
  1.  S SUCCESS=0,(TOLINK,ERROR)=""
  1.  ;
  1.  D
  1.  .N PORT S PORT=""
  1.  .I $G(PARMS("ACK CODE"))'="AA",$G(PARMS("ACK CODE"))'="AE",$G(PARMS("ACK CODE"))'="AR" S ERROR="INVALID ACK CODE" Q
  1.  .;
  1.  .I '$G(HLMSTATE("IEN")) S ERROR="ORIGINAL MESSAGE TO ACKNOWLEDGE IS NOT IDENTIFIED" Q
  1.  .I $G(HLMSTATE("BATCH")) S ERROR="BATCH ACKNOWLEDGMENTS MUST USE $$BATCHACK^HLOAPI3" Q
  1.  .;
  1.  .I $G(HLMSTATE("HDR","MESSAGE CONTROL ID"))="" S ERROR="MESSAGE CONTROL ID MUST EXIST TO RETURN AN APPLICATION ACK" Q
  1.  .S PARMS("MESSAGE TYPE")=$G(PARMS("MESSAGE TYPE"),"ACK")
  1.  .S:PARMS("MESSAGE TYPE")="ACK" PARMS("MESSAGE STRUCTURE")="ACK"
  1.  .S PARMS("EVENT")=$G(PARMS("EVENT"),$G(HLMSTATE("HDR","EVENT")))
  1.  .I $$NEWMSG^HLOAPI(.PARMS,.ACK)  ;can't fail!
  1.  .;
  1.  .;if the return link can not be determined, the HL Logical Link file has a problem that must be fixed at the site
  1.  .I $G(PARMS("RETURN LINK IEN")) D
  1.  ..S TOLINK=$P($G(^HLCS(870,PARMS("RETURN LINK IEN"),0)),"^")
  1.  ..S PORT=$$PORT2^HLOTLNK(TOLINK)
  1.  .E  I $L($G(PARMS("RETURN LINK NAME"))) D
  1.  ..S TOLINK=PARMS("RETURN LINK NAME")
  1.  ..S PORT=$$PORT2^HLOTLNK(TOLINK)
  1.  .E  D
  1.  ..S TOLINK=$$ACKLINK(.HLMSTATE,.PORT)
  1.  .I (TOLINK="")!('PORT) S ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED" Q
  1.  .;
  1.  .S ACK("HDR","APP ACK TYPE")="NE"
  1.  .S ACK("HDR","ACCEPT ACK TYPE")=$G(PARMS("ACCEPT ACK TYPE"),"AL")
  1.  .S ACK("STATUS","QUEUE")=$G(PARMS("QUEUE"),$G(HLMSTATE("STATUS","QUEUE")))
  1.  .S ACK("STATUS","PORT")=PORT
  1.  .S ACK("HDR","SECURITY")=$G(PARMS("SECURITY"))
  1.  .S ACK("HDR","SENDING APPLICATION")=$G(HLMSTATE("HDR","RECEIVING APPLICATION"))
  1.  .S ACK("HDR","RECEIVING APPLICATION")=$G(HLMSTATE("HDR","SENDING APPLICATION"))
  1.  .F I=1:1:3 S ACK("HDR","RECEIVING FACILITY",I)=$G(HLMSTATE("HDR","SENDING FACILITY",I))
  1.  .S ACK("ACK TO","STATUS")=$S(PARMS("ACK CODE")="AA":"SU",1:"ER")
  1.  .S ACK("ACK TO")=$G(HLMSTATE("HDR","MESSAGE CONTROL ID"))
  1.  .S ACK("ACK TO IEN")=HLMSTATE("IEN")
  1.  .S ACK("STATUS","LINK NAME")=TOLINK
  1.  .S ACK("LINE COUNT")=0
  1.  . ;; Next line modified for HL*1.6*138 - RBN
  1.  .;;S ACK("MSA")="MSA"_ACK("HDR","FIELD SEPARATOR")_PARMS("ACK CODE")_ACK("HDR","FIELD SEPARATOR")_$G(HLMSTATE("HDR","MESSAGE CONTROL ID"))_ACK("HDR","FIELD SEPARATOR")_$G(PARMS("ERROR MESSAGE"))
  1.  .S ACK("MSA")="MSA"_ACK("HDR","FIELD SEPARATOR")_PARMS("ACK CODE")_ACK("HDR","FIELD SEPARATOR")_$G(HLMSTATE("HDR","MESSAGE CONTROL ID"))_ACK("HDR","FIELD SEPARATOR")_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(PARMS("ERROR MESSAGE")))
  1.  .S SUCCESS=1
  1.  K PARMS
  1.  K:'SUCCESS ACK
  1.  Q SUCCESS
  1.  ;
  1. SENDACK(ACK,ERROR) ;;This is used to signal that an application acknowledgment is complete.
  1.  ;;Input:
  1.  ;;  ACK (pass by reference,required) An array that contains the acknowledgment msg
  1.  ;;Output:
  1.  ;; Function returns 1 on success, 0 on failure
  1.  ;; ERROR (pass by reference) error msg
  1.  ;;
  1.  N SEG
  1.  ;if the application added its own MSA, then the ACK("MSA") node was killed
  1.  I $D(ACK("MSA")) S SEG(1)=ACK("MSA") D ADDSEG^HLOMSG(.ACK,.SEG)
  1.  ;
  1.  I $$SEND^HLOAPI1(.ACK,.ERROR) Q 1
  1.  Q 0
  1.  ;
  1.  N LINK
  1.  S LINK=$$RTRNLNK^HLOAPP($G(HLMSTATE("HDR","RECEIVING APPLICATION")))
  1.  I LINK]"" S PORT=$$PORT2^HLOTLNK(LINK) Q LINK
  1.  S LINK=$$RTRNLNK^HLOTLNK($G(HLMSTATE("HDR","SENDING FACILITY",1)),$G(HLMSTATE("HDR","SENDING FACILITY",2)),$G(HLMSTATE("HDR","SENDING FACILITY",3)))
  1.  S:$G(HLMSTATE("HDR","SENDING FACILITY",3))="DNS" PORT=$P(HLMSTATE("HDR","SENDING FACILITY",2),":",2)
  1.  I LINK]"",'PORT S PORT=$$PORT2^HLOTLNK(LINK)
  1.  Q LINK
  1.  ;
  1. CHKPARMS(HLMSTATE,PARMS,ERROR) ;
  1.  N LEN,SARY,HARY
  1.  ;
  1.  ;shortcut to reference the header sub-array
  1.  S HARY="HLMSTATE(""HDR"")"
  1.  ;
  1.  ;shortcut to reference the status sub-array
  1.  S SARY="HLMSTATE(""STATUS"")"
  1.  ;
  1.  S ERROR=""
  1.  I $G(PARMS("ACCEPT ACK TYPE"))="" S PARMS("ACCEPT ACK TYPE")="AL"
  1.  I $G(PARMS("APP ACK TYPE"))="" S PARMS("APP ACK TYPE")="NE"
  1.  I PARMS("ACCEPT ACK TYPE")'="NE",PARMS("ACCEPT ACK TYPE")'="AL" S ERROR="INVALID ACCEPT ACKNOWLEDGMENT TYPE"
  1.  I PARMS("APP ACK TYPE")'="NE",PARMS("APP ACK TYPE")'="AL" S ERROR="INVALID APPLICATION ACKNOWLEDGMENT TYPE"
  1.  S LEN=$L($G(PARMS("QUEUE")))
  1.  I $G(PARMS("QUEUE"))["^" S ERROR="QUEUE NAME MAY NOT CONTAIN '^'"
  1.  I LEN>20 S ERROR="QUEUE PARAMETER IS MAX 20 LENGTH",PARMS("QUEUE")=$E(PARMS("QUEUE"),1,20)
  1.  I 'LEN S PARMS("QUEUE")="DEFAULT"
  1.  D
  1.  .N APPIEN
  1.  .I $G(PARMS("SENDING APPLICATION"))="" D  Q
  1.  ..S ERROR="SENDING APPLICATION IS REQUIRED"
  1.  ..S PARMS("SENDING APPLICATION")=""
  1.  .E  D  Q:'APPIEN
  1.  ..S APPIEN=$$GETIEN^HLOAPP(PARMS("SENDING APPLICATION"))
  1.  ..I 'APPIEN S ERROR="SENDING APPLICATION NOT FOUND IN THE HLO APPLICATION REGISTRY"
  1.  .I $L($G(PARMS("SEQUENCE QUEUE"))) D
  1.  ..I ($L(PARMS("SEQUENCE QUEUE"))>30) S ERROR="SEQUENCE QUEUE NAME > 30 CHARACTERS" Q
  1.  ..I PARMS("SEQUENCE QUEUE")["^" S ERROR="SEQUENCE QUEUE NAME MAY NOT CONTAIN '^'" Q
  1.  ..I $G(PARMS("APP ACK TYPE"))'="AL" S ERROR="SEQUENCE QUEUES REQUIRE AN APPLICATION ACKNOWLEDGMENT" Q
  1.  ..I $G(PARMS("ACCEPT ACK TYPE"))'="AL" S ERROR="SEQUENCE QUEUES REQUIRE AN ACCEPT ACKNOWLEDGMENT" Q
  1.  ;
  1.  ;move parameters into HLMSTATE
  1.  S @HARY@("ACCEPT ACK TYPE")=PARMS("ACCEPT ACK TYPE")
  1.  S @HARY@("APP ACK TYPE")=PARMS("APP ACK TYPE")
  1.  S @HARY@("SENDING APPLICATION")=$E(PARMS("SENDING APPLICATION"),1,60)
  1.  S @HARY@("SECURITY")=$G(PARMS("SECURITY"))
  1.  S @SARY@("APP ACK RESPONSE")=$G(PARMS("APP ACK RESPONSE"))
  1.  S @SARY@("ACCEPT ACK RESPONSE")=$G(PARMS("ACCEPT ACK RESPONSE"))
  1.  S @SARY@("FAILURE RESPONSE")=$G(PARMS("FAILURE RESPONSE"))
  1.  S @SARY@("QUEUE")=PARMS("QUEUE")
  1.  S @SARY@("SEQUENCE QUEUE")=$G(PARMS("SEQUENCE QUEUE"))
  1.  Q:$L(ERROR) 0
  1.  Q 1
  1.  ;
  1.  ;
  1. SETCODE(SEG,VALUE,FIELD,COMP,REP) ; Implements SETCNE and SETCWE
  1.  ;
  1.  N SUB,VAR
  1.  Q:'$G(FIELD)
  1.  S:'$G(REP) REP=1
  1.  I '$G(COMP) D
  1.  .S VAR="COMP",SUB=1
  1.  E  D
  1.  .S VAR="SUB"
  1.  S @VAR=1,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ID"))
  1.  S @VAR=2,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("TEXT"))
  1.  S @VAR=3,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("SYSTEM"))
  1.  S @VAR=4,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE ID"))
  1.  S @VAR=5,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE TEXT"))
  1.  S @VAR=6,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE SYSTEM"))
  1.  S @VAR=7,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("SYSTEM VERSION"))
  1.  S @VAR=8,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE SYSTEM VERSION"))
  1.  S @VAR=9,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ORIGINAL TEXT"))
  1.  Q
  1.  ;
  1. CHKWHO(HLMSTATE,WHOTO,ERROR) ;
  1.  N RETURN,I
  1.  S RETURN=1
  1.  I '$$CHECKWHO^HLOASUB1(.WHOTO,.RETURN,.ERROR) S RETURN=0
  1.  ;
  1.  ;move parameters into HLMSTATE
  1.  S HLMSTATE("STATUS","LINK IEN")=$G(RETURN("LINK IEN"))
  1.  S HLMSTATE("STATUS","LINK NAME")=$G(RETURN("LINK NAME"))
  1.  ;** P158 START **
  1.  ;S HLMSTATE("STATUS","PORT")=$P($G(RETURN("RECEIVING FACILITY",2)),":",2)
  1.  S HLMSTATE("STATUS","PORT")=$G(RETURN("LINK PORT"))
  1.  ;** P158 END **
  1.  S HLMSTATE("HDR","RECEIVING APPLICATION")=$G(RETURN("RECEIVING APPLICATION"))
  1.  F I=1:1:3 S HLMSTATE("HDR","RECEIVING FACILITY",I)=$G(RETURN("RECEIVING FACILITY",I))
  1.  Q RETURN