Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTSCOREV

YTSCOREV.m

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