YS187PST.m

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 ---YS187PST   2729     printed  Mar 13, 2025@21:17:21                                                                                                                                                                                                    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