YS187PST ;BAL/KTL- Patch 187 Post-Init ; 07/28/2021 3:19pm
;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
;
; Routine ICR
; Name ICR#
; ------------------------------------- -----
; SUPPORTED PARAMETER TOOL ENTRY POINTS 2263
; KERNEL XLFJSON 6682
;
Q
POST ;
; Delete namespaced logging for MCMI4
N J
K ^TMP("YKTL")
S J="" F S J=$O(^YKTL(J)) Q:J="" D
. K ^YKTL(J)
; Update Case Mix Tool
D POST^YS187CMT
D MKBAT
D SSRRTN
Q
MKBAT ;Find all users with Battery definitions and create PARAMETER entries
; for MHA Web
N YSUSR,JARR,YSJSON,PRES
N YSWDGT,YSWPARR,YSDUZ
S YSUSR=0 F S YSUSR=$O(^YTT(601.781,"AC",YSUSR)) Q:YSUSR="" D
. S YSWDGT=1
. S YSDUZ=YSUSR_";VA(200,"
. K YSWPARR
. D GETWP^XPAR(.YSWPARR,YSDUZ,"YS MHA_WEB BATTERIES",YSWDGT)
. I '$D(YSWPARR) D
.. K JARR,YSJSON
.. D BATTC(YSUSR,.JARR)
.. D ENCODE^XLFJSON("JARR","YSJSON")
.. S PRES=$$SETPARAM("YS MHA_WEB BATTERIES",.YSJSON,YSUSR)
Q
BATTC(YSUSR,JARR) ;battery content
; OUTPUT: BATTERY NAME ^ INSTRUMENT list sorted by BATTERY & SEQUENCE
N G7,YSBATS,YSBID,YSCONID,YSNAME,YSUB,YS1,YSBNAME,BATNUM,ISEQ,INAM
S YSUB=0 F S YSUB=$O(^YTT(601.781,"AC",YSUSR,YSUB)) Q:YSUB'>0 D
. S YSBID=$P(^YTT(601.781,YSUB,0),U,3)
. S YSBNAME=$P($G(^YTT(601.77,YSBID,0)),U,2)
. S:$L(YSBNAME) YS1(YSBNAME)=YSBID
S BATNUM=0
S YSNAME="" F S YSNAME=$O(YS1(YSNAME)) Q:YSNAME="" S YSBID=YS1(YSNAME) D
. S BATNUM=BATNUM+1
. S YSBATS=0 F S YSBATS=$O(^YTT(601.78,"AC",YSBID,YSBATS)) Q:YSBATS'>0 D
.. S YSCONID=$O(^YTT(601.78,"AC",YSBID,YSBATS,0))
.. S G7=$G(^YTT(601.78,YSCONID,0))
.. S ISEQ=$P(G7,U,3)
.. S INAM=$$GET1^DIQ(601.78,YSCONID_",",3)
.. S JARR("batteries",BATNUM,"name")=YSNAME
.. S JARR("batteries",BATNUM,"instruments",ISEQ)=INAM
Q
SETPARAM(YSPNAM,YSJSON,YSUSR) ;Set Parameter
; Batteries=YS MHA_WEB BATTERIES
N II,YSDUZ
N FDA,IENS,FDAIEN,YSMSG
N YSINST
S YSINST=1
S YSDUZ=YSUSR_";VA(200,"
D EN^XPAR(YSDUZ,YSPNAM,YSINST,.YSJSON,.YSMSG)
I +YSMSG'=0 Q "ERROR: "_$P(YSMSG,U,2)
Q "OK"
SSRRTN ; Set the Suicide TAG & ROUTINE fileds in 601.71
N TEMP,CNT,TEST,YSFDA,INSTIEN,XXX,TAG,YSERR
K YSFDA
S TEMP=""
F CNT=1:1:2 D
. S TEMP=$T(INSTF+CNT)
. S TEMP=$P(TEMP,";;",2)
. S TEST=$P(TEMP,U,1) D
. S INSTIEN="" S INSTIEN=$O(^YTT(601.71,"B",TEST,""))
. S XXX=INSTIEN_","
. S YSFDA(601.71,XXX,95)="YTQRQAD6"
. S TAG=$P(TEMP,U,2)
. I TAG="zzzzz" Q
. S YSFDA(601.71,XXX,96)=TAG
D FILE^DIE("K","YSFDA","YSERR")
I $G(YSERR)'="" W !,"ERROR= ",YSERR
Q
;
INSTF ;HIGH RISK/POSTIIVE RESPONSE Instrument updates
;;BDI2^BDI2
;;CCSA-DSM5^CCSA
;;zzzzz
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS187PST 2729 printed Sep 23, 2025@19:48:37 Page 2
YS187PST ;BAL/KTL- Patch 187 Post-Init ; 07/28/2021 3:19pm
+1 ;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
+2 ;
+3 ; Routine ICR
+4 ; Name ICR#
+5 ; ------------------------------------- -----
+6 ; SUPPORTED PARAMETER TOOL ENTRY POINTS 2263
+7 ; KERNEL XLFJSON 6682
+8 ;
+9 QUIT
POST ;
+1 ; Delete namespaced logging for MCMI4
+2 NEW J
+3 KILL ^TMP("YKTL")
+4 SET J=""
FOR
SET J=$ORDER(^YKTL(J))
if J=""
QUIT
Begin DoDot:1
+5 KILL ^YKTL(J)
End DoDot:1
+6 ; Update Case Mix Tool
+7 DO POST^YS187CMT
+8 DO MKBAT
+9 DO SSRRTN
+10 QUIT
MKBAT ;Find all users with Battery definitions and create PARAMETER entries
+1 ; for MHA Web
+2 NEW YSUSR,JARR,YSJSON,PRES
+3 NEW YSWDGT,YSWPARR,YSDUZ
+4 SET YSUSR=0
FOR
SET YSUSR=$ORDER(^YTT(601.781,"AC",YSUSR))
if YSUSR=""
QUIT
Begin DoDot:1
+5 SET YSWDGT=1
+6 SET YSDUZ=YSUSR_";VA(200,"
+7 KILL YSWPARR
+8 DO GETWP^XPAR(.YSWPARR,YSDUZ,"YS MHA_WEB BATTERIES",YSWDGT)
+9 IF '$DATA(YSWPARR)
Begin DoDot:2
+10 KILL JARR,YSJSON
+11 DO BATTC(YSUSR,.JARR)
+12 DO ENCODE^XLFJSON("JARR","YSJSON")
+13 SET PRES=$$SETPARAM("YS MHA_WEB BATTERIES",.YSJSON,YSUSR)
End DoDot:2
End DoDot:1
+14 QUIT
BATTC(YSUSR,JARR) ;battery content
+1 ; OUTPUT: BATTERY NAME ^ INSTRUMENT list sorted by BATTERY & SEQUENCE
+2 NEW G7,YSBATS,YSBID,YSCONID,YSNAME,YSUB,YS1,YSBNAME,BATNUM,ISEQ,INAM
+3 SET YSUB=0
FOR
SET YSUB=$ORDER(^YTT(601.781,"AC",YSUSR,YSUB))
if YSUB'>0
QUIT
Begin DoDot:1
+4 SET YSBID=$PIECE(^YTT(601.781,YSUB,0),U,3)
+5 SET YSBNAME=$PIECE($GET(^YTT(601.77,YSBID,0)),U,2)
+6 if $LENGTH(YSBNAME)
SET YS1(YSBNAME)=YSBID
End DoDot:1
+7 SET BATNUM=0
+8 SET YSNAME=""
FOR
SET YSNAME=$ORDER(YS1(YSNAME))
if YSNAME=""
QUIT
SET YSBID=YS1(YSNAME)
Begin DoDot:1
+9 SET BATNUM=BATNUM+1
+10 SET YSBATS=0
FOR
SET YSBATS=$ORDER(^YTT(601.78,"AC",YSBID,YSBATS))
if YSBATS'>0
QUIT
Begin DoDot:2
+11 SET YSCONID=$ORDER(^YTT(601.78,"AC",YSBID,YSBATS,0))
+12 SET G7=$GET(^YTT(601.78,YSCONID,0))
+13 SET ISEQ=$PIECE(G7,U,3)
+14 SET INAM=$$GET1^DIQ(601.78,YSCONID_",",3)
+15 SET JARR("batteries",BATNUM,"name")=YSNAME
+16 SET JARR("batteries",BATNUM,"instruments",ISEQ)=INAM
End DoDot:2
End DoDot:1
+17 QUIT
SETPARAM(YSPNAM,YSJSON,YSUSR) ;Set Parameter
+1 ; Batteries=YS MHA_WEB BATTERIES
+2 NEW II,YSDUZ
+3 NEW FDA,IENS,FDAIEN,YSMSG
+4 NEW YSINST
+5 SET YSINST=1
+6 SET YSDUZ=YSUSR_";VA(200,"
+7 DO EN^XPAR(YSDUZ,YSPNAM,YSINST,.YSJSON,.YSMSG)
+8 IF +YSMSG'=0
QUIT "ERROR: "_$PIECE(YSMSG,U,2)
+9 QUIT "OK"
SSRRTN ; Set the Suicide TAG & ROUTINE fileds in 601.71
+1 NEW TEMP,CNT,TEST,YSFDA,INSTIEN,XXX,TAG,YSERR
+2 KILL YSFDA
+3 SET TEMP=""
+4 FOR CNT=1:1:2
Begin DoDot:1
+5 SET TEMP=$TEXT(INSTF+CNT)
+6 SET TEMP=$PIECE(TEMP,";;",2)
+7 SET TEST=$PIECE(TEMP,U,1)
Begin DoDot:2
End DoDot:2
+8 SET INSTIEN=""
SET INSTIEN=$ORDER(^YTT(601.71,"B",TEST,""))
+9 SET XXX=INSTIEN_","
+10 SET YSFDA(601.71,XXX,95)="YTQRQAD6"
+11 SET TAG=$PIECE(TEMP,U,2)
+12 IF TAG="zzzzz"
QUIT
+13 SET YSFDA(601.71,XXX,96)=TAG
End DoDot:1
+14 DO FILE^DIE("K","YSFDA","YSERR")
+15 IF $GET(YSERR)'=""
WRITE !,"ERROR= ",YSERR
+16 QUIT
+17 ;
INSTF ;HIGH RISK/POSTIIVE RESPONSE Instrument updates
+1 ;;BDI2^BDI2
+2 ;;CCSA-DSM5^CCSA
+3 ;;zzzzz
+4 ;
+5 QUIT
