Routine: RGMTSTAT

RGMTSTAT ;BIR/DLR,CML,PTD-MPI/PD Maintenance Query ;07/30/02

 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20**;30 Apr 99

 ;Reference to ^ORD(101 supported by IA #2596

PROCESS ;Processor of QRY msg from protocol, RGMT DEFERRED QRY CLIENT.

 S RGMT=0 N REP,SG,HLP,HLRESLTA K ^TMP("HLA",$J)

 F RGMT=1:1 X HLNEXT Q:HLQUIT'>0  S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG

 ;;Queue the deferred status acknowledgment off

 S RGMTER=$$RESP() I RGMTER'>0 S HLP("ERRTEXT")="Unable to queue query"

 S ^TMP("HLA",$J,1)="MSA"_HL("FS")_$S(RGMTER>0:"AA",1:"AE")_HL("FS")_HL("MID")

 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HLP)

 K RGMTER,RGMTID,RGCOMP,SITE,RGMTFS,RGMTRCV,RGMTQRD,^TMP("HLA",$J)

MSH ;process MSH segment

 S RGMTFS=HL("FS")

 S RGMTID=HL("MID")

 S RGCOMP=$E(HL("ECH"),1)

 S REP=$E(HL("ECH"),2)

 S SITE=$$LKUP^XUAF4($P($P(HLNODE,HL("FS"),4),RGCOMP))

 S ZTSAVE("RGMTID")=""

 S ZTSAVE("RGCOMP")=""

 S ZTSAVE("SITE")=""

 S ZTSAVE("RGMTFS")=""

 S ZTSAVE("REP")=""

QRD ;process QRD segment

 S RGMTQRD=HLNODE

 S RGMTRCV=$P(RGMTQRD,HL("FS"),5)

 S ZTSAVE("RGMTRCV")=""

 S ZTSAVE("RGMTQRD")=""

STATUS ;processor of QRY acknowledgments, QCK and DSR, from protocol, RGMT DEFERRED QRY SERVER.

 ;if ack msg type is returned the protocols are not installed

 I HL("MTN")="QCK" D

 .S RGMT=0

 .F RGMT=1:1 X HLNEXT Q:HLQUIT'>0  S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG

 .S $P(^XTMP("RGMT","RGHLMQ",SITE,0),"^",2)="AA"

 ;the "DSR" ack type should use protocol, RGMT DEFERRED QRY RESPONSE SERVER, if not call its entry point ACK

 I HL("MTN")="DSR" D ACK

BLD(RGMT) ;Build Query message

 S DIC="^ORD(101,",X=RGMT D ^DIC K DIC S EID=+Y I EID<0 S EID=""

 S HL="HL",INT=0

 W !,EID Q:EID="" -1

 D INIT^HLFNC2(EID,.HL,INT)

 S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4),REP=$E(HL("ECH"),2)

 Q +$G(EID)

ROUTE ;Generate recipient list/route QRY msg using protocol, RGMT DEFERRED QRY CLIENT.

 N CLIENT

 K RGMT

 S CLIENT="RGMT DEFERRED QRY CLIENT"

 D LINK^HLUTIL3(SITE,.RGMT)

 I $O(RGMT(0)) S HLL("LINKS",1)=CLIENT_"^"_$P(RGMT($O(RGMT(0))),U)

 K RGMT

GEN ;generate hl7 message

 N HLRESLT,HLP

 D GENERATE^HLMA(EID,"GM",1,.HLRESLT,"",.HLP)

RESP() ;response to remote query

 N ZTSK,ZTRTN,ZTDESC,ZTREQ,ZTIO,ZTDTH

 S ZTREQ="@",ZTDTH=$$NOW^XLFDT,ZTIO="",ZTRTN="DSR^RGMTSTAT",ZTDESC="RGMT QUERY RESP" D ^%ZTLOAD D ^%ZISC

 Q $G(ZTSK)

