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
;
Q
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)
Q
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")=""
Q
QRD ;process QRD segment
S RGMTQRD=HLNODE
S RGMTRCV=$P(RGMTQRD,HL("FS"),5)
S ZTSAVE("RGMTRCV")=""
S ZTSAVE("RGMTQRD")=""
Q
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
Q
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
Q
GEN ;generate hl7 message
N HLRESLT,HLP
D GENERATE^HLMA(EID,"GM",1,.HLRESLT,"",.HLP)
Q
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")
Q
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
Q
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)
Q
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
Q
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)
Q
MSA ;Message ack segment
S RGMTAA=$P(HLNODE,HL("FS"),3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTSTAT 6424 printed Dec 13, 2024@01:42:28 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
