HLTP3.m

HLTP3 ;SFIRMFO/RSD - Transaction Processor for TCP ;07/29/2009  14:51

 ;;1.6;HEALTH LEVEL SEVEN;**19,43,57,58,59,66,69,109,115,108,116,117,125,120,133,122,140,142,145**;Oct 13, 1995;Build 4

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 Q

NEW(X) ;process new msg. ien in 773^ien in 772

 ;HLMTIENS=ien in #773; HLMTIEN=ien in #772

 ;HLHDRO=original header;  HLHDR=response header

 ;set error trap

 N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLTP3"

 N HL,HLEID,HLEIDS,HLERR,HLHDR,HLHDRO,HLMTIEN,HLMTIENS,HLJ,HLMSA,HLQUIT,HLNODE,HLNEXT,HLRESLTA,HLDONE1,HLASTRSP,HLRESLT

 S HLRESLT=""

 D INIT^HLTP3A

 ;error with header, return commit/app reject

 I $G(HLRESLT) D  Q

 . ;set status & unlock record

 . D STATUS^HLTF0(HLMTIENS,4,,,1),EXIT

 . ;quit if no commit or app ack

 . I $G(HL("ACAT"))="NE",$G(HL("APAT"))="NE" Q

 . S X=$S($G(HL("ACAT"))="AL":"CR",1:"AR")

 . ;HLTCP=ien of acknowledgment msg. from ACK^HLTP4

 . D ACK^HLTP4(X,$P(HLRESLT,U,2)) Q:'$G(HLTCP)

 . ;write ack back

 . S X=$$WRITE^HLCSTCP2(HLTCP)

 . ;update counter to sent

 . D LLCNT^HLCSTCP(HLDP,4)

 . ;update status of ack

 . D STATUS^HLTF0(HLTCP,3,,,1)

 ;

 ;check for duplicate msg., use rec. app and msg. id x-ref

 ; patch HL*1.6*142 start

 ; HL("HDR FLDS:3-6") extracted from field 3 to field 6 of header

 ; defined in HLDIE routine

 ; I $G(HL("MID"))]"",$G(HL("RAP")) S X=$O(^HLMA("AH",HL("RAP"),HL("MID"),0)) D  Q:'$D(HLMTIENS)

 I ($G(HL("MID"))]""),($G(HL("HDR FLDS:3-6"))]"") D  Q:'$D(HLMTIENS)

 . S X=$O(^HLMA("AH-NEW",HL("HDR FLDS:3-6"),HL("MID"),0))

 . ; patch HL*1.6*142 end

 . ;HLASTMSG=last ien received during this connection

 . ;if no duplicate, save msg. ien and quit

 . I X=HLMTIENS!'X S HLASTMSG=HLMTIENS Q

 . N MSH,OIENS

 . S (OIENS,Y)=X D  S Y=HLMTIENS D

 .. ;combine MSH into single string

 .. S MSH(Y)="",I=0 F  S I=$O(^HLMA(Y,"MSH",I)) Q:'I  S MSH(Y)=MSH(Y)_$G(^(I,0))

 .; patch 117 & 125, check if identical

 .I MSH(HLMTIENS)'=MSH(OIENS) S HLASTMSG=HLMTIENS Q

 .;

 . ;msg is duplicate, set status

 . D STATUS^HLTF0(HLMTIENS,4,109,"Duplicate with ien "_OIENS,1),EXIT

 . ;msg was resent, ignore it.

 . I HLASTMSG=HLMTIENS K HLMTIENS Q

 . ;find original response and send back

 . S HLASTRSP=$O(^HLMA("AF",OIENS,OIENS))

 . ; patch HL*1.6*142 start

 . ; the original msg may need to be updated again if 1st time

 . ; update failed

 . S HLASTMSG("OIENS")=OIENS

 . ;

 . ; the original message and its commit ACK were purged, OIENS is

 . ; duplicate and needs to create its own commit ACK (happened

 . ; between MPI and VIE in 9/2008), the OIENS will be processed

 . ; by the application routine again.

 . I $G(HL("ACAT"))="AL",'$G(HL("ACK")),'HLASTRSP D

 .. N HLTCP,HLMTIENS

 .. S HLMTIENS=OIENS

 .. D ACK^HLTP4("CA")

 .. D LLCNT^HLCSTCP(HLDP,3,1) ; decreament and will be added later

 .. S HLASTRSP=HLTCP

 . ; patch HL*1.6*142 end

 ;

 ; patch HL*1.6*145 start

 ; Quit if this is application ack to application ack

 I $G(HL("ACK")) D  Q

 . N HLERRMG,X

 . S HLERRMG="Received application acknowledgement to an application acknowledgement"

 . ;msg is a resend, HLASTRSP=ien of original response (commit ACK)

 . I $G(HLASTRSP) D

 .. S HLTCP=HLASTRSP

 .. D STATUS^HLTF0(HLTCP,8)

 .. S ^HLMA(+HLTCP,"S")=$$NOW^XLFDT

 .. D LLCNT^HLCSTCP(HLDP,3)

 . E  D  Q:'$G(HLTCP)

 .. ;Send CR and update status of original and current ack messages

 .. D ACK^HLTP4("CR",HLERRMG)

 . ;

 . ; write commit ACK (original commit ACK)

 . S X=$$WRITE^HLCSTCP2(HLTCP)

 . D STATUS^HLTF0(HLTCP,3,,"'Reject' commit ACK: "_HLERRMG,1)

 . S ^HLMA(+HLTCP,"S")=$$NOW^XLFDT

 . D LLCNT^HLCSTCP(HLDP,4)

 . S HLTCP=""

 . ; D STATUS^HLTF0(HL("MTIENS"),3,,,1),STATUS^HLTF0(HLMTIENS,3,,,1)

 . D STATUS^HLTF0(HL("MTIENS"),3,,,1)

 . D STATUS^HLTF0(HLMTIENS,4,,HLERRMG,1)

 . ;unlock record

 . D EXIT

 ; patch HL*1.6*145 end

 ;

 ; enhance ack., send commit, quit if not an ack, msg will be 

 ; processed by filer

 I $G(HL("ACAT"))="AL" D  Q:'$G(HL("MTIENS"))

 . ;msg is a resend, HLASTRSP=ien of original response (commit ACK)

 .I $G(HLASTRSP) D

 ..S HLTCP=HLASTRSP

 ..D LLCNT^HLCSTCP(HLDP,3)

 . E  D  Q:'$G(HLTCP)

 ..D ACK^HLTP4("CA") ;**109** LLCNT^HLCSTCP(HLDP,3) called in ACK^HLTP4

 . ;

 . ; write commit ACK (original commit ACK)

 . S X=$$WRITE^HLCSTCP2(HLTCP)

 . ; patch HL*1.6*142

 . ; D LLCNT^HLCSTCP(HLDP,4),STATUS^HLTF0(HLTCP,3,,,1):'$G(HLASTRSP)

 . D LLCNT^HLCSTCP(HLDP,4)

 . I '$G(HLASTRSP) D

 .. D STATUS^HLTF0(HLTCP,3,,,1)

 . S HLTCP=""

 . ;if not an ack, set status to awaiting processing **109** and put on in queue

 . I '$G(HL("MTIENS")),'$G(HLASTRSP) D STATUS^HLTF0(HLMTIENS,9),EXIT,SETINQUE^HLTP31

 . ;

 . ; patch HL*1.6*142 start

 . ;if the original msg failed to en-queue and update status

 . ; it may happen when COTS disconnect the listener during

 . ; writing the commit ACK

 . ; deal with a non-application ACK duplicate message

 . I '$G(HL("MTIENS")),$G(HLASTRSP) D

 .. N STATUS

 .. S STATUS=+$G(^HLMA(HLASTRSP,"P"))

 .. I STATUS,(STATUS'=3) D

 ... ; update the original messsage, ien=HLASTMSG("OIENS")

 ... D STATUS^HLTF0(HLASTMSG("OIENS"),9)

 ... D EXIT

 ... N HLMTIENS

 ... S HLMTIENS=HLASTMSG("OIENS")

 ... D SETINQUE^HLTP31

 ... D STATUS^HLTF0(HLASTRSP,3,,,1)

 . ; patch HL*1.6*142 end

 ;

 ;enhance ack., no commit & no app ack

 I $G(HL("ACAT"))="NE",$G(HL("APAT"))="NE" D  Q

 . ;set status to awaiting processing, **109** and put on in queue

 . I '$G(HLASTRSP) D STATUS^HLTF0(HLMTIENS,9),EXIT,SETINQUE^HLTP31

 ;

 ; patch HL*1.6*120 start

 ;resending old response, msg is a resend

 ; do not re-send duplicate when $G(HL("ACAT"))="AL"

 ; the following resend is for original mode application ACK

 I $G(HLASTRSP),$G(HL("ACAT"))'="AL" S HLTCP=HLASTRSP G ACK

 ; patch HL*1.6*120 end

 ;

 ; patch HL*1.6*142 start

 ; to handle duplicate when the original message encountered

 ; a write error of commit ACK

 ; quit if duplicate

 ; Q:$G(HLASTRSP)

 S HLASTRSP("FLAG")=0

 I $G(HLASTRSP),$G(HL("ACAT"))="AL" D

 . I +$G(^HLMA(+$G(HLASTRSP),"P")),(+$P($G(^HLMA(+$G(HLASTRSP),"P")),"^")'=3) D

 .. S HLASTRSP("FLAG")=1

 ; don't quit if this is duplicate application ACK msg with accept

 ; ACK type="AL", and its original commit ACK is not done.

 I $G(HLASTRSP),('HLASTRSP("FLAG")) Q

 ;

 ; if duplicate, change ien to orginal msg ien

 I $G(HLASTRSP) D

 . S HLMTIENS=+$G(HLASTMSG("OIENS"))

 . S HLMTIEN=+$G(^HLMA(HLMTIENS,0))

 ; patch HL*1.6*142 end

 ;

CONT ;continue processing an enhance ack msg. called from DEFACK

 ;Set special HL variables for processing rtn

 S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"

 ;

 ; message is an acknowledgement, HLMSA=ack code^id^text

 I ($G(HLMSA)]"") D  Q

 . ;X=1 if ack ok, 0=reject of error

 . S X=$E(HLMSA,2)="A"

 . ;Update status of original message and remove it from the queue

 . D STATUS^HLTF0(HL("MTIENS"),$S(X:3,1:4),"",$S(X:"",1:$P(HLMSA,HL("FS"),3)),1)

 . ; patch HL*1.6*142

 . ; time: original message receives the application ACK

 . S $P(^HLMA(HL("MTIENS"),"S"),"^",5)=$$NOW^XLFDT

 . D DEQUE^HLCSREP($P($G(^HLMA(HL("MTIENS"),0)),"^",7),"O",HL("MTIENS"))

 . D

 .. N HLTCP ;variable to update status in file #772.

 ..;

 ..;**108**

 .. N TEMP

 .. S TEMP=HLMTIENS

 .. N HLMTIENS

 .. S HLMTIENS=TEMP

 ..;**END 108**

 ..;

 .. ; patch HL*1.6*142 start

 .. ; time: starts to process the incoming message

 .. S $P(^HLMA(HLMTIENS,"S"),"^",6)=$$NOW^XLFDT

 .. D PROCACK^HLTP2(HLMTIEN,HL("EID"),.HLRESLT,.HL)

 .. ; time: ends processing the incoming message

 .. S $P(^HLMA(HLMTIENS,"S"),"^",7)=$$NOW^XLFDT

 . ; if duplicate, and the original msg failed to

 . ; complete the processing

 . I $G(HLASTRSP) D STATUS^HLTF0(HLASTRSP,3,,,1)

 . ; patch HL*1.6*142 end

 . ;update status of incoming & unlock

 . D STATUS^HLTF0(HLMTIENS,$S($G(HLRESLT):4,1:3),$S($G(HLRESLT):+$G(HLRESLT),1:""),$S($G(HLRESLT):$P(HLRESLT,U,2),1:""),1),EXIT

 ;

 ;get entry action, exit action and processing routine

 K HLHDR,HLLD0,HLLD1,HLMSA

 I HL("EIDS")="",$G(HLEIDS)]"" S HL("EIDS")=HLEIDS ;**CIRN**

 D EVENT^HLUTIL1(HL("EIDS"),"15,20,771",.HLN)

 S HLENROU=$G(HLN(20)),HLEXROU=$G(HLN(15)),HLPROU=$G(HLN(771))

 ;quit if no processing routine,update status and quit

 I HLPROU']"" S HLRESLT="10^"_$G(^HL(771.7,10,0)) D STATUS^HLTF0(HLMTIENS,3,,,1),EXIT Q

 ;HLORNOD=subscriber protocol for Fileman auditing, ien;global ref

 N HLORNODD S HLORNOD=HL("EIDS")_";ORD(101,"

 ;Execute entry action of client protocol

 X:HLENROU]"" HLENROU K HLENROU,HLDONE1

 ;

 ; patch HL*1.6*142 start

 ; time: starts to process the incoming message

 S $P(^HLMA(HLMTIENS,"S"),"^",6)=$$NOW^XLFDT

 ;Execute processing routine

 X HLPROU S HLRESLT=0 S:($D(HLERR)) HLRESLT="9^"_HLERR

 ; time: ends processing the incoming message

 S $P(^HLMA(HLMTIENS,"S"),"^",7)=$$NOW^XLFDT

 ; if duplicate, and the original msg failed to

 ; complete the processing

 I $G(HLASTRSP) D STATUS^HLTF0(HLASTRSP,3,,,1)

 ; patch HL*1.6*142 end

 ;update status of incoming to complete & unlock

 D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S(HLRESLT:$P(HLRESLT,U,2),1:""),1,$S($G(HLERR("SKIP_EVENT"))=1:1,1:0)),EXIT

 ;HLTCPO=link open, HLTCP=ien of ack msg. from GENACK