DSRTYPE S RGMTCNT=3

 F RGMTPC=1:1:$L(RGMTQRD,REP) S RGMTTYP=$P($P(RGMTQRD,RGMTFS,10),REP,RGMTPC) D

 .S RGDSPCNT=1,RGMT1=0

 .S RGMT1="" F  S RGMT1=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1)) Q:RGMT1=""  D

 ..I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1))'="" S ^TMP("HLS",$J,RGMTCNT)="DSP"_RGMTFS_RGDSPCNT_RGMTFS_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1)_COMP_RGMT1 D

 ...S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1 Q

 ..S RGMT2="" F  S RGMT2=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2)) Q:RGMT2=""  D

 ...I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2))'="" S ^TMP("HLS",$J,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2)_COMP_RGMT1_COMP_RGMT2 D

 ....S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1 Q

 ...S RGMT3="" F  S RGMT3=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3)) Q:RGMT3=""  D

 ....I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3))'="" D

 .....S ^TMP("HLS",$J,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3)_COMP_RGMT1_COMP_RGMT2_COMP_RGMT3

 .....S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1

 ....S RGMT4="" F  S RGMT4=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4)) Q:RGMT4=""  D

 .....I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4))'="" D

 ......S ^TMP("HLS",$J,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4)_COMP_RGMT1_COMP_RGMT2_COMP_RGMT3_COMP_RGMT4

 ......S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1

 K ^XTMP("RGMT","HLMQMONT"),^XTMP("RGMT","HLMQHLMA"),^XTMP("RGMT","HLMQETOT")

