YTQRCDB2 ;BAL/KTL - MHA CLOUD DATABASE RPC CALLS; 1/25/2017
;;5.01;MENTAL HEALTH;**239,250,236**;Dec 30, 1994;Build 25
;
;
;Reference to VADPT APIs supported by ICR #10061
;Reference to $$KSP^XUPARAM supported by ICR #2541
;Reference to DIUTC supported by ICR #6445
;Reference to PXRMINDX in ICR #4290
;
Q
PID2(ARGS,RESULTS) ;Get additional patient demographics
N DFN,VA,VADM,YSNM,YSDOB,YSAGE,YSSSN,YSSEX,YSSX,YSSIG
S DFN=$G(ARGS("dfn"))
I +DFN=0 D SETERROR^YTQRUTL(404,"Bad patient identifier") QUIT
I '$D(^DPT(DFN,0)) D SETERROR^YTQRUTL(404,"Not Found: "_DFN) QUIT
D DEM^VADPT,PID^VADPT
S YSNM=VADM(1)
S YSDOB=$P(VADM(3),U,2)
S YSAGE=VADM(4)
S YSSSN="xxx-xx-"_VA("BID")
S YSSEX=$P(VADM(5),U,1)
S YSSX=YSSEX
S YSSIG=$P($G(VADM(14,5)),U,2)
S RESULTS("dob")=YSDOB
S RESULTS("ssn")=YSSSN
S RESULTS("sex")=YSSEX
S RESULTS("sigi")=YSSIG
Q
TZ(ARGS,RESULTS) ;Get Timezone
N INST,PROP,UTC
F PROP="fileman","external","offset","timezone" D
. S RESULTS(PROP)=""
S INST=$$KSP^XUPARAM("INST") Q:+INST=0
S UTC=$$UTC^DIUTC($$NOW^XLFDT(),,INST,,1)
S RESULTS("fileman")=$P(UTC,U)
S RESULTS("external")=$P(UTC,U,2)
S RESULTS("offset")=$P(UTC,U,3)
S RESULTS("timezone")=$P(UTC,U,4)
Q
GETLIST(ARGS,RESULTS) ; GET Insts for Pat
N LST,TST,I,NM,TEST,DFN,SRISK
N ADMINDT,ADMINID,CMPL,CNT,HIT,PAT,G,YSIENS,YSDATA,N,STR,ERRLST,ERRSTR
N ADMINAR,XDT,SAVEDT,SRC,ORD,RVW,NAME
N NMARR
S NM="",N=0
K ^TMP("YTQ-JSON",$J) S CNT=0
D SETRES("{""instruments"":[")
S HIT=""
S DFN=+$G(ARGS("dfn"))
D UPDTSRFL^YTQRQAD4 ; update Suicide Risk Flag
I DFN'?1N.NP D SETERROR^YTQRUTL(404,"Bad Patient ID: "_DFN) QUIT
I '$D(^DPT(DFN,0)) D SETERROR^YTQRUTL(404,"Patient Not Found: "_DFN) QUIT
F S NM=$O(^YTT(601.84,"C",DFN,NM)) Q:'NM D
.S G=$G(^YTT(601.84,NM,0))
.I G="" S ERRLST(NM)="" Q ;-->out
.S CMPL=$P(G,U,9) Q:CMPL'="Y"
.S ADMINDT=$P(G,U,4) Q:ADMINDT=""
.S TST=$P(G,U,3),NAME=$P($G(^YTT(601.71,TST,0)),U,1)
.I $P($G(^YTT(601.71,TST,2)),U,2)="C" QUIT
.S SRISK=$P(G,U,14) I SRISK="" S SRISK=0
.Q:$G(NMARR(NAME))'=""&($G(NMARR(NAME))>ADMINDT)
.I $D(NMARR(NAME)) K ADMINAR(-NMARR(NAME),NAME)
.S ADMINAR(-ADMINDT,NAME)=SRISK,NMARR(NAME)=ADMINDT
S XDT="" F S XDT=$O(ADMINAR(XDT)) Q:XDT="" D
.S NM="" F S NM=$O(ADMINAR(XDT,NM)) Q:NM="" D
..S STR="{""instrumentName"":"""_NM_""", ""suicideRisk"":"""_ADMINAR(XDT,NM)_""" },"
..D SETRES(STR) S HIT=1
I HIT S STR=^TMP("YTQ-JSON",$J,CNT,0),STR=$E(STR,1,$L(STR)-1),^TMP("YTQ-JSON",$J,CNT,0)=STR
D SETRES("]}")
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
GETALST(ARGS,RESULTS) ; GET admins for Pat+Inst
N TST,I,ADM,TEST,DFN,SRISK
N ADMINDT,ADMINID,CMPL,CNT,HIT,G,N,STR
N XDT,SAVEDT,SRC,ORD,RVW,INSTIEN
S ADM="",N=0
K ^TMP("YTQ-JSON",$J) S CNT=0
S HIT=""
S DFN=+$G(ARGS("dfn")),TEST=$G(ARGS("instrumentName"))
I DFN'?1N.NP D SETERROR^YTQRUTL(404,"Bad Patient ID: "_DFN) QUIT
I '$D(^DPT(DFN,0)) D SETERROR^YTQRUTL(404,"Patient Not Found: "_DFN) QUIT
S INSTIEN=$O(^YTT(601.71,"B",TEST,0)) I +INSTIEN=0 D SETERROR^YTQRUTL(404,"Instrument Not Found: "_TEST) QUIT
D SETRES("{""instruments"":[")
S XDT=""
F S XDT=$O(^PXRMINDX(601.84,"PI",DFN,INSTIEN,XDT),-1) Q:XDT="" D ;Get list of instr IENs
. S ADM=0 F S ADM=$O(^PXRMINDX(601.84,"PI",DFN,INSTIEN,XDT,ADM)) Q:ADM="" D
.. S G=$G(^YTT(601.84,ADM,0))
.. I G="" Q
.. S CMPL=$P(G,U,9) Q:CMPL'="Y"
.. S STR=""
.. S TST=$P(G,U,3),ORD=$P(G,U,6),RVW=$P(G,U,17)
.. S SRC=$P(G,U,13) S:SRC'="" SRC=$P($G(^YTT(601.844,SRC,0)),U)
.. I $P($G(^YTT(601.71,TST,2)),U,2)="C" QUIT
.. S ADMINID=$P(G,U,1),ADMINDT=$P($P(G,U,4),":",1,2)
.. S SAVEDT=$P($P(G,U,5),":",1,2)
.. S SRISK=$P(G,U,14) I SRISK="" S SRISK=0
.. S STR="{""adminId"":"""_ADMINID_""", ""instrumentName"":"""_TEST_""" , ""instrumentIen"":"""_INSTIEN_""" , ""administrationDate"":"""_$P($$FMTE^XLFDT(ADMINDT),":",1,2)
.. S STR=STR_""" , ""saveDate"":"""_$P($$FMTE^XLFDT(SAVEDT),":",1,2)_""" , ""suicideRisk"":"""_SRISK_""", ""entrySource"":"""_SRC
.. S STR=STR_""" , ""orderedBy"":"""_ORD_""" , ""reviewed"":"""_RVW_""" },"
.. D SETRES(STR) S HIT=1
I HIT S STR=^TMP("YTQ-JSON",$J,CNT,0),STR=$E(STR,1,$L(STR)-1),^TMP("YTQ-JSON",$J,CNT,0)=STR
D SETRES("]}")
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
SETRES(STR) ;
S CNT=CNT+1,^TMP("YTQ-JSON",$J,CNT,0)=STR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQRCDB2 4351 printed Aug 26, 2025@22:34:31 Page 2
YTQRCDB2 ;BAL/KTL - MHA CLOUD DATABASE RPC CALLS; 1/25/2017
+1 ;;5.01;MENTAL HEALTH;**239,250,236**;Dec 30, 1994;Build 25
+2 ;
+3 ;
+4 ;Reference to VADPT APIs supported by ICR #10061
+5 ;Reference to $$KSP^XUPARAM supported by ICR #2541
+6 ;Reference to DIUTC supported by ICR #6445
+7 ;Reference to PXRMINDX in ICR #4290
+8 ;
+9 QUIT
PID2(ARGS,RESULTS) ;Get additional patient demographics
+1 NEW DFN,VA,VADM,YSNM,YSDOB,YSAGE,YSSSN,YSSEX,YSSX,YSSIG
+2 SET DFN=$GET(ARGS("dfn"))
+3 IF +DFN=0
DO SETERROR^YTQRUTL(404,"Bad patient identifier")
QUIT
+4 IF '$DATA(^DPT(DFN,0))
DO SETERROR^YTQRUTL(404,"Not Found: "_DFN)
QUIT
+5 DO DEM^VADPT
DO PID^VADPT
+6 SET YSNM=VADM(1)
+7 SET YSDOB=$PIECE(VADM(3),U,2)
+8 SET YSAGE=VADM(4)
+9 SET YSSSN="xxx-xx-"_VA("BID")
+10 SET YSSEX=$PIECE(VADM(5),U,1)
+11 SET YSSX=YSSEX
+12 SET YSSIG=$PIECE($GET(VADM(14,5)),U,2)
+13 SET RESULTS("dob")=YSDOB
+14 SET RESULTS("ssn")=YSSSN
+15 SET RESULTS("sex")=YSSEX
+16 SET RESULTS("sigi")=YSSIG
+17 QUIT
TZ(ARGS,RESULTS) ;Get Timezone
+1 NEW INST,PROP,UTC
+2 FOR PROP="fileman","external","offset","timezone"
Begin DoDot:1
+3 SET RESULTS(PROP)=""
End DoDot:1
+4 SET INST=$$KSP^XUPARAM("INST")
if +INST=0
QUIT
+5 SET UTC=$$UTC^DIUTC($$NOW^XLFDT(),,INST,,1)
+6 SET RESULTS("fileman")=$PIECE(UTC,U)
+7 SET RESULTS("external")=$PIECE(UTC,U,2)
+8 SET RESULTS("offset")=$PIECE(UTC,U,3)
+9 SET RESULTS("timezone")=$PIECE(UTC,U,4)
+10 QUIT
GETLIST(ARGS,RESULTS) ; GET Insts for Pat
+1 NEW LST,TST,I,NM,TEST,DFN,SRISK
+2 NEW ADMINDT,ADMINID,CMPL,CNT,HIT,PAT,G,YSIENS,YSDATA,N,STR,ERRLST,ERRSTR
+3 NEW ADMINAR,XDT,SAVEDT,SRC,ORD,RVW,NAME
+4 NEW NMARR
+5 SET NM=""
SET N=0
+6 KILL ^TMP("YTQ-JSON",$JOB)
SET CNT=0
+7 DO SETRES("{""instruments"":[")
+8 SET HIT=""
+9 SET DFN=+$GET(ARGS("dfn"))
+10 ; update Suicide Risk Flag
DO UPDTSRFL^YTQRQAD4
+11 IF DFN'?1N.NP
DO SETERROR^YTQRUTL(404,"Bad Patient ID: "_DFN)
QUIT
+12 IF '$DATA(^DPT(DFN,0))
DO SETERROR^YTQRUTL(404,"Patient Not Found: "_DFN)
QUIT
+13 FOR
SET NM=$ORDER(^YTT(601.84,"C",DFN,NM))
if 'NM
QUIT
Begin DoDot:1
+14 SET G=$GET(^YTT(601.84,NM,0))
+15 ;-->out
IF G=""
SET ERRLST(NM)=""
QUIT
+16 SET CMPL=$PIECE(G,U,9)
if CMPL'="Y"
QUIT
+17 SET ADMINDT=$PIECE(G,U,4)
if ADMINDT=""
QUIT
+18 SET TST=$PIECE(G,U,3)
SET NAME=$PIECE($GET(^YTT(601.71,TST,0)),U,1)
+19 IF $PIECE($GET(^YTT(601.71,TST,2)),U,2)="C"
QUIT
+20 SET SRISK=$PIECE(G,U,14)
IF SRISK=""
SET SRISK=0
+21 if $GET(NMARR(NAME))'=""&($GET(NMARR(NAME))>ADMINDT)
QUIT
+22 IF $DATA(NMARR(NAME))
KILL ADMINAR(-NMARR(NAME),NAME)
+23 SET ADMINAR(-ADMINDT,NAME)=SRISK
SET NMARR(NAME)=ADMINDT
End DoDot:1
+24 SET XDT=""
FOR
SET XDT=$ORDER(ADMINAR(XDT))
if XDT=""
QUIT
Begin DoDot:1
+25 SET NM=""
FOR
SET NM=$ORDER(ADMINAR(XDT,NM))
if NM=""
QUIT
Begin DoDot:2
+26 SET STR="{""instrumentName"":"""_NM_""", ""suicideRisk"":"""_ADMINAR(XDT,NM)_""" },"
+27 DO SETRES(STR)
SET HIT=1
End DoDot:2
End DoDot:1
+28 IF HIT
SET STR=^TMP("YTQ-JSON",$JOB,CNT,0)
SET STR=$EXTRACT(STR,1,$LENGTH(STR)-1)
SET ^TMP("YTQ-JSON",$JOB,CNT,0)=STR
+29 DO SETRES("]}")
+30 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+31 QUIT
GETALST(ARGS,RESULTS) ; GET admins for Pat+Inst
+1 NEW TST,I,ADM,TEST,DFN,SRISK
+2 NEW ADMINDT,ADMINID,CMPL,CNT,HIT,G,N,STR
+3 NEW XDT,SAVEDT,SRC,ORD,RVW,INSTIEN
+4 SET ADM=""
SET N=0
+5 KILL ^TMP("YTQ-JSON",$JOB)
SET CNT=0
+6 SET HIT=""
+7 SET DFN=+$GET(ARGS("dfn"))
SET TEST=$GET(ARGS("instrumentName"))
+8 IF DFN'?1N.NP
DO SETERROR^YTQRUTL(404,"Bad Patient ID: "_DFN)
QUIT
+9 IF '$DATA(^DPT(DFN,0))
DO SETERROR^YTQRUTL(404,"Patient Not Found: "_DFN)
QUIT
+10 SET INSTIEN=$ORDER(^YTT(601.71,"B",TEST,0))
IF +INSTIEN=0
DO SETERROR^YTQRUTL(404,"Instrument Not Found: "_TEST)
QUIT
+11 DO SETRES("{""instruments"":[")
+12 SET XDT=""
+13 ;Get list of instr IENs
FOR
SET XDT=$ORDER(^PXRMINDX(601.84,"PI",DFN,INSTIEN,XDT),-1)
if XDT=""
QUIT
Begin DoDot:1
+14 SET ADM=0
FOR
SET ADM=$ORDER(^PXRMINDX(601.84,"PI",DFN,INSTIEN,XDT,ADM))
if ADM=""
QUIT
Begin DoDot:2
+15 SET G=$GET(^YTT(601.84,ADM,0))
+16 IF G=""
QUIT
+17 SET CMPL=$PIECE(G,U,9)
if CMPL'="Y"
QUIT
+18 SET STR=""
+19 SET TST=$PIECE(G,U,3)
SET ORD=$PIECE(G,U,6)
SET RVW=$PIECE(G,U,17)
+20 SET SRC=$PIECE(G,U,13)
if SRC'=""
SET SRC=$PIECE($GET(^YTT(601.844,SRC,0)),U)
+21 IF $PIECE($GET(^YTT(601.71,TST,2)),U,2)="C"
QUIT
+22 SET ADMINID=$PIECE(G,U,1)
SET ADMINDT=$PIECE($PIECE(G,U,4),":",1,2)
+23 SET SAVEDT=$PIECE($PIECE(G,U,5),":",1,2)
+24 SET SRISK=$PIECE(G,U,14)
IF SRISK=""
SET SRISK=0
+25 SET STR="{""adminId"":"""_ADMINID_""", ""instrumentName"":"""_TEST_""" , ""instrumentIen"":"""_INSTIEN_""" , ""administrationDate"":"""_$PIECE($$FMTE^XLFDT(ADMINDT),":",1,2)
+26 SET STR=STR_""" , ""saveDate"":"""_$PIECE($$FMTE^XLFDT(SAVEDT),":",1,2)_""" , ""suicideRisk"":"""_SRISK_""", ""entrySource"":"""_SRC
+27 SET STR=STR_""" , ""orderedBy"":"""_ORD_""" , ""reviewed"":"""_RVW_""" },"
+28 DO SETRES(STR)
SET HIT=1
End DoDot:2
End DoDot:1
+29 IF HIT
SET STR=^TMP("YTQ-JSON",$JOB,CNT,0)
SET STR=$EXTRACT(STR,1,$LENGTH(STR)-1)
SET ^TMP("YTQ-JSON",$JOB,CNT,0)=STR
+30 DO SETRES("]}")
+31 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+32 QUIT
SETRES(STR) ;
+1 SET CNT=CNT+1
SET ^TMP("YTQ-JSON",$JOB,CNT,0)=STR
+2 QUIT
