YTQAPI2C ;SLC/BLD- MHAX ANSWERS SPECIAL HANDLING #2 ;2/7/2018 17:35
;;5.01;MENTAL HEALTH;**136,139,250**;Dec 30, 1994;Build 26
;
; This routine was split from YTQAPI2A.
; 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(TSTNM,YSDATA,N,YSAD,YSTSTN) ; add "hidden" computed question text
N ANSWER,DEPSCORE,IEN,KEY,LP,PCT,PTSD,SATTSCORE,SCORES,SCRE,SUCSCORE,SUISCORE,SWHENSCORES,TEXT,TEXT1,TEXT2
N TEXT2A,TEXT2B,TOT,YSCORE,YSCREC,SUISCRN,ALLQUES,POSTXT1,POSTXT2,QUE1621,QUE67,QUE915,YSBPRS
;
;bld/dsb 4/19/2018 Complex Reporting for BPRS-A
I TSTNM="BPRS-A" D Q
.N LP,TOT,YSCORE,TOTARRAY,TOTDIST,TOTANX,TOTPARNA,TOTWITH,TOTPATH,YSBPRS
.S TOT=0,TOTARRAY="",YSCORE="",II=1
.D GETSCORE^YTQAPI8(.YSCORE,.YS)
.I ^TMP($J,"YSCOR",1)'="[DATA]" Q
.F I=3:1 Q:'$D(YSDATA(I)) S YSBPRS(I-2)=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")
.;D YSARRAY(.YSBPRS)
.S TOTDIST=YSBPRS(4)+(YSBPRS(12))+YSBPRS(15) ;Thinking Disturbance
.S TOTANX=YSBPRS(2)+(YSBPRS(5))+YSBPRS(9) ;Anxious Depression
.S TOTPARNA=YSBPRS(10)+(YSBPRS(11))+YSBPRS(14) ;Paranoid Disturbances
.S TOTWITH=YSBPRS(3)+(YSBPRS(13))+YSBPRS(16) ;Withdrawal Retardation
.F I=1:1:16 S TOTPATH=$G(TOTPATH)+YSBPRS(I) ;TOTAL PATHOLOGY SCORE
.S YSDATA(N)="7771^9999;1^"_TOTDIST,N=N+1
.S YSDATA(N)="7772^9999;1^"_TOTANX,N=N+1
.S YSDATA(N)="7773^9999;1^"_TOTPARNA,N=N+1
.S YSDATA(N)="7774^9999;1^"_TOTWITH,N=N+1
.S YSDATA(N)="7775^9999;1^"_TOTPATH,N=N+1
.S YSDATA(N)="7776^9999;1^"_"In the past week.",N=N+1
.Q
;
;bld 4/19/2018 logic for PSS-3 2nd Report
;
I TSTNM="PSS-3 2ND" D Q
.N I,OLDN,SCORE,SC,TEXT,QNBR,QNBRTXT,QNBR,POSTXT,LEN,LSTQNBR,QUENBR,TMP,POSTXT1,POSTXT2,POSTXT3,YSARRY
.S N=N+1,OLDN=N
.D GETSCORE^YTQAPI8(.YSCORE,.YS)
.I ^TMP($J,"YSCOR",1)'="[DATA]" Q
.D YSARRAY(.YSARRY)
.M TMP=^TMP($J,"YSCOR")
.S POSTXT1="Presence of one or more Positive Indicators means that, in addition "
.S POSTXT2="to any immediate suicide safety measures, the treating provider "
.S POSTXT3="should consider consulting a mental health professional.|'Yes' indicates a positive response. 'No' indicates a negative response."
.;
.S QUENBR=7771
.F I=1:1:7 S SCORE=$S($G(SCORE)="":$P(TMP(I),"=",2),1:SCORE_"^"_$P(TMP(I),"=",2))
.S YSDATA(N)="7780^9999;1^"_POSTXT1 S N=N+1
.S YSDATA(N)="7781^9999;1^"_POSTXT2 S N=N+1
.S YSDATA(N)="7782^9999;1^"_POSTXT3 S N=N+1
.I $P(SCORE,U,1)=1 S YSDATA(N)=QUENBR_"^9999;1^Active suicide ideation |with a past attempt." S N=N+1,QUENBR=QUENBR+1 ;QUESTION 1
.I $P(SCORE,U,2)=1 S YSDATA(N)=QUENBR_"^9999;1^Has or recently begun a suicide plan." S N=N+1,QUENBR=QUENBR+1 ;QUESTION 2
.I $P(SCORE,U,3)=1 S YSDATA(N)=QUENBR_"^9999;1^Reports recent intent to act on suicidal ideation." S N=N+1,QUENBR=QUENBR+1 ;QUESTION 3
.I $P(SCORE,U,4)=1 S YSDATA(N)=QUENBR_"^9999;1^Has a past psychiatric hospitalization." S N=N+1,QUENBR=QUENBR+1 ;QUESTION 4
.I $P(SCORE,U,5)=1 S YSDATA(N)=QUENBR_"^9999;1^Has a pattern of excessive substance use." S N=N+1,QUENBR=QUENBR+1 ;QUESTION 5
.I $P(SCORE,U,6)=1 S YSDATA(N)=QUENBR_"^9999;1^Currently presents with irritable, agitated, and/or aggressive behavior." S N=N+1,QUENBR=QUENBR+1 ;QUESTION 6
.I SCORE'[1 S YSDATA(N)=QUENBR_"^9999;1^None" S N=N+1,QUENBR=QUENBR+1
.S SC="" F I=1:1:6 I $P(SCORE,"^",I)>2 S SC=$S($G(SC)="":$P(SCORE,"^",I),1:SC_"^"_$P(SCORE,"^",I)),SC(I)=$P(SCORE,"^",I)
.S LEN=$S($G(SC)="":0,1:$L(SC,"^"))
.S TEXT=": The response was either Refused or Unable to Complete."
.;
.I LEN>0 D
..S QUENBR=7778
..S QNBR="",LSTQNBR=$O(SC(QNBR),-1)
..F I=1:1:LSTQNBR S QNBR=$O(SC(QNBR)) Q:'QNBR D Q:('$D(SC(QNBR)))!(QNBR>LSTQNBR)
...S QNBRTXT=$S($G(QNBRTXT)="":QNBR,QNBR'=LSTQNBR:QNBRTXT_", "_QNBR,1:QNBRTXT_" and "_QNBR)
..;
..S YSDATA(N)=QUENBR_"^9999;1^Question "_QNBRTXT_TEXT
;
I TSTNM="PCL-5 WEEKLY" D Q
.Q
.N OLDN,QUE15,QUE67,QUE915,QUE1621,CLUSTERB,CLUSTERC,CLUSTERD,CLUSTERE,TOTAL
.S N=N+1
.D GETSCORE^YTQAPI8(.YSCORE,.YS)
.I ^TMP($J,"YSCOR",1)'="[DATA]" Q
.M TMP=^TMP($J,"YSCOR")
.S CLUSTERB=$P(^TMP($J,"YSCOR",3),"=",2)
.S CLUSTERC=$P(^TMP($J,"YSCOR",4),"=",2)
.S CLUSTERD=$P(^TMP($J,"YSCOR",5),"=",2)
.S CLUSTERE=$P(^TMP($J,"YSCOR",6),"=",2)
.S TOTAL=CLUSTERB+CLUSTERC+CLUSTERD+CLUSTERE
.S YSDATA(N)="7771^9999;1^"_TOTAL S N=N+1
.S YSDATA(N)="7772^9999;1^"_CLUSTERB S N=N+1
.S YSDATA(N)="7773^9999;1^"_CLUSTERC S N=N+1
.S YSDATA(N)="7774^9999;1^"_CLUSTERD S N=N+1
.S YSDATA(N)="7775^9999;1^"_CLUSTERE S N=N+1
;
;Heavness in Smoking Index
I TSTNM="HSI" D Q
.N QUE1,QUE2,ANS1,TXT1,TXT2,TXT3,DEPENCE,INDEX,SAMPLE1,SAMPLE2,SCOREINFO
.S N=N+1
.D GETSCORE^YTQAPI8(.YSCORE,.YS)
.I ^TMP($J,"YSCOR",1)'="[DATA]" Q
.M TMP=^TMP($J,"YSCOR")
.S ANS1=$P(TMP(2),"=",2)
.S TOT=ANS1
.S SAMPLE1=5,SAMPLE2="""high"""
.S DEPENCE=$S(TOT=0:"NO nicotine dependence",12[TOT:"LOW nicotine dependence",34[TOT:"MODERATE nicotine dependence",1:"HIGH nicotine dependence")
.S TXT1="("_TOT_" represents the sum of points for each question and "_DEPENCE
.S TXT2="is the associated dependence level for that score from below, e.g., a Nicotine"
.S TXT3=" Dependence Score of """_SAMPLE1_""""_" would indicate "_SAMPLE2_" nicotine dependence.)"
.S SCOREINFO=TXT1_TXT2
.S INDEX="HEAVINESS OF SMOKING INDEX: "_TOT_" indicating "_DEPENCE
.S YSDATA(N)="7771^9999;1^"_INDEX S N=N+1
.S YSDATA(N)="7772^9999;1^"_TXT1 S N=N+1
.S YSDATA(N)="7773^9999;1^"_TXT2 S N=N+1
.S YSDATA(N)="7774^9999:1^"_TXT3 S N=N+1
;
I TSTNM="WEMWBS" D Q
.N I,SCORE,TEXT
.S N=N+1,SCORE=0
.D GETSCORE^YTQAPI8(.YSCORE,.YS)
.I ^TMP($J,"YSCOR",1)'="[DATA]" Q
.M TMP=^TMP($J,"YSCOR")
.S SCORE=$P(^TMP($J,"YSCOR",2),"=",2)
.S TEXT="WEMWBS Total Score: ",TEXT=TEXT_SCORE
.S YSDATA(N)="7771^9999;1^"_TEXT
;
;
I TSTNM="MHRM" D Q
.N I,SCORE,TEXT,YSTOTAL,YSMHRM,II,YSCALEI,YSKEYI,YSQN,YSTARG,YSVAL,YSAI,YSAN,YSOS,YSSE,YSLS,YSBF,YSOW,YSNP,YSSP,YSAE,G
.S N=N+1,SCORE=0,II=1,YSTOTAL=0
.S (YSOS,YSSE,YSLS,YSBF,YSOW,YSNP,YSSP,YSAE)=0
.D GETSCORE^YTQAPI8(.YSCORE,.YS)
.F I=2:1 Q:'$D(^TMP($J,"YSG",I)) I ^TMP($J,"YSG",I)?1"Scale".E D
.. 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))
...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 YSMHRM(II)=YSVAL,II=II+1 ;S ^TMP($J,"TEST",II,YSQN,YSAN,YSTARG)=YSVAL
.;
.F I=1:1:4 S YSOS=YSOS+$G(YSMHRM(I)) ;Overcoming Stuckness
.F I=5:1:8 S YSSE=YSSE+$G(YSMHRM(I)) ;Self-Empowerment
.F I=9:1:12 S YSLS=YSLS+$G(YSMHRM(I)) ;Learning and Self-redefinition
.F I=13:1:16 S YSBF=YSBF+$G(YSMHRM(I)) ;Basic Functioning
.F I=17:1:20 S YSOW=YSOW+$G(YSMHRM(I)) ;Overall Well Being
.F I=21:1:24 S YSNP=YSNP+$G(YSMHRM(I)) ;New Potentials
.F I=25:1:26 S YSSP=YSSP+$G(YSMHRM(I)) ;Spirituality
.F I=27:1:30 S YSAE=YSAE+$G(YSMHRM(I)) ;Advocacy/Enrichment
.;
.S YSTOTAL=$P(^TMP($J,"YSCOR",2),"=",2)
.S YSDATA(N)="7771^9999;1^"_YSTOTAL,N=N+1
.S YSDATA(N)="7772^9999;1^"_YSOS,N=N+1
.S YSDATA(N)="7773^9999;1^"_YSSE,N=N+1
.S YSDATA(N)="7774^9999;1^"_YSLS,N=N+1
.S YSDATA(N)="7775^9999;1^"_YSBF,N=N+1
.S YSDATA(N)="7776^9999;1^"_YSOW,N=N+1
.S YSDATA(N)="7777^9999;1^"_YSNP,N=N+1
.S YSDATA(N)="7778^9999;1^"_YSSP,N=N+1
.S YSDATA(N)="7779^9999;1^"_YSAE,N=N+1
;
I $L($T(SPECIAL^YTQAPI2D)) D SPECIAL^YTQAPI2D(TSTNM,.YSDATA,N,.YSAD,.YSTSTN)
Q
;
;************************************************************************
; ADD ADDITONAL INSTRUMENT LOGIC ABOVE THE FIRST *** LINE
;************************************************************************
;
YSARRAY(YSARRAY) ;
N II,YSVAL,YSCALEI,YSKEYI,G,YSQN,YSAI,YSAN,YSTARG
K YSARRAY
S II=1
F I=2:1 Q:'$D(^TMP($J,"YSG",I)) I ^TMP($J,"YSG",I)?1"Scale".E D
. 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))
..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 YSARRAY(II)=YSVAL,II=II+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI2C 9223 printed Jan 18, 2025@03:19:23 Page 2
YTQAPI2C ;SLC/BLD- MHAX ANSWERS SPECIAL HANDLING #2 ;2/7/2018 17:35
+1 ;;5.01;MENTAL HEALTH;**136,139,250**;Dec 30, 1994;Build 26
+2 ;
+3 ; This routine was split from YTQAPI2A.
+4 ; This routine handles limited complex reporting requirements without
+5 ; modifying YS_AUX.DLL by adding free text "answers" that can be used by
+6 ; a report.
+7 ;,
+8 ; Assumptions: EDIT incomplete instrument should ignore the extra answers
+9 ; since there are no associated questions. GRAPHING should ignore the
+10 ; answers since they not numeric.
+11 ;
SPECIAL(TSTNM,YSDATA,N,YSAD,YSTSTN) ; add "hidden" computed question text
+1 NEW ANSWER,DEPSCORE,IEN,KEY,LP,PCT,PTSD,SATTSCORE,SCORES,SCRE,SUCSCORE,SUISCORE,SWHENSCORES,TEXT,TEXT1,TEXT2
+2 NEW TEXT2A,TEXT2B,TOT,YSCORE,YSCREC,SUISCRN,ALLQUES,POSTXT1,POSTXT2,QUE1621,QUE67,QUE915,YSBPRS
+3 ;
+4 ;bld/dsb 4/19/2018 Complex Reporting for BPRS-A
+5 IF TSTNM="BPRS-A"
Begin DoDot:1
+6 NEW LP,TOT,YSCORE,TOTARRAY,TOTDIST,TOTANX,TOTPARNA,TOTWITH,TOTPATH,YSBPRS
+7 SET TOT=0
SET TOTARRAY=""
SET YSCORE=""
SET II=1
+8 DO GETSCORE^YTQAPI8(.YSCORE,.YS)
+9 IF ^TMP($JOB,"YSCOR",1)'="[DATA]"
QUIT
+10 FOR I=3:1
if '$DATA(YSDATA(I))
QUIT
SET YSBPRS(I-2)=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")
+11 ;D YSARRAY(.YSBPRS)
+12 ;Thinking Disturbance
SET TOTDIST=YSBPRS(4)+(YSBPRS(12))+YSBPRS(15)
+13 ;Anxious Depression
SET TOTANX=YSBPRS(2)+(YSBPRS(5))+YSBPRS(9)
+14 ;Paranoid Disturbances
SET TOTPARNA=YSBPRS(10)+(YSBPRS(11))+YSBPRS(14)
+15 ;Withdrawal Retardation
SET TOTWITH=YSBPRS(3)+(YSBPRS(13))+YSBPRS(16)
+16 ;TOTAL PATHOLOGY SCORE
FOR I=1:1:16
SET TOTPATH=$GET(TOTPATH)+YSBPRS(I)
+17 SET YSDATA(N)="7771^9999;1^"_TOTDIST
SET N=N+1
+18 SET YSDATA(N)="7772^9999;1^"_TOTANX
SET N=N+1
+19 SET YSDATA(N)="7773^9999;1^"_TOTPARNA
SET N=N+1
+20 SET YSDATA(N)="7774^9999;1^"_TOTWITH
SET N=N+1
+21 SET YSDATA(N)="7775^9999;1^"_TOTPATH
SET N=N+1
+22 SET YSDATA(N)="7776^9999;1^"_"In the past week."
SET N=N+1
+23 QUIT
End DoDot:1
QUIT
+24 ;
+25 ;bld 4/19/2018 logic for PSS-3 2nd Report
+26 ;
+27 IF TSTNM="PSS-3 2ND"
Begin DoDot:1
+28 NEW I,OLDN,SCORE,SC,TEXT,QNBR,QNBRTXT,QNBR,POSTXT,LEN,LSTQNBR,QUENBR,TMP,POSTXT1,POSTXT2,POSTXT3,YSARRY
+29 SET N=N+1
SET OLDN=N
+30 DO GETSCORE^YTQAPI8(.YSCORE,.YS)
+31 IF ^TMP($JOB,"YSCOR",1)'="[DATA]"
QUIT
+32 DO YSARRAY(.YSARRY)
+33 MERGE TMP=^TMP($JOB,"YSCOR")
+34 SET POSTXT1="Presence of one or more Positive Indicators means that, in addition "
+35 SET POSTXT2="to any immediate suicide safety measures, the treating provider "
+36 SET POSTXT3="should consider consulting a mental health professional.|'Yes' indicates a positive response. 'No' indicates a negative response."
+37 ;
+38 SET QUENBR=7771
+39 FOR I=1:1:7
SET SCORE=$SELECT($GET(SCORE)="":$PIECE(TMP(I),"=",2),1:SCORE_"^"_$PIECE(TMP(I),"=",2))
+40 SET YSDATA(N)="7780^9999;1^"_POSTXT1
SET N=N+1
+41 SET YSDATA(N)="7781^9999;1^"_POSTXT2
SET N=N+1
+42 SET YSDATA(N)="7782^9999;1^"_POSTXT3
SET N=N+1
+43 ;QUESTION 1
IF $PIECE(SCORE,U,1)=1
SET YSDATA(N)=QUENBR_"^9999;1^Active suicide ideation |with a past attempt."
SET N=N+1
SET QUENBR=QUENBR+1
+44 ;QUESTION 2
IF $PIECE(SCORE,U,2)=1
SET YSDATA(N)=QUENBR_"^9999;1^Has or recently begun a suicide plan."
SET N=N+1
SET QUENBR=QUENBR+1
+45 ;QUESTION 3
IF $PIECE(SCORE,U,3)=1
SET YSDATA(N)=QUENBR_"^9999;1^Reports recent intent to act on suicidal ideation."
SET N=N+1
SET QUENBR=QUENBR+1
+46 ;QUESTION 4
IF $PIECE(SCORE,U,4)=1
SET YSDATA(N)=QUENBR_"^9999;1^Has a past psychiatric hospitalization."
SET N=N+1
SET QUENBR=QUENBR+1
+47 ;QUESTION 5
IF $PIECE(SCORE,U,5)=1
SET YSDATA(N)=QUENBR_"^9999;1^Has a pattern of excessive substance use."
SET N=N+1
SET QUENBR=QUENBR+1
+48 ;QUESTION 6
IF $PIECE(SCORE,U,6)=1
SET YSDATA(N)=QUENBR_"^9999;1^Currently presents with irritable, agitated, and/or aggressive behavior."
SET N=N+1
SET QUENBR=QUENBR+1
+49 IF SCORE'[1
SET YSDATA(N)=QUENBR_"^9999;1^None"
SET N=N+1
SET QUENBR=QUENBR+1
+50 SET SC=""
FOR I=1:1:6
IF $PIECE(SCORE,"^",I)>2
SET SC=$SELECT($GET(SC)="":$PIECE(SCORE,"^",I),1:SC_"^"_$PIECE(SCORE,"^",I))
SET SC(I)=$PIECE(SCORE,"^",I)
+51 SET LEN=$SELECT($GET(SC)="":0,1:$LENGTH(SC,"^"))
+52 SET TEXT=": The response was either Refused or Unable to Complete."
+53 ;
+54 IF LEN>0
Begin DoDot:2
+55 SET QUENBR=7778
+56 SET QNBR=""
SET LSTQNBR=$ORDER(SC(QNBR),-1)
+57 FOR I=1:1:LSTQNBR
SET QNBR=$ORDER(SC(QNBR))
if 'QNBR
QUIT
Begin DoDot:3
+58 SET QNBRTXT=$SELECT($GET(QNBRTXT)="":QNBR,QNBR'=LSTQNBR:QNBRTXT_", "_QNBR,1:QNBRTXT_" and "_QNBR)
End DoDot:3
if ('$DATA(SC(QNBR)))!(QNBR>LSTQNBR)
QUIT
+59 ;
+60 SET YSDATA(N)=QUENBR_"^9999;1^Question "_QNBRTXT_TEXT
End DoDot:2
End DoDot:1
QUIT
+61 ;
+62 IF TSTNM="PCL-5 WEEKLY"
Begin DoDot:1
+63 QUIT
+64 NEW OLDN,QUE15,QUE67,QUE915,QUE1621,CLUSTERB,CLUSTERC,CLUSTERD,CLUSTERE,TOTAL
+65 SET N=N+1
+66 DO GETSCORE^YTQAPI8(.YSCORE,.YS)
+67 IF ^TMP($JOB,"YSCOR",1)'="[DATA]"
QUIT
+68 MERGE TMP=^TMP($JOB,"YSCOR")
+69 SET CLUSTERB=$PIECE(^TMP($JOB,"YSCOR",3),"=",2)
+70 SET CLUSTERC=$PIECE(^TMP($JOB,"YSCOR",4),"=",2)
+71 SET CLUSTERD=$PIECE(^TMP($JOB,"YSCOR",5),"=",2)
+72 SET CLUSTERE=$PIECE(^TMP($JOB,"YSCOR",6),"=",2)
+73 SET TOTAL=CLUSTERB+CLUSTERC+CLUSTERD+CLUSTERE
+74 SET YSDATA(N)="7771^9999;1^"_TOTAL
SET N=N+1
+75 SET YSDATA(N)="7772^9999;1^"_CLUSTERB
SET N=N+1
+76 SET YSDATA(N)="7773^9999;1^"_CLUSTERC
SET N=N+1
+77 SET YSDATA(N)="7774^9999;1^"_CLUSTERD
SET N=N+1
+78 SET YSDATA(N)="7775^9999;1^"_CLUSTERE
SET N=N+1
End DoDot:1
QUIT
+79 ;
+80 ;Heavness in Smoking Index
+81 IF TSTNM="HSI"
Begin DoDot:1
+82 NEW QUE1,QUE2,ANS1,TXT1,TXT2,TXT3,DEPENCE,INDEX,SAMPLE1,SAMPLE2,SCOREINFO
+83 SET N=N+1
+84 DO GETSCORE^YTQAPI8(.YSCORE,.YS)
+85 IF ^TMP($JOB,"YSCOR",1)'="[DATA]"
QUIT
+86 MERGE TMP=^TMP($JOB,"YSCOR")
+87 SET ANS1=$PIECE(TMP(2),"=",2)
+88 SET TOT=ANS1
+89 SET SAMPLE1=5
SET SAMPLE2="""high"""
+90 SET DEPENCE=$SELECT(TOT=0:"NO nicotine dependence",12[TOT:"LOW nicotine dependence",34[TOT:"MODERATE nicotine dependence",1:"HIGH nicotine dependence")
+91 SET TXT1="("_TOT_" represents the sum of points for each question and "_DEPENCE
+92 SET TXT2="is the associated dependence level for that score from below, e.g., a Nicotine"
+93 SET TXT3=" Dependence Score of """_SAMPLE1_""""_" would indicate "_SAMPLE2_" nicotine dependence.)"
+94 SET SCOREINFO=TXT1_TXT2
+95 SET INDEX="HEAVINESS OF SMOKING INDEX: "_TOT_" indicating "_DEPENCE
+96 SET YSDATA(N)="7771^9999;1^"_INDEX
SET N=N+1
+97 SET YSDATA(N)="7772^9999;1^"_TXT1
SET N=N+1
+98 SET YSDATA(N)="7773^9999;1^"_TXT2
SET N=N+1
+99 SET YSDATA(N)="7774^9999:1^"_TXT3
SET N=N+1
End DoDot:1
QUIT
+100 ;
+101 IF TSTNM="WEMWBS"
Begin DoDot:1
+102 NEW I,SCORE,TEXT
+103 SET N=N+1
SET SCORE=0
+104 DO GETSCORE^YTQAPI8(.YSCORE,.YS)
+105 IF ^TMP($JOB,"YSCOR",1)'="[DATA]"
QUIT
+106 MERGE TMP=^TMP($JOB,"YSCOR")
+107 SET SCORE=$PIECE(^TMP($JOB,"YSCOR",2),"=",2)
+108 SET TEXT="WEMWBS Total Score: "
SET TEXT=TEXT_SCORE
+109 SET YSDATA(N)="7771^9999;1^"_TEXT
End DoDot:1
QUIT
+110 ;
+111 ;
+112 IF TSTNM="MHRM"
Begin DoDot:1
+113 NEW I,SCORE,TEXT,YSTOTAL,YSMHRM,II,YSCALEI,YSKEYI,YSQN,YSTARG,YSVAL,YSAI,YSAN,YSOS,YSSE,YSLS,YSBF,YSOW,YSNP,YSSP,YSAE,G
+114 SET N=N+1
SET SCORE=0
SET II=1
SET YSTOTAL=0
+115 SET (YSOS,YSSE,YSLS,YSBF,YSOW,YSNP,YSSP,YSAE)=0
+116 DO GETSCORE^YTQAPI8(.YSCORE,.YS)
+117 FOR I=2:1
if '$DATA(^TMP($JOB,"YSG",I))
QUIT
IF ^TMP($JOB,"YSG",I)?1"Scale".E
Begin DoDot:2
+118 SET YSCALEI=$PIECE(^TMP($JOB,"YSG",I),U)
SET YSCALEI=$PIECE(YSCALEI,"=",2)
+119 SET YSKEYI=0
FOR
SET YSKEYI=$ORDER(^YTT(601.91,"AC",YSCALEI,YSKEYI))
if YSKEYI'>0
QUIT
Begin DoDot:3
+120 SET G=^YTT(601.91,YSKEYI,0)
+121 SET YSQN=$PIECE(G,U,3)
SET YSTARG=$PIECE(G,U,4)
SET YSVAL=$PIECE(G,U,5)
+122 SET YSAI=$ORDER(^YTT(601.85,"AC",YSAD,YSQN,0))
+123 if YSAI'>0
QUIT
+124 if '$DATA(^YTT(601.85,YSAI,0))
QUIT
+125 SET YSAN=""
+126 IF $DATA(^YTT(601.85,YSAI,1,1,0))
SET YSAN=^YTT(601.85,YSAI,1,1,0)
+127 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))
+128 ;S ^TMP($J,"TEST",II,YSQN,YSAN,YSTARG)=YSVAL
IF YSAN=YSTARG
SET YSMHRM(II)=YSVAL
SET II=II+1
End DoDot:3
End DoDot:2
+129 ;
+130 ;Overcoming Stuckness
FOR I=1:1:4
SET YSOS=YSOS+$GET(YSMHRM(I))
+131 ;Self-Empowerment
FOR I=5:1:8
SET YSSE=YSSE+$GET(YSMHRM(I))
+132 ;Learning and Self-redefinition
FOR I=9:1:12
SET YSLS=YSLS+$GET(YSMHRM(I))
+133 ;Basic Functioning
FOR I=13:1:16
SET YSBF=YSBF+$GET(YSMHRM(I))
+134 ;Overall Well Being
FOR I=17:1:20
SET YSOW=YSOW+$GET(YSMHRM(I))
+135 ;New Potentials
FOR I=21:1:24
SET YSNP=YSNP+$GET(YSMHRM(I))
+136 ;Spirituality
FOR I=25:1:26
SET YSSP=YSSP+$GET(YSMHRM(I))
+137 ;Advocacy/Enrichment
FOR I=27:1:30
SET YSAE=YSAE+$GET(YSMHRM(I))
+138 ;
+139 SET YSTOTAL=$PIECE(^TMP($JOB,"YSCOR",2),"=",2)
+140 SET YSDATA(N)="7771^9999;1^"_YSTOTAL
SET N=N+1
+141 SET YSDATA(N)="7772^9999;1^"_YSOS
SET N=N+1
+142 SET YSDATA(N)="7773^9999;1^"_YSSE
SET N=N+1
+143 SET YSDATA(N)="7774^9999;1^"_YSLS
SET N=N+1
+144 SET YSDATA(N)="7775^9999;1^"_YSBF
SET N=N+1
+145 SET YSDATA(N)="7776^9999;1^"_YSOW
SET N=N+1
+146 SET YSDATA(N)="7777^9999;1^"_YSNP
SET N=N+1
+147 SET YSDATA(N)="7778^9999;1^"_YSSP
SET N=N+1
+148 SET YSDATA(N)="7779^9999;1^"_YSAE
SET N=N+1
End DoDot:1
QUIT
+149 ;
+150 IF $LENGTH($TEXT(SPECIAL^YTQAPI2D))
DO SPECIAL^YTQAPI2D(TSTNM,.YSDATA,N,.YSAD,.YSTSTN)
+151 QUIT
+152 ;
+153 ;************************************************************************
+154 ; ADD ADDITONAL INSTRUMENT LOGIC ABOVE THE FIRST *** LINE
+155 ;************************************************************************
+156 ;
YSARRAY(YSARRAY) ;
+1 NEW II,YSVAL,YSCALEI,YSKEYI,G,YSQN,YSAI,YSAN,YSTARG
+2 KILL YSARRAY
+3 SET II=1
+4 FOR I=2:1
if '$DATA(^TMP($JOB,"YSG",I))
QUIT
IF ^TMP($JOB,"YSG",I)?1"Scale".E
Begin DoDot:1
+5 SET YSCALEI=$PIECE(^TMP($JOB,"YSG",I),U)
SET YSCALEI=$PIECE(YSCALEI,"=",2)
+6 SET YSKEYI=0
FOR
SET YSKEYI=$ORDER(^YTT(601.91,"AC",YSCALEI,YSKEYI))
if YSKEYI'>0
QUIT
Begin DoDot:2
+7 SET G=^YTT(601.91,YSKEYI,0)
+8 SET YSQN=$PIECE(G,U,3)
SET YSTARG=$PIECE(G,U,4)
SET YSVAL=$PIECE(G,U,5)
+9 SET YSAI=$ORDER(^YTT(601.85,"AC",YSAD,YSQN,0))
+10 if YSAI'>0
QUIT
+11 if '$DATA(^YTT(601.85,YSAI,0))
QUIT
+12 SET YSAN=""
+13 IF $DATA(^YTT(601.85,YSAI,1,1,0))
SET YSAN=^YTT(601.85,YSAI,1,1,0)
+14 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))
+15 IF YSAN=YSTARG
SET YSARRAY(II)=YSVAL
SET II=II+1
End DoDot:2
End DoDot:1
+16 QUIT