DSR ;response to remote query

 N EID,INT,COMP,RGMT,RGMT1,RGMT2,RGMT3,RGMT4,RGMTPC,RGMTTYP,RGMTFAC,RGMTCNT,RGDSPCNT,RGHLMQ

 K ^TMP("HLS",$J),^XTMP("RGMT","HLMQMONT"),^XTMP("RGMT","HLMQHLMA"),^XTMP("RGMT","HLMQETOT")

 S COMP=RGCOMP

 S RGMTFAC=$P($$SITE^VASITE,"^",3)

 F RGMTPC=1:1:$L($P(RGMTQRD,RGMTFS,10),REP) S RGMTTYP=$P($P(RGMTQRD,RGMTFS,10),REP,RGMTPC) D

 .S RGHLMQ=1 I RGMTTYP="MONT" D EN2^RGMTMONT

 .S RGHLMQ=1 I RGMTTYP="HLMA" D HLMA2^RGMTUT98

 .S RGHLMQ=1 I RGMTTYP="UT01" D EN2^RGMTUT01

 .S RGMTHQ=1 I RGMTTYP="ETOT" D DUMP2^RGMTETOT D

 ..S ^XTMP("RGMT","HLMQETOT",RGMTFAC,"@@RUNDATE")=$P($$SITE^VASITE,"^",2)_"^"_$$HTE^XLFDT($H)

 S RGMT="RGMT DEFERRED QRY RESP SERVER"

 I $$BLD(RGMT)'>0 S HLP("ERRTEXT")="Could not find protocol" Q

 S ^TMP("HLS",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_RGMTID

 S ^TMP("HLS",$J,2)=RGMTQRD

 D DSRTYPE

 D GEN

 K RGMTQRD,REP,ZTSAVE,RGMTRCV,RGMTMID,SITE,RGMTFS,RGCOMP,SUBCOMP,X,Y

RTERSP ;router for DSR msg from protocol, RGMT DEFERRED QRY RESP SERVER.

 N CLIENT,SITE

 S CLIENT="RGMT DEFERRED QRY RESP CLIENT"

 S SITE=$$LKUP^XUAF4("200M")

 D LINK^HLUTIL3(SITE,.RGMT)

 I $O(RGMT(0)) S HLL("LINKS",1)=CLIENT_"^"_$P(RGMT($O(RGMT(0))),U)

ACK ;processor of DSR msg should be using protocol, RGMT DEFERRED QRY RESP CLIENT,

 ;but is using the originating QRY protocol, RGMT DEFERRED QRY CLIENT.

 S RGMT=0 K ^TMP("HLA",$J)

 F RGMT=1:1 X HLNEXT Q:HLQUIT'>0  S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG

 S ^TMP("HLA",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")

 N HLRESLTA,HLP D GENACK^HLMA1(HL("EID"),HL("EIDS"),"GM",1,.HLRESLTA,"",.HLP)

 S $P(^XTMP("RGMT","RGHLMQ",SITE,0),"^",2)="F"

 K RGMT,RGMTAA

DSP ;display segment

 N RGMTDSP,RGMTRPT,RGCS,RGDATA,RGNODE

 S RGDATA=$P(HLNODE,HL("FS"),4,99)

 S RGMTDSP=$P(HLNODE,HL("FS"),2)

 S RGMTRPT=$P(HLNODE,HL("FS"),3)

 I '$D(^XTMP("RGMT","RGHLMQ",SITE,0)) S ^XTMP("RGMT","RGHLMQ",SITE,0)=$$FMADD^XLFDT(DT,7)_"^"_"F"

 S RGNODE="^XTMP(""RGMT"",""HLMQ"_$S(RGMTRPT=1:"MONT""",RGMTRPT=2:"HLMA""",RGMTRPT=3:"ETOT""",1:"UT01""")_","_SITE

 F RGCS=2:1:$L(RGDATA,RGCOMP) S RGNODE=RGNODE_","""_$P(RGDATA,RGCOMP,RGCS)_""""

 S RGNODE=RGNODE_")"

 I RGNODE["@@ RUNDATE" S @RGNODE=$$GET1^DIQ(4,+SITE_",",.01)_"^"_$P(RGDATA,RGCOMP) Q

 S @RGNODE=$P(RGDATA,RGCOMP)

MSA ;Message ack segment

 S RGMTAA=$P(HLNODE,HL("FS"),3)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTSTAT   6424     printed  Mar 13, 2025@20:47:07                                                                                                                                                                                                    Page 2

RGMTSTAT  ;BIR/DLR,CML,PTD-MPI/PD Maintenance Query ;07/30/02

 +1       ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20**;30 Apr 99

 +2       ;

 +3       ;Reference to ^ORD(101 supported by IA #2596

 +4       ;

 +5        QUIT

PROCESS   ;Processor of QRY msg from protocol, RGMT DEFERRED QRY CLIENT.

 +1        SET RGMT=0

           NEW REP,SG,HLP,HLRESLTA

           KILL ^TMP("HLA",$JOB)

 +2        FOR RGMT=1:1

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT

               SET SG=$EXTRACT(HLNODE,1,3)

               if $TEXT(@SG)]""

                   DO @SG

 +3       ;;Queue the deferred status acknowledgment off

 +4        SET RGMTER=$$RESP()

           IF RGMTER'>0

               SET HLP("ERRTEXT")="Unable to queue query"

 +5        SET ^TMP("HLA",$JOB,1)="MSA"_HL("FS")_$SELECT(RGMTER>0:"AA",1:"AE")_HL("FS")_HL("MID")

 +6        DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HLP)

 +7        KILL RGMTER,RGMTID,RGCOMP,SITE,RGMTFS,RGMTRCV,RGMTQRD,^TMP("HLA",$JOB)

 +8        QUIT

MSH       ;process MSH segment

 +1        SET RGMTFS=HL("FS")

 +2        SET RGMTID=HL("MID")

 +3        SET RGCOMP=$EXTRACT(HL("ECH"),1)

 +4        SET REP=$EXTRACT(HL("ECH"),2)

 +5        SET SITE=$$LKUP^XUAF4($PIECE($PIECE(HLNODE,HL("FS"),4),RGCOMP))

 +6        SET ZTSAVE("RGMTID")=""

 +7        SET ZTSAVE("RGCOMP")=""

 +8        SET ZTSAVE("SITE")=""

 +9        SET ZTSAVE("RGMTFS")=""

 +10       SET ZTSAVE("REP")=""

 +11       QUIT

QRD       ;process QRD segment

 +1        SET RGMTQRD=HLNODE

 +2        SET RGMTRCV=$PIECE(RGMTQRD,HL("FS"),5)

 +3        SET ZTSAVE("RGMTRCV")=""

 +4        SET ZTSAVE("RGMTQRD")=""

 +5        QUIT

STATUS    ;processor of QRY acknowledgments, QCK and DSR, from protocol, RGMT DEFERRED QRY SERVER.

 +1       ;if ack msg type is returned the protocols are not installed

 +2        IF HL("MTN")="QCK"

               Begin DoDot:1

 +3                SET RGMT=0

 +4                FOR RGMT=1:1

                       XECUTE HLNEXT

                       if HLQUIT'>0

                           QUIT

                       SET SG=$EXTRACT(HLNODE,1,3)

                       if $TEXT(@SG)]""

                           DO @SG

 +5                SET $PIECE(^XTMP("RGMT","RGHLMQ",SITE,0),"^",2)="AA"

               End DoDot:1

 +6       ;the "DSR" ack type should use protocol, RGMT DEFERRED QRY RESPONSE SERVER, if not call its entry point ACK

 +7        IF HL("MTN")="DSR"

               DO ACK

 +8        QUIT

BLD(RGMT) ;Build Query message

 +1        SET DIC="^ORD(101,"

           SET X=RGMT

           DO ^DIC

           KILL DIC

           SET EID=+Y

           IF EID<0

               SET EID=""

 +2        SET HL="HL"

           SET INT=0

 +3        WRITE !,EID

           if EID=""

               QUIT -1

 +4        DO INIT^HLFNC2(EID,.HL,INT)

 +5        SET COMP=$EXTRACT(HL("ECH"),1)

           SET SUBCOMP=$EXTRACT(HL("ECH"),4)

           SET REP=$EXTRACT(HL("ECH"),2)

 +6        QUIT +$GET(EID)

ROUTE     ;Generate recipient list/route QRY msg using protocol, RGMT DEFERRED QRY CLIENT.

 +1        NEW CLIENT

 +2        KILL RGMT

 +3        SET CLIENT="RGMT DEFERRED QRY CLIENT"

 +4        DO LINK^HLUTIL3(SITE,.RGMT)

 +5        IF $ORDER(RGMT(0))

               SET HLL("LINKS",1)=CLIENT_"^"_$PIECE(RGMT($ORDER(RGMT(0))),U)

 +6        KILL RGMT

 +7        QUIT

GEN       ;generate hl7 message

 +1        NEW HLRESLT,HLP

 +2        DO GENERATE^HLMA(EID,"GM",1,.HLRESLT,"",.HLP)

 +3        QUIT

RESP()    ;response to remote query

 +1        NEW ZTSK,ZTRTN,ZTDESC,ZTREQ,ZTIO,ZTDTH

 +2        SET ZTREQ="@"

           SET ZTDTH=$$NOW^XLFDT

           SET ZTIO=""

           SET ZTRTN="DSR^RGMTSTAT"

           SET ZTDESC="RGMT QUERY RESP"

           DO ^%ZTLOAD

           DO ^%ZISC

 +3        QUIT $GET(ZTSK)

DSRTYPE    SET RGMTCNT=3

 +1        FOR RGMTPC=1:1:$LENGTH(RGMTQRD,REP)

               SET RGMTTYP=$PIECE($PIECE(RGMTQRD,RGMTFS,10),REP,RGMTPC)

               Begin DoDot:1

 +2                SET RGDSPCNT=1

                   SET RGMT1=0

 +3                SET RGMT1=""

FOR

                       SET RGMT1=$ORDER(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1))

                       if RGMT1=""

                           QUIT

                       Begin DoDot:2

 +4                        IF $GET(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1))'=""

                               SET ^TMP("HLS",$JOB,RGMTCNT)="DSP"_RGMTFS_RGDSPCNT_RGMTFS_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1)_COMP_RGMT1

                               Begin DoDot:3

 +5                                SET RGMTCNT=$GET(RGMTCNT)+1

                                   SET RGDSPCNT=RGDSPCNT+1

                                   QUIT

                               End DoDot:3

 +6                        SET RGMT2=""

FOR

                               SET RGMT2=$ORDER(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2))

                               if RGMT2=""

                                   QUIT

                               Begin DoDot:3

 +7                                IF $GET(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2))'=""

                                       SET ^TMP("HLS",$JOB,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2)_COMP_RGMT1_COMP_RGMT2

                                       Begin DoDot:4

 +8                                        SET RGMTCNT=$GET(RGMTCNT)+1

                                           SET RGDSPCNT=RGDSPCNT+1

                                           QUIT

                                       End DoDot:4

 +9                                SET RGMT3=""

FOR

                                       SET RGMT3=$ORDER(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3))

                                       if RGMT3=""

                                           QUIT

                                       Begin DoDot:4

 +10                                       IF $GET(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3))'=""

                                               Begin DoDot:5

 +11                                               SET ^TMP("HLS",$JOB,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3)_COMP_RGMT1_COMP_RGMT2_COMP_RGMT3

 +12                                               SET RGMTCNT=$GET(RGMTCNT)+1

                                                   SET RGDSPCNT=RGDSPCNT+1

                                               End DoDot:5

 +13                                       SET RGMT4=""

FOR

                                               SET RGMT4=$ORDER(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4))

                                               if RGMT4=""

                                                   QUIT

                                               Begin DoDot:5

 +14                                               IF $GET(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4))'=""

                                                       Begin DoDot:6

 +15                                                       SET ^TMP("HLS",$JOB,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4)_COMP_RGMT1_COMP_RGMT2_COMP_RGMT3_COMP_RGMT4

 +16                                                       SET RGMTCNT=$GET(RGMTCNT)+1

                                                           SET RGDSPCNT=RGDSPCNT+1

                                                       End DoDot:6

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +17       KILL ^XTMP("RGMT","HLMQMONT"),^XTMP("RGMT","HLMQHLMA"),^XTMP("RGMT","HLMQETOT")

 +18       QUIT

DSR       ;response to remote query

 +1        NEW EID,INT,COMP,RGMT,RGMT1,RGMT2,RGMT3,RGMT4,RGMTPC,RGMTTYP,RGMTFAC,RGMTCNT,RGDSPCNT,RGHLMQ

 +2        KILL ^TMP("HLS",$JOB),^XTMP("RGMT","HLMQMONT"),^XTMP("RGMT","HLMQHLMA"),^XTMP("RGMT","HLMQETOT")

 +3        SET COMP=RGCOMP

 +4        SET RGMTFAC=$PIECE($$SITE^VASITE,"^",3)

 +5        FOR RGMTPC=1:1:$LENGTH($PIECE(RGMTQRD,RGMTFS,10),REP)

               SET RGMTTYP=$PIECE($PIECE(RGMTQRD,RGMTFS,10),REP,RGMTPC)

               Begin DoDot:1

 +6                SET RGHLMQ=1

                   IF RGMTTYP="MONT"

                       DO EN2^RGMTMONT

 +7                SET RGHLMQ=1

                   IF RGMTTYP="HLMA"

                       DO HLMA2^RGMTUT98

 +8                SET RGHLMQ=1

                   IF RGMTTYP="UT01"

                       DO EN2^RGMTUT01

 +9                SET RGMTHQ=1

                   IF RGMTTYP="ETOT"

                       DO DUMP2^RGMTETOT

                       Begin DoDot:2

 +10                       SET ^XTMP("RGMT","HLMQETOT",RGMTFAC,"@@RUNDATE")=$PIECE($$SITE^VASITE,"^",2)_"^"_$$HTE^XLFDT($HOROLOG)

                       End DoDot:2

               End DoDot:1

 +11       SET RGMT="RGMT DEFERRED QRY RESP SERVER"

 +12       IF $$BLD(RGMT)'>0

               SET HLP("ERRTEXT")="Could not find protocol"

               QUIT

 +13       SET ^TMP("HLS",$JOB,1)="MSA"_HL("FS")_"AA"_HL("FS")_RGMTID

 +14       SET ^TMP("HLS",$JOB,2)=RGMTQRD

 +15       DO DSRTYPE

 +16       DO GEN

 +17       KILL RGMTQRD,REP,ZTSAVE,RGMTRCV,RGMTMID,SITE,RGMTFS,RGCOMP,SUBCOMP,X,Y

 +18       QUIT

RTERSP    ;router for DSR msg from protocol, RGMT DEFERRED QRY RESP SERVER.

 +1        NEW CLIENT,SITE

 +2        SET CLIENT="RGMT DEFERRED QRY RESP CLIENT"

 +3        SET SITE=$$LKUP^XUAF4("200M")

 +4        DO LINK^HLUTIL3(SITE,.RGMT)

 +5        IF $ORDER(RGMT(0))

               SET HLL("LINKS",1)=CLIENT_"^"_$PIECE(RGMT($ORDER(RGMT(0))),U)

 +6        QUIT

ACK       ;processor of DSR msg should be using protocol, RGMT DEFERRED QRY RESP CLIENT,

 +1       ;but is using the originating QRY protocol, RGMT DEFERRED QRY CLIENT.

 +2        SET RGMT=0

           KILL ^TMP("HLA",$JOB)

 +3        FOR RGMT=1:1

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT

               SET SG=$EXTRACT(HLNODE,1,3)

               if $TEXT(@SG)]""

                   DO @SG

 +4        SET ^TMP("HLA",$JOB,1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")

 +5        NEW HLRESLTA,HLP

           DO GENACK^HLMA1(HL("EID"),HL("EIDS"),"GM",1,.HLRESLTA,"",.HLP)

 +6        SET $PIECE(^XTMP("RGMT","RGHLMQ",SITE,0),"^",2)="F"

 +7        KILL RGMT,RGMTAA

 +8        QUIT

DSP       ;display segment

 +1        NEW RGMTDSP,RGMTRPT,RGCS,RGDATA,RGNODE

 +2        SET RGDATA=$PIECE(HLNODE,HL("FS"),4,99)

 +3        SET RGMTDSP=$PIECE(HLNODE,HL("FS"),2)

 +4        SET RGMTRPT=$PIECE(HLNODE,HL("FS"),3)

 +5        IF '$DATA(^XTMP("RGMT","RGHLMQ",SITE,0))

               SET ^XTMP("RGMT","RGHLMQ",SITE,0)=$$FMADD^XLFDT(DT,7)_"^"_"F"

 +6        SET RGNODE="^XTMP(""RGMT"",""HLMQ"_$SELECT(RGMTRPT=1:"MONT""",RGMTRPT=2:"HLMA""",RGMTRPT=3:"ETOT""",1:"UT01""")_","_SITE

 +7        FOR RGCS=2:1:$LENGTH(RGDATA,RGCOMP)

               SET RGNODE=RGNODE_","""_$PIECE(RGDATA,RGCOMP,RGCS)_""""

 +8        SET RGNODE=RGNODE_")"

 +9        IF RGNODE["@@ RUNDATE"

               SET @RGNODE=$$GET1^DIQ(4,+SITE_",",.01)_"^"_$PIECE(RGDATA,RGCOMP)

               QUIT

 +10       SET @RGNODE=$PIECE(RGDATA,RGCOMP)

 +11       QUIT

MSA       ;Message ack segment

 +1        SET RGMTAA=$PIECE(HLNODE,HL("FS"),3)

 +2        QUIT

RGMTSTAT.m