YTQAPI2A ;SLC/KCM - MHAX ANSWERS SPECIAL HANDLING ;10/17/16 13:43
;;5.01;MENTAL HEALTH;**121,134,123**;Dec 30, 1994;Build 73
;
; This routine handles limited complex reporting requirements without
; modifying YS_AUX.DLL by adding free text "answers" that can be used by
; a report.
;
; Assumptions: EDIT incomplete instrument should ignore the extra answers
; since there are no associated questions. GRAPHING should ignore the
; answers since they not numeric.
;
SPECIAL(YSDATA,N,YSAD,YSTSTN) ; add "hidden" computed question text
; 123 - 134 need YS array below for call to GETSCORE
I $G(YSAD) S YS("AD")=YSAD
S N=N+1
N TSTNM S TSTNM=$P(YSDATA(2),U,3)
;
I TSTNM="CCSA-DSM5" D Q
.N ANS,CHCE,I,LP,RES,SAVEN,SC,STR,TMP
.D SETARR
.S LP=2,SAVEN=N
.F S LP=$O(YSDATA(LP)) Q:'LP S RES=$P(YSDATA(LP),U,3) S CHCE=$S(RES=3448:0,RES=3449:1,RES>3449:2) I CHCE D
..S ANS=$P(YSDATA(LP),U)
..I CHCE=2 D
...I (ANS=7216)!(ANS=7217) S TMP(7771)=7771_U_"9999;1^Positive"
...I ANS=7218 S TMP(7772)=7772_U_"9999;1^Positive"
...I (ANS=7219)!(ANS=7220) S TMP(7773)=7773_U_"9999;1^Positive"
...I (ANS=7221)!(ANS=7222)!(ANS=7223) S TMP(7774)=7774_U_"9999;1^Positive"
...I (ANS=7224)!(ANS=7225) S TMP(7775)=7775_U_"9999;1^Positive"
...I ANS=7229 S TMP(7778)=7778_U_"9999;1^Positive"
...I ANS=7230 S TMP(7779)=7779_U_"9999;1^Positive"
...I (ANS=7231)!(ANS=7232) S TMP(7780)=7780_U_"9999;1^Positive"
...I ANS=7233 S TMP(7781)=7781_U_"9999;1^Positive"
...I (ANS=7234)!(ANS=7235) S TMP(7782)=7782_U_"9999;1^Positive"
..; CHCE will be 1 here, 3 scales with lower threshold for being positive
..I ANS=7226 S TMP(7776)=7776_U_"9999;1^Positive"
..I (ANS=7227)!(ANS=7228) S TMP(7777)=7777_U_"9999;1^Positive"
..I (ANS=7236)!(ANS=7237)!(ANS=7238) S TMP(7783)=7783_U_"9999;1^Positive"
.;Calculations completed, need to update TMP array into YSDATA
.S I=0 F S I=$O(TMP(I)) Q:'I S YSDATA(SAVEN)=TMP(I),SAVEN=SAVEN+1
.Q
;
; Questions: 3382 = PHQ9 question #9
; Choices: 1008 = Several days, 1009 = More than half the days,
; 1010 = Nearly every day
I TSTNM="PHQ9","^1008^1009^1010^"[(U_$$ANSWER(3382)_U) D Q
. S YSDATA(N)="7771^9999;1^Question 9 answered in the POSITIVE direction, additional clinical assessment is indicated."
;
;
;Calculate totals for the CEMI, SIP-2L, and YBOCSII.
I TSTNM="SIP-2L"!(TSTNM="CEMI")!(TSTNM="YBOCSII") D Q
.N LP,TOT,YSCORE,SCALE,SCORE
.S TOT=0
.D GETSCORE^YTQAPI8(.YSCORE,.YS)
.I ^TMP($J,"YSCOR",1)'="[DATA]" Q
.S LP=1
.F S LP=$O(^TMP($J,"YSCOR",LP)) Q:'LP D
..; run this code to get the total score for SIP-2L, CEMI, YBOCSII
..S TOT=TOT+$P(^TMP($J,"YSCOR",LP),"=",2)
..S YSDATA(N)="7772^9999;1^"_TOT
..;
;
I $L($T(SPECIAL^YTQAPI2B)) D SPECIAL^YTQAPI2B(TSTNM,.YSDATA,N,.YSAD,.YSTSTN) Q
Q
;
ANSWER(QID) ; return answer given question ID
N ANS,I
S ANS=""
S I=2 F S I=$O(YSDATA(I)) Q:'I D Q:$L(ANS)
. I $P(YSDATA(I),U)=QID S ANS=$P(YSDATA(I),U,3)
Q ANS
;
SETARR ; set YSDATA(ARR) for the customized questions
F I=1:1 S STR=$T(SCLGRP+I) Q:$P(STR,";;",2)="Q" D
.S SC=$P($P(STR,";;",2),";",3)
.S TMP(SC)=SC_U_"9999;1^Negative"
Q
;
SCLGRP ;; Scale grouping for the CCSA-DSM5 ;;QIEN^QIEN;Scale Name;custom question to display;
;;7216^7217;Depression;7771;
;;7218;Anger;7772;
;;7219^7220;Mania;7773;
;;7221^7222^7223;Anxiety;7774;
;;7224^7225;Somatic Symptoms;7775;
;;7226;Suicidal Ideation;7776
;;7227^7228;Psychosis;7777;
;;7229;Sleep Problems;7778;
;;7230;Memory;7779;
;;7231^7232;Repetitive Thoughts and Behaviors;7780;
;;7233;Dissociation;7781;
;;7334^7235;Personality Functioning;7782;
;;7236^7237^7238;Substance Use;7783;
;;Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI2A 3741 printed Dec 13, 2024@02:18:14 Page 2
YTQAPI2A ;SLC/KCM - MHAX ANSWERS SPECIAL HANDLING ;10/17/16 13:43
+1 ;;5.01;MENTAL HEALTH;**121,134,123**;Dec 30, 1994;Build 73
+2 ;
+3 ; This routine handles limited complex reporting requirements without
+4 ; modifying YS_AUX.DLL by adding free text "answers" that can be used by
+5 ; a report.
+6 ;
+7 ; Assumptions: EDIT incomplete instrument should ignore the extra answers
+8 ; since there are no associated questions. GRAPHING should ignore the
+9 ; answers since they not numeric.
+10 ;
SPECIAL(YSDATA,N,YSAD,YSTSTN) ; add "hidden" computed question text
+1 ; 123 - 134 need YS array below for call to GETSCORE
+2 IF $GET(YSAD)
SET YS("AD")=YSAD
+3 SET N=N+1
+4 NEW TSTNM
SET TSTNM=$PIECE(YSDATA(2),U,3)
+5 ;
+6 IF TSTNM="CCSA-DSM5"
Begin DoDot:1
+7 NEW ANS,CHCE,I,LP,RES,SAVEN,SC,STR,TMP
+8 DO SETARR
+9 SET LP=2
SET SAVEN=N
+10 FOR
SET LP=$ORDER(YSDATA(LP))
if 'LP
QUIT
SET RES=$PIECE(YSDATA(LP),U,3)
SET CHCE=$SELECT(RES=3448:0,RES=3449:1,RES>3449:2)
IF CHCE
Begin DoDot:2
+11 SET ANS=$PIECE(YSDATA(LP),U)
+12 IF CHCE=2
Begin DoDot:3
+13 IF (ANS=7216)!(ANS=7217)
SET TMP(7771)=7771_U_"9999;1^Positive"
+14 IF ANS=7218
SET TMP(7772)=7772_U_"9999;1^Positive"
+15 IF (ANS=7219)!(ANS=7220)
SET TMP(7773)=7773_U_"9999;1^Positive"
+16 IF (ANS=7221)!(ANS=7222)!(ANS=7223)
SET TMP(7774)=7774_U_"9999;1^Positive"
+17 IF (ANS=7224)!(ANS=7225)
SET TMP(7775)=7775_U_"9999;1^Positive"
+18 IF ANS=7229
SET TMP(7778)=7778_U_"9999;1^Positive"
+19 IF ANS=7230
SET TMP(7779)=7779_U_"9999;1^Positive"
+20 IF (ANS=7231)!(ANS=7232)
SET TMP(7780)=7780_U_"9999;1^Positive"
+21 IF ANS=7233
SET TMP(7781)=7781_U_"9999;1^Positive"
+22 IF (ANS=7234)!(ANS=7235)
SET TMP(7782)=7782_U_"9999;1^Positive"
End DoDot:3
+23 ; CHCE will be 1 here, 3 scales with lower threshold for being positive
+24 IF ANS=7226
SET TMP(7776)=7776_U_"9999;1^Positive"
+25 IF (ANS=7227)!(ANS=7228)
SET TMP(7777)=7777_U_"9999;1^Positive"
+26 IF (ANS=7236)!(ANS=7237)!(ANS=7238)
SET TMP(7783)=7783_U_"9999;1^Positive"
End DoDot:2
+27 ;Calculations completed, need to update TMP array into YSDATA
+28 SET I=0
FOR
SET I=$ORDER(TMP(I))
if 'I
QUIT
SET YSDATA(SAVEN)=TMP(I)
SET SAVEN=SAVEN+1
+29 QUIT
End DoDot:1
QUIT
+30 ;
+31 ; Questions: 3382 = PHQ9 question #9
+32 ; Choices: 1008 = Several days, 1009 = More than half the days,
+33 ; 1010 = Nearly every day
+34 IF TSTNM="PHQ9"
IF "^1008^1009^1010^"[(U_$$ANSWER(3382)_U)
Begin DoDot:1
+35 SET YSDATA(N)="7771^9999;1^Question 9 answered in the POSITIVE direction, additional clinical assessment is indicated."
End DoDot:1
QUIT
+36 ;
+37 ;
+38 ;Calculate totals for the CEMI, SIP-2L, and YBOCSII.
+39 IF TSTNM="SIP-2L"!(TSTNM="CEMI")!(TSTNM="YBOCSII")
Begin DoDot:1
+40 NEW LP,TOT,YSCORE,SCALE,SCORE
+41 SET TOT=0
+42 DO GETSCORE^YTQAPI8(.YSCORE,.YS)
+43 IF ^TMP($JOB,"YSCOR",1)'="[DATA]"
QUIT
+44 SET LP=1
+45 FOR
SET LP=$ORDER(^TMP($JOB,"YSCOR",LP))
if 'LP
QUIT
Begin DoDot:2
+46 ; run this code to get the total score for SIP-2L, CEMI, YBOCSII
+47 SET TOT=TOT+$PIECE(^TMP($JOB,"YSCOR",LP),"=",2)
+48 SET YSDATA(N)="7772^9999;1^"_TOT
+49 ;
End DoDot:2
End DoDot:1
QUIT
+50 ;
+51 IF $LENGTH($TEXT(SPECIAL^YTQAPI2B))
DO SPECIAL^YTQAPI2B(TSTNM,.YSDATA,N,.YSAD,.YSTSTN)
QUIT
+52 QUIT
+53 ;
ANSWER(QID) ; return answer given question ID
+1 NEW ANS,I
+2 SET ANS=""
+3 SET I=2
FOR
SET I=$ORDER(YSDATA(I))
if 'I
QUIT
Begin DoDot:1
+4 IF $PIECE(YSDATA(I),U)=QID
SET ANS=$PIECE(YSDATA(I),U,3)
End DoDot:1
if $LENGTH(ANS)
QUIT
+5 QUIT ANS
+6 ;
SETARR ; set YSDATA(ARR) for the customized questions
+1 FOR I=1:1
SET STR=$TEXT(SCLGRP+I)
if $PIECE(STR,";;",2)="Q"
QUIT
Begin DoDot:1
+2 SET SC=$PIECE($PIECE(STR,";;",2),";",3)
+3 SET TMP(SC)=SC_U_"9999;1^Negative"
End DoDot:1
+4 QUIT
+5 ;
SCLGRP ;; Scale grouping for the CCSA-DSM5 ;;QIEN^QIEN;Scale Name;custom question to display;
+1 ;;7216^7217;Depression;7771;
+2 ;;7218;Anger;7772;
+3 ;;7219^7220;Mania;7773;
+4 ;;7221^7222^7223;Anxiety;7774;
+5 ;;7224^7225;Somatic Symptoms;7775;
+6 ;;7226;Suicidal Ideation;7776
+7 ;;7227^7228;Psychosis;7777;
+8 ;;7229;Sleep Problems;7778;
+9 ;;7230;Memory;7779;
+10 ;;7231^7232;Repetitive Thoughts and Behaviors;7780;
+11 ;;7233;Dissociation;7781;
+12 ;;7334^7235;Personality Functioning;7782;
+13 ;;7236^7237^7238;Substance Use;7783;
+14 ;;Q
+15 QUIT
+16 ;
