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