YTSASRS ;ISP/LMT - Scoring and Report for ASRS ;Dec 20, 2023@13:04:34
;;5.01;MENTAL HEALTH;**239**;Dec 30, 1994;Build 16
;
;
DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
; input
; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
; YSDATA(2+n)=questionId^sequence^choiceId
; YS("AD")=adminId
; YSTRNG=1 for score, 2 for report
; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
; output if YSTRNG=2: append special "answers" to YSDATA
;
N YSN,YSTEXT
;
I YSTRNG=1 D SCORESV
;
I YSTRNG=2 D
. D LDSCORES^YTSCORE(.YSDATA,.YS) ; puts score into ^TMP($J,"YSCOR",2)
. S YSTEXT=$$REPORT(.YSDATA)
. S YSN=$O(YSDATA(""),-1) ; get last node
. S YSN=YSN+1
. S YSDATA(YSN)="7771^9999;1^"_$P(YSTEXT,U,1)
. S YSN=YSN+1
. S YSDATA(YSN)="7772^9999;1^"_$P(YSTEXT,U,2)
Q
;
;
SCORESV ; calculate the score
; expects YSDATA from DLLSTR (YSDATA from LOADANSW^YTSCORE,SCALEG^YTQAPI3)
;
; ZEXCEPT: YSDATA
N YSANSWER,YSCHOICEID,YSI,YSJ,YSPARTA,YSQUESTION,YSSCLID,YSSCLNM,YSSCRCARD
;
S YSSCRCARD(9331)=1 ;answer must be greater than this to have a score of 1
S YSSCRCARD(9332)=1
S YSSCRCARD(9333)=1
S YSSCRCARD(9334)=2
S YSSCRCARD(9335)=2
S YSSCRCARD(9336)=2
S YSPARTA=0
;
S YSI=2
F S YSI=$O(YSDATA(YSI)) Q:'YSI D
. S YSQUESTION=$P(YSDATA(YSI),U)
. S YSCHOICEID=$P(YSDATA(YSI),U,3)
. S YSANSWER=$P($G(^YTT(601.75,+YSCHOICEID,0)),U,2)
. I YSQUESTION=""!(YSANSWER="") QUIT
. I $D(YSSCRCARD(YSQUESTION)) D
. . I YSANSWER>YSSCRCARD(YSQUESTION) S YSPARTA=YSPARTA+1
;
; set scores into ^TMP($J,"YSCOR",n)=scaleName=score {rawScore^tScore}
K ^TMP($J,"YSCOR")
I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
. S ^TMP($J,"YSCOR",1)="[ERROR]"
. S ^TMP($J,"YSCOR",2)="No Scale found for ADMIN"
;
S ^TMP($J,"YSCOR",1)="[DATA]"
S YSI=2
S YSJ=1
F S YSI=$O(^TMP($J,"YSG",YSI)) Q:'YSI D
. S YSSCLID=+$P(^TMP($J,"YSG",YSI),"=",2)
. S YSSCLNM=$P(^TMP($J,"YSG",YSI),U,4)
. S YSJ=YSJ+1
. I YSSCLID=1566 S ^TMP($J,"YSCOR",YSJ)=YSSCLNM_"="_YSPARTA
Q
;
;
REPORT(YSDATA) ; build the scoring display for the report
; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
; YSDATA from DLLSTR
;
N YSANSWER,YSCHOICEID,YSCNT,YSI,YSINDENT,YSNAME,YSNODE,YSPARTA,YSPARTB,YSQUESTION,YSSCRCARD,YSVAL
N YSCNTNT,YSQIDNT,YSJ,YSINSNAM
;
; Part A
S YSI=0 F S YSI=$O(^TMP($J,"YSCOR",YSI)) Q:'YSI D
. S YSNAME=$P(^TMP($J,"YSCOR",YSI),"=")
. S YSVAL=$P(^TMP($J,"YSCOR",YSI),"=",2)
. S YSPARTA=""
. I YSNAME="Total Part A" D
. . I YSVAL>3 S YSPARTA="Veteran's responses are highly consistent with ADHD in adults and| further investigation is warranted."
. . E S YSPARTA="Veteran's symptoms are not consistent with ADHD in adults."
;
; Part B Relevant Responses
S YSSCRCARD(9337)=2 ;answer must be greater than this to be considered relevant
S YSSCRCARD(9338)=2
S YSSCRCARD(9339)=1
S YSSCRCARD(9340)=2
S YSSCRCARD(9341)=2
S YSSCRCARD(9342)=1
S YSSCRCARD(9343)=2
S YSSCRCARD(9344)=2
S YSSCRCARD(9345)=2
S YSSCRCARD(9346)=1
S YSSCRCARD(9347)=2
S YSSCRCARD(9348)=1
;
S YSINDENT=9
S YSPARTB="|"
S YSCNT=0
;
S YSINSNAM=$P(YSDATA(2),U,3)
I YSINSNAM'="" S YSINSNAM=$O(^YTT(601.71,"B",YSINSNAM,0))
S YSI=2
F S YSI=$O(YSDATA(YSI)) Q:'YSI D
. S YSNODE=$G(YSDATA(YSI))
. S YSQUESTION=$P(YSNODE,U,1)
. S YSCHOICEID=$P(YSNODE,U,3)
. S YSANSWER=$P($G(^YTT(601.75,+YSCHOICEID,0)),U,2)
. I YSQUESTION=""!(YSANSWER="") QUIT
. S YSQIDNT=""
. S YSCNTNT=0
. S YSJ=0 F S YSJ=$O(^YTT(601.76,"AE",YSQUESTION,YSJ)) Q:'YSJ D
. . I $P($G(^YTT(601.76,YSJ,0)),U,2)=YSINSNAM S YSCNTNT=YSJ
. I YSCNTNT S YSQIDNT=$P(^YTT(601.76,YSCNTNT,0),U,5) ;MH CONTENT question DESIGNATOR
. S:$E(YSQIDNT,$L(YSQIDNT))="." YSQIDNT=$E(YSQIDNT,1,$L(YSQIDNT)-1) ;Remove trailing .
. ;
. I $D(YSSCRCARD(YSQUESTION)),YSANSWER>YSSCRCARD(YSQUESTION) D
. . S YSCNT=YSCNT+1
. . S YSPARTB=YSPARTB_$$QFORMAT^YTSLEC(YSQIDNT,YSQUESTION,YSINDENT) ; question
. . S YSPARTB=YSPARTB_"|"_$$REPEAT^XLFSTR(" ",YSINDENT)_$P($G(^YTT(601.75,YSCHOICEID,1)),U,1) ; answer
;
I 'YSCNT S YSPARTB="None." ; There are no relevant responses.
;
Q YSPARTA_U_YSPARTB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSASRS 4270 printed Apr 09, 2024@21:20:31 Page 2
YTSASRS ;ISP/LMT - Scoring and Report for ASRS ;Dec 20, 2023@13:04:34
+1 ;;5.01;MENTAL HEALTH;**239**;Dec 30, 1994;Build 16
+2 ;
+3 ;
DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
+1 ; input
+2 ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
+3 ; YSDATA(2+n)=questionId^sequence^choiceId
+4 ; YS("AD")=adminId
+5 ; YSTRNG=1 for score, 2 for report
+6 ; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
+7 ; output if YSTRNG=2: append special "answers" to YSDATA
+8 ;
+9 NEW YSN,YSTEXT
+10 ;
+11 IF YSTRNG=1
DO SCORESV
+12 ;
+13 IF YSTRNG=2
Begin DoDot:1
+14 ; puts score into ^TMP($J,"YSCOR",2)
DO LDSCORES^YTSCORE(.YSDATA,.YS)
+15 SET YSTEXT=$$REPORT(.YSDATA)
+16 ; get last node
SET YSN=$ORDER(YSDATA(""),-1)
+17 SET YSN=YSN+1
+18 SET YSDATA(YSN)="7771^9999;1^"_$PIECE(YSTEXT,U,1)
+19 SET YSN=YSN+1
+20 SET YSDATA(YSN)="7772^9999;1^"_$PIECE(YSTEXT,U,2)
End DoDot:1
+21 QUIT
+22 ;
+23 ;
SCORESV ; calculate the score
+1 ; expects YSDATA from DLLSTR (YSDATA from LOADANSW^YTSCORE,SCALEG^YTQAPI3)
+2 ;
+3 ; ZEXCEPT: YSDATA
+4 NEW YSANSWER,YSCHOICEID,YSI,YSJ,YSPARTA,YSQUESTION,YSSCLID,YSSCLNM,YSSCRCARD
+5 ;
+6 ;answer must be greater than this to have a score of 1
SET YSSCRCARD(9331)=1
+7 SET YSSCRCARD(9332)=1
+8 SET YSSCRCARD(9333)=1
+9 SET YSSCRCARD(9334)=2
+10 SET YSSCRCARD(9335)=2
+11 SET YSSCRCARD(9336)=2
+12 SET YSPARTA=0
+13 ;
+14 SET YSI=2
+15 FOR
SET YSI=$ORDER(YSDATA(YSI))
if 'YSI
QUIT
Begin DoDot:1
+16 SET YSQUESTION=$PIECE(YSDATA(YSI),U)
+17 SET YSCHOICEID=$PIECE(YSDATA(YSI),U,3)
+18 SET YSANSWER=$PIECE($GET(^YTT(601.75,+YSCHOICEID,0)),U,2)
+19 IF YSQUESTION=""!(YSANSWER="")
QUIT
+20 IF $DATA(YSSCRCARD(YSQUESTION))
Begin DoDot:2
+21 IF YSANSWER>YSSCRCARD(YSQUESTION)
SET YSPARTA=YSPARTA+1
End DoDot:2
End DoDot:1
+22 ;
+23 ; set scores into ^TMP($J,"YSCOR",n)=scaleName=score {rawScore^tScore}
+24 KILL ^TMP($JOB,"YSCOR")
+25 ;-->out
IF $DATA(^TMP($JOB,"YSG",1))
IF ^TMP($JOB,"YSG",1)="[ERROR]"
Begin DoDot:1
+26 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
+27 SET ^TMP($JOB,"YSCOR",2)="No Scale found for ADMIN"
End DoDot:1
QUIT
+28 ;
+29 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+30 SET YSI=2
+31 SET YSJ=1
+32 FOR
SET YSI=$ORDER(^TMP($JOB,"YSG",YSI))
if 'YSI
QUIT
Begin DoDot:1
+33 SET YSSCLID=+$PIECE(^TMP($JOB,"YSG",YSI),"=",2)
+34 SET YSSCLNM=$PIECE(^TMP($JOB,"YSG",YSI),U,4)
+35 SET YSJ=YSJ+1
+36 IF YSSCLID=1566
SET ^TMP($JOB,"YSCOR",YSJ)=YSSCLNM_"="_YSPARTA
End DoDot:1
+37 QUIT
+38 ;
+39 ;
REPORT(YSDATA) ; build the scoring display for the report
+1 ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
+2 ; YSDATA from DLLSTR
+3 ;
+4 NEW YSANSWER,YSCHOICEID,YSCNT,YSI,YSINDENT,YSNAME,YSNODE,YSPARTA,YSPARTB,YSQUESTION,YSSCRCARD,YSVAL
+5 NEW YSCNTNT,YSQIDNT,YSJ,YSINSNAM
+6 ;
+7 ; Part A
+8 SET YSI=0
FOR
SET YSI=$ORDER(^TMP($JOB,"YSCOR",YSI))
if 'YSI
QUIT
Begin DoDot:1
+9 SET YSNAME=$PIECE(^TMP($JOB,"YSCOR",YSI),"=")
+10 SET YSVAL=$PIECE(^TMP($JOB,"YSCOR",YSI),"=",2)
+11 SET YSPARTA=""
+12 IF YSNAME="Total Part A"
Begin DoDot:2
+13 IF YSVAL>3
SET YSPARTA="Veteran's responses are highly consistent with ADHD in adults and| further investigation is warranted."
+14 IF '$TEST
SET YSPARTA="Veteran's symptoms are not consistent with ADHD in adults."
End DoDot:2
End DoDot:1
+15 ;
+16 ; Part B Relevant Responses
+17 ;answer must be greater than this to be considered relevant
SET YSSCRCARD(9337)=2
+18 SET YSSCRCARD(9338)=2
+19 SET YSSCRCARD(9339)=1
+20 SET YSSCRCARD(9340)=2
+21 SET YSSCRCARD(9341)=2
+22 SET YSSCRCARD(9342)=1
+23 SET YSSCRCARD(9343)=2
+24 SET YSSCRCARD(9344)=2
+25 SET YSSCRCARD(9345)=2
+26 SET YSSCRCARD(9346)=1
+27 SET YSSCRCARD(9347)=2
+28 SET YSSCRCARD(9348)=1
+29 ;
+30 SET YSINDENT=9
+31 SET YSPARTB="|"
+32 SET YSCNT=0
+33 ;
+34 SET YSINSNAM=$PIECE(YSDATA(2),U,3)
+35 IF YSINSNAM'=""
SET YSINSNAM=$ORDER(^YTT(601.71,"B",YSINSNAM,0))
+36 SET YSI=2
+37 FOR
SET YSI=$ORDER(YSDATA(YSI))
if 'YSI
QUIT
Begin DoDot:1
+38 SET YSNODE=$GET(YSDATA(YSI))
+39 SET YSQUESTION=$PIECE(YSNODE,U,1)
+40 SET YSCHOICEID=$PIECE(YSNODE,U,3)
+41 SET YSANSWER=$PIECE($GET(^YTT(601.75,+YSCHOICEID,0)),U,2)
+42 IF YSQUESTION=""!(YSANSWER="")
QUIT
+43 SET YSQIDNT=""
+44 SET YSCNTNT=0
+45 SET YSJ=0
FOR
SET YSJ=$ORDER(^YTT(601.76,"AE",YSQUESTION,YSJ))
if 'YSJ
QUIT
Begin DoDot:2
+46 IF $PIECE($GET(^YTT(601.76,YSJ,0)),U,2)=YSINSNAM
SET YSCNTNT=YSJ
End DoDot:2
+47 ;MH CONTENT question DESIGNATOR
IF YSCNTNT
SET YSQIDNT=$PIECE(^YTT(601.76,YSCNTNT,0),U,5)
+48 ;Remove trailing .
if $EXTRACT(YSQIDNT,$LENGTH(YSQIDNT))="."
SET YSQIDNT=$EXTRACT(YSQIDNT,1,$LENGTH(YSQIDNT)-1)
+49 ;
+50 IF $DATA(YSSCRCARD(YSQUESTION))
IF YSANSWER>YSSCRCARD(YSQUESTION)
Begin DoDot:2
+51 SET YSCNT=YSCNT+1
+52 ; question
SET YSPARTB=YSPARTB_$$QFORMAT^YTSLEC(YSQIDNT,YSQUESTION,YSINDENT)
+53 ; answer
SET YSPARTB=YSPARTB_"|"_$$REPEAT^XLFSTR(" ",YSINDENT)_$PIECE($GET(^YTT(601.75,YSCHOICEID,1)),U,1)
End DoDot:2
End DoDot:1
+54 ;
+55 ; There are no relevant responses.
IF 'YSCNT
SET YSPARTB="None."
+56 ;
+57 QUIT YSPARTA_U_YSPARTB
