- YTSCORE ;SLC/KCM - Scoring for complex instruments ;Feb 28, 2024@15:02:07
- ;;5.01;MENTAL HEALTH;**119,123,142,141,217,234,244,240**;Dec 30, 1994;Build 10
- ;
- ;
- Q
- DLL ; stub entry point for instruments scored by DLL
- Q
- ;
- DESGNTR(YSQN,DES) ; Create DESIGNTR variable, used for Reports
- N STR76
- S DES="NO DESIGNATOR"
- Q:'$G(YSQN)
- S STR76=$O(^YTT(601.76,"AE",YSQN,0))
- Q:'$G(STR76)
- S DES=$P($P($G(^YTT(601.76,STR76,0)),U,5),".")
- Q
- ;
- LOADANSW(YSDATA,YS) ; patch 123, loads answers, builds YSDATA array
- ;input:AD = ADMINISTRATION #
- ;output: [DATA]
- ; ADMIN ID^DFN^INSTRUMENT^DATE GIVEN^IS COMPLETE
- ; QUESTION #^seq^ANSWER
- ;
- N G,G1,N,YSQN,YSTSTN,YSEQ,YSICON
- N IEN71
- S YSAD=$G(YS("AD"))
- I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="Bad ADMIN num, admin is "_YSAD Q ;-->out
- I '$D(^YTT(601.85,"AC",YSAD)) S YSDATA(1)="[ERROR]",YSDATA(2)="No entry in MH ANSWERS" Q ;-->out
- S YSTSTN=$P(^YTT(601.84,YSAD,0),U,3)
- S YSDATA(1)="[DATA]"
- S YSDATA(2)=YSAD_U_$$GET1^DIQ(601.84,YSAD_",",1,"I")_U_$$GET1^DIQ(601.84,YSAD_",",2,"E")_U_$$GET1^DIQ(601.84,YSAD_",",3,"I")_U_$$GET1^DIQ(601.84,YSAD_",",8,"I")
- S YSQN=0,N=2
- F S YSQN=$O(^YTT(601.85,"AC",YSAD,YSQN)) Q:YSQN'>0 S G=0 D
- .S G=$O(^YTT(601.85,"AC",YSAD,YSQN,G)) Q:G'>0 S G1=0 D
- ..S YSICON=$O(^YTT(601.76,"AF",YSTSTN,YSQN,0))
- ..S YSEQ=1
- ..I YSICON?1N.N S YSEQ=$P(^YTT(601.76,YSICON,0),U,3)
- ..S:$P(^YTT(601.85,G,0),U,4)?1N.N N=N+1,YSDATA(N)=YSQN_U_YSEQ_U_$P(^YTT(601.85,G,0),U,4)
- ..F S G1=$O(^YTT(601.85,G,1,G1)) Q:G1'>0 D
- ...S N=N+1,YSDATA(N)=YSQN_U_YSEQ_";"_G1_U_$G(^YTT(601.85,G,1,G1,0))
- Q
- ;
- SCOREINS(YSDATA,IEN71) ;
- ; patch 123, scores responses (answers) for a given instrument
- ; YSDATA contains Answers for instrument
- N I,G,N,YSAI,YSAN,YSCALEI,YSKEYI,YSRAW,YSRTN,YSTARG,YSQN,YSVAL
- K ^TMP($J,"YSCOR"),^TMP($J,"YSG")
- I '$D(^YTT(601.86,"AD",IEN71)) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="Scale grp not found" Q ;-->out
- S YS("CODE")=$$GET1^DIQ(601.71,IEN71_",",.01) ; get the Instrument Name
- D SCALEG^YTQAPI3(.YSDATA,.YS)
- S YSDATA=$NA(^TMP($J,"YSCOR"))
- S ^TMP($J,"YSCOR",1)="[DATA]",N=1
- ;
- S YSRTN=$$GET1^DIQ(601.71,IEN71_",",92) ;routine for scoring
- I (YSRTN'=""),(YSRTN'="YTSCORE") D Q
- .S YSRTN="DLLSTR^"_YSRTN_"(.YSDATA,.YS,1)"
- .D @YSRTN
- ; original code, this uses MH SCORING KEY File to calculate ^TMP for "regular instruments"
- F I=2:1 Q:'$D(^TMP($J,"YSG",I)) I ^TMP($J,"YSG",I)?1"Scale".E S YSRAW="0",N=N+1,^TMP($J,"YSCOR",N)=$P(^TMP($J,"YSG",I),U,4)_"=" D S ^TMP($J,"YSCOR",N)=^TMP($J,"YSCOR",N)_YSRAW
- .S YSCALEI=$P(^TMP($J,"YSG",I),U),YSCALEI=$P(YSCALEI,"=",2)
- .S YSKEYI=0 F S YSKEYI=$O(^YTT(601.91,"AC",YSCALEI,YSKEYI)) Q:YSKEYI'>0 D
- ..S G=^YTT(601.91,YSKEYI,0)
- ..S YSQN=$P(G,U,3),YSTARG=$P(G,U,4),YSVAL=$P(G,U,5)
- ..S YSAI=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
- ..Q:YSAI'>0
- ..Q:'$D(^YTT(601.85,YSAI,0)) ;ASF 11/15/07
- ..S YSAN=""
- ..I $D(^YTT(601.85,YSAI,1,1,0)) S YSAN=^YTT(601.85,YSAI,1,1,0)
- ..I $P(^YTT(601.85,YSAI,0),U,4)?1N.N S YSAN=$P(^YTT(601.85,YSAI,0),U,4),YSAN=$G(^YTT(601.75,YSAN,1))
- ..I YSAN=YSTARG S YSRAW=YSRAW+YSVAL
- Q
- ;
- CHKSCRE() ;
- N REVSCR71,REVSCR84
- S REVSCR71=$$GET1^DIQ(601.71,IEN71_",",93) ; Instrument scoring version number
- S REVSCR84=$$GET1^DIQ(601.84,YSAD_",",14) ; Administration scoring version number
- Q (REVSCR71=REVSCR84)
- ;
- LDSCORES(YSDATA,YS) ; new call for patch 123
- ;input:AD = ADMINISTRATION #
- ;output: [DATA] in ^TMP($J,"YSCOR")
- N G,N,IEN71,SCALE,YSAD,YSCODEN,YSCALE
- S YSAD=$G(YS("AD"))
- K ^TMP($J,"YSCOR") S YSDATA=$NA(^TMP($J,"YSCOR"))
- I YSAD'?1N.N S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="Bad ADMIN # in LDSCORES" Q ;-->out
- S IEN71=$$GET1^DIQ(601.84,YSAD_",",2,"I") I IEN71'?1N.N D Q
- .S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="No Instrument in 601.84"
- ;Check if scoring may have changed before loading scores
- I '$$CHKSCRE D SCORSAVE^YTQAPI11(.YSDATA,.YS)
- I '$D(^YTT(601.92,"AC",YSAD)) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="No entry in MH RESULTS" Q ;-->out
- ;
- S YS("CODE")=$$GET1^DIQ(601.84,YSAD_",",2)
- D SCALEG^YTQAPI3(.YSDATA,.YS)
- ;
- S YSDATA=$NA(^TMP($J,"YSCOR"))
- S ^TMP($J,"YSCOR",1)="[DATA]",N=1
- ;
- S YSCALE=""
- F S YSCALE=$O(^YTT(601.92,"AC",YSAD,YSCALE)) Q:'YSCALE D
- .S G=$G(^YTT(601.92,YSCALE,0))
- .S SCALE=$P(G,U,3),N=N+1
- .S ^TMP($J,"YSCOR",N)=SCALE_"="_$P(G,U,4)_$S($P(G,U,5):U_$P(G,U,5),1:"")
- Q
- ;
- UPDSCORE(YSDATA,YS) ; files entries in MH RESULTS (601.92)
- ;input:AD = ADMINISTRATION #
- ;output: [DATA]
- N DIFF,IEN71,YSAD,YSCALE,YSC,YSG,Z
- S YSAD=$G(YS("AD"))
- I YSAD'?1N.N S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="No ADMIN # in UPDSCORE" Q ;-->out
- S IEN71=$$GET1^DIQ(601.84,YSAD_",",2,"I")
- ; are there existing scores in MH RESULT
- I $D(^YTT(601.92,"AC",YSAD)) D OLDSCRES(.YSCALE,.YSAD)
- ;
- S Z=1 F S Z=$O(^TMP($J,"YSCOR",Z)) Q:Z'>0 D
- .S YSG=^TMP($J,"YSCOR",Z)
- .S YSC=$P(YSG,"=")
- .S DIFF=0
- .I $D(YSCALE(YSC)) D Q
- ..S DIFF=$$CHKSCR(.YSC,.YSG)
- ..I DIFF D ADDAUDIT(.YSC,.YSG)
- .D ADDSCRE
- ; set admin.revision = instrument.revision
- D SETREV(.YSAD,.IEN71)
- Q
- ;
- CHKSCR(YSC,YSG) ; return 1 if there are different values, 0 if values in scoring are the same
- N I,OLDSC,YSCOR
- S DIFF=0
- S YSCOR=$P(YSG,"=",2,7)
- S OLDSC=$P(YSCALE(YSC),U,4,7)
- F I=1:1:4 I $P($G(OLDSC),U,I)'=$P($G(YSCOR),U,I) S DIFF=1 Q:DIFF
- Q DIFF
- ;
- ADDAUDIT(YSC,YSG) ; add entry in AUDIT node, update value in existing MH RESULTS record
- N AUDIEN,AUD,DIERR
- S AUDIEN=$P(YSCALE(YSC),U)
- D NOW^%DTC
- S AUD(1,601.921,"+2,"_AUDIEN_",",.01)=%
- S AUD(1,601.921,"+2,"_AUDIEN_",",2)=$$GET1^DIQ(601.84,YSAD_",",14)
- F I=4:1:7 I $L($P(YSCALE(YSC),U,I)) S AUD(1,601.921,"+2,"_AUDIEN_",",(I-1))=$P(YSCALE(YSC),U,I)
- D UPDATE^DIE("","AUD(1)")
- I $D(DIERR) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="Did not set Audit node in MH RESULTS" Q
- D CLEAN^DILF
- ;
- ; update existing node with new ones; use FILE^DIE
- N I,FDA,DIERR,YSGANS
- S YSGANS=$P(YSG,"=",2,5)
- F I=1:1:4 I $L($P(YSGANS,U,I))!$L($P(YSCALE(YSC),U,I+3)) S FDA(601.92,AUDIEN_",",(I+2))=$P(YSGANS,U,I)
- D FILE^DIE("","FDA")
- I $D(DIERR) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="Did not update records in MH RESULTS File" Q
- D CLEAN^DILF
- K %,%H,%I,X
- Q
- ;
- ADDSCRE ;add score to MH RESULTS
- N FDA,FDAIEN,DIERR,STR,YSRNEW,YSRFND
- S YSRNEW=$P($G(^YTT(601.92,0)),U,3),YSRFND=0
- S:YSRNEW<100000 YSRNEW=100000
- L +^YTT(601.92,0):DILOCKTM+10
- I '$T D QUIT
- . S ^TMP($J,"YSCOR",1)="[ERROR]"
- . S ^TMP($J,"YSCOR",2)="Could not get lock on MH RESULTS file"
- F Q:YSRFND D:'$D(^YTT(601.92,YSRNEW)) S YSRNEW=YSRNEW+1
- . L +^YTT(601.92,YSRNEW):DILOCKTM Q:'$T
- . S STR=$P(YSG,"=",2)
- . S FDAIEN(1)=YSRNEW
- . S FDA(601.92,"+1,",.01)=YSRNEW
- . S FDA(601.92,"+1,",1)=YSAD
- . S FDA(601.92,"+1,",2)=$P(YSG,"=",1)
- . S FDA(601.92,"+1,",3)=$P(STR,U,1) ; raw score
- . S:$L($P(STR,U,2)) FDA(601.92,"+1,",4)=$P(STR,U,2) ; transformed score 1
- . S:$L($P(STR,U,3)) FDA(601.92,"+1,",5)=$P(STR,U,3) ; transformed score 2
- . S:$L($P(STR,U,4)) FDA(601.92,"+1,",6)=$P(STR,U,4) ; transformed score 3
- . D UPDATE^DIE("","FDA","FDAIEN")
- . L -^YTT(601.92,YSRNEW)
- . S YSRFND=1
- L -^YTT(601.92,0)
- I $D(DIERR) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="Did not add MH RESULTS entry" Q
- Q
- ;
- OLDSCRES(YSCALE,YSAD) ; if existing score, build array containing them
- N IEN92,STR
- S IEN92=0
- F S IEN92=$O(^YTT(601.92,"AC",YSAD,IEN92)) Q:'IEN92 D
- .S STR=$G(^YTT(601.92,IEN92,0))
- .S YSCALE($P(STR,U,3))=STR
- Q
- ;
- SETREV(YSAD,IEN71) ; set revision value in MH ADMINISTRATIONS to value in MH TEST AND SURVEYS
- N FDA,DIERR
- S FDA(601.84,YSAD_",",14)=$$GET1^DIQ(601.71,IEN71_",",93)
- D FILE^DIE("","FDA")
- I $D(DIERR) S ^TMP($J,"YSCOR",1)="[ERROR]",^TMP($J,"YSCOR",2)="Did not set Scoring Revision in MH ADMIN"
- D CLEAN^DILF
- D UPRSLT^YTQEVNT(YSAD,"score") ; publish score update event
- Q
- ;
- LDTSCOR(TSARR,YSAD) ;
- N CNT,DATA,IEN92,RAW,T1,T2,T3
- S IEN92="",CNT=1
- I YSAD'?1N.N S TSARR("NOADM")="No Administration to get scores" Q
- I '$D(^YTT(601.92,"AC",YSAD)) S TSARR("NOADM")="No scores in MH RESULTS File" Q
- F S IEN92=$O(^YTT(601.92,"AC",YSAD,IEN92)) Q:'IEN92 D
- .S DATA=$G(^YTT(601.92,IEN92,0))
- .S RAW=$P(DATA,U,4),T1=$P(DATA,U,5),T2=$P(DATA,U,6),T3=$P(DATA,U,7)
- .S RAW=$S($L(RAW)=1:" "_RAW,1:RAW)
- .S T1=$S($L(T1)=1:" "_T1,1:T1),T2=$S($L(T2)=1:" "_T2,1:T2),T3=$S($L(T3)=1:" "_T3,1:T3)
- .S TSARR($P($P(DATA,U,3),":"))=$P(DATA,U,3)_U_RAW_U_T1_U_T2_U_T3
- Q
- BYKEY(YSDATA) ; use YSDATA to score by key and put into ^TMP($J,"YSCOR")
- ; expects scales to already be in ^TMP($J,"YSG")
- N I,J,TEST,ANSWERS,SCORES,QID,CID,YS
- K ^TMP($J,"YSCOR")
- S TEST=$P(YSDATA(2),U,3),YS("CODE")=TEST
- I $L(TEST) S TEST=$O(^YTT(601.71,"B",TEST,0))
- I 'TEST S ^TMP($J,"YSCOR",1)="[ERROR]",^(2)="No test found" QUIT
- S I=2,J=0 F S I=$O(YSDATA(I)) Q:'I D ; build ANSWERS array
- . S QID=$P(YSDATA(I),U),CID=$P(YSDATA(I),U,3)
- . S J=J+1,ANSWERS(J,"id")=QID,ANSWERS(J,"value")=CID
- D SUMKEY^YTSCOREX(TEST,.ANSWERS,.SCORES)
- S J=1,^TMP($J,"YSCOR",J)="[DATA]"
- S I=0 F S I=$O(SCORES(I)) Q:'I D
- . S J=J+1,^TMP($J,"YSCOR",J)=$G(SCORES(I,"name"))_"="_SCORES(I,"raw")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSCORE 9243 printed Jan 18, 2025@03:20:48 Page 2
- YTSCORE ;SLC/KCM - Scoring for complex instruments ;Feb 28, 2024@15:02:07
- +1 ;;5.01;MENTAL HEALTH;**119,123,142,141,217,234,244,240**;Dec 30, 1994;Build 10
- +2 ;
- +3 ;
- +4 QUIT
- DLL ; stub entry point for instruments scored by DLL
- +1 QUIT
- +2 ;
- DESGNTR(YSQN,DES) ; Create DESIGNTR variable, used for Reports
- +1 NEW STR76
- +2 SET DES="NO DESIGNATOR"
- +3 if '$GET(YSQN)
- QUIT
- +4 SET STR76=$ORDER(^YTT(601.76,"AE",YSQN,0))
- +5 if '$GET(STR76)
- QUIT
- +6 SET DES=$PIECE($PIECE($GET(^YTT(601.76,STR76,0)),U,5),".")
- +7 QUIT
- +8 ;
- LOADANSW(YSDATA,YS) ; patch 123, loads answers, builds YSDATA array
- +1 ;input:AD = ADMINISTRATION #
- +2 ;output: [DATA]
- +3 ; ADMIN ID^DFN^INSTRUMENT^DATE GIVEN^IS COMPLETE
- +4 ; QUESTION #^seq^ANSWER
- +5 ;
- +6 NEW G,G1,N,YSQN,YSTSTN,YSEQ,YSICON
- +7 NEW IEN71
- +8 SET YSAD=$GET(YS("AD"))
- +9 ;-->out
- IF YSAD'?1N.N
- SET YSDATA(1)="[ERROR]"
- SET YSDATA(2)="Bad ADMIN num, admin is "_YSAD
- QUIT
- +10 ;-->out
- IF '$DATA(^YTT(601.85,"AC",YSAD))
- SET YSDATA(1)="[ERROR]"
- SET YSDATA(2)="No entry in MH ANSWERS"
- QUIT
- +11 SET YSTSTN=$PIECE(^YTT(601.84,YSAD,0),U,3)
- +12 SET YSDATA(1)="[DATA]"
- +13 SET YSDATA(2)=YSAD_U_$$GET1^DIQ(601.84,YSAD_",",1,"I")_U_$$GET1^DIQ(601.84,YSAD_",",2,"E")_U_$$GET1^DIQ(601.84,YSAD_",",3,"I")_U_$$GET1^DIQ(601.84,YSAD_",",8,"I")
- +14 SET YSQN=0
- SET N=2
- +15 FOR
- SET YSQN=$ORDER(^YTT(601.85,"AC",YSAD,YSQN))
- if YSQN'>0
- QUIT
- SET G=0
- Begin DoDot:1
- +16 SET G=$ORDER(^YTT(601.85,"AC",YSAD,YSQN,G))
- if G'>0
- QUIT
- SET G1=0
- Begin DoDot:2
- +17 SET YSICON=$ORDER(^YTT(601.76,"AF",YSTSTN,YSQN,0))
- +18 SET YSEQ=1
- +19 IF YSICON?1N.N
- SET YSEQ=$PIECE(^YTT(601.76,YSICON,0),U,3)
- +20 if $PIECE(^YTT(601.85,G,0),U,4)?1N.N
- SET N=N+1
- SET YSDATA(N)=YSQN_U_YSEQ_U_$PIECE(^YTT(601.85,G,0),U,4)
- +21 FOR
- SET G1=$ORDER(^YTT(601.85,G,1,G1))
- if G1'>0
- QUIT
- Begin DoDot:3
- +22 SET N=N+1
- SET YSDATA(N)=YSQN_U_YSEQ_";"_G1_U_$GET(^YTT(601.85,G,1,G1,0))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 QUIT
- +24 ;
- SCOREINS(YSDATA,IEN71) ;
- +1 ; patch 123, scores responses (answers) for a given instrument
- +2 ; YSDATA contains Answers for instrument
- +3 NEW I,G,N,YSAI,YSAN,YSCALEI,YSKEYI,YSRAW,YSRTN,YSTARG,YSQN,YSVAL
- +4 KILL ^TMP($JOB,"YSCOR"),^TMP($JOB,"YSG")
- +5 ;-->out
- IF '$DATA(^YTT(601.86,"AD",IEN71))
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="Scale grp not found"
- QUIT
- +6 ; get the Instrument Name
- SET YS("CODE")=$$GET1^DIQ(601.71,IEN71_",",.01)
- +7 DO SCALEG^YTQAPI3(.YSDATA,.YS)
- +8 SET YSDATA=$NAME(^TMP($JOB,"YSCOR"))
- +9 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
- SET N=1
- +10 ;
- +11 ;routine for scoring
- SET YSRTN=$$GET1^DIQ(601.71,IEN71_",",92)
- +12 IF (YSRTN'="")
- IF (YSRTN'="YTSCORE")
- Begin DoDot:1
- +13 SET YSRTN="DLLSTR^"_YSRTN_"(.YSDATA,.YS,1)"
- +14 DO @YSRTN
- End DoDot:1
- QUIT
- +15 ; original code, this uses MH SCORING KEY File to calculate ^TMP for "regular instruments"
- +16 FOR I=2:1
- if '$DATA(^TMP($JOB,"YSG",I))
- QUIT
- IF ^TMP($JOB,"YSG",I)?1"Scale".E
- SET YSRAW="0"
- SET N=N+1
- SET ^TMP($JOB,"YSCOR",N)=$PIECE(^TMP($JOB,"YSG",I),U,4)_"="
- Begin DoDot:1
- +17 SET YSCALEI=$PIECE(^TMP($JOB,"YSG",I),U)
- SET YSCALEI=$PIECE(YSCALEI,"=",2)
- +18 SET YSKEYI=0
- FOR
- SET YSKEYI=$ORDER(^YTT(601.91,"AC",YSCALEI,YSKEYI))
- if YSKEYI'>0
- QUIT
- Begin DoDot:2
- +19 SET G=^YTT(601.91,YSKEYI,0)
- +20 SET YSQN=$PIECE(G,U,3)
- SET YSTARG=$PIECE(G,U,4)
- SET YSVAL=$PIECE(G,U,5)
- +21 SET YSAI=$ORDER(^YTT(601.85,"AC",YSAD,YSQN,0))
- +22 if YSAI'>0
- QUIT
- +23 ;ASF 11/15/07
- if '$DATA(^YTT(601.85,YSAI,0))
- QUIT
- +24 SET YSAN=""
- +25 IF $DATA(^YTT(601.85,YSAI,1,1,0))
- SET YSAN=^YTT(601.85,YSAI,1,1,0)
- +26 IF $PIECE(^YTT(601.85,YSAI,0),U,4)?1N.N
- SET YSAN=$PIECE(^YTT(601.85,YSAI,0),U,4)
- SET YSAN=$GET(^YTT(601.75,YSAN,1))
- +27 IF YSAN=YSTARG
- SET YSRAW=YSRAW+YSVAL
- End DoDot:2
- End DoDot:1
- SET ^TMP($JOB,"YSCOR",N)=^TMP($JOB,"YSCOR",N)_YSRAW
- +28 QUIT
- +29 ;
- CHKSCRE() ;
- +1 NEW REVSCR71,REVSCR84
- +2 ; Instrument scoring version number
- SET REVSCR71=$$GET1^DIQ(601.71,IEN71_",",93)
- +3 ; Administration scoring version number
- SET REVSCR84=$$GET1^DIQ(601.84,YSAD_",",14)
- +4 QUIT (REVSCR71=REVSCR84)
- +5 ;
- LDSCORES(YSDATA,YS) ; new call for patch 123
- +1 ;input:AD = ADMINISTRATION #
- +2 ;output: [DATA] in ^TMP($J,"YSCOR")
- +3 NEW G,N,IEN71,SCALE,YSAD,YSCODEN,YSCALE
- +4 SET YSAD=$GET(YS("AD"))
- +5 KILL ^TMP($JOB,"YSCOR")
- SET YSDATA=$NAME(^TMP($JOB,"YSCOR"))
- +6 ;-->out
- IF YSAD'?1N.N
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="Bad ADMIN # in LDSCORES"
- QUIT
- +7 SET IEN71=$$GET1^DIQ(601.84,YSAD_",",2,"I")
- IF IEN71'?1N.N
- Begin DoDot:1
- +8 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="No Instrument in 601.84"
- End DoDot:1
- QUIT
- +9 ;Check if scoring may have changed before loading scores
- +10 IF '$$CHKSCRE
- DO SCORSAVE^YTQAPI11(.YSDATA,.YS)
- +11 ;-->out
- IF '$DATA(^YTT(601.92,"AC",YSAD))
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="No entry in MH RESULTS"
- QUIT
- +12 ;
- +13 SET YS("CODE")=$$GET1^DIQ(601.84,YSAD_",",2)
- +14 DO SCALEG^YTQAPI3(.YSDATA,.YS)
- +15 ;
- +16 SET YSDATA=$NAME(^TMP($JOB,"YSCOR"))
- +17 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
- SET N=1
- +18 ;
- +19 SET YSCALE=""
- +20 FOR
- SET YSCALE=$ORDER(^YTT(601.92,"AC",YSAD,YSCALE))
- if 'YSCALE
- QUIT
- Begin DoDot:1
- +21 SET G=$GET(^YTT(601.92,YSCALE,0))
- +22 SET SCALE=$PIECE(G,U,3)
- SET N=N+1
- +23 SET ^TMP($JOB,"YSCOR",N)=SCALE_"="_$PIECE(G,U,4)_$SELECT($PIECE(G,U,5):U_$PIECE(G,U,5),1:"")
- End DoDot:1
- +24 QUIT
- +25 ;
- UPDSCORE(YSDATA,YS) ; files entries in MH RESULTS (601.92)
- +1 ;input:AD = ADMINISTRATION #
- +2 ;output: [DATA]
- +3 NEW DIFF,IEN71,YSAD,YSCALE,YSC,YSG,Z
- +4 SET YSAD=$GET(YS("AD"))
- +5 ;-->out
- IF YSAD'?1N.N
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="No ADMIN # in UPDSCORE"
- QUIT
- +6 SET IEN71=$$GET1^DIQ(601.84,YSAD_",",2,"I")
- +7 ; are there existing scores in MH RESULT
- +8 IF $DATA(^YTT(601.92,"AC",YSAD))
- DO OLDSCRES(.YSCALE,.YSAD)
- +9 ;
- +10 SET Z=1
- FOR
- SET Z=$ORDER(^TMP($JOB,"YSCOR",Z))
- if Z'>0
- QUIT
- Begin DoDot:1
- +11 SET YSG=^TMP($JOB,"YSCOR",Z)
- +12 SET YSC=$PIECE(YSG,"=")
- +13 SET DIFF=0
- +14 IF $DATA(YSCALE(YSC))
- Begin DoDot:2
- +15 SET DIFF=$$CHKSCR(.YSC,.YSG)
- +16 IF DIFF
- DO ADDAUDIT(.YSC,.YSG)
- End DoDot:2
- QUIT
- +17 DO ADDSCRE
- End DoDot:1
- +18 ; set admin.revision = instrument.revision
- +19 DO SETREV(.YSAD,.IEN71)
- +20 QUIT
- +21 ;
- CHKSCR(YSC,YSG) ; return 1 if there are different values, 0 if values in scoring are the same
- +1 NEW I,OLDSC,YSCOR
- +2 SET DIFF=0
- +3 SET YSCOR=$PIECE(YSG,"=",2,7)
- +4 SET OLDSC=$PIECE(YSCALE(YSC),U,4,7)
- +5 FOR I=1:1:4
- IF $PIECE($GET(OLDSC),U,I)'=$PIECE($GET(YSCOR),U,I)
- SET DIFF=1
- if DIFF
- QUIT
- +6 QUIT DIFF
- +7 ;
- ADDAUDIT(YSC,YSG) ; add entry in AUDIT node, update value in existing MH RESULTS record
- +1 NEW AUDIEN,AUD,DIERR
- +2 SET AUDIEN=$PIECE(YSCALE(YSC),U)
- +3 DO NOW^%DTC
- +4 SET AUD(1,601.921,"+2,"_AUDIEN_",",.01)=%
- +5 SET AUD(1,601.921,"+2,"_AUDIEN_",",2)=$$GET1^DIQ(601.84,YSAD_",",14)
- +6 FOR I=4:1:7
- IF $LENGTH($PIECE(YSCALE(YSC),U,I))
- SET AUD(1,601.921,"+2,"_AUDIEN_",",(I-1))=$PIECE(YSCALE(YSC),U,I)
- +7 DO UPDATE^DIE("","AUD(1)")
- +8 IF $DATA(DIERR)
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="Did not set Audit node in MH RESULTS"
- QUIT
- +9 DO CLEAN^DILF
- +10 ;
- +11 ; update existing node with new ones; use FILE^DIE
- +12 NEW I,FDA,DIERR,YSGANS
- +13 SET YSGANS=$PIECE(YSG,"=",2,5)
- +14 FOR I=1:1:4
- IF $LENGTH($PIECE(YSGANS,U,I))!$LENGTH($PIECE(YSCALE(YSC),U,I+3))
- SET FDA(601.92,AUDIEN_",",(I+2))=$PIECE(YSGANS,U,I)
- +15 DO FILE^DIE("","FDA")
- +16 IF $DATA(DIERR)
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="Did not update records in MH RESULTS File"
- QUIT
- +17 DO CLEAN^DILF
- +18 KILL %,%H,%I,X
- +19 QUIT
- +20 ;
- ADDSCRE ;add score to MH RESULTS
- +1 NEW FDA,FDAIEN,DIERR,STR,YSRNEW,YSRFND
- +2 SET YSRNEW=$PIECE($GET(^YTT(601.92,0)),U,3)
- SET YSRFND=0
- +3 if YSRNEW<100000
- SET YSRNEW=100000
- +4 LOCK +^YTT(601.92,0):DILOCKTM+10
- +5 IF '$TEST
- Begin DoDot:1
- +6 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- +7 SET ^TMP($JOB,"YSCOR",2)="Could not get lock on MH RESULTS file"
- End DoDot:1
- QUIT
- +8 FOR
- if YSRFND
- QUIT
- if '$DATA(^YTT(601.92,YSRNEW))
- Begin DoDot:1
- +9 LOCK +^YTT(601.92,YSRNEW):DILOCKTM
- if '$TEST
- QUIT
- +10 SET STR=$PIECE(YSG,"=",2)
- +11 SET FDAIEN(1)=YSRNEW
- +12 SET FDA(601.92,"+1,",.01)=YSRNEW
- +13 SET FDA(601.92,"+1,",1)=YSAD
- +14 SET FDA(601.92,"+1,",2)=$PIECE(YSG,"=",1)
- +15 ; raw score
- SET FDA(601.92,"+1,",3)=$PIECE(STR,U,1)
- +16 ; transformed score 1
- if $LENGTH($PIECE(STR,U,2))
- SET FDA(601.92,"+1,",4)=$PIECE(STR,U,2)
- +17 ; transformed score 2
- if $LENGTH($PIECE(STR,U,3))
- SET FDA(601.92,"+1,",5)=$PIECE(STR,U,3)
- +18 ; transformed score 3
- if $LENGTH($PIECE(STR,U,4))
- SET FDA(601.92,"+1,",6)=$PIECE(STR,U,4)
- +19 DO UPDATE^DIE("","FDA","FDAIEN")
- +20 LOCK -^YTT(601.92,YSRNEW)
- +21 SET YSRFND=1
- End DoDot:1
- SET YSRNEW=YSRNEW+1
- +22 LOCK -^YTT(601.92,0)
- +23 IF $DATA(DIERR)
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="Did not add MH RESULTS entry"
- QUIT
- +24 QUIT
- +25 ;
- OLDSCRES(YSCALE,YSAD) ; if existing score, build array containing them
- +1 NEW IEN92,STR
- +2 SET IEN92=0
- +3 FOR
- SET IEN92=$ORDER(^YTT(601.92,"AC",YSAD,IEN92))
- if 'IEN92
- QUIT
- Begin DoDot:1
- +4 SET STR=$GET(^YTT(601.92,IEN92,0))
- +5 SET YSCALE($PIECE(STR,U,3))=STR
- End DoDot:1
- +6 QUIT
- +7 ;
- SETREV(YSAD,IEN71) ; set revision value in MH ADMINISTRATIONS to value in MH TEST AND SURVEYS
- +1 NEW FDA,DIERR
- +2 SET FDA(601.84,YSAD_",",14)=$$GET1^DIQ(601.71,IEN71_",",93)
- +3 DO FILE^DIE("","FDA")
- +4 IF $DATA(DIERR)
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^TMP($JOB,"YSCOR",2)="Did not set Scoring Revision in MH ADMIN"
- +5 DO CLEAN^DILF
- +6 ; publish score update event
- DO UPRSLT^YTQEVNT(YSAD,"score")
- +7 QUIT
- +8 ;
- LDTSCOR(TSARR,YSAD) ;
- +1 NEW CNT,DATA,IEN92,RAW,T1,T2,T3
- +2 SET IEN92=""
- SET CNT=1
- +3 IF YSAD'?1N.N
- SET TSARR("NOADM")="No Administration to get scores"
- QUIT
- +4 IF '$DATA(^YTT(601.92,"AC",YSAD))
- SET TSARR("NOADM")="No scores in MH RESULTS File"
- QUIT
- +5 FOR
- SET IEN92=$ORDER(^YTT(601.92,"AC",YSAD,IEN92))
- if 'IEN92
- QUIT
- Begin DoDot:1
- +6 SET DATA=$GET(^YTT(601.92,IEN92,0))
- +7 SET RAW=$PIECE(DATA,U,4)
- SET T1=$PIECE(DATA,U,5)
- SET T2=$PIECE(DATA,U,6)
- SET T3=$PIECE(DATA,U,7)
- +8 SET RAW=$SELECT($LENGTH(RAW)=1:" "_RAW,1:RAW)
- +9 SET T1=$SELECT($LENGTH(T1)=1:" "_T1,1:T1)
- SET T2=$SELECT($LENGTH(T2)=1:" "_T2,1:T2)
- SET T3=$SELECT($LENGTH(T3)=1:" "_T3,1:T3)
- +10 SET TSARR($PIECE($PIECE(DATA,U,3),":"))=$PIECE(DATA,U,3)_U_RAW_U_T1_U_T2_U_T3
- End DoDot:1
- +11 QUIT
- BYKEY(YSDATA) ; use YSDATA to score by key and put into ^TMP($J,"YSCOR")
- +1 ; expects scales to already be in ^TMP($J,"YSG")
- +2 NEW I,J,TEST,ANSWERS,SCORES,QID,CID,YS
- +3 KILL ^TMP($JOB,"YSCOR")
- +4 SET TEST=$PIECE(YSDATA(2),U,3)
- SET YS("CODE")=TEST
- +5 IF $LENGTH(TEST)
- SET TEST=$ORDER(^YTT(601.71,"B",TEST,0))
- +6 IF 'TEST
- SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- SET ^(2)="No test found"
- QUIT
- +7 ; build ANSWERS array
- SET I=2
- SET J=0
- FOR
- SET I=$ORDER(YSDATA(I))
- if 'I
- QUIT
- Begin DoDot:1
- +8 SET QID=$PIECE(YSDATA(I),U)
- SET CID=$PIECE(YSDATA(I),U,3)
- +9 SET J=J+1
- SET ANSWERS(J,"id")=QID
- SET ANSWERS(J,"value")=CID
- End DoDot:1
- +10 DO SUMKEY^YTSCOREX(TEST,.ANSWERS,.SCORES)
- +11 SET J=1
- SET ^TMP($JOB,"YSCOR",J)="[DATA]"
- +12 SET I=0
- FOR
- SET I=$ORDER(SCORES(I))
- if 'I
- QUIT
- Begin DoDot:1
- +13 SET J=J+1
- SET ^TMP($JOB,"YSCOR",J)=$GET(SCORES(I,"name"))_"="_SCORES(I,"raw")
- End DoDot:1
- +14 QUIT