- 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 Feb 18, 2025@23:45:30 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