HLTF2 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;10/17/2007 09:44
;;1.6;HEALTH LEVEL SEVEN;**25,122**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
MERGEIN(LLD0,LLD1,MTIEN,HDR,MSA) ;Merge Data From Communication Server
;Module Logical Link File into Message Text File
;
;This is a subroutine call with parameter passing. The output
;parameters HDR (and optionally) MSA are returned by this call.
;
;Required input parameters
; LLD0 = Internal entry number where message is stored in Logical Link
; file or XM if message is stored in MailMan
; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
; Link file (Only required for messages stored in Logical
; Link file)
; MTIEN = Internal entry number where message is to be copied to in
; Message Text file
; HDR = The variable in which the message header segment will
; be returned
; MSA = The variable in which the message acknowledgement segment
; will be returned, if one exists for this message
;
;Check for required parameters
I $G(LLD0)']""!('$G(MTIEN)) Q
I LLD0'="XM",'$G(LLD1) Q
N FLG,HLCHAR,HLEVN,HLFS,I,X,X1,HLDONE
S (FLG,HLCHAR,HLEVN,X)=0
;
; patch HL*1.6*122: MPI-client/server
F L +^HL(772,+$G(MTIEN)):10 Q:$T H 1
;
;Move data from Logical Link file to Message Text file
I LLD0'="XM" D
.S I=0 F S X=$O(^HLCS(870,LLD0,1,LLD1,1,X)) Q:X'>0 S X1=$G(^(X,0)) S:"FHS,BHS,MSH"[$E(X1,1,3) FLG=1 I FLG S HLCHAR=HLCHAR+$L(X1) D
..;If header segment, process it and set HDR equal to it
..I X1'="","FHS,BHS,MSH"[$E(X1,1,3) D
...I '$D(HDR) S HDR=X1,HLFS=$E(X1,4) I $E(HDR,1,3)="BHS" S MSA="MSA"_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),1)_HLFS_$P(HDR,HLFS,12)_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),2)
...S $P(X1,HLFS,8)=""
...S:$E(X1,1,3)="MSH" HLEVN=HLEVN+1
..;If acknowledgement segment, set MSA equal to it
..I $E(X1,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=X1
..S I=I+1,^HL(772,MTIEN,"IN",I,0)=X1
;
;Move data from MailMan Message file to Message Text file
I LLD0="XM" D
.S I=0 F X XMREC Q:XMER<0 S:"FHS,BHS,MSH"[$E(XMRG,1,3) FLG=1 I FLG S HLCHAR=HLCHAR+$L(XMRG) D Q:XMER<0
..;If header segment, process it and set HDR equal to it
..I XMRG'="","FHS,BHS,MSH"[$E(XMRG,1,3) D
...I '$D(HDR) S HDR=XMRG,HLFS=$E(XMRG,4) I $E(HDR,1,3)="BHS" S MSA="MSA"_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),1)_HLFS_$P(HDR,HLFS,12)_HLFS_$P($P(HDR,HLFS,10),$E(HDR,5),2)
...S $P(XMRG,HLFS,8)=""
...S:$E(XMRG,1,3)="MSH" HLEVN=HLEVN+1
..;If acknowledgement segment, set MSA equal to it
..I $E(XMRG,1,3)="MSA",'$D(MSA),$E($G(HDR),1,3)="MSH" S MSA=XMRG
..S I=I+1,^HL(772,MTIEN,"IN",I,0)=XMRG
S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
;Update statistics in Message Text file for this entry
;
; patch HL*1.6*122: MPI-client/server
L -^HL(772,+$G(MTIEN))
;
D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
Q
MERGEOUT(MTIEN,LLD0,LLD1,HDR) ;Merge Text in Message Text File into
;Communication Server Module Logical Link File
;
;This is a routine call with parameter passing. There are no output
;parameters returned by this call.
;
;Required input parameters
; MTIEN = Internal entry number where message is stored in Message
; Text file
; LLD0 = Internal entry number where message is to be copied to in
; Logical Link file
; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
; Link file
; HDR = Name of the array that contains HL7 Header segment
; format: HLHDR - Used with indirection to build message in out
; queue
; This routine will first take the header information in the array
; specified by HDR and merge into the Message Text field of file 870.
; Then it will move the message contained in 772 (MTIEN) into 870.
;
;Check for required parameters
I '$G(MTIEN)!('$G(LLD0))!('$G(LLD1))!(HDR="") Q
;
;-- initilize
N I,X
S I=0
;
; patch HL*1.6*122: MPI-client/server
F L +^HLCS(870,+$G(LLD0),2,+$G(LLD1)):10 Q:$T H 1
;
;-- move header into 870 from HDR array
S X="" F S X=$O(@HDR@(X)) Q:'X D
. S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=@HDR@(X)
S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=""
;
;Move data from Message Text file to Logical Link file
S X=0 F S X=$O(^HL(772,MTIEN,"IN",X)) Q:X="" D
. S I=I+1,^HLCS(870,LLD0,2,LLD1,1,I,0)=$G(^HL(772,MTIEN,"IN",X,0))
;
;-- update 0 node of message and format arrays
S ^HLCS(870,LLD0,2,LLD1,1,0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
;
; patch HL*1.6*122: MPI-client/server
L -^HLCS(870,+$G(LLD0),2,+$G(LLD1))
;
Q
OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
;Version 1.5 Interface Only
;
; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
; OUT, IN, and ACK to HLTF2 routine.
;
Q:'$D(HLFS)
;
I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"I") Q
;
;-- if message contained MSA find inbound message
I $D(HLMSA),$D(HLNDAP),$P(HLMSA,HLFS,3)]"" D
. N HLDAI
. S HLDAI=0
. F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="I")
. I 'HLDAI K HLDAI
;
D STUFF^HLTF0("O")
;
N HLAC S HLAC=$S($D(HLERR):4,'$P(HLNDAP0,"^",10):1,1:2) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
D:$D(HLCHAR) STATS^HLTF0(HLDA,HLCHAR,$G(HLEVN))
;
;-- update status if MSA and found inbound message
I $D(HLMSA),$D(HLDAI) D
.N HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
.S HLAC=$P(HLMSA,HLFS,2)
.I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
.S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
Q
;
IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
;Version 1.5 Interface Only
;
; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
; OUT, IN, and ACK to HLTF2 routine.
;
Q:'$D(HLFS)
I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"O",$G(HLDA)) Q
;
N HLDAI S HLDA=0
I $D(HLNDAP),HLMID]"" D
.F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMID,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)="I")
.I HLDA D
..S HLDT=+$P($G(^HL(772,HLDA,0)),"^"),HLDT1=$$HLDATE^HLFNC(HLDT)
..K ^HL(772,HLDA,"IN")
.I $D(HLMSA),$P(HLMSA,HLFS,3)]"" D
..S HLDAI=0
..F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="O")
..I 'HLDAI K HLDAI
;
; patch HL*1.6*122: MPI-client/server
; I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
I 'HLDA D CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
;
D STUFF^HLTF0("I")
N HLAC S HLAC=$S($D(HLERR):4,1:1) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
;
D MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
;
I '$D(HLERR),$D(HLMSA),$D(HLDAI) D
.N HLAC,HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
.S HLAC=$P(HLMSA,HLFS,2) I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
.S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
Q
;
ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
;
; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
; OUT, IN, and ACK to HLTF2 routine.
;
; To determine the correct message to link the ACK, HLIO is used.
; For an ack from DHCP (original message from remote system) then
; HLIO should be "I" so that the correct inbound message is ack-ed. For
; an inbound ack (original message outbound from DHCP) HLIO should be
; "O". This distinction must be made due to the possible duplicate
; message ids from a bi-direction interface.
;
; Input : MSA - MSA from ACK message.
; HLIO - Either "I" or "O" : See note above.
;Output : None
;
N HLAC,HLMIDI
;-- set up required vars
S HLAC=$P(HLMSA,HLFS,2),HLMIDI=$P(HLMSA,HLFS,3)
;-- quit
Q:HLMIDI']""!(HLAC']"")!('$D(HLNDAP))
;-- find message to ack
I '$G(HLDA) S HLDA=0 D
. F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMIDI,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)=HLIO)
;-- quit if no message
Q:'$D(^HL(772,+HLDA,0))
;-- check for error
I $P(HLMSA,HLFS,4)]"" N HLERR S HLERR=$P(HLMSA,HLFS,4)
I $D(HLERR),'$D(HLMSG) N HLMSG S HLMSG="Error During Receipt of Acknowledgement Message"_$S(HLAC="AR":" - Application Reject",HLAC="AE":" - Application Error",1:"")_" - "_HLERR
;-- update status
S HLAC=$S(HLMTN="MCF":2,HLAC'="AA":4,1:3)
D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTF2 8648 printed Oct 16, 2024@18:00:42 Page 2
HLTF2 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;10/17/2007 09:44
+1 ;;1.6;HEALTH LEVEL SEVEN;**25,122**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
MERGEIN(LLD0,LLD1,MTIEN,HDR,MSA) ;Merge Data From Communication Server
+1 ;Module Logical Link File into Message Text File
+2 ;
+3 ;This is a subroutine call with parameter passing. The output
+4 ;parameters HDR (and optionally) MSA are returned by this call.
+5 ;
+6 ;Required input parameters
+7 ; LLD0 = Internal entry number where message is stored in Logical Link
+8 ; file or XM if message is stored in MailMan
+9 ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
+10 ; Link file (Only required for messages stored in Logical
+11 ; Link file)
+12 ; MTIEN = Internal entry number where message is to be copied to in
+13 ; Message Text file
+14 ; HDR = The variable in which the message header segment will
+15 ; be returned
+16 ; MSA = The variable in which the message acknowledgement segment
+17 ; will be returned, if one exists for this message
+18 ;
+19 ;Check for required parameters
+20 IF $GET(LLD0)']""!('$GET(MTIEN))
QUIT
+21 IF LLD0'="XM"
IF '$GET(LLD1)
QUIT
+22 NEW FLG,HLCHAR,HLEVN,HLFS,I,X,X1,HLDONE
+23 SET (FLG,HLCHAR,HLEVN,X)=0
+24 ;
+25 ; patch HL*1.6*122: MPI-client/server
+26 FOR
LOCK +^HL(772,+$GET(MTIEN)):10
if $TEST
QUIT
HANG 1
+27 ;
+28 ;Move data from Logical Link file to Message Text file
+29 IF LLD0'="XM"
Begin DoDot:1
+30 SET I=0
FOR
SET X=$ORDER(^HLCS(870,LLD0,1,LLD1,1,X))
if X'>0
QUIT
SET X1=$GET(^(X,0))
if "FHS,BHS,MSH"[$EXTRACT(X1,1,3)
SET FLG=1
IF FLG
SET HLCHAR=HLCHAR+$LENGTH(X1)
Begin DoDot:2
+31 ;If header segment, process it and set HDR equal to it
+32 IF X1'=""
IF "FHS,BHS,MSH"[$EXTRACT(X1,1,3)
Begin DoDot:3
+33 IF '$DATA(HDR)
SET HDR=X1
SET HLFS=$EXTRACT(X1,4)
IF $EXTRACT(HDR,1,3)="BHS"
SET MSA="MSA"_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),1)_HLFS_$PIECE(HDR,HLFS,12)_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),2)
+34 SET $PIECE(X1,HLFS,8)=""
+35 if $EXTRACT(X1,1,3)="MSH"
SET HLEVN=HLEVN+1
End DoDot:3
+36 ;If acknowledgement segment, set MSA equal to it
+37 IF $EXTRACT(X1,1,3)="MSA"
IF '$DATA(MSA)
IF $EXTRACT($GET(HDR),1,3)="MSH"
SET MSA=X1
+38 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=X1
End DoDot:2
End DoDot:1
+39 ;
+40 ;Move data from MailMan Message file to Message Text file
+41 IF LLD0="XM"
Begin DoDot:1
+42 SET I=0
FOR
XECUTE XMREC
if XMER<0
QUIT
if "FHS,BHS,MSH"[$EXTRACT(XMRG,1,3)
SET FLG=1
IF FLG
SET HLCHAR=HLCHAR+$LENGTH(XMRG)
Begin DoDot:2
+43 ;If header segment, process it and set HDR equal to it
+44 IF XMRG'=""
IF "FHS,BHS,MSH"[$EXTRACT(XMRG,1,3)
Begin DoDot:3
+45 IF '$DATA(HDR)
SET HDR=XMRG
SET HLFS=$EXTRACT(XMRG,4)
IF $EXTRACT(HDR,1,3)="BHS"
SET MSA="MSA"_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),1)_HLFS_$PIECE(HDR,HLFS,12)_HLFS_$PIECE($PIECE(HDR,HLFS,10),$EXTRACT(HDR,5),2)
+46 SET $PIECE(XMRG,HLFS,8)=""
+47 if $EXTRACT(XMRG,1,3)="MSH"
SET HLEVN=HLEVN+1
End DoDot:3
+48 ;If acknowledgement segment, set MSA equal to it
+49 IF $EXTRACT(XMRG,1,3)="MSA"
IF '$DATA(MSA)
IF $EXTRACT($GET(HDR),1,3)="MSH"
SET MSA=XMRG
+50 SET I=I+1
SET ^HL(772,MTIEN,"IN",I,0)=XMRG
End DoDot:2
if XMER<0
QUIT
End DoDot:1
+51 SET ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
+52 ;Update statistics in Message Text file for this entry
+53 ;
+54 ; patch HL*1.6*122: MPI-client/server
+55 LOCK -^HL(772,+$GET(MTIEN))
+56 ;
+57 DO STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
+58 QUIT
MERGEOUT(MTIEN,LLD0,LLD1,HDR) ;Merge Text in Message Text File into
+1 ;Communication Server Module Logical Link File
+2 ;
+3 ;This is a routine call with parameter passing. There are no output
+4 ;parameters returned by this call.
+5 ;
+6 ;Required input parameters
+7 ; MTIEN = Internal entry number where message is stored in Message
+8 ; Text file
+9 ; LLD0 = Internal entry number where message is to be copied to in
+10 ; Logical Link file
+11 ; LLD1 = Internal entry number of IN QUEUE multiple entry in Logical
+12 ; Link file
+13 ; HDR = Name of the array that contains HL7 Header segment
+14 ; format: HLHDR - Used with indirection to build message in out
+15 ; queue
+16 ; This routine will first take the header information in the array
+17 ; specified by HDR and merge into the Message Text field of file 870.
+18 ; Then it will move the message contained in 772 (MTIEN) into 870.
+19 ;
+20 ;Check for required parameters
+21 IF '$GET(MTIEN)!('$GET(LLD0))!('$GET(LLD1))!(HDR="")
QUIT
+22 ;
+23 ;-- initilize
+24 NEW I,X
+25 SET I=0
+26 ;
+27 ; patch HL*1.6*122: MPI-client/server
+28 FOR
LOCK +^HLCS(870,+$GET(LLD0),2,+$GET(LLD1)):10
if $TEST
QUIT
HANG 1
+29 ;
+30 ;-- move header into 870 from HDR array
+31 SET X=""
FOR
SET X=$ORDER(@HDR@(X))
if 'X
QUIT
Begin DoDot:1
+32 SET I=I+1
SET ^HLCS(870,LLD0,2,LLD1,1,I,0)=@HDR@(X)
End DoDot:1
+33 SET I=I+1
SET ^HLCS(870,LLD0,2,LLD1,1,I,0)=""
+34 ;
+35 ;Move data from Message Text file to Logical Link file
+36 SET X=0
FOR
SET X=$ORDER(^HL(772,MTIEN,"IN",X))
if X=""
QUIT
Begin DoDot:1
+37 SET I=I+1
SET ^HLCS(870,LLD0,2,LLD1,1,I,0)=$GET(^HL(772,MTIEN,"IN",X,0))
End DoDot:1
+38 ;
+39 ;-- update 0 node of message and format arrays
+40 SET ^HLCS(870,LLD0,2,LLD1,1,0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
+41 ;
+42 ; patch HL*1.6*122: MPI-client/server
+43 LOCK -^HLCS(870,+$GET(LLD0),2,+$GET(LLD1))
+44 ;
+45 QUIT
OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
+1 ;Version 1.5 Interface Only
+2 ;
+3 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
+4 ; OUT, IN, and ACK to HLTF2 routine.
+5 ;
+6 if '$DATA(HLFS)
QUIT
+7 ;
+8 IF HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR")
if '$DATA(HLMSA)
QUIT
DO ACK(HLMSA,"I")
QUIT
+9 ;
+10 ;-- if message contained MSA find inbound message
+11 IF $DATA(HLMSA)
IF $DATA(HLNDAP)
IF $PIECE(HLMSA,HLFS,3)]""
Begin DoDot:1
+12 NEW HLDAI
+13 SET HLDAI=0
+14 FOR
SET HLDAI=$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),$PIECE(HLMSA,HLFS,3),HLDAI))
if 'HLDAI!($PIECE($GET(^HL(772,+HLDAI,0)),U,4)="I")
QUIT
+15 IF 'HLDAI
KILL HLDAI
End DoDot:1
+16 ;
+17 DO STUFF^HLTF0("O")
+18 ;
+19 NEW HLAC
SET HLAC=$SELECT($DATA(HLERR):4,'$PIECE(HLNDAP0,"^",10):1,1:2)
DO STATUS^HLTF0(HLDA,HLAC,$GET(HLMSG))
+20 if $DATA(HLCHAR)
DO STATS^HLTF0(HLDA,HLCHAR,$GET(HLEVN))
+21 ;
+22 ;-- update status if MSA and found inbound message
+23 IF $DATA(HLMSA)
IF $DATA(HLDAI)
Begin DoDot:1
+24 NEW HLERR,HLMSG
IF $PIECE(HLMSA,HLFS,4)]""
SET HLERR=$PIECE(HLMSA,HLFS,4)
+25 SET HLAC=$PIECE(HLMSA,HLFS,2)
+26 IF HLAC'="AA"
SET HLMSG=$SELECT(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
+27 SET HLAC=$SELECT(HLAC'="AA":4,1:3)
DO STATUS^HLTF0(HLDAI,HLAC,$GET(HLMSG))
End DoDot:1
+28 QUIT
+29 ;
IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
+1 ;Version 1.5 Interface Only
+2 ;
+3 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
+4 ; OUT, IN, and ACK to HLTF2 routine.
+5 ;
+6 if '$DATA(HLFS)
QUIT
+7 IF HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR")
if '$DATA(HLMSA)
QUIT
DO ACK(HLMSA,"O",$GET(HLDA))
QUIT
+8 ;
+9 NEW HLDAI
SET HLDA=0
+10 IF $DATA(HLNDAP)
IF HLMID]""
Begin DoDot:1
+11 FOR
SET HLDA=+$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),HLMID,HLDA))
if 'HLDA!($PIECE($GET(^HL(772,+HLDA,0)),U,4)="I")
QUIT
+12 IF HLDA
Begin DoDot:2
+13 SET HLDT=+$PIECE($GET(^HL(772,HLDA,0)),"^")
SET HLDT1=$$HLDATE^HLFNC(HLDT)
+14 KILL ^HL(772,HLDA,"IN")
End DoDot:2
+15 IF $DATA(HLMSA)
IF $PIECE(HLMSA,HLFS,3)]""
Begin DoDot:2
+16 SET HLDAI=0
+17 FOR
SET HLDAI=$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),$PIECE(HLMSA,HLFS,3),HLDAI))
if 'HLDAI!($PIECE($GET(^HL(772,+HLDAI,0)),U,4)="O")
QUIT
+18 IF 'HLDAI
KILL HLDAI
End DoDot:2
End DoDot:1
+19 ;
+20 ; patch HL*1.6*122: MPI-client/server
+21 ; I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
+22 IF 'HLDA
DO CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1)
KILL HLZ
+23 ;
+24 DO STUFF^HLTF0("I")
+25 NEW HLAC
SET HLAC=$SELECT($DATA(HLERR):4,1:1)
DO STATUS^HLTF0(HLDA,HLAC,$GET(HLMSG))
+26 ;
+27 DO MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
+28 ;
+29 IF '$DATA(HLERR)
IF $DATA(HLMSA)
IF $DATA(HLDAI)
Begin DoDot:1
+30 NEW HLAC,HLERR,HLMSG
IF $PIECE(HLMSA,HLFS,4)]""
SET HLERR=$PIECE(HLMSA,HLFS,4)
+31 SET HLAC=$PIECE(HLMSA,HLFS,2)
IF HLAC'="AA"
SET HLMSG=$SELECT(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
+32 SET HLAC=$SELECT(HLAC'="AA":4,1:3)
DO STATUS^HLTF0(HLDAI,HLAC,$GET(HLMSG))
End DoDot:1
+33 QUIT
+34 ;
ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
+1 ;
+2 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
+3 ; OUT, IN, and ACK to HLTF2 routine.
+4 ;
+5 ; To determine the correct message to link the ACK, HLIO is used.
+6 ; For an ack from DHCP (original message from remote system) then
+7 ; HLIO should be "I" so that the correct inbound message is ack-ed. For
+8 ; an inbound ack (original message outbound from DHCP) HLIO should be
+9 ; "O". This distinction must be made due to the possible duplicate
+10 ; message ids from a bi-direction interface.
+11 ;
+12 ; Input : MSA - MSA from ACK message.
+13 ; HLIO - Either "I" or "O" : See note above.
+14 ;Output : None
+15 ;
+16 NEW HLAC,HLMIDI
+17 ;-- set up required vars
+18 SET HLAC=$PIECE(HLMSA,HLFS,2)
SET HLMIDI=$PIECE(HLMSA,HLFS,3)
+19 ;-- quit
+20 if HLMIDI']""!(HLAC']"")!('$DATA(HLNDAP))
QUIT
+21 ;-- find message to ack
+22 IF '$GET(HLDA)
SET HLDA=0
Begin DoDot:1
+23 FOR
SET HLDA=+$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),HLMIDI,HLDA))
if 'HLDA!($PIECE($GET(^HL(772,+HLDA,0)),U,4)=HLIO)
QUIT
End DoDot:1
+24 ;-- quit if no message
+25 if '$DATA(^HL(772,+HLDA,0))
QUIT
+26 ;-- check for error
+27 IF $PIECE(HLMSA,HLFS,4)]""
NEW HLERR
SET HLERR=$PIECE(HLMSA,HLFS,4)
+28 IF $DATA(HLERR)
IF '$DATA(HLMSG)
NEW HLMSG
SET HLMSG="Error During Receipt of Acknowledgement Message"_$SELECT(HLAC="AR":" - Application Reject",HLAC="AE":" - Application Error",1:"")_" - "_HLERR
+29 ;-- update status
+30 SET HLAC=$SELECT(HLMTN="MCF":2,HLAC'="AA":4,1:3)
+31 DO STATUS^HLTF0(HLDA,HLAC,$GET(HLMSG))
+32 QUIT
+33 ;
