YS142FIX ;SLC/KCM - Patch 142 fix scores with extra scales ; 03/20/2017
;;5.01;MENTAL HEALTH;**142**;Dec 30, 1994;Build 14
;
ADM2019 ; loop through administrations from 2019
N YS142S,YS142T,YS142D,YS142A,YS142U ; scales,test,date,admin,updates
D BLDSCL
S ^XTMP("YTS-RESCORE",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"MH Extraneous Scores"
S YS142U=0
S YS142T=0 F S YS142T=$O(^YTT(601.84,"AC",YS142T)) Q:'YS142T D
. S YS142D=3190000 F S YS142D=$O(^YTT(601.84,"AC",YS142T,YS142D)) Q:'YS142D D
. . S YS142A=0 F S YS142A=$O(^YTT(601.84,"AC",YS142T,YS142D,YS142A)) Q:'YS142A D
. . . I $$SCALERR(YS142A) D RESCORE(YS142A)
S ^XTMP("YTS-RESCORE","SCALE-UPDATES")=YS142U
Q
RESCORE(YS142A) ; delete results and rescore admin
; expects YS142U (update count)
D DELRSLTS^YTSCOREV(YS142A)
S $P(^YTT(601.84,YS142A,0),U,12)=0 ; force re-score to current revision
I $$SCOREONE^YTSCOREV(YS142A) S YS142U=YS142U+1
Q
SCALERR(YS142A) ; return 1 if more scale scores than expected
N TEST,CNT,RSLT,IEN
S TEST=$P($G(^YTT(601.84,YS142A,0)),U,3)
I '$G(YS142S(TEST),0) QUIT 0
;
S CNT=0,RSLT=0
S IEN=0 F S IEN=$O(^YTT(601.92,"AC",YS142A,IEN)) Q:'IEN D Q:RSLT
. S CNT=CNT+1
. I CNT>YS142S(TEST) S RSLT=1
Q RSLT
;
BLDSCL ; Build scales into YS142S
; builds array of scale counts per instrument
N TEST,SCLCNT,GSEQ,GRP,SSEQ,SCL
S TEST=0 F S TEST=$O(^YTT(601.71,TEST)) Q:'TEST D
. I $P($G(^YTT(601.71,TEST,2)),U,2)'="Y" QUIT ; is active instrument?
. S SCLCNT=0
. S GSEQ=0 F S GSEQ=$O(^YTT(601.86,"AC",TEST,GSEQ)) Q:'GSEQ D
. . S GRP=0 F S GRP=$O(^YTT(601.86,"AC",TEST,GSEQ,GRP)) Q:'GRP D
. . . S SSEQ=0 F S SSEQ=$O(^YTT(601.87,"AC",GRP,SSEQ)) Q:'SSEQ D
. . . . S SCL=0 F S SCL=$O(^YTT(601.87,"AC",GRP,SSEQ,SCL)) Q:'SCL D
. . . . . S SCLCNT=SCLCNT+1
. S YS142S(TEST)=SCLCNT ;_U_$P(^YTT(601.71,TEST,0),U)
Q
QTASK(RESUME) ; Create background task for checking extraneous scales
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
S ZTIO=""
S ZTRTN="ADM2019^YS142FIX"
S ZTDESC="Check extraneous MH scales"
S ZTDTH=RESUME
D ^%ZTLOAD
I '$G(ZTSK) D MES^XPDUTL("Unsuccessful queue of re-scoring job.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS142FIX 2160 printed Nov 22, 2024@17:22:24 Page 2
YS142FIX ;SLC/KCM - Patch 142 fix scores with extra scales ; 03/20/2017
+1 ;;5.01;MENTAL HEALTH;**142**;Dec 30, 1994;Build 14
+2 ;
ADM2019 ; loop through administrations from 2019
+1 ; scales,test,date,admin,updates
NEW YS142S,YS142T,YS142D,YS142A,YS142U
+2 DO BLDSCL
+3 SET ^XTMP("YTS-RESCORE",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"MH Extraneous Scores"
+4 SET YS142U=0
+5 SET YS142T=0
FOR
SET YS142T=$ORDER(^YTT(601.84,"AC",YS142T))
if 'YS142T
QUIT
Begin DoDot:1
+6 SET YS142D=3190000
FOR
SET YS142D=$ORDER(^YTT(601.84,"AC",YS142T,YS142D))
if 'YS142D
QUIT
Begin DoDot:2
+7 SET YS142A=0
FOR
SET YS142A=$ORDER(^YTT(601.84,"AC",YS142T,YS142D,YS142A))
if 'YS142A
QUIT
Begin DoDot:3
+8 IF $$SCALERR(YS142A)
DO RESCORE(YS142A)
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET ^XTMP("YTS-RESCORE","SCALE-UPDATES")=YS142U
+10 QUIT
RESCORE(YS142A) ; delete results and rescore admin
+1 ; expects YS142U (update count)
+2 DO DELRSLTS^YTSCOREV(YS142A)
+3 ; force re-score to current revision
SET $PIECE(^YTT(601.84,YS142A,0),U,12)=0
+4 IF $$SCOREONE^YTSCOREV(YS142A)
SET YS142U=YS142U+1
+5 QUIT
SCALERR(YS142A) ; return 1 if more scale scores than expected
+1 NEW TEST,CNT,RSLT,IEN
+2 SET TEST=$PIECE($GET(^YTT(601.84,YS142A,0)),U,3)
+3 IF '$GET(YS142S(TEST),0)
QUIT 0
+4 ;
+5 SET CNT=0
SET RSLT=0
+6 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.92,"AC",YS142A,IEN))
if 'IEN
QUIT
Begin DoDot:1
+7 SET CNT=CNT+1
+8 IF CNT>YS142S(TEST)
SET RSLT=1
End DoDot:1
if RSLT
QUIT
+9 QUIT RSLT
+10 ;
BLDSCL ; Build scales into YS142S
+1 ; builds array of scale counts per instrument
+2 NEW TEST,SCLCNT,GSEQ,GRP,SSEQ,SCL
+3 SET TEST=0
FOR
SET TEST=$ORDER(^YTT(601.71,TEST))
if 'TEST
QUIT
Begin DoDot:1
+4 ; is active instrument?
IF $PIECE($GET(^YTT(601.71,TEST,2)),U,2)'="Y"
QUIT
+5 SET SCLCNT=0
+6 SET GSEQ=0
FOR
SET GSEQ=$ORDER(^YTT(601.86,"AC",TEST,GSEQ))
if 'GSEQ
QUIT
Begin DoDot:2
+7 SET GRP=0
FOR
SET GRP=$ORDER(^YTT(601.86,"AC",TEST,GSEQ,GRP))
if 'GRP
QUIT
Begin DoDot:3
+8 SET SSEQ=0
FOR
SET SSEQ=$ORDER(^YTT(601.87,"AC",GRP,SSEQ))
if 'SSEQ
QUIT
Begin DoDot:4
+9 SET SCL=0
FOR
SET SCL=$ORDER(^YTT(601.87,"AC",GRP,SSEQ,SCL))
if 'SCL
QUIT
Begin DoDot:5
+10 SET SCLCNT=SCLCNT+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+11 ;_U_$P(^YTT(601.71,TEST,0),U)
SET YS142S(TEST)=SCLCNT
End DoDot:1
+12 QUIT
QTASK(RESUME) ; Create background task for checking extraneous scales
+1 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+2 SET ZTIO=""
+3 SET ZTRTN="ADM2019^YS142FIX"
+4 SET ZTDESC="Check extraneous MH scales"
+5 SET ZTDTH=RESUME
+6 DO ^%ZTLOAD
+7 IF '$GET(ZTSK)
DO MES^XPDUTL("Unsuccessful queue of re-scoring job.")
+8 QUIT
