YTSCOREV ;SLC/KCM - Update scores with revision change ; 9/15/2015
;;5.01;MENTAL HEALTH;**119,123**;Dec 30, 1994;Build 73
;
RESCORE ; background task to ensure all results recorded for administrations
; expects: YSRSREV (revision identifier) to be passed in
; examples: "0~1" for all instruments, "142~2" for one instrument
; quit if re-scoring has been completed
I $$GET^XPAR("SYS","YS123 SCORING COMPLETE",YSRSREV,"Q") QUIT
S ^XTMP("YTS-RESCORE",YSRSREV,"RUNNING")=1
; schedule task to continue tomorrow
D QTASK(YSRSREV,$$HADD^XLFDT($H,1))
;
DIRECT ; enter here to run interactively without tasking
; expects: YSRSREV (revision identifier) to be passed in
;
; ^XTMP("YTS-RESCORE",0)=T+90^DT^MH Ensure Scores Recorded
; ^XTMP("YTS-RESCORE",revId,"LAST")=IEN from last admin done
; ^XTMP("YTS-RESCORE",revId,"EVALUATED")=number of admins checked
; ^XTMP("YTS-RESCORE",revId,"RESCORED")=number of admins re-scored
; ^XTMP("YTS-RESCORE",revId,"ELAPSED")=seconds this session
; ^XTMP("YTS-RESCORE",revId,"TOTTIME")=total elapsed time
; ^XTMP("YTS-RESCORE",revId,"SESSIONS")=number of tasked scoring jobs completed
; ^XTMP("YTS-RESCORE",revId,"RUNNING")=true if re-scoring currently active
; ^XTMP("YTS-RESCORE",revId,"RESUME")=$H start ^ taskId
; ^XTMP("YTS-RESCORE","ERRORS")=count
; ^XTMP("YTS-RESCORE","ERRORS",#)=error text
; ^XTMP("YTS-RESCORE","STOP")=1 ;if the current session(s) should stop
;
S ^XTMP("YTS-RESCORE",YSRSREV,"RUNNING")=1
S ^XTMP("YTS-RESCORE",0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"MH Save All Scores"
N YS123HRS,YS123LIM,YS123ADM,YS123OUT,YS123CNT,YS123TS,YS123NEW
S YS123HRS=$$GET^XPAR("ALL","YS123 TASK LIMIT HOURS",1,"Q")
S:'YS123HRS YS123HRS=4
S YS123TS=$H,YS123OUT=0 ; start, exit
S YS123CNT=+$G(^XTMP("YTS-RESCORE",YSRSREV,"EVALUATED")) ; count
S YS123LIM=$$FMADD^XLFDT($$NOW^XLFDT,0,YS123HRS,0,0) ; time limit
S YS123ADM=+$G(^XTMP("YTS-RESCORE",YSRSREV,"LAST")) ; last completed
F S YS123ADM=$O(^YTT(601.84,YS123ADM)) D Q:YS123OUT
. ; no more administrations, re-scoring is done
. I 'YS123ADM D QUIT
. . D EN^XPAR("SYS","YS123 SCORING COMPLETE",YSRSREV,"NOW")
. . S YS123OUT=1
. . S ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=$$HDIFF^XLFDT($H,YS123TS,2)
. . S ^("TOTTIME")=$G(^XTMP("YTS-RESCORE",YSRSREV,"TOTTIME"))+$G(^("ELAPSED"))
. . S ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=0
. ; check every 10000 to see if this process has gone longer than limit
. S YS123CNT=YS123CNT+1
. I (YS123CNT#10000=0) D QUIT:YS123OUT
. . H 1 ; make sure this doesn't take too many the resources
. . S ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=$$HDIFF^XLFDT($H,YS123TS,2)
. . I $$NOW^XLFDT>YS123LIM S YS123OUT=1
. . I $G(^XTMP("YTS-RESCORE","STOP")) S YS123OUT=1
. . I YS123OUT D
. . . S ^("TOTTIME")=$G(^XTMP("YTS-RESCORE",YSRSREV,"TOTTIME"))+$G(^("ELAPSED"))
. . . S ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=0
. . . S ^XTMP("YTS-RESCORE",YSRSREV,"LAST")=$O(^YTT(601.84,YS123ADM),-1)
. ; check if scoring only one instrument and quit if not that instrument
. I +YSRSREV,(+YSRSREV'=$P($G(^YTT(601.84,YS123ADM,0)),U,3)) QUIT
. ; rescore this administration surrounded by error trap
. S YS123NEW=$$SCOREONE(YS123ADM)
. I YS123NEW S ^("RESCORED")=$G(^XTMP("YTS-RESCORE",YSRSREV,"RESCORED"))+1
. S ^XTMP("YTS-RESCORE",YSRSREV,"LAST")=YS123ADM
. S ^XTMP("YTS-RESCORE",YSRSREV,"EVALUATED")=YS123CNT
I $D(ZTQUEUED) S ZTREQ="@"
S ^("SESSIONS")=$G(^XTMP("YTS-RESCORE",YSRSREV,"SESSIONS"))+1
S ^XTMP("YTS-RESCORE",YSRSREV,"RUNNING")=0
Q
QTASK(YSRSREV,RESUME) ; Create background task for rescoring administrations
; YSRSREV: revision ID (for example: 0~1, 142~2)
; RESUME: $H start time for task
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
S ZTIO=""
S ZTRTN="RESCORE^YTSCOREV"
S ZTDESC="Rescore MH Instrument Administrations"
S ZTDTH=RESUME
S ZTSAVE("YSRSREV")=""
D ^%ZTLOAD
I '$G(ZTSK) D MES^XPDUTL("Unsuccessful queue of re-scoring job.")
S ^XTMP("YTS-RESCORE",0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"MH Save All Scores"
S ^XTMP("YTS-RESCORE",YSRSREV,"RESUME")=RESUME_U_$S($G(ZTSK):ZTSK,1:"Queuing Error")
Q
;
; -- score a single administration with error handling
;
SCOREONE(YS123ADM) ; score one adminstration
N $ES,$ET S $ET="D ERRHND^YTSCOREV"
K ^TMP($J)
N YSDATA,YS,IEN71,YSAD,YS123NEW
S YS("AD")=YS123ADM,YS123NEW=0
S IEN71=$P(^YTT(601.84,YS123ADM,0),U,3)
; old scores (in 601.2) will be skipped since we are iterating on 601.84
I $P($G(^YTT(601.71,IEN71,8)),U,3)="Y" QUIT 0 ; also skip legacy scoring
; if complex instrument prior to patch 123, delete any results first
I ($P($G(^YTT(601.71,IEN71,9)),U)="DLL"),'$P($G(^YTT(601.84,YS123ADM,0)),U,12) D DELRSLTS(YS123ADM)
I $$DIFFREV(IEN71,YS123ADM) D
. D LOADANSW^YTSCORE(.YSDATA,.YS) ; .YSDATA recieves answers
. D SCOREINS^YTSCORE(.YSDATA,IEN71) ; ^TMP($J,"YSCOR") and ^TMP($J,"YSG")
. D UPDSCORE^YTSCORE(.YSDATA,.YS) ; .YSDATA doesn't seem to do anything
. S YS123NEW=1
K ^TMP($J)
Q YS123NEW
;
DIFFREV(IEN71,YS123ADM) ; return true if different revision
N REVSCR71,REVSCR84
S REVSCR71=$P($G(^YTT(601.71,IEN71,9)),U,3)
S REVSCR84=$P($G(^YTT(601.84,YS123ADM,0)),U,12)
Q (REVSCR71'=REVSCR84)
;
DELRSLTS(YS123ADM) ; delete the current results of an administration
N IEN,RLST
; get the list of IEN's before deleting things from the xref used
S IEN=0 F S IEN=$O(^YTT(601.92,"AC",YS123ADM,IEN)) Q:'IEN S RLST(IEN)=""
S IEN=0 F S IEN=$O(RLST(IEN)) Q:'IEN D
. I $P(^YTT(601.92,IEN,0),U,2)'=YS123ADM Q ; double check the admin first
. D FMDEL^YTXCHGU(601.92,IEN) ; then delete
Q
ERRHND ; Handle errors & clear stack
; Grab the error code
N ERROR S ERROR=$$EC^%ZOSV
; Ignore errors when clearing the call stack
I ERROR["ZTER" D UNWIND^%ZTER
; Make sure we don't loop if there is an error during processing of
; the error handler.
N $ET S $ET="D ^%ZTER,UNWIND^%ZTER"
; Uncomment below to save error trap information for each re-score failure,
; but changing past data to fix errors is likey not desirable. We do want to
; avoid filling the error trap.
; D ^%ZTER ; record re-score failure in error trap
; Record administration number and error in ^XTMP log
S ^XTMP("YTS-RESCORE","ERRORS")=$G(^XTMP("YTS-RESCORE","ERRORS"))+1
N ERRNUM S ERRNUM=^XTMP("YTS-RESCORE","ERRORS")
S ^XTMP("YTS-RESCORE","ERRORS",ERRNUM)=$G(YS123ADM)_U_$H_U_ERROR
; clear the call stack
D UNWIND^%ZTER
Q
;
; -- display report of any current/recent re-scoring processes
;
MONLOOP ; monitor re-scoring loop
D HOME^%ZIS
N ACTION
S ACTION="R" F D Q:"RB"'[ACTION
. I ACTION="R" D SHOWPROG
. I ACTION="B" D SHOWERRS
. W ! S ACTION=$$GETCMD
Q
SHOWPROG ; show progress of re-scoring process
; loop through revId's and show progress
N REVID,TSTNAM,REVNUM,STS,EVAL,TOTL,SCRD,TIME,SESS
S REVID=0 F S REVID=$O(^XTMP("YTS-RESCORE",REVID)) Q:REVID'["~" D
. S TSTNAM=$S(+REVID=0:"all instruments",1:$P(^YTT(601.71,+REVID,0),U))
. S REVNUM=$P(REVID,"~",2)
. ;
. S STS=""
. I $$GET^XPAR("SYS","YS123 SCORING COMPLETE",REVID,"Q") S STS="complete" I 1
. I '$L(STS) D
. . I $G(^XTMP("YTS-RESCORE",REVID,"RUNNING")) S STS="running" Q
. . N X S X=$G(^XTMP("YTS-RESCORE",REVID,"RESUME"))
. . S STS="queued to run at "_$$HTE^XLFDT($P(X,U))_" (task #"_$P(X,U,2)_")"
. ;
. S TOTL=$P(^YTT(601.84,0),U,4)
. S EVAL=$G(^XTMP("YTS-RESCORE",REVID,"EVALUATED"))
. S SCRD=$G(^XTMP("YTS-RESCORE",REVID,"RESCORED"))
. S SESS=$G(^XTMP("YTS-RESCORE",REVID,"SESSIONS"))
. S TIME=$G(^XTMP("YTS-RESCORE",REVID,"TOTTIME"))+$G(^("ELAPSED"))
. S TIME=$$SEC2HMS(TIME)
. I $G(^XTMP("YTS-RESCORE",REVID,"RUNNING")) S SESS=SESS+1
. ;
. W !
. W !,"Progress -- Rescore "_TSTNAM_" to revision "_REVNUM
. W !," Current Status: "_STS
. W !," Administrations: "_+EVAL_" evaluated of "_TOTL
. W !," Total Re-scored: "_SCRD
. W !," Elapsed Time: "_TIME_" (in "_SESS_" sessions)"
;
W !!,"Errors Encountered: "_$G(^XTMP("YTS-RESCORE","ERRORS"),0),!
Q
SHOWERRS ; browse the errors
N I,X,ADM,TM,ERR
K ^TMP("YTS123BR",$J)
S I=0 F S I=$O(^XTMP("YTS-RESCORE","ERRORS",I)) Q:'I D
. S X=^XTMP("YTS-RESCORE","ERRORS",I)
. S ADM=$P(X,U,1),TM=$$HTE^XLFDT($P(X,U,2)),ERR=$P(X,U,3,99)
. S ^TMP("YTS123BR",$J,I)=$J(ADM,8)_" "_TM_" "_ERR
D BROWSE^DDBR($NA(^TMP("YTS123BR",$J)),"NR","YS*5.01*123 Re-scoring Errors")
K ^TMP("YTS123BR",$J)
Q
GETCMD() ; Get the next command
N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="SB^R:Refresh;B:Browse Errors;Q:Quit"
S DIR("B")="Refresh"
D ^DIR
I $D(DIRUT)!$D(DIROUT) S Y="Q"
Q Y
;
SEC2HMS(SS) ; return "#h #m #s" from seconds
N HH,MM
S HH=SS\3600,SS=SS-(HH*3600)
S MM=SS\60,SS=SS-(MM*60)
Q HH_"h "_MM_"m "_SS_"s"
;
LSTREV ; list revised instruments
N IEN,ADM,TEST,CNT
S CNT=0,IEN=0 F S IEN=$O(^YTT(601.92,IEN)) Q:'IEN D
. I $D(^YTT(601.92,IEN,1))<10 Q
. S ADM=$P(^YTT(601.92,IEN,0),U,2),CNT=CNT+1
. S TEST=$P(^YTT(601.84,ADM,0),U,3)
. W !,ADM,?10,$P(^YTT(601.71,TEST,0),U)
. W ?22,$P(^YTT(601.92,IEN,0),U,3)
. W ?47,"was ",$P(^YTT(601.92,IEN,1,1,0),U,3,6)
. W ?62,"now ",$P(^YTT(601.92,IEN,0),U,4,7)
W !!,"Admin Total: ",CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSCOREV 9337 printed Apr 09, 2024@21:19:36 Page 2
YTSCOREV ;SLC/KCM - Update scores with revision change ; 9/15/2015
+1 ;;5.01;MENTAL HEALTH;**119,123**;Dec 30, 1994;Build 73
+2 ;
RESCORE ; background task to ensure all results recorded for administrations
+1 ; expects: YSRSREV (revision identifier) to be passed in
+2 ; examples: "0~1" for all instruments, "142~2" for one instrument
+3 ; quit if re-scoring has been completed
+4 IF $$GET^XPAR("SYS","YS123 SCORING COMPLETE",YSRSREV,"Q")
QUIT
+5 SET ^XTMP("YTS-RESCORE",YSRSREV,"RUNNING")=1
+6 ; schedule task to continue tomorrow
+7 DO QTASK(YSRSREV,$$HADD^XLFDT($HOROLOG,1))
+8 ;
DIRECT ; enter here to run interactively without tasking
+1 ; expects: YSRSREV (revision identifier) to be passed in
+2 ;
+3 ; ^XTMP("YTS-RESCORE",0)=T+90^DT^MH Ensure Scores Recorded
+4 ; ^XTMP("YTS-RESCORE",revId,"LAST")=IEN from last admin done
+5 ; ^XTMP("YTS-RESCORE",revId,"EVALUATED")=number of admins checked
+6 ; ^XTMP("YTS-RESCORE",revId,"RESCORED")=number of admins re-scored
+7 ; ^XTMP("YTS-RESCORE",revId,"ELAPSED")=seconds this session
+8 ; ^XTMP("YTS-RESCORE",revId,"TOTTIME")=total elapsed time
+9 ; ^XTMP("YTS-RESCORE",revId,"SESSIONS")=number of tasked scoring jobs completed
+10 ; ^XTMP("YTS-RESCORE",revId,"RUNNING")=true if re-scoring currently active
+11 ; ^XTMP("YTS-RESCORE",revId,"RESUME")=$H start ^ taskId
+12 ; ^XTMP("YTS-RESCORE","ERRORS")=count
+13 ; ^XTMP("YTS-RESCORE","ERRORS",#)=error text
+14 ; ^XTMP("YTS-RESCORE","STOP")=1 ;if the current session(s) should stop
+15 ;
+16 SET ^XTMP("YTS-RESCORE",YSRSREV,"RUNNING")=1
+17 SET ^XTMP("YTS-RESCORE",0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"MH Save All Scores"
+18 NEW YS123HRS,YS123LIM,YS123ADM,YS123OUT,YS123CNT,YS123TS,YS123NEW
+19 SET YS123HRS=$$GET^XPAR("ALL","YS123 TASK LIMIT HOURS",1,"Q")
+20 if 'YS123HRS
SET YS123HRS=4
+21 ; start, exit
SET YS123TS=$HOROLOG
SET YS123OUT=0
+22 ; count
SET YS123CNT=+$GET(^XTMP("YTS-RESCORE",YSRSREV,"EVALUATED"))
+23 ; time limit
SET YS123LIM=$$FMADD^XLFDT($$NOW^XLFDT,0,YS123HRS,0,0)
+24 ; last completed
SET YS123ADM=+$GET(^XTMP("YTS-RESCORE",YSRSREV,"LAST"))
+25 FOR
SET YS123ADM=$ORDER(^YTT(601.84,YS123ADM))
Begin DoDot:1
+26 ; no more administrations, re-scoring is done
+27 IF 'YS123ADM
Begin DoDot:2
+28 DO EN^XPAR("SYS","YS123 SCORING COMPLETE",YSRSREV,"NOW")
+29 SET YS123OUT=1
+30 SET ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=$$HDIFF^XLFDT($HOROLOG,YS123TS,2)
+31 SET ^("TOTTIME")=$GET(^XTMP("YTS-RESCORE",YSRSREV,"TOTTIME"))+$GET(^("ELAPSED"))
+32 SET ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=0
End DoDot:2
QUIT
+33 ; check every 10000 to see if this process has gone longer than limit
+34 SET YS123CNT=YS123CNT+1
+35 IF (YS123CNT#10000=0)
Begin DoDot:2
+36 ; make sure this doesn't take too many the resources
HANG 1
+37 SET ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=$$HDIFF^XLFDT($HOROLOG,YS123TS,2)
+38 IF $$NOW^XLFDT>YS123LIM
SET YS123OUT=1
+39 IF $GET(^XTMP("YTS-RESCORE","STOP"))
SET YS123OUT=1
+40 IF YS123OUT
Begin DoDot:3
+41 SET ^("TOTTIME")=$GET(^XTMP("YTS-RESCORE",YSRSREV,"TOTTIME"))+$GET(^("ELAPSED"))
+42 SET ^XTMP("YTS-RESCORE",YSRSREV,"ELAPSED")=0
+43 SET ^XTMP("YTS-RESCORE",YSRSREV,"LAST")=$ORDER(^YTT(601.84,YS123ADM),-1)
End DoDot:3
End DoDot:2
if YS123OUT
QUIT
+44 ; check if scoring only one instrument and quit if not that instrument
+45 IF +YSRSREV
IF (+YSRSREV'=$PIECE($GET(^YTT(601.84,YS123ADM,0)),U,3))
QUIT
+46 ; rescore this administration surrounded by error trap
+47 SET YS123NEW=$$SCOREONE(YS123ADM)
+48 IF YS123NEW
SET ^("RESCORED")=$GET(^XTMP("YTS-RESCORE",YSRSREV,"RESCORED"))+1
+49 SET ^XTMP("YTS-RESCORE",YSRSREV,"LAST")=YS123ADM
+50 SET ^XTMP("YTS-RESCORE",YSRSREV,"EVALUATED")=YS123CNT
End DoDot:1
if YS123OUT
QUIT
+51 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+52 SET ^("SESSIONS")=$GET(^XTMP("YTS-RESCORE",YSRSREV,"SESSIONS"))+1
+53 SET ^XTMP("YTS-RESCORE",YSRSREV,"RUNNING")=0
+54 QUIT
QTASK(YSRSREV,RESUME) ; Create background task for rescoring administrations
+1 ; YSRSREV: revision ID (for example: 0~1, 142~2)
+2 ; RESUME: $H start time for task
+3 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+4 SET ZTIO=""
+5 SET ZTRTN="RESCORE^YTSCOREV"
+6 SET ZTDESC="Rescore MH Instrument Administrations"
+7 SET ZTDTH=RESUME
+8 SET ZTSAVE("YSRSREV")=""
+9 DO ^%ZTLOAD
+10 IF '$GET(ZTSK)
DO MES^XPDUTL("Unsuccessful queue of re-scoring job.")
+11 SET ^XTMP("YTS-RESCORE",0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"MH Save All Scores"
+12 SET ^XTMP("YTS-RESCORE",YSRSREV,"RESUME")=RESUME_U_$SELECT($GET(ZTSK):ZTSK,1:"Queuing Error")
+13 QUIT
+14 ;
+15 ; -- score a single administration with error handling
+16 ;
SCOREONE(YS123ADM) ; score one adminstration
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERRHND^YTSCOREV"
+2 KILL ^TMP($JOB)
+3 NEW YSDATA,YS,IEN71,YSAD,YS123NEW
+4 SET YS("AD")=YS123ADM
SET YS123NEW=0
+5 SET IEN71=$PIECE(^YTT(601.84,YS123ADM,0),U,3)
+6 ; old scores (in 601.2) will be skipped since we are iterating on 601.84
+7 ; also skip legacy scoring
IF $PIECE($GET(^YTT(601.71,IEN71,8)),U,3)="Y"
QUIT 0
+8 ; if complex instrument prior to patch 123, delete any results first
+9 IF ($PIECE($GET(^YTT(601.71,IEN71,9)),U)="DLL")
IF '$PIECE($GET(^YTT(601.84,YS123ADM,0)),U,12)
DO DELRSLTS(YS123ADM)
+10 IF $$DIFFREV(IEN71,YS123ADM)
Begin DoDot:1
+11 ; .YSDATA recieves answers
DO LOADANSW^YTSCORE(.YSDATA,.YS)
+12 ; ^TMP($J,"YSCOR") and ^TMP($J,"YSG")
DO SCOREINS^YTSCORE(.YSDATA,IEN71)
+13 ; .YSDATA doesn't seem to do anything
DO UPDSCORE^YTSCORE(.YSDATA,.YS)
+14 SET YS123NEW=1
End DoDot:1
+15 KILL ^TMP($JOB)
+16 QUIT YS123NEW
+17 ;
DIFFREV(IEN71,YS123ADM) ; return true if different revision
+1 NEW REVSCR71,REVSCR84
+2 SET REVSCR71=$PIECE($GET(^YTT(601.71,IEN71,9)),U,3)
+3 SET REVSCR84=$PIECE($GET(^YTT(601.84,YS123ADM,0)),U,12)
+4 QUIT (REVSCR71'=REVSCR84)
+5 ;
DELRSLTS(YS123ADM) ; delete the current results of an administration
+1 NEW IEN,RLST
+2 ; get the list of IEN's before deleting things from the xref used
+3 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.92,"AC",YS123ADM,IEN))
if 'IEN
QUIT
SET RLST(IEN)=""
+4 SET IEN=0
FOR
SET IEN=$ORDER(RLST(IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 ; double check the admin first
IF $PIECE(^YTT(601.92,IEN,0),U,2)'=YS123ADM
QUIT
+6 ; then delete
DO FMDEL^YTXCHGU(601.92,IEN)
End DoDot:1
+7 QUIT
ERRHND ; Handle errors & clear stack
+1 ; Grab the error code
+2 NEW ERROR
SET ERROR=$$EC^%ZOSV
+3 ; Ignore errors when clearing the call stack
+4 IF ERROR["ZTER"
DO UNWIND^%ZTER
+5 ; Make sure we don't loop if there is an error during processing of
+6 ; the error handler.
+7 NEW $ETRAP
SET $ETRAP="D ^%ZTER,UNWIND^%ZTER"
+8 ; Uncomment below to save error trap information for each re-score failure,
+9 ; but changing past data to fix errors is likey not desirable. We do want to
+10 ; avoid filling the error trap.
+11 ; D ^%ZTER ; record re-score failure in error trap
+12 ; Record administration number and error in ^XTMP log
+13 SET ^XTMP("YTS-RESCORE","ERRORS")=$GET(^XTMP("YTS-RESCORE","ERRORS"))+1
+14 NEW ERRNUM
SET ERRNUM=^XTMP("YTS-RESCORE","ERRORS")
+15 SET ^XTMP("YTS-RESCORE","ERRORS",ERRNUM)=$GET(YS123ADM)_U_$HOROLOG_U_ERROR
+16 ; clear the call stack
+17 DO UNWIND^%ZTER
+18 QUIT
+19 ;
+20 ; -- display report of any current/recent re-scoring processes
+21 ;
MONLOOP ; monitor re-scoring loop
+1 DO HOME^%ZIS
+2 NEW ACTION
+3 SET ACTION="R"
FOR
Begin DoDot:1
+4 IF ACTION="R"
DO SHOWPROG
+5 IF ACTION="B"
DO SHOWERRS
+6 WRITE !
SET ACTION=$$GETCMD
End DoDot:1
if "RB"'[ACTION
QUIT
+7 QUIT
SHOWPROG ; show progress of re-scoring process
+1 ; loop through revId's and show progress
+2 NEW REVID,TSTNAM,REVNUM,STS,EVAL,TOTL,SCRD,TIME,SESS
+3 SET REVID=0
FOR
SET REVID=$ORDER(^XTMP("YTS-RESCORE",REVID))
if REVID'["~"
QUIT
Begin DoDot:1
+4 SET TSTNAM=$SELECT(+REVID=0:"all instruments",1:$PIECE(^YTT(601.71,+REVID,0),U))
+5 SET REVNUM=$PIECE(REVID,"~",2)
+6 ;
+7 SET STS=""
+8 IF $$GET^XPAR("SYS","YS123 SCORING COMPLETE",REVID,"Q")
SET STS="complete"
IF 1
+9 IF '$LENGTH(STS)
Begin DoDot:2
+10 IF $GET(^XTMP("YTS-RESCORE",REVID,"RUNNING"))
SET STS="running"
QUIT
+11 NEW X
SET X=$GET(^XTMP("YTS-RESCORE",REVID,"RESUME"))
+12 SET STS="queued to run at "_$$HTE^XLFDT($PIECE(X,U))_" (task #"_$PIECE(X,U,2)_")"
End DoDot:2
+13 ;
+14 SET TOTL=$PIECE(^YTT(601.84,0),U,4)
+15 SET EVAL=$GET(^XTMP("YTS-RESCORE",REVID,"EVALUATED"))
+16 SET SCRD=$GET(^XTMP("YTS-RESCORE",REVID,"RESCORED"))
+17 SET SESS=$GET(^XTMP("YTS-RESCORE",REVID,"SESSIONS"))
+18 SET TIME=$GET(^XTMP("YTS-RESCORE",REVID,"TOTTIME"))+$GET(^("ELAPSED"))
+19 SET TIME=$$SEC2HMS(TIME)
+20 IF $GET(^XTMP("YTS-RESCORE",REVID,"RUNNING"))
SET SESS=SESS+1
+21 ;
+22 WRITE !
+23 WRITE !,"Progress -- Rescore "_TSTNAM_" to revision "_REVNUM
+24 WRITE !," Current Status: "_STS
+25 WRITE !," Administrations: "_+EVAL_" evaluated of "_TOTL
+26 WRITE !," Total Re-scored: "_SCRD
+27 WRITE !," Elapsed Time: "_TIME_" (in "_SESS_" sessions)"
End DoDot:1
+28 ;
+29 WRITE !!,"Errors Encountered: "_$GET(^XTMP("YTS-RESCORE","ERRORS"),0),!
+30 QUIT
SHOWERRS ; browse the errors
+1 NEW I,X,ADM,TM,ERR
+2 KILL ^TMP("YTS123BR",$JOB)
+3 SET I=0
FOR
SET I=$ORDER(^XTMP("YTS-RESCORE","ERRORS",I))
if 'I
QUIT
Begin DoDot:1
+4 SET X=^XTMP("YTS-RESCORE","ERRORS",I)
+5 SET ADM=$PIECE(X,U,1)
SET TM=$$HTE^XLFDT($PIECE(X,U,2))
SET ERR=$PIECE(X,U,3,99)
+6 SET ^TMP("YTS123BR",$JOB,I)=$JUSTIFY(ADM,8)_" "_TM_" "_ERR
End DoDot:1
+7 DO BROWSE^DDBR($NAME(^TMP("YTS123BR",$JOB)),"NR","YS*5.01*123 Re-scoring Errors")
+8 KILL ^TMP("YTS123BR",$JOB)
+9 QUIT
GETCMD() ; Get the next command
+1 NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="SB^R:Refresh;B:Browse Errors;Q:Quit"
+3 SET DIR("B")="Refresh"
+4 DO ^DIR
+5 IF $DATA(DIRUT)!$DATA(DIROUT)
SET Y="Q"
+6 QUIT Y
+7 ;
SEC2HMS(SS) ; return "#h #m #s" from seconds
+1 NEW HH,MM
+2 SET HH=SS\3600
SET SS=SS-(HH*3600)
+3 SET MM=SS\60
SET SS=SS-(MM*60)
+4 QUIT HH_"h "_MM_"m "_SS_"s"
+5 ;
LSTREV ; list revised instruments
+1 NEW IEN,ADM,TEST,CNT
+2 SET CNT=0
SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.92,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 IF $DATA(^YTT(601.92,IEN,1))<10
QUIT
+4 SET ADM=$PIECE(^YTT(601.92,IEN,0),U,2)
SET CNT=CNT+1
+5 SET TEST=$PIECE(^YTT(601.84,ADM,0),U,3)
+6 WRITE !,ADM,?10,$PIECE(^YTT(601.71,TEST,0),U)
+7 WRITE ?22,$PIECE(^YTT(601.92,IEN,0),U,3)
+8 WRITE ?47,"was ",$PIECE(^YTT(601.92,IEN,1,1,0),U,3,6)
+9 WRITE ?62,"now ",$PIECE(^YTT(601.92,IEN,0),U,4,7)
End DoDot:1
+10 WRITE !!,"Admin Total: ",CNT
+11 QUIT
