HLOCNRT ;DAOU/ALA-Generate HL7 Optimized Message ;05/12/2009
;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137,146**;Oct 13, 1995;Build 16
;Per VHA Directive 2004-038, this routine should not be modified.
;
;**Program Description**
; This program uses the traditional protocol setup and hard-coded
; message builders of HL7 1.6 to send messages via HL7 Optimized code.
Q
;
EN(HLOPRTCL,ARYTYP,HLP,HLL,RESULT) ;
;Input:
; HLOPRTCL (required) Protocol IEN or Protocol Name
; ARYTYP (required) set to "GM" if the message is contained in the global array ^TMP("HLS",$J), or set to "LM" if the message is contained in the local array HLA("HLS").
; HLP (optional, pass-by-reference) Additional HL7 message
; parameters. These optional subscripts to HLP are supported:
; "APP ACK RESPONSE" = <tag^routine> to call when the app ack is received
; "CONTPTR"
; "SECURITY"
; "SEQUENCE QUEUE" - A queue used to maintain the order of
; the messages via application acks. If used, the
; application MUST specify that both an accept ack
; and application ack be returned.
;
; HLL (optional, pass-by-reference) Used to dynamically add message
; recipients. The format is HLL("LINKS",<i>)=<destination protocol name or ien>^<destination link or ien>.
;
;
; Output
; RESULT (pass-by-reference)
; On success:
; <subscriber protocol ien>^<link ien>^<message id>^0
; On failure:
; <subscriber protocol ien>^<link ien>^<message id>^<error code>^<optional error message>
;
; RESULT("IEN")=the ien, file 778, if a message record in file 778
; was created, regardless of whether or not the message
; was successfully queued for transmission.
;
; If the message was sent to more than 1 destination,
; the addtional message statuses are returned as RESULT(1),
; RESULT(2), etc., in the same format as above, as the iens
; of message records created are returned as RESULT(1,"IEN"),
; RESULT(2,"IEN"), etc.
; ZTSTOP = Stop processing flag (used by HDR)
; Function returns:
; On success: 1
; On failure: ^<error code>^<error message>
;
NEW HLORESL,HLMSTATE,APPARMS,WHOTO,ERROR,WHO
S ZTSTOP=0,HLORESL=1,RESULT=""
;
; Get IEN of protocol if name is passed
I '$L(HLOPRTCL) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
I ('HLOPRTCL)!(HLOPRTCL'=+HLOPRTCL) S HLOPRTCL=+$O(^ORD(101,"B",HLOPRTCL,0))
I 'HLOPRTCL S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
I '$D(^ORD(101,HLOPRTCL)) S HLORESL="^99^HL7 1.6 Protocol not found",RESULT="^^"_HLORESL,ZTSTOP=1 Q HLORESL
;
; If the VistA HL7 Protocol exists, call the Conversion Utility
; to set up the APPARMS, WHOTO arrays from protocol logical link,
; and the optional HLL and HLP arrays
D APAR^HLOCVU(HLOPRTCL,.APPARMS,.WHO,.WHOTO,.HLP,.HLL)
;
; If special HLP parameters are defined, convert them
I $D(HLP) D
. I $G(HLP("SECURITY"))'="" S APPARMS("SECURITY")=HLP("SECURITY")
. I $G(HLP("CONTPTR"))'="" S APPARMS("CONTINUATION POINTER")=HLP("CONTPTR")
. I $G(HLP("QUEUE"))'="" S APPARMS("QUEUE")=HLP("QUEUE")
. I $G(HLP("SEQUENCE QUEUE"))'="" S APPARMS("SEQUENCE QUEUE")=HLP("SEQUENCE QUEUE")
. I $G(HLP("APP ACK RESPONSE"))'="" S APPARMS("APP ACK RESPONSE")=HLP("APP ACK RESPONSE")
;
; Create HL Optimized message
I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR) S HLORESL="^99^"_ERROR,ZTSTOP=1,RESULT="^^"_HLORESL Q HLORESL
I $E(ARYTYP,1)="G" S HLOMESG="^TMP(""HLS"",$J)"
I $E(ARYTYP,1)="L" S HLOMESG="HLA(""HLS"")"
;
; Move the existing message from array into HL Optimized
D MOVEMSG^HLOAPI(.HLMSTATE,HLOMESG)
;
; Send message via HL Optimized
I $D(WHOTO) D
.N COUNT
.I '$$SENDMANY^HLOAPI1(.HLMSTATE,.APPARMS,.WHOTO) D
..S HLORESL="^99^Unable to send message",ZTSTOP=1
.I $G(WHOTO(1,"IEN")) D
..S RESULT=WHO(1)_"^"_$P($G(^HLB(WHOTO(1,"IEN"),0)),"^")_"^"_$S($G(WHOTO(1,"QUEUED")):0,1:1)_"^"_$G(WHOTO(1,"ERROR"))
..;**P146 START CJM
..S RESULT("IEN")=WHOTO(1,"IEN")
..;**P146 END CJM
.E D
..S RESULT=$G(WH0(1))_"^^1^"_$G(WHOTO(1,"ERROR"))
..;**P146 START CJM
..S RESULT("IEN")=""
..;**P146 END CJM
..S HLORESL="^99^"_$G(WHOTO(1,"ERROR")),ZTSTOP=1
.S COUNT=1
.F S COUNT=$O(WHOTO(COUNT)) Q:'COUNT D
..I $G(WHOTO(COUNT,"IEN")) D
...S RESULT(COUNT-1)=WHO(COUNT)_"^"_$P($G(^HLB(WHOTO(COUNT,"IEN"),0)),"^")_"^"_$S($G(WHOTO(COUNT,"QUEUED")):0,1:1)_"^"_$G(WHOTO(COUNT,"ERROR"))
...;**P146 START CJM
...S RESULT(COUNT-1,"IEN")=WHOTO(COUNT,"IEN")
...;**P146 END CJM
..E D
...S RESULT(COUNT-1)=WH0(COUNT)_"^^1^"_$G(WHOTO(COUNT,"ERROR"))
...;**P146 START CJM
...S RESULT(COUNT-1,"IEN")=""
...;**P146 END CJM
;
E S HLORESL="^99^Unable to send message",ZTSTOP=1,RESULT="^^"_HLORESL
Q HLORESL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOCNRT 5110 printed Sep 23, 2025@19:34:43 Page 2
HLOCNRT ;DAOU/ALA-Generate HL7 Optimized Message ;05/12/2009
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137,146**;Oct 13, 1995;Build 16
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program uses the traditional protocol setup and hard-coded
+6 ; message builders of HL7 1.6 to send messages via HL7 Optimized code.
+7 QUIT
+8 ;
EN(HLOPRTCL,ARYTYP,HLP,HLL,RESULT) ;
+1 ;Input:
+2 ; HLOPRTCL (required) Protocol IEN or Protocol Name
+3 ; ARYTYP (required) set to "GM" if the message is contained in the global array ^TMP("HLS",$J), or set to "LM" if the message is contained in the local array HLA("HLS").
+4 ; HLP (optional, pass-by-reference) Additional HL7 message
+5 ; parameters. These optional subscripts to HLP are supported:
+6 ; "APP ACK RESPONSE" = <tag^routine> to call when the app ack is received
+7 ; "CONTPTR"
+8 ; "SECURITY"
+9 ; "SEQUENCE QUEUE" - A queue used to maintain the order of
+10 ; the messages via application acks. If used, the
+11 ; application MUST specify that both an accept ack
+12 ; and application ack be returned.
+13 ;
+14 ; HLL (optional, pass-by-reference) Used to dynamically add message
+15 ; recipients. The format is HLL("LINKS",<i>)=<destination protocol name or ien>^<destination link or ien>.
+16 ;
+17 ;
+18 ; Output
+19 ; RESULT (pass-by-reference)
+20 ; On success:
+21 ; <subscriber protocol ien>^<link ien>^<message id>^0
+22 ; On failure:
+23 ; <subscriber protocol ien>^<link ien>^<message id>^<error code>^<optional error message>
+24 ;
+25 ; RESULT("IEN")=the ien, file 778, if a message record in file 778
+26 ; was created, regardless of whether or not the message
+27 ; was successfully queued for transmission.
+28 ;
+29 ; If the message was sent to more than 1 destination,
+30 ; the addtional message statuses are returned as RESULT(1),
+31 ; RESULT(2), etc., in the same format as above, as the iens
+32 ; of message records created are returned as RESULT(1,"IEN"),
+33 ; RESULT(2,"IEN"), etc.
+34 ; ZTSTOP = Stop processing flag (used by HDR)
+35 ; Function returns:
+36 ; On success: 1
+37 ; On failure: ^<error code>^<error message>
+38 ;
+39 NEW HLORESL,HLMSTATE,APPARMS,WHOTO,ERROR,WHO
+40 SET ZTSTOP=0
SET HLORESL=1
SET RESULT=""
+41 ;
+42 ; Get IEN of protocol if name is passed
+43 IF '$LENGTH(HLOPRTCL)
SET HLORESL="^99^HL7 1.6 Protocol not found"
SET RESULT="^^"_HLORESL
SET ZTSTOP=1
QUIT HLORESL
+44 IF ('HLOPRTCL)!(HLOPRTCL'=+HLOPRTCL)
SET HLOPRTCL=+$ORDER(^ORD(101,"B",HLOPRTCL,0))
+45 IF 'HLOPRTCL
SET HLORESL="^99^HL7 1.6 Protocol not found"
SET RESULT="^^"_HLORESL
SET ZTSTOP=1
QUIT HLORESL
+46 IF '$DATA(^ORD(101,HLOPRTCL))
SET HLORESL="^99^HL7 1.6 Protocol not found"
SET RESULT="^^"_HLORESL
SET ZTSTOP=1
QUIT HLORESL
+47 ;
+48 ; If the VistA HL7 Protocol exists, call the Conversion Utility
+49 ; to set up the APPARMS, WHOTO arrays from protocol logical link,
+50 ; and the optional HLL and HLP arrays
+51 DO APAR^HLOCVU(HLOPRTCL,.APPARMS,.WHO,.WHOTO,.HLP,.HLL)
+52 ;
+53 ; If special HLP parameters are defined, convert them
+54 IF $DATA(HLP)
Begin DoDot:1
+55 IF $GET(HLP("SECURITY"))'=""
SET APPARMS("SECURITY")=HLP("SECURITY")
+56 IF $GET(HLP("CONTPTR"))'=""
SET APPARMS("CONTINUATION POINTER")=HLP("CONTPTR")
+57 IF $GET(HLP("QUEUE"))'=""
SET APPARMS("QUEUE")=HLP("QUEUE")
+58 IF $GET(HLP("SEQUENCE QUEUE"))'=""
SET APPARMS("SEQUENCE QUEUE")=HLP("SEQUENCE QUEUE")
+59 IF $GET(HLP("APP ACK RESPONSE"))'=""
SET APPARMS("APP ACK RESPONSE")=HLP("APP ACK RESPONSE")
End DoDot:1
+60 ;
+61 ; Create HL Optimized message
+62 IF '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR)
SET HLORESL="^99^"_ERROR
SET ZTSTOP=1
SET RESULT="^^"_HLORESL
QUIT HLORESL
+63 IF $EXTRACT(ARYTYP,1)="G"
SET HLOMESG="^TMP(""HLS"",$J)"
+64 IF $EXTRACT(ARYTYP,1)="L"
SET HLOMESG="HLA(""HLS"")"
+65 ;
+66 ; Move the existing message from array into HL Optimized
+67 DO MOVEMSG^HLOAPI(.HLMSTATE,HLOMESG)
+68 ;
+69 ; Send message via HL Optimized
+70 IF $DATA(WHOTO)
Begin DoDot:1
+71 NEW COUNT
+72 IF '$$SENDMANY^HLOAPI1(.HLMSTATE,.APPARMS,.WHOTO)
Begin DoDot:2
+73 SET HLORESL="^99^Unable to send message"
SET ZTSTOP=1
End DoDot:2
+74 IF $GET(WHOTO(1,"IEN"))
Begin DoDot:2
+75 SET RESULT=WHO(1)_"^"_$PIECE($GET(^HLB(WHOTO(1,"IEN"),0)),"^")_"^"_$SELECT($GET(WHOTO(1,"QUEUED")):0,1:1)_"^"_$GET(WHOTO(1,"ERROR"))
+76 ;**P146 START CJM
+77 SET RESULT("IEN")=WHOTO(1,"IEN")
+78 ;**P146 END CJM
End DoDot:2
+79 IF '$TEST
Begin DoDot:2
+80 SET RESULT=$GET(WH0(1))_"^^1^"_$GET(WHOTO(1,"ERROR"))
+81 ;**P146 START CJM
+82 SET RESULT("IEN")=""
+83 ;**P146 END CJM
+84 SET HLORESL="^99^"_$GET(WHOTO(1,"ERROR"))
SET ZTSTOP=1
End DoDot:2
+85 SET COUNT=1
+86 FOR
SET COUNT=$ORDER(WHOTO(COUNT))
if 'COUNT
QUIT
Begin DoDot:2
+87 IF $GET(WHOTO(COUNT,"IEN"))
Begin DoDot:3
+88 SET RESULT(COUNT-1)=WHO(COUNT)_"^"_$PIECE($GET(^HLB(WHOTO(COUNT,"IEN"),0)),"^")_"^"_$SELECT($GET(WHOTO(COUNT,"QUEUED")):0,1:1)_"^"_$GET(WHOTO(COUNT,"ERROR"))
+89 ;**P146 START CJM
+90 SET RESULT(COUNT-1,"IEN")=WHOTO(COUNT,"IEN")
+91 ;**P146 END CJM
End DoDot:3
+92 IF '$TEST
Begin DoDot:3
+93 SET RESULT(COUNT-1)=WH0(COUNT)_"^^1^"_$GET(WHOTO(COUNT,"ERROR"))
+94 ;**P146 START CJM
+95 SET RESULT(COUNT-1,"IEN")=""
+96 ;**P146 END CJM
End DoDot:3
End DoDot:2
End DoDot:1
+97 ;
+98 IF '$TEST
SET HLORESL="^99^Unable to send message"
SET ZTSTOP=1
SET RESULT="^^"_HLORESL
+99 QUIT HLORESL
