- YTQAPI2A ;SLC/KCM - MHAX ANSWERS SPECIAL HANDLING ;10/17/16 13:43
- ;;5.01;MENTAL HEALTH;**121,134,123,250**;Dec 30, 1994;Build 26
- ;
- ; 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=3449:1,RES>3449:2,1:0) 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 3738 printed Feb 18, 2025@23:44:31 Page 2
- YTQAPI2A ;SLC/KCM - MHAX ANSWERS SPECIAL HANDLING ;10/17/16 13:43
- +1 ;;5.01;MENTAL HEALTH;**121,134,123,250**;Dec 30, 1994;Build 26
- +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=3449:1,RES>3449:2,1:0)
- 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 ;
