HLOAPI2 ;ALB/CJM/OAK/RBN-HL7 - Developer API's for sending application acks ;07/12/2012
;;1.6;HEALTH LEVEL SEVEN;**126,131,133,134,137,138,146,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
ACK(HLMSTATE,PARMS,ACK,ERROR) ;; Default behavior is to return a general
;;application ack. The application may optionally specify the message
;;type and event or call $$ADDSEG^HLOAPI to add segments.
;;A generic MSA segment (components 1-3) is added automatically IF the
;;application doesn't call $$ADDSEG^HLOAPI to add an MSA segment as the
;;FIRST segment following the header.
;;$$SENDACK must be called when the ack is completed. The return
;;destination is determined automatically from the original message
;;
;;This API should NOT be called for batch messages, use $$BATCHACK instead.
;;Input:
;; HLMSTATE (pass by reference, required) the array obtained by calling $$STARTMSG^HLOPRS when parsing the original message
;; PARMS (pass by reference) These subscripts may be defined:
;; "ACK CODE" (required) MSA1[ {AA,AE,AR}
;; "ERROR MESSAGE" - MSA3, should be used only if AE or AR
;; "ACCEPT ACK RESPONSE" - the <tag^routine> to call when the commit ack is received (optional)
;; "ACCEPT ACK TYPE" - {AL,NE} (optional, defaults to AL)
;; "CONTINUATION POINTER" (optional)indicates a fragmented message
;; "COUNTRY" - the 3 character country code (optional)
;; "EVENT" - the 3 character event type (optional, defaults to the event code of the original message)
;; "ENCODING CHARACTERS" - the four 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" - field separator (optional, defaults to "|")
;; "MESSAGE TYPE" - if not defined, ACK is used
;; "MESSAGE STRUCTURE" (optional)
;; "RETURN LINK NAME" (optional)
;; "RETURN LINK IEN" (optional)
;; "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
;; "SECURITY" (optional) 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 when the function returns
;; ACK (pass by reference, required) the acknowledgment message being built.
;; ERROR (pass by reference) error msg
;;
N I,SEG,TOLINK,SUCCESS
S SUCCESS=0,(TOLINK,ERROR)=""
;
D
.N PORT S PORT=""
.I $G(PARMS("ACK CODE"))'="AA",$G(PARMS("ACK CODE"))'="AE",$G(PARMS("ACK CODE"))'="AR" S ERROR="INVALID ACK CODE" Q
.;
.I '$G(HLMSTATE("IEN")) S ERROR="ORIGINAL MESSAGE TO ACKNOWLEDGE IS NOT IDENTIFIED" Q
.I $G(HLMSTATE("BATCH")) S ERROR="BATCH ACKNOWLEDGMENTS MUST USE $$BATCHACK^HLOAPI3" Q
.;
.I $G(HLMSTATE("HDR","MESSAGE CONTROL ID"))="" S ERROR="MESSAGE CONTROL ID MUST EXIST TO RETURN AN APPLICATION ACK" 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"),$G(HLMSTATE("HDR","EVENT")))
.I $$NEWMSG^HLOAPI(.PARMS,.ACK) ;can't fail!
.;
.;if the return link can not be determined, the HL Logical Link file has a problem that must be fixed at the site
.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(.HLMSTATE,.PORT)
.I (TOLINK="")!('PORT) S ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED" Q
.;
.S ACK("HDR","APP ACK TYPE")="NE"
.S ACK("HDR","ACCEPT ACK TYPE")=$G(PARMS("ACCEPT ACK TYPE"),"AL")
.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("ACK TO","STATUS")=$S(PARMS("ACK CODE")="AA":"SU",1:"ER")
.S ACK("ACK TO")=$G(HLMSTATE("HDR","MESSAGE CONTROL ID"))
.S ACK("ACK TO IEN")=HLMSTATE("IEN")
.S ACK("STATUS","LINK NAME")=TOLINK
.S ACK("LINE COUNT")=0
. ;; Next line modified for HL*1.6*138 - RBN
.;;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"))
.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")))
.S SUCCESS=1
K PARMS
K:'SUCCESS ACK
Q SUCCESS
;
SENDACK(ACK,ERROR) ;;This is used to signal that an application acknowledgment is complete.
;;Input:
;; ACK (pass by reference,required) An array that contains the acknowledgment msg
;;Output:
;; Function returns 1 on success, 0 on failure
;; ERROR (pass by reference) error msg
;;
N SEG
;if the application added its own MSA, then the ACK("MSA") node was killed
I $D(ACK("MSA")) S SEG(1)=ACK("MSA") D ADDSEG^HLOMSG(.ACK,.SEG)
;
I $$SEND^HLOAPI1(.ACK,.ERROR) Q 1
Q 0
;
ACKLINK(HLMSTATE,PORT) ; Finds the link & port to return the application ack to.
N LINK
S LINK=$$RTRNLNK^HLOAPP($G(HLMSTATE("HDR","RECEIVING APPLICATION")))
I LINK]"" S PORT=$$PORT2^HLOTLNK(LINK) Q LINK
S LINK=$$RTRNLNK^HLOTLNK($G(HLMSTATE("HDR","SENDING FACILITY",1)),$G(HLMSTATE("HDR","SENDING FACILITY",2)),$G(HLMSTATE("HDR","SENDING FACILITY",3)))
S:$G(HLMSTATE("HDR","SENDING FACILITY",3))="DNS" PORT=$P(HLMSTATE("HDR","SENDING FACILITY",2),":",2)
I LINK]"",'PORT S PORT=$$PORT2^HLOTLNK(LINK)
Q LINK
;
CHKPARMS(HLMSTATE,PARMS,ERROR) ;
N LEN,SARY,HARY
;
;shortcut to reference the header sub-array
S HARY="HLMSTATE(""HDR"")"
;
;shortcut to reference the status sub-array
S SARY="HLMSTATE(""STATUS"")"
;
S ERROR=""
I $G(PARMS("ACCEPT ACK TYPE"))="" S PARMS("ACCEPT ACK TYPE")="AL"
I $G(PARMS("APP ACK TYPE"))="" S PARMS("APP ACK TYPE")="NE"
I PARMS("ACCEPT ACK TYPE")'="NE",PARMS("ACCEPT ACK TYPE")'="AL" S ERROR="INVALID ACCEPT ACKNOWLEDGMENT TYPE"
I PARMS("APP ACK TYPE")'="NE",PARMS("APP ACK TYPE")'="AL" S ERROR="INVALID APPLICATION ACKNOWLEDGMENT TYPE"
S LEN=$L($G(PARMS("QUEUE")))
I $G(PARMS("QUEUE"))["^" S ERROR="QUEUE NAME MAY NOT CONTAIN '^'"
I LEN>20 S ERROR="QUEUE PARAMETER IS MAX 20 LENGTH",PARMS("QUEUE")=$E(PARMS("QUEUE"),1,20)
I 'LEN S PARMS("QUEUE")="DEFAULT"
D
.N APPIEN
.I $G(PARMS("SENDING APPLICATION"))="" D Q
..S ERROR="SENDING APPLICATION IS REQUIRED"
..S PARMS("SENDING APPLICATION")=""
.E D Q:'APPIEN
..S APPIEN=$$GETIEN^HLOAPP(PARMS("SENDING APPLICATION"))
..I 'APPIEN S ERROR="SENDING APPLICATION NOT FOUND IN THE HLO APPLICATION REGISTRY"
.I $L($G(PARMS("SEQUENCE QUEUE"))) D
..I ($L(PARMS("SEQUENCE QUEUE"))>30) S ERROR="SEQUENCE QUEUE NAME > 30 CHARACTERS" Q
..I PARMS("SEQUENCE QUEUE")["^" S ERROR="SEQUENCE QUEUE NAME MAY NOT CONTAIN '^'" Q
..I $G(PARMS("APP ACK TYPE"))'="AL" S ERROR="SEQUENCE QUEUES REQUIRE AN APPLICATION ACKNOWLEDGMENT" Q
..I $G(PARMS("ACCEPT ACK TYPE"))'="AL" S ERROR="SEQUENCE QUEUES REQUIRE AN ACCEPT ACKNOWLEDGMENT" Q
;
;move parameters into HLMSTATE
S @HARY@("ACCEPT ACK TYPE")=PARMS("ACCEPT ACK TYPE")
S @HARY@("APP ACK TYPE")=PARMS("APP ACK TYPE")
S @HARY@("SENDING APPLICATION")=$E(PARMS("SENDING APPLICATION"),1,60)
S @HARY@("SECURITY")=$G(PARMS("SECURITY"))
S @SARY@("APP ACK RESPONSE")=$G(PARMS("APP ACK RESPONSE"))
S @SARY@("ACCEPT ACK RESPONSE")=$G(PARMS("ACCEPT ACK RESPONSE"))
S @SARY@("FAILURE RESPONSE")=$G(PARMS("FAILURE RESPONSE"))
S @SARY@("QUEUE")=PARMS("QUEUE")
S @SARY@("SEQUENCE QUEUE")=$G(PARMS("SEQUENCE QUEUE"))
Q:$L(ERROR) 0
Q 1
;
;
SETCODE(SEG,VALUE,FIELD,COMP,REP) ; Implements SETCNE and SETCWE
;
N SUB,VAR
Q:'$G(FIELD)
S:'$G(REP) REP=1
I '$G(COMP) D
.S VAR="COMP",SUB=1
E D
.S VAR="SUB"
S @VAR=1,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ID"))
S @VAR=2,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("TEXT"))
S @VAR=3,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("SYSTEM"))
S @VAR=4,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE ID"))
S @VAR=5,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE TEXT"))
S @VAR=6,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE SYSTEM"))
S @VAR=7,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("SYSTEM VERSION"))
S @VAR=8,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ALTERNATE SYSTEM VERSION"))
S @VAR=9,SEG(FIELD,REP,COMP,SUB)=$G(VALUE("ORIGINAL TEXT"))
Q
;
CHKWHO(HLMSTATE,WHOTO,ERROR) ;
N RETURN,I
S RETURN=1
I '$$CHECKWHO^HLOASUB1(.WHOTO,.RETURN,.ERROR) S RETURN=0
;
;move parameters into HLMSTATE
S HLMSTATE("STATUS","LINK IEN")=$G(RETURN("LINK IEN"))
S HLMSTATE("STATUS","LINK NAME")=$G(RETURN("LINK NAME"))
;** P158 START **
;S HLMSTATE("STATUS","PORT")=$P($G(RETURN("RECEIVING FACILITY",2)),":",2)
S HLMSTATE("STATUS","PORT")=$G(RETURN("LINK PORT"))
;** P158 END **
S HLMSTATE("HDR","RECEIVING APPLICATION")=$G(RETURN("RECEIVING APPLICATION"))
F I=1:1:3 S HLMSTATE("HDR","RECEIVING FACILITY",I)=$G(RETURN("RECEIVING FACILITY",I))
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOAPI2 9749 printed Oct 16, 2024@17:59:14 Page 2
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
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ACK(HLMSTATE,PARMS,ACK,ERROR) ;; Default behavior is to return a general
+1 ;;application ack. The application may optionally specify the message
+2 ;;type and event or call $$ADDSEG^HLOAPI to add segments.
+3 ;;A generic MSA segment (components 1-3) is added automatically IF the
+4 ;;application doesn't call $$ADDSEG^HLOAPI to add an MSA segment as the
+5 ;;FIRST segment following the header.
+6 ;;$$SENDACK must be called when the ack is completed. The return
+7 ;;destination is determined automatically from the original message
+8 ;;
+9 ;;This API should NOT be called for batch messages, use $$BATCHACK instead.
+10 ;;Input:
+11 ;; HLMSTATE (pass by reference, required) the array obtained by calling $$STARTMSG^HLOPRS when parsing the original message
+12 ;; PARMS (pass by reference) These subscripts may be defined:
+13 ;; "ACK CODE" (required) MSA1[ {AA,AE,AR}
+14 ;; "ERROR MESSAGE" - MSA3, should be used only if AE or AR
+15 ;; "ACCEPT ACK RESPONSE" - the <tag^routine> to call when the commit ack is received (optional)
+16 ;; "ACCEPT ACK TYPE" - {AL,NE} (optional, defaults to AL)
+17 ;; "CONTINUATION POINTER" (optional)indicates a fragmented message
+18 ;; "COUNTRY" - the 3 character country code (optional)
+19 ;; "EVENT" - the 3 character event type (optional, defaults to the event code of the original message)
+20 ;; "ENCODING CHARACTERS" - the four HL7 encoding characters (optional,defaults to "^~\&"
+21 ;; "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.
+22 ;; "FIELD SEPARATOR" - field separator (optional, defaults to "|")
+23 ;; "MESSAGE TYPE" - if not defined, ACK is used
+24 ;; "MESSAGE STRUCTURE" (optional)
+25 ;; "RETURN LINK NAME" (optional)
+26 ;; "RETURN LINK IEN" (optional)
+27 ;; "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
+28 ;; "SECURITY" (optional) security information to include in the header segment, SEQ 8 (optional)
+29 ;; "VERSION" - the HL7 Version ID (optional, defaults to 2.4)
+30 ;;Output:
+31 ;; Function returns 1 on success, 0 on failure
+32 ;; PARMS - left undefined when the function returns
+33 ;; ACK (pass by reference, required) the acknowledgment message being built.
+34 ;; ERROR (pass by reference) error msg
+35 ;;
+36 NEW I,SEG,TOLINK,SUCCESS
+37 SET SUCCESS=0
SET (TOLINK,ERROR)=""
+38 ;
+39 Begin DoDot:1
+40 NEW PORT
SET PORT=""
+41 IF $GET(PARMS("ACK CODE"))'="AA"
IF $GET(PARMS("ACK CODE"))'="AE"
IF $GET(PARMS("ACK CODE"))'="AR"
SET ERROR="INVALID ACK CODE"
QUIT
+42 ;
+43 IF '$GET(HLMSTATE("IEN"))
SET ERROR="ORIGINAL MESSAGE TO ACKNOWLEDGE IS NOT IDENTIFIED"
QUIT
+44 IF $GET(HLMSTATE("BATCH"))
SET ERROR="BATCH ACKNOWLEDGMENTS MUST USE $$BATCHACK^HLOAPI3"
QUIT
+45 ;
+46 IF $GET(HLMSTATE("HDR","MESSAGE CONTROL ID"))=""
SET ERROR="MESSAGE CONTROL ID MUST EXIST TO RETURN AN APPLICATION ACK"
QUIT
+47 SET PARMS("MESSAGE TYPE")=$GET(PARMS("MESSAGE TYPE"),"ACK")
+48 if PARMS("MESSAGE TYPE")="ACK"
SET PARMS("MESSAGE STRUCTURE")="ACK"
+49 SET PARMS("EVENT")=$GET(PARMS("EVENT"),$GET(HLMSTATE("HDR","EVENT")))
+50 ;can't fail!
IF $$NEWMSG^HLOAPI(.PARMS,.ACK)
+51 ;
+52 ;if the return link can not be determined, the HL Logical Link file has a problem that must be fixed at the site
+53 IF $GET(PARMS("RETURN LINK IEN"))
Begin DoDot:2
+54 SET TOLINK=$PIECE($GET(^HLCS(870,PARMS("RETURN LINK IEN"),0)),"^")
+55 SET PORT=$$PORT2^HLOTLNK(TOLINK)
End DoDot:2
+56 IF '$TEST
IF $LENGTH($GET(PARMS("RETURN LINK NAME")))
Begin DoDot:2
+57 SET TOLINK=PARMS("RETURN LINK NAME")
+58 SET PORT=$$PORT2^HLOTLNK(TOLINK)
End DoDot:2
+59 IF '$TEST
Begin DoDot:2
+60 SET TOLINK=$$ACKLINK(.HLMSTATE,.PORT)
End DoDot:2
+61 IF (TOLINK="")!('PORT)
SET ERROR="TRANSMISSION LINK FOR APPLICATION ACK CANNOT BE DETERMINED"
QUIT
+62 ;
+63 SET ACK("HDR","APP ACK TYPE")="NE"
+64 SET ACK("HDR","ACCEPT ACK TYPE")=$GET(PARMS("ACCEPT ACK TYPE"),"AL")
+65 SET ACK("STATUS","QUEUE")=$GET(PARMS("QUEUE"),$GET(HLMSTATE("STATUS","QUEUE")))
+66 SET ACK("STATUS","PORT")=PORT
+67 SET ACK("HDR","SECURITY")=$GET(PARMS("SECURITY"))
+68 SET ACK("HDR","SENDING APPLICATION")=$GET(HLMSTATE("HDR","RECEIVING APPLICATION"))
+69 SET ACK("HDR","RECEIVING APPLICATION")=$GET(HLMSTATE("HDR","SENDING APPLICATION"))
+70 FOR I=1:1:3
SET ACK("HDR","RECEIVING FACILITY",I)=$GET(HLMSTATE("HDR","SENDING FACILITY",I))
+71 SET ACK("ACK TO","STATUS")=$SELECT(PARMS("ACK CODE")="AA":"SU",1:"ER")
+72 SET ACK("ACK TO")=$GET(HLMSTATE("HDR","MESSAGE CONTROL ID"))
+73 SET ACK("ACK TO IEN")=HLMSTATE("IEN")
+74 SET ACK("STATUS","LINK NAME")=TOLINK
+75 SET ACK("LINE COUNT")=0
+76 ;; Next line modified for HL*1.6*138 - RBN
+77 ;;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"))
+78 SET ACK("MSA")="MSA"_ACK("HDR","FIELD SEPARATOR")_PARMS("ACK CODE")_ACK("HDR","FIELD SEPARATOR")_$GET(HLMSTATE("HDR","MESSAGE CONTROL ID"))_ACK("HDR","FIELD SEPARATOR")_$$ESCAPE^HLOPBLD(.HLMSTATE,$GET(PARMS("ERROR MESSAGE")))
+79 SET SUCCESS=1
End DoDot:1
+80 KILL PARMS
+81 if 'SUCCESS
KILL ACK
+82 QUIT SUCCESS
+83 ;
SENDACK(ACK,ERROR) ;;This is used to signal that an application acknowledgment is complete.
+1 ;;Input:
+2 ;; ACK (pass by reference,required) An array that contains the acknowledgment msg
+3 ;;Output:
+4 ;; Function returns 1 on success, 0 on failure
+5 ;; ERROR (pass by reference) error msg
+6 ;;
+7 NEW SEG
+8 ;if the application added its own MSA, then the ACK("MSA") node was killed
+9 IF $DATA(ACK("MSA"))
SET SEG(1)=ACK("MSA")
DO ADDSEG^HLOMSG(.ACK,.SEG)
+10 ;
+11 IF $$SEND^HLOAPI1(.ACK,.ERROR)
QUIT 1
+12 QUIT 0
+13 ;
ACKLINK(HLMSTATE,PORT) ; Finds the link & port to return the application ack to.
+1 NEW LINK
+2 SET LINK=$$RTRNLNK^HLOAPP($GET(HLMSTATE("HDR","RECEIVING APPLICATION")))
+3 IF LINK]""
SET PORT=$$PORT2^HLOTLNK(LINK)
QUIT LINK
+4 SET LINK=$$RTRNLNK^HLOTLNK($GET(HLMSTATE("HDR","SENDING FACILITY",1)),$GET(HLMSTATE("HDR","SENDING FACILITY",2)),$GET(HLMSTATE("HDR","SENDING FACILITY",3)))
+5 if $GET(HLMSTATE("HDR","SENDING FACILITY",3))="DNS"
SET PORT=$PIECE(HLMSTATE("HDR","SENDING FACILITY",2),":",2)
+6 IF LINK]""
IF 'PORT
SET PORT=$$PORT2^HLOTLNK(LINK)
+7 QUIT LINK
+8 ;
CHKPARMS(HLMSTATE,PARMS,ERROR) ;
+1 NEW LEN,SARY,HARY
+2 ;
+3 ;shortcut to reference the header sub-array
+4 SET HARY="HLMSTATE(""HDR"")"
+5 ;
+6 ;shortcut to reference the status sub-array
+7 SET SARY="HLMSTATE(""STATUS"")"
+8 ;
+9 SET ERROR=""
+10 IF $GET(PARMS("ACCEPT ACK TYPE"))=""
SET PARMS("ACCEPT ACK TYPE")="AL"
+11 IF $GET(PARMS("APP ACK TYPE"))=""
SET PARMS("APP ACK TYPE")="NE"
+12 IF PARMS("ACCEPT ACK TYPE")'="NE"
IF PARMS("ACCEPT ACK TYPE")'="AL"
SET ERROR="INVALID ACCEPT ACKNOWLEDGMENT TYPE"
+13 IF PARMS("APP ACK TYPE")'="NE"
IF PARMS("APP ACK TYPE")'="AL"
SET ERROR="INVALID APPLICATION ACKNOWLEDGMENT TYPE"
+14 SET LEN=$LENGTH($GET(PARMS("QUEUE")))
+15 IF $GET(PARMS("QUEUE"))["^"
SET ERROR="QUEUE NAME MAY NOT CONTAIN '^'"
+16 IF LEN>20
SET ERROR="QUEUE PARAMETER IS MAX 20 LENGTH"
SET PARMS("QUEUE")=$EXTRACT(PARMS("QUEUE"),1,20)
+17 IF 'LEN
SET PARMS("QUEUE")="DEFAULT"
+18 Begin DoDot:1
+19 NEW APPIEN
+20 IF $GET(PARMS("SENDING APPLICATION"))=""
Begin DoDot:2
+21 SET ERROR="SENDING APPLICATION IS REQUIRED"
+22 SET PARMS("SENDING APPLICATION")=""
End DoDot:2
QUIT
+23 IF '$TEST
Begin DoDot:2
+24 SET APPIEN=$$GETIEN^HLOAPP(PARMS("SENDING APPLICATION"))
+25 IF 'APPIEN
SET ERROR="SENDING APPLICATION NOT FOUND IN THE HLO APPLICATION REGISTRY"
End DoDot:2
if 'APPIEN
QUIT
+26 IF $LENGTH($GET(PARMS("SEQUENCE QUEUE")))
Begin DoDot:2
+27 IF ($LENGTH(PARMS("SEQUENCE QUEUE"))>30)
SET ERROR="SEQUENCE QUEUE NAME > 30 CHARACTERS"
QUIT
+28 IF PARMS("SEQUENCE QUEUE")["^"
SET ERROR="SEQUENCE QUEUE NAME MAY NOT CONTAIN '^'"
QUIT
+29 IF $GET(PARMS("APP ACK TYPE"))'="AL"
SET ERROR="SEQUENCE QUEUES REQUIRE AN APPLICATION ACKNOWLEDGMENT"
QUIT
+30 IF $GET(PARMS("ACCEPT ACK TYPE"))'="AL"
SET ERROR="SEQUENCE QUEUES REQUIRE AN ACCEPT ACKNOWLEDGMENT"
QUIT
End DoDot:2
End DoDot:1
+31 ;
+32 ;move parameters into HLMSTATE
+33 SET @HARY@("ACCEPT ACK TYPE")=PARMS("ACCEPT ACK TYPE")
+34 SET @HARY@("APP ACK TYPE")=PARMS("APP ACK TYPE")
+35 SET @HARY@("SENDING APPLICATION")=$EXTRACT(PARMS("SENDING APPLICATION"),1,60)
+36 SET @HARY@("SECURITY")=$GET(PARMS("SECURITY"))
+37 SET @SARY@("APP ACK RESPONSE")=$GET(PARMS("APP ACK RESPONSE"))
+38 SET @SARY@("ACCEPT ACK RESPONSE")=$GET(PARMS("ACCEPT ACK RESPONSE"))
+39 SET @SARY@("FAILURE RESPONSE")=$GET(PARMS("FAILURE RESPONSE"))
+40 SET @SARY@("QUEUE")=PARMS("QUEUE")
+41 SET @SARY@("SEQUENCE QUEUE")=$GET(PARMS("SEQUENCE QUEUE"))
+42 if $LENGTH(ERROR)
QUIT 0
+43 QUIT 1
+44 ;
+45 ;
SETCODE(SEG,VALUE,FIELD,COMP,REP) ; Implements SETCNE and SETCWE
+1 ;
+2 NEW SUB,VAR
+3 if '$GET(FIELD)
QUIT
+4 if '$GET(REP)
SET REP=1
+5 IF '$GET(COMP)
Begin DoDot:1
+6 SET VAR="COMP"
SET SUB=1
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 SET VAR="SUB"
End DoDot:1
+9 SET @VAR=1
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("ID"))
+10 SET @VAR=2
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("TEXT"))
+11 SET @VAR=3
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("SYSTEM"))
+12 SET @VAR=4
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("ALTERNATE ID"))
+13 SET @VAR=5
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("ALTERNATE TEXT"))
+14 SET @VAR=6
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("ALTERNATE SYSTEM"))
+15 SET @VAR=7
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("SYSTEM VERSION"))
+16 SET @VAR=8
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("ALTERNATE SYSTEM VERSION"))
+17 SET @VAR=9
SET SEG(FIELD,REP,COMP,SUB)=$GET(VALUE("ORIGINAL TEXT"))
+18 QUIT
+19 ;
CHKWHO(HLMSTATE,WHOTO,ERROR) ;
+1 NEW RETURN,I
+2 SET RETURN=1
+3 IF '$$CHECKWHO^HLOASUB1(.WHOTO,.RETURN,.ERROR)
SET RETURN=0
+4 ;
+5 ;move parameters into HLMSTATE
+6 SET HLMSTATE("STATUS","LINK IEN")=$GET(RETURN("LINK IEN"))
+7 SET HLMSTATE("STATUS","LINK NAME")=$GET(RETURN("LINK NAME"))
+8 ;** P158 START **
+9 ;S HLMSTATE("STATUS","PORT")=$P($G(RETURN("RECEIVING FACILITY",2)),":",2)
+10 SET HLMSTATE("STATUS","PORT")=$GET(RETURN("LINK PORT"))
+11 ;** P158 END **
+12 SET HLMSTATE("HDR","RECEIVING APPLICATION")=$GET(RETURN("RECEIVING APPLICATION"))
+13 FOR I=1:1:3
SET HLMSTATE("HDR","RECEIVING FACILITY",I)=$GET(RETURN("RECEIVING FACILITY",I))
+14 QUIT RETURN