ACK I $G(HLTCPO),$G(HLTCP) D  Q

 . D LLCNT^HLCSTCP(HLDP,3)

 . ;write ack back over open tcp link

 . S X=$$WRITE^HLCSTCP2(HLTCP)

 . ;update status of ack to complete

 . D:'$G(HLASTRSP) STATUS^HLTF0(HLTCP,3,,,1)

 . D LLCNT^HLCSTCP(HLDP,4)

 Q

 ;

DEFACK(HLDP,X) ;process the deferred application ack, called from HLCSIN

 ;HLDP=logical link, X=ien in file 773

 ;

 ; patch HL*1.6*120 start

 ; clean non-Kernel variables

 D

 . ; protect variables defined in STARTIN^HLCSIN

 . N HLFLG,HLEXIT,HLPTRFLR

 . ; protect variables defined in DEFACK^HLCSIN

 . N HLXX,HLD0,HLPCT

 . ; protect input parameters of this sub-routine

 . N HLDP,X

 . D KILL^XUSCLEAN

 ; patch HL*1.6*120 end

 ;

 ;set error trap

 N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLTP3"

 N HLERR     ;patch HL*1.6*109

 Q:'$G(HLDP)!'$G(X)  Q:'$G(^HLMA(X,0))

 Q:'$D(^HLMA("AC","I",HLDP,X))

 ;

 N HL,HLA,HLD0,HLEID,HLEIDS,HLHDR,HLHDRO,HLMTIEN,HLMTIENS,HLJ,HLMSA,HLN,HLQUIT,HLNODE,HLNEXT,HLRESLT,HLRESLTA,HLTCP,HLXX,Z,HLDONE1

 S HLMTIENS=X,X=^HLMA(HLMTIENS,0),HLMTIEN=+$P(X,U),HL("MID")=$P(X,U,2),HL("MTIENS")=$P(X,U,10),HL("LL")=$P(X,U,7),HLTCP="",HL("Q")=""""""

 S HL("EIDS")=$P(X,U,8),HL("SAP")=$P(X,U,11),HL("RAP")=$P(X,U,12),HL("MTP")=$P(X,U,13),HL("ETP")=$P(X,U,14)

 S:$P(X,U,15) HL("MTP_ETP")=$P(X,U,15)

 S:HL("SAP") HL("SAN")=$P($G(^HL(771,HL("SAP"),0)),U) S:HL("RAP") HL("RAN")=$P($G(^HL(771,HL("RAP"),0)),U)

 S:HL("MTP") HL("MTN")=$P($G(^HL(771.2,HL("MTP"),0)),U) S:HL("ETP") HL("ETN")=$P($G(^HL(779.001,HL("ETP"),0)),U)

 S:$G(HL("MTP_ETP")) HL("MTN_ETN")=$P($G(^HL(779.005,HL("MTP_ETP"),0)),U)

 S HL("EID")=$P($G(^HL(772,HLMTIEN,0)),U,10)

 M HLHDRO=^HLMA(HLMTIENS,"MSH")

 ; if no header quit

 Q:'$O(HLHDRO(0))

 ;

 S HL("FS")=$E(HLHDRO(1,0),4),HL("ECH")=$$P^HLTPCK2(.HLHDRO,2),HL("SFN")=$$P^HLTPCK2(.HLHDRO,4),HL("RFN")=$$P^HLTPCK2(.HLHDRO,6),HL("DTM")=$$P^HLTPCK2(.HLHDRO,7)

 ;

 ; quit if ien of #772 is not defined

 Q:'HLMTIEN

 ; quit if field separator is not defined

 Q:HL("FS")=""

 ;

 S X=$$P^HLTPCK2(.HLHDRO,1)

 ;

 ; patch HL*1.6*120 start

 I X="MSH" D

 . S HL("PID")=$$P^HLTPCK2(.HLHDRO,11),HL("VER")=$$P^HLTPCK2(.HLHDRO,12),HL("APAT")=$$P^HLTPCK2(.HLHDRO,16),HL("CC")=$$P^HLTPCK2(.HLHDRO,17)

 . ;

 . ; 2nd component is Processing mode

 . S HL("PMOD")=$P(HL("PID"),$E(HL("ECH"),1),2)

 . ; first component is Processing id

 . S HL("PID")=$P(HL("PID"),$E(HL("ECH"),1))

 ;

 I X'="MSH" D

 . S X=$$P^HLTPCK2(.HLHDRO,9),Z=$E(HL("ECH")),HL("PID")=$P(X,Z,2),HL("VER")=$P(X,Z,4)

 . ;

 . ; original code incorrectly treats repetition separator as

 . ; subcomponent separator

 . I $E(HL("ECH"),2)]"",X[$E(HL("ECH"),2) D

 .. S HL("SUB-COMPONENT")=$E(HL("ECH"),2)

 . ; if subcomponent separator is correctly applied

 . I $E(HL("ECH"),4)]"",X[$E(HL("ECH"),4) D

 .. S HL("SUB-COMPONENT")=$E(HL("ECH"),4)

 . ;

 . I $D(HL("SUB-COMPONENT")),HL("PID")[HL("SUB-COMPONENT") D

 .. ; 2nd sub-component is Processing mode

 .. S HL("PMOD")=$P(HL("PID"),HL("SUB-COMPONENT"),2)

 .. ; first sub-component is Processing id

 .. S HL("PID")=$P(HL("PID"),HL("SUB-COMPONENT"))

 . ; patch HL*1.6*120 end

 . ;

 . Q:$$P^HLTPCK2(.HLHDRO,10)=""

 . ;HLMSA=ack code^id^text

 . S HLMSA=$P($$P^HLTPCK2(.HLHDRO,10),$E(HL("ECH")),1),$P(HLMSA,HL("FS"),2)=$$P^HLTPCK2(.HLHDRO,12),$P(HLMSA,HL("FS"),3)=$P($$P^HLTPCK2(.HLHDRO,10),$E(HL("ECH")),2),HL("MSAID")=$P(HLMSA,HL("FS"),2)

 ;

 ; quit if this is a commit ack

 I $P($G(^HL(772,HLMTIEN,"IN",1,0)),HL("FS"),1)="MSA",$E($P($G(^HL(772,HLMTIEN,"IN",1,0)),HL("FS"),2))="C" Q

 ;

 ;**  HL*1.6*117 **

 K HLL("SET FOR APP ACK"),HLL("LINKS")

 ;

 D CONT

 Q

 ;

MSA(Y) ;Y=ien in 772, returns MSA segment

 ;ack code^msg being ack id^text

 ; patch HL*1.6*122

 ; for HL7 v2.5 and beyond with MSA as 3rd segment

 N X,SUBIEN,DATA,DONE

 S X=$G(^HL(772,Y,"IN",1,0)),X=$S($E(X,1,3)="MSA":$E(X,5,999),1:"")

 Q:X]"" X

 ;

 S DONE=0

 S SUBIEN=1

 F  S SUBIEN=$O(^HL(772,Y,"IN",SUBIEN)) Q:'SUBIEN  D  Q:DONE

 . S DATA=$G(^HL(772,Y,"IN",SUBIEN,0)) I DATA="" D

 .. S DONE=1

 .. S SUBIEN=$O(^HL(772,Y,"IN",SUBIEN)) Q:'SUBIEN

 .. S X=$G(^HL(772,Y,"IN",SUBIEN,0)),X=$S($E(X,1,3)="MSA":$E(X,5,999),1:"")

 ; patch HL*1.6*122 end

 ;

 Q X

 ;

ERROR ;error trap

 D ^%ZTER

 I $G(HLMTIENS),$D(^HLMA(HLMTIENS,0)) D STATUS^HLTF0(HLMTIENS,4,,,1),EXIT

 ; release locks created by inbound filer

 ; patch HL*1.6*140

 ; L -^HLMA("AC","I",+$G(HLXX))

 L -^HLMA("IN-FILER","AC","I",+$G(HLXX))

 G UNWIND^%ZTER

 ;

 ;

EXIT ;unlock

 I $G(HLMTIENS) L -^HLMA(HLMTIENS)

 Q

 ;

ONAC(IEN773) ;

 ;Returns 1 if the message is on the "AC","I" xref

 ;Returns 0 otherwise

 ;

 N LINK

 S LINK=$P($G(^HLMA(IEN773,0)),"^",17)

 Q:'LINK 0

 Q $D(^HLMA("AC","I",LINK,IEN773))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---HLTP3   13938     printed  Feb 18, 2025@23:26:25                                                                                                                                                                                                      Page 2

HLTP3     ;SFIRMFO/RSD - Transaction Processor for TCP ;07/29/2009  14:51

 +1       ;;1.6;HEALTH LEVEL SEVEN;**19,43,57,58,59,66,69,109,115,108,116,117,125,120,133,122,140,142,145**;Oct 13, 1995;Build 4

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4        QUIT 

NEW(X)    ;process new msg. ien in 773^ien in 772

 +1       ;HLMTIENS=ien in #773; HLMTIEN=ien in #772

 +2       ;HLHDRO=original header;  HLHDR=response header

 +3       ;set error trap

 +4        NEW $ETRAP,$ESTACK

           SET $ETRAP="D ERROR^HLTP3"

 +5        NEW HL,HLEID,HLEIDS,HLERR,HLHDR,HLHDRO,HLMTIEN,HLMTIENS,HLJ,HLMSA,HLQUIT,HLNODE,HLNEXT,HLRESLTA,HLDONE1,HLASTRSP,HLRESLT

 +6        SET HLRESLT=""

 +7        DO INIT^HLTP3A

 +8       ;error with header, return commit/app reject

 +9        IF $GET(HLRESLT)

               Begin DoDot:1

 +10      ;set status & unlock record

 +11               DO STATUS^HLTF0(HLMTIENS,4,,,1)

                   DO EXIT

 +12      ;quit if no commit or app ack

 +13               IF $GET(HL("ACAT"))="NE"

                       IF $GET(HL("APAT"))="NE"

                           QUIT 

 +14               SET X=$SELECT($GET(HL("ACAT"))="AL":"CR",1:"AR")

 +15      ;HLTCP=ien of acknowledgment msg. from ACK^HLTP4

 +16               DO ACK^HLTP4(X,$PIECE(HLRESLT,U,2))

                   if '$GET(HLTCP)

                       QUIT 

 +17      ;write ack back

 +18               SET X=$$WRITE^HLCSTCP2(HLTCP)

 +19      ;update counter to sent

 +20               DO LLCNT^HLCSTCP(HLDP,4)

 +21      ;update status of ack

 +22               DO STATUS^HLTF0(HLTCP,3,,,1)

               End DoDot:1

               QUIT 

 +23      ;

 +24      ;check for duplicate msg., use rec. app and msg. id x-ref

 +25      ; patch HL*1.6*142 start

 +26      ; HL("HDR FLDS:3-6") extracted from field 3 to field 6 of header

 +27      ; defined in HLDIE routine

 +28      ; I $G(HL("MID"))]"",$G(HL("RAP")) S X=$O(^HLMA("AH",HL("RAP"),HL("MID"),0)) D  Q:'$D(HLMTIENS)

 +29       IF ($GET(HL("MID"))]"")

               IF ($GET(HL("HDR FLDS:3-6"))]"")

                   Begin DoDot:1

 +30                   SET X=$ORDER(^HLMA("AH-NEW",HL("HDR FLDS:3-6"),HL("MID"),0))

 +31      ; patch HL*1.6*142 end

 +32      ;HLASTMSG=last ien received during this connection

 +33      ;if no duplicate, save msg. ien and quit

 +34                   IF X=HLMTIENS!'X

                           SET HLASTMSG=HLMTIENS

                           QUIT 

 +35                   NEW MSH,OIENS

 +36                   SET (OIENS,Y)=X

                       Begin DoDot:2

 +37      ;combine MSH into single string

 +38                       SET MSH(Y)=""

                           SET I=0

                           FOR 

                               SET I=$ORDER(^HLMA(Y,"MSH",I))

                               if 'I

                                   QUIT 

                               SET MSH(Y)=MSH(Y)_$GET(^(I,0))

                       End DoDot:2

                       SET Y=HLMTIENS

                       Begin DoDot:2

                       End DoDot:2

 +39      ; patch 117 & 125, check if identical

 +40                   IF MSH(HLMTIENS)'=MSH(OIENS)

                           SET HLASTMSG=HLMTIENS

                           QUIT 

 +41      ;

 +42      ;msg is duplicate, set status

 +43                   DO STATUS^HLTF0(HLMTIENS,4,109,"Duplicate with ien "_OIENS,1)

                       DO EXIT

 +44      ;msg was resent, ignore it.

 +45                   IF HLASTMSG=HLMTIENS

                           KILL HLMTIENS

                           QUIT 

 +46      ;find original response and send back

 +47                   SET HLASTRSP=$ORDER(^HLMA("AF",OIENS,OIENS))

 +48      ; patch HL*1.6*142 start

 +49      ; the original msg may need to be updated again if 1st time

 +50      ; update failed

 +51                   SET HLASTMSG("OIENS")=OIENS

 +52      ;

 +53      ; the original message and its commit ACK were purged, OIENS is

 +54      ; duplicate and needs to create its own commit ACK (happened

 +55      ; between MPI and VIE in 9/2008), the OIENS will be processed

 +56      ; by the application routine again.

 +57                   IF $GET(HL("ACAT"))="AL"

                           IF '$GET(HL("ACK"))

                               IF 'HLASTRSP

                                   Begin DoDot:2

 +58                                   NEW HLTCP,HLMTIENS

 +59                                   SET HLMTIENS=OIENS

 +60                                   DO ACK^HLTP4("CA")

 +61      ; decreament and will be added later

                                       DO LLCNT^HLCSTCP(HLDP,3,1)

 +62                                   SET HLASTRSP=HLTCP

                                   End DoDot:2

 +63      ; patch HL*1.6*142 end

                   End DoDot:1

                   if '$DATA(HLMTIENS)

                       QUIT 

 +64      ;

 +65      ; patch HL*1.6*145 start

 +66      ; Quit if this is application ack to application ack

 +67       IF $GET(HL("ACK"))

               Begin DoDot:1

 +68               NEW HLERRMG,X

 +69               SET HLERRMG="Received application acknowledgement to an application acknowledgement"

 +70      ;msg is a resend, HLASTRSP=ien of original response (commit ACK)

 +71               IF $GET(HLASTRSP)

                       Begin DoDot:2

 +72                       SET HLTCP=HLASTRSP

 +73                       DO STATUS^HLTF0(HLTCP,8)

 +74                       SET ^HLMA(+HLTCP,"S")=$$NOW^XLFDT

 +75                       DO LLCNT^HLCSTCP(HLDP,3)

                       End DoDot:2

 +76              IF '$TEST

                       Begin DoDot:2

 +77      ;Send CR and update status of original and current ack messages

 +78                       DO ACK^HLTP4("CR",HLERRMG)

                       End DoDot:2

                       if '$GET(HLTCP)

                           QUIT 

 +79      ;

 +80      ; write commit ACK (original commit ACK)

 +81               SET X=$$WRITE^HLCSTCP2(HLTCP)

 +82               DO STATUS^HLTF0(HLTCP,3,,"'Reject' commit ACK: "_HLERRMG,1)

 +83               SET ^HLMA(+HLTCP,"S")=$$NOW^XLFDT

 +84               DO LLCNT^HLCSTCP(HLDP,4)

 +85               SET HLTCP=""

 +86      ; D STATUS^HLTF0(HL("MTIENS"),3,,,1),STATUS^HLTF0(HLMTIENS,3,,,1)

 +87               DO STATUS^HLTF0(HL("MTIENS"),3,,,1)

 +88               DO STATUS^HLTF0(HLMTIENS,4,,HLERRMG,1)

 +89      ;unlock record

 +90               DO EXIT

               End DoDot:1

               QUIT 

 +91      ; patch HL*1.6*145 end

 +92      ;

 +93      ; enhance ack., send commit, quit if not an ack, msg will be 

 +94      ; processed by filer

 +95       IF $GET(HL("ACAT"))="AL"

               Begin DoDot:1

 +96      ;msg is a resend, HLASTRSP=ien of original response (commit ACK)

 +97               IF $GET(HLASTRSP)

                       Begin DoDot:2

 +98                       SET HLTCP=HLASTRSP

 +99                       DO LLCNT^HLCSTCP(HLDP,3)

                       End DoDot:2

 +100             IF '$TEST

                       Begin DoDot:2

 +101     ;**109** LLCNT^HLCSTCP(HLDP,3) called in ACK^HLTP4

                           DO ACK^HLTP4("CA")

                       End DoDot:2

                       if '$GET(HLTCP)

                           QUIT 

 +102     ;

 +103     ; write commit ACK (original commit ACK)

 +104              SET X=$$WRITE^HLCSTCP2(HLTCP)

 +105     ; patch HL*1.6*142

 +106     ; D LLCNT^HLCSTCP(HLDP,4),STATUS^HLTF0(HLTCP,3,,,1):'$G(HLASTRSP)

 +107              DO LLCNT^HLCSTCP(HLDP,4)

 +108              IF '$GET(HLASTRSP)

                       Begin DoDot:2

 +109                      DO STATUS^HLTF0(HLTCP,3,,,1)

                       End DoDot:2

 +110              SET HLTCP=""

 +111     ;if not an ack, set status to awaiting processing **109** and put on in queue

 +112              IF '$GET(HL("MTIENS"))

                       IF '$GET(HLASTRSP)

                           DO STATUS^HLTF0(HLMTIENS,9)

                           DO EXIT

                           DO SETINQUE^HLTP31

 +113     ;

 +114     ; patch HL*1.6*142 start

 +115     ;if the original msg failed to en-queue and update status

 +116     ; it may happen when COTS disconnect the listener during

 +117     ; writing the commit ACK

 +118     ; deal with a non-application ACK duplicate message

 +119              IF '$GET(HL("MTIENS"))

                       IF $GET(HLASTRSP)

                           Begin DoDot:2

 +120                          NEW STATUS

 +121                          SET STATUS=+$GET(^HLMA(HLASTRSP,"P"))

 +122                          IF STATUS

                                   IF (STATUS'=3)

                                       Begin DoDot:3

 +123     ; update the original messsage, ien=HLASTMSG("OIENS")

 +124                                      DO STATUS^HLTF0(HLASTMSG("OIENS"),9)

 +125                                      DO EXIT

 +126                                      NEW HLMTIENS

 +127                                      SET HLMTIENS=HLASTMSG("OIENS")

 +128                                      DO SETINQUE^HLTP31

 +129                                      DO STATUS^HLTF0(HLASTRSP,3,,,1)

                                       End DoDot:3

                           End DoDot:2

 +130     ; patch HL*1.6*142 end

               End DoDot:1

               if '$GET(HL("MTIENS"))

                   QUIT 

 +131     ;

 +132     ;enhance ack., no commit & no app ack

 +133      IF $GET(HL("ACAT"))="NE"

               IF $GET(HL("APAT"))="NE"

                   Begin DoDot:1

 +134     ;set status to awaiting processing, **109** and put on in queue

 +135                  IF '$GET(HLASTRSP)

                           DO STATUS^HLTF0(HLMTIENS,9)

                           DO EXIT

                           DO SETINQUE^HLTP31

                   End DoDot:1

                   QUIT 

 +136     ;

 +137     ; patch HL*1.6*120 start

 +138     ;resending old response, msg is a resend

 +139     ; do not re-send duplicate when $G(HL("ACAT"))="AL"

 +140     ; the following resend is for original mode application ACK

 +141      IF $GET(HLASTRSP)

               IF $GET(HL("ACAT"))'="AL"

                   SET HLTCP=HLASTRSP

                   GOTO ACK

 +142     ; patch HL*1.6*120 end

 +143     ;

 +144     ; patch HL*1.6*142 start

 +145     ; to handle duplicate when the original message encountered

 +146     ; a write error of commit ACK

 +147     ; quit if duplicate

 +148     ; Q:$G(HLASTRSP)

 +149      SET HLASTRSP("FLAG")=0

 +150      IF $GET(HLASTRSP)

               IF $GET(HL("ACAT"))="AL"

                   Begin DoDot:1

 +151                  IF +$GET(^HLMA(+$GET(HLASTRSP),"P"))

                           IF (+$PIECE($GET(^HLMA(+$GET(HLASTRSP),"P")),"^")'=3)

                               Begin DoDot:2

 +152                              SET HLASTRSP("FLAG")=1

                               End DoDot:2

                   End DoDot:1

 +153     ; don't quit if this is duplicate application ACK msg with accept

 +154     ; ACK type="AL", and its original commit ACK is not done.

 +155      IF $GET(HLASTRSP)

               IF ('HLASTRSP("FLAG"))

                   QUIT 

 +156     ;

 +157     ; if duplicate, change ien to orginal msg ien

 +158      IF $GET(HLASTRSP)

               Begin DoDot:1

 +159              SET HLMTIENS=+$GET(HLASTMSG("OIENS"))

 +160              SET HLMTIEN=+$GET(^HLMA(HLMTIENS,0))

               End DoDot:1

 +161     ; patch HL*1.6*142 end

 +162     ;

CONT      ;continue processing an enhance ack msg. called from DEFACK

 +1       ;Set special HL variables for processing rtn

 +2        SET HLQUIT=0

           SET HLNODE=""

           SET HLNEXT="D HLNEXT^HLCSUTL"

 +3       ;

 +4       ; message is an acknowledgement, HLMSA=ack code^id^text

 +5        IF ($GET(HLMSA)]"")

               Begin DoDot:1

 +6       ;X=1 if ack ok, 0=reject of error

 +7                SET X=$EXTRACT(HLMSA,2)="A"

 +8       ;Update status of original message and remove it from the queue

 +9                DO STATUS^HLTF0(HL("MTIENS"),$SELECT(X:3,1:4),"",$SELECT(X:"",1:$PIECE(HLMSA,HL("FS"),3)),1)

 +10      ; patch HL*1.6*142

 +11      ; time: original message receives the application ACK

 +12               SET $PIECE(^HLMA(HL("MTIENS"),"S"),"^",5)=$$NOW^XLFDT

 +13               DO DEQUE^HLCSREP($PIECE($GET(^HLMA(HL("MTIENS"),0)),"^",7),"O",HL("MTIENS"))

 +14               Begin DoDot:2

 +15      ;variable to update status in file #772.

                       NEW HLTCP

 +16      ;

 +17      ;**108**

 +18                   NEW TEMP

 +19                   SET TEMP=HLMTIENS

 +20                   NEW HLMTIENS

 +21                   SET HLMTIENS=TEMP

 +22      ;**END 108**

 +23      ;

 +24      ; patch HL*1.6*142 start

 +25      ; time: starts to process the incoming message

 +26                   SET $PIECE(^HLMA(HLMTIENS,"S"),"^",6)=$$NOW^XLFDT

 +27                   DO PROCACK^HLTP2(HLMTIEN,HL("EID"),.HLRESLT,.HL)

 +28      ; time: ends processing the incoming message

 +29                   SET $PIECE(^HLMA(HLMTIENS,"S"),"^",7)=$$NOW^XLFDT

                   End DoDot:2

 +30      ; if duplicate, and the original msg failed to

 +31      ; complete the processing

 +32               IF $GET(HLASTRSP)

                       DO STATUS^HLTF0(HLASTRSP,3,,,1)

 +33      ; patch HL*1.6*142 end

 +34      ;update status of incoming & unlock

 +35               DO STATUS^HLTF0(HLMTIENS,$SELECT($GET(HLRESLT):4,1:3),$SELECT($GET(HLRESLT):+$GET(HLRESLT),1:""),$SELECT($GET(HLRESLT):$PIECE(HLRESLT,U,2),1:""),1)

                   DO EXIT

               End DoDot:1

               QUIT 

 +36      ;

 +37      ;get entry action, exit action and processing routine

 +38       KILL HLHDR,HLLD0,HLLD1,HLMSA

 +39      ;**CIRN**

           IF HL("EIDS")=""

               IF $GET(HLEIDS)]""

                   SET HL("EIDS")=HLEIDS

 +40       DO EVENT^HLUTIL1(HL("EIDS"),"15,20,771",.HLN)

 +41       SET HLENROU=$GET(HLN(20))

           SET HLEXROU=$GET(HLN(15))

           SET HLPROU=$GET(HLN(771))

 +42      ;quit if no processing routine,update status and quit

 +43       IF HLPROU']""

               SET HLRESLT="10^"_$GET(^HL(771.7,10,0))

               DO STATUS^HLTF0(HLMTIENS,3,,,1)

               DO EXIT

               QUIT 

 +44      ;HLORNOD=subscriber protocol for Fileman auditing, ien;global ref

 +45       NEW HLORNODD

           SET HLORNOD=HL("EIDS")_";ORD(101,"

 +46      ;Execute entry action of client protocol

 +47       if HLENROU]""

               XECUTE HLENROU

           KILL HLENROU,HLDONE1

 +48      ;

 +49      ; patch HL*1.6*142 start

 +50      ; time: starts to process the incoming message

 +51       SET $PIECE(^HLMA(HLMTIENS,"S"),"^",6)=$$NOW^XLFDT

 +52      ;Execute processing routine

 +53       XECUTE HLPROU

           SET HLRESLT=0

           if ($DATA(HLERR))

               SET HLRESLT="9^"_HLERR

 +54      ; time: ends processing the incoming message

 +55       SET $PIECE(^HLMA(HLMTIENS,"S"),"^",7)=$$NOW^XLFDT

 +56      ; if duplicate, and the original msg failed to

 +57      ; complete the processing

 +58       IF $GET(HLASTRSP)