YTSCMIXG ;SLC/KCM - Score Case Mix Level ; 11/03/2020
;;5.01;MENTAL HEALTH;**174,187,238**;DEC 30,1994;Build 25
;
DLLSTR(YSDATA,YS,YSMODE) ; main tag for both scores and report text
;.YSDATA(1)=[DATA]
;.YSDATA(2)=adminId^dfn^testNm^dtGiven^complete
;.YSDATA(3..n)=questionId^sequence^choiceId
;.YS("AD")=adminId
;YSMODE=1 for calc score, 2 for report text
;
; if score, calculate based on answers in YSDATA, save in ^TMP($J,"YSCOR")
I YSMODE=1 D SCORE(.YSDATA) QUIT
; if report, build special text, add pseudo-question responses to YSDATA
I YSMODE=2 D REPORT(.YSDATA,.YS) QUIT
Q
SCORE(YSDATA) ; iterate through answers and calculate score
; looks like this is in every scoring routine...
; SCOREINS^YTSCORE sets up ^TMP($J,"YSG") with scales
; if no scales are defined, we can't score instrument
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"
; -- compute the ADL, then the Case Mix Level
N I,QID,CID,QSTN,ADL,ADLD,LVL,LVLNM,ADLNM
S I=2 F S I=$O(YSDATA(I)) Q:'I D
. S QID=$P(YSDATA(I),U),CID=$P(YSDATA(I),U,3)
. S QSTN(QID)=$$GET1^DIQ(601.75,CID_",",4,"I")
S ADLD=0 ; count ADL dependencies
I $G(QSTN(8535))>1 S ADLD=ADLD+1 ; Q1 Dependency: 2-4 Dressing
I $G(QSTN(8536))>1 S ADLD=ADLD+1 ; Q2 Dependency: 2-3 Grooming
I $G(QSTN(8537))>3 S ADLD=ADLD+1 ; Q3 Dependency: 4-5 Bathing
I $G(QSTN(8538))>1 S ADLD=ADLD+1 ; Q4 Dependency: 2-4 Eating
I $G(QSTN(8539))>1 S ADLD=ADLD+1 ; Q5 Dependency: 2-3 Bed Mobility*
I $G(QSTN(8540))>1 S ADLD=ADLD+1 ; Q6 Dependency: 2-4 Transferring*
I $G(QSTN(8541))>1 S ADLD=ADLD+1 ; Q7 Dependency: 2-4 Walking
I $G(QSTN(8544))>0 S ADLD=ADLD+1 ;Q10 Dependency: 1-7 Toileting*
S ADL=$S(ADLD<4:"Low",((ADLD>3)&(ADLD<7)):"Medium",ADLD>6:"High")
S LVL=$$LEVEL(.QSTN,ADL,ADLD)
; store the scores as numeric as required by MH RESULTS
S LVLNM=$P(^YTT(601.87,1352,0),U,4) ; 1352 is case mix level
S ADLNM=$P(^YTT(601.87,1353,0),U,4) ; 1353 is number of ADL dependencies
S ^TMP($J,"YSCOR",1)="[DATA]"
S ^TMP($J,"YSCOR",2)=LVLNM_"="_$S($L(LVL):$A(LVL)-64,1:0)
S ^TMP($J,"YSCOR",3)=ADLNM_"="_ADLD
Q
LEVEL(QSTN,ADL,ADLD) ; Return Case Mix Level given questions(.QSTN) and ADL score
N Q4,Q5,Q6,Q8,Q10,Q13,Q14,Q15
S Q4=$G(QSTN(8538)) ; Eating
S Q5=$G(QSTN(8539)) ; Bed Mobility
S Q6=$G(QSTN(8540)) ; Transferring
S Q8=$G(QSTN(8542)) ; Behavior
S Q10=$G(QSTN(8544)) ; Toileting
S Q13=$G(QSTN(8547)) ; Special Treatments
S Q14=$G(QSTN(8549)) ; Clinical Monitoring
S Q15=$G(QSTN(8550)) ; Special Nursing
;
; B: special nursing with tubefeedsing or treatments & monitoring
N SPNURS S SPNURS=0
I ((Q13=1)!(Q13=2))&(Q14=2) S SPNURS=1
I SPNURS,(ADL="Low") Q "C"
I SPNURS,(ADL="Medium") Q "F"
I SPNURS,(ADL="High") Q "K"
;
; C: behavioral consideration for low & medium
I ADL="Low",(Q8>1) Q "B"
I ADL="Medium",(Q8>1) Q "E"
;
; D: low and medium ADL without special nursing or behavior
; (Q5=Bed Mobility, Q6=Transferring, Q10=Toileting, Q8=Behavior)
N CRIT S CRIT=0 I (Q5>1)!(Q6>1)!(Q10>0) S CRIT=1
I ADLD<3,(Q8<2),'CRIT Q "L"
I ADL="Low",(Q8<2) Q "A"
I ADL="Medium",(Q8<2) Q "D"
;
; E: high ADL without special nursing (Q4=Eating, Q8=Behavior)
I ADLD>6,(Q4<3),(Q8<2) Q "G"
I ADLD>6,(Q4<3),(Q8>1) Q "H"
I ADLD>6,(Q4>2),(Q8<3),'$$NEUROICD Q "I"
I ADLD>6,(Q4>2),((Q8>2)!$$NEUROICD) Q "J"
Q ""
;
NEUROICD() ; Return 1 if any applicable neurodiagnoses present
; expects QSTN from LEVEL
Q +$G(QSTN(8551)) ; Q16 -- Neuromuscular Diagnosis
;
; the following currently inactive code uses a clinical reminders taxonomy
; expects YS("AD") as adminId
;N YTDFN,YTRMDR,YTFNDG
;S YTDFN=$P(^YTT(601.84,YS("AD"),0),U,2) Q:'YTDFN 0
;S YTRMDR=$$FIND1^DIC(811.9,"","BX","CASE MIX NEURO") Q:'YTRMDR 0
;D FIDATA^PXRM(YTDFN,YTRMDR,.YTFNDG)
;Q ($G(YTFNDG(1))>0)
;
REPORT(YSDATA,YS) ; add textual scores to report
; at this point YTQRRPT has already called GETSCORE^YTQAPI8 so
; ^TMP($J,"YSCOR") is defined and we're in the middle of ALLANS^YTQAPI2
; YSDATA(2+n)=questionId^sequence^choiceId or text response
N I,LVLNM,ADLNM,LVL,ADLD,ADL,STXT,QTXT,SPTX,QID,CID,NUM,LEG,CTXT
S LVLNM=$P(^YTT(601.87,1352,0),U,4) ; 1352 is case mix level
S ADLNM=$P(^YTT(601.87,1353,0),U,4) ; 1353 is number of ADL dependencies
S I=0 F S I=$O(^TMP($J,"YSCOR",I)) Q:'I D
. I $P(^TMP($J,"YSCOR",I),"=")=LVLNM S LVL=$P(^TMP($J,"YSCOR",I),"=",2)
. I $P(^TMP($J,"YSCOR",I),"=")=ADLNM S ADLD=$P(^TMP($J,"YSCOR",I),"=",2)
S ADL=$S(((+ADLD=ADLD)&(ADLD<4)):"Low",((ADLD>3)&(ADLD<7)):"Medium",ADLD>6:"High",1:"Unknown")
S LVL=$S(LVL>0:$C(LVL+64),1:"Unknown")
S STXT=" Case Mix Level: "_LVL_"| ADL Category: "_ADL_" |"
S QTXT="",SPTX="" ; question text & special treatments (Q13a)
S I=2 F S I=$O(YSDATA(I)) Q:'I D
. S QID=$P(YSDATA(I),U),CID=$P(YSDATA(I),U,3)
. Q:QID>8549 ; handle Q1 thru Q14, remaining are in template
. I QID=8548 S:CID'=1156 SPTX=CID Q ; get checkbox text & quit
. S NUM=+$P($P(^YTT(601.76,QID,0),U,5),"Q",2) ; question number
. S LEG=$P(^YTT(601.75,CID,0),U,2) ; legacy value (score)
. S CTXT=$TR(^YTT(601.75,CID,1),"?",".") ; choice text as stmt
. I $E(CTXT,1,2)="* " S CTXT=$E(CTXT,3,$L(CTXT)) ; * already added to LEG
. I $L(CTXT)>69 S CTXT=$$WRAP(CTXT,68) ; wrap longer choices
. ; mark dependencies
. I QID<8543,(QID'=8537),(LEG>1) S LEG="*"_LEG ; Q1-Q8, except Q3
. I QID=8537,(LEG>3) S LEG="*"_LEG ; Q3 (bathing)
. I QID=8544,(LEG>0) S LEG="*"_LEG ; Q10 (toileting)
. ; set up question, score, & response
. S LEG=$S($L(LEG)=2:LEG,1:" "_LEG)
. S QTXT(NUM)=$P($T(QUESTIONS+NUM),";;",2)_" "_LEG_" "_CTXT
I $L(SPTX) D ; add special tx if any
. S SPTX="One or more TX such as: "_SPTX
. I $L(SPTX)>69 S SPTX=$$WRAP(SPTX,68)
. S QTXT(13)=QTXT(13)_$P(SPTX,"One or more TX such as:",2)
F I=1:1:14 S QTXT=QTXT_QTXT(I) ; make one string
S I=$O(YSDATA(""),-1)+1
S YSDATA(I)="7771^9999;1^"_STXT ; scoring text
S YSDATA(I+1)="7772^9999;1^"_QTXT ; question text (1-14)
Q
WRAP(IN,MAX) ; Return with | and spacing in correct place
N X,I,J,TXT,WORD
S J=1,TXT(J)=$P(IN," ")
F I=2:1:$L(IN," ") S WORD=$P(IN," ",I) D
. I ($L(TXT(J))+$L(WORD)+1)<MAX S TXT(J)=TXT(J)_" "_WORD I 1
. E S J=J+1,TXT(J)=WORD
S X=TXT(1),I=1 F S I=$O(TXT(I)) Q:'I S X=X_"| "_TXT(I)
Q X
;
QUESTIONS ; question number and header text
;;|Q1. DRESSING|
;;|Q2. GROOMING|
;;|Q3. BATHING|
;;|Q4. EATING|
;;|Q5. BED MOBILITY|
;;|Q6. TRANSFERRING|
;;|Q7. WALKING|
;;|Q8. BEHAVIOR|
;;|Q9. COMMUNICATION|
;;|Q10. TOILETING|
;;|Q11. MDS HC 2.0/CPS Cognitive Skill for Daily Decision Making|
;;|Q12. MDS 2.0/CPS: Short Term Memory (recall of what was learned or known)|
;;|Q13. SPECIAL TREATMENTS|
;;|Q14. CLINICAL MONITORING|
;;zzzzz
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSCMIXG 7121 printed Oct 16, 2024@18:20:16 Page 2
YTSCMIXG ;SLC/KCM - Score Case Mix Level ; 11/03/2020
+1 ;;5.01;MENTAL HEALTH;**174,187,238**;DEC 30,1994;Build 25
+2 ;
DLLSTR(YSDATA,YS,YSMODE) ; main tag for both scores and report text
+1 ;.YSDATA(1)=[DATA]
+2 ;.YSDATA(2)=adminId^dfn^testNm^dtGiven^complete
+3 ;.YSDATA(3..n)=questionId^sequence^choiceId
+4 ;.YS("AD")=adminId
+5 ;YSMODE=1 for calc score, 2 for report text
+6 ;
+7 ; if score, calculate based on answers in YSDATA, save in ^TMP($J,"YSCOR")
+8 IF YSMODE=1
DO SCORE(.YSDATA)
QUIT
+9 ; if report, build special text, add pseudo-question responses to YSDATA
+10 IF YSMODE=2
DO REPORT(.YSDATA,.YS)
QUIT
+11 QUIT
SCORE(YSDATA) ; iterate through answers and calculate score
+1 ; looks like this is in every scoring routine...
+2 ; SCOREINS^YTSCORE sets up ^TMP($J,"YSG") with scales
+3 ; if no scales are defined, we can't score instrument
+4 KILL ^TMP($JOB,"YSCOR")
+5 ;-->out
IF $DATA(^TMP($JOB,"YSG",1))
IF ^TMP($JOB,"YSG",1)="[ERROR]"
Begin DoDot:1
+6 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
+7 SET ^TMP($JOB,"YSCOR",2)="No Scale found for ADMIN"
End DoDot:1
QUIT
+8 ; -- compute the ADL, then the Case Mix Level
+9 NEW I,QID,CID,QSTN,ADL,ADLD,LVL,LVLNM,ADLNM
+10 SET I=2
FOR
SET I=$ORDER(YSDATA(I))
if 'I
QUIT
Begin DoDot:1
+11 SET QID=$PIECE(YSDATA(I),U)
SET CID=$PIECE(YSDATA(I),U,3)
+12 SET QSTN(QID)=$$GET1^DIQ(601.75,CID_",",4,"I")
End DoDot:1
+13 ; count ADL dependencies
SET ADLD=0
+14 ; Q1 Dependency: 2-4 Dressing
IF $GET(QSTN(8535))>1
SET ADLD=ADLD+1
+15 ; Q2 Dependency: 2-3 Grooming
IF $GET(QSTN(8536))>1
SET ADLD=ADLD+1
+16 ; Q3 Dependency: 4-5 Bathing
IF $GET(QSTN(8537))>3
SET ADLD=ADLD+1
+17 ; Q4 Dependency: 2-4 Eating
IF $GET(QSTN(8538))>1
SET ADLD=ADLD+1
+18 ; Q5 Dependency: 2-3 Bed Mobility*
IF $GET(QSTN(8539))>1
SET ADLD=ADLD+1
+19 ; Q6 Dependency: 2-4 Transferring*
IF $GET(QSTN(8540))>1
SET ADLD=ADLD+1
+20 ; Q7 Dependency: 2-4 Walking
IF $GET(QSTN(8541))>1
SET ADLD=ADLD+1
+21 ;Q10 Dependency: 1-7 Toileting*
IF $GET(QSTN(8544))>0
SET ADLD=ADLD+1
+22 SET ADL=$SELECT(ADLD<4:"Low",((ADLD>3)&(ADLD<7)):"Medium",ADLD>6:"High")
+23 SET LVL=$$LEVEL(.QSTN,ADL,ADLD)
+24 ; store the scores as numeric as required by MH RESULTS
+25 ; 1352 is case mix level
SET LVLNM=$PIECE(^YTT(601.87,1352,0),U,4)
+26 ; 1353 is number of ADL dependencies
SET ADLNM=$PIECE(^YTT(601.87,1353,0),U,4)
+27 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+28 SET ^TMP($JOB,"YSCOR",2)=LVLNM_"="_$SELECT($LENGTH(LVL):$ASCII(LVL)-64,1:0)
+29 SET ^TMP($JOB,"YSCOR",3)=ADLNM_"="_ADLD
+30 QUIT
LEVEL(QSTN,ADL,ADLD) ; Return Case Mix Level given questions(.QSTN) and ADL score
+1 NEW Q4,Q5,Q6,Q8,Q10,Q13,Q14,Q15
+2 ; Eating
SET Q4=$GET(QSTN(8538))
+3 ; Bed Mobility
SET Q5=$GET(QSTN(8539))
+4 ; Transferring
SET Q6=$GET(QSTN(8540))
+5 ; Behavior
SET Q8=$GET(QSTN(8542))
+6 ; Toileting
SET Q10=$GET(QSTN(8544))
+7 ; Special Treatments
SET Q13=$GET(QSTN(8547))
+8 ; Clinical Monitoring
SET Q14=$GET(QSTN(8549))
+9 ; Special Nursing
SET Q15=$GET(QSTN(8550))
+10 ;
+11 ; B: special nursing with tubefeedsing or treatments & monitoring
+12 NEW SPNURS
SET SPNURS=0
+13 IF ((Q13=1)!(Q13=2))&(Q14=2)
SET SPNURS=1
+14 IF SPNURS
IF (ADL="Low")
QUIT "C"
+15 IF SPNURS
IF (ADL="Medium")
QUIT "F"
+16 IF SPNURS
IF (ADL="High")
QUIT "K"
+17 ;
+18 ; C: behavioral consideration for low & medium
+19 IF ADL="Low"
IF (Q8>1)
QUIT "B"
+20 IF ADL="Medium"
IF (Q8>1)
QUIT "E"
+21 ;
+22 ; D: low and medium ADL without special nursing or behavior
+23 ; (Q5=Bed Mobility, Q6=Transferring, Q10=Toileting, Q8=Behavior)
+24 NEW CRIT
SET CRIT=0
IF (Q5>1)!(Q6>1)!(Q10>0)
SET CRIT=1
+25 IF ADLD<3
IF (Q8<2)
IF 'CRIT
QUIT "L"
+26 IF ADL="Low"
IF (Q8<2)
QUIT "A"
+27 IF ADL="Medium"
IF (Q8<2)
QUIT "D"
+28 ;
+29 ; E: high ADL without special nursing (Q4=Eating, Q8=Behavior)
+30 IF ADLD>6
IF (Q4<3)
IF (Q8<2)
QUIT "G"
+31 IF ADLD>6
IF (Q4<3)
IF (Q8>1)
QUIT "H"
+32 IF ADLD>6
IF (Q4>2)
IF (Q8<3)
IF '$$NEUROICD
QUIT "I"
+33 IF ADLD>6
IF (Q4>2)
IF ((Q8>2)!$$NEUROICD)
QUIT "J"
+34 QUIT ""
+35 ;
NEUROICD() ; Return 1 if any applicable neurodiagnoses present
+1 ; expects QSTN from LEVEL
+2 ; Q16 -- Neuromuscular Diagnosis
QUIT +$GET(QSTN(8551))
+3 ;
+4 ; the following currently inactive code uses a clinical reminders taxonomy
+5 ; expects YS("AD") as adminId
+6 ;N YTDFN,YTRMDR,YTFNDG
+7 ;S YTDFN=$P(^YTT(601.84,YS("AD"),0),U,2) Q:'YTDFN 0
+8 ;S YTRMDR=$$FIND1^DIC(811.9,"","BX","CASE MIX NEURO") Q:'YTRMDR 0
+9 ;D FIDATA^PXRM(YTDFN,YTRMDR,.YTFNDG)
+10 ;Q ($G(YTFNDG(1))>0)
+11 ;
REPORT(YSDATA,YS) ; add textual scores to report
+1 ; at this point YTQRRPT has already called GETSCORE^YTQAPI8 so
+2 ; ^TMP($J,"YSCOR") is defined and we're in the middle of ALLANS^YTQAPI2
+3 ; YSDATA(2+n)=questionId^sequence^choiceId or text response
+4 NEW I,LVLNM,ADLNM,LVL,ADLD,ADL,STXT,QTXT,SPTX,QID,CID,NUM,LEG,CTXT
+5 ; 1352 is case mix level
SET LVLNM=$PIECE(^YTT(601.87,1352,0),U,4)
+6 ; 1353 is number of ADL dependencies
SET ADLNM=$PIECE(^YTT(601.87,1353,0),U,4)
+7 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"YSCOR",I))
if 'I
QUIT
Begin DoDot:1
+8 IF $PIECE(^TMP($JOB,"YSCOR",I),"=")=LVLNM
SET LVL=$PIECE(^TMP($JOB,"YSCOR",I),"=",2)
+9 IF $PIECE(^TMP($JOB,"YSCOR",I),"=")=ADLNM
SET ADLD=$PIECE(^TMP($JOB,"YSCOR",I),"=",2)
End DoDot:1
+10 SET ADL=$SELECT(((+ADLD=ADLD)&(ADLD<4)):"Low",((ADLD>3)&(ADLD<7)):"Medium",ADLD>6:"High",1:"Unknown")
+11 SET LVL=$SELECT(LVL>0:$CHAR(LVL+64),1:"Unknown")
+12 SET STXT=" Case Mix Level: "_LVL_"| ADL Category: "_ADL_" |"
+13 ; question text & special treatments (Q13a)
SET QTXT=""
SET SPTX=""
+14 SET I=2
FOR
SET I=$ORDER(YSDATA(I))
if 'I
QUIT
Begin DoDot:1
+15 SET QID=$PIECE(YSDATA(I),U)
SET CID=$PIECE(YSDATA(I),U,3)
+16 ; handle Q1 thru Q14, remaining are in template
if QID>8549
QUIT
+17 ; get checkbox text & quit
IF QID=8548
if CID'=1156
SET SPTX=CID
QUIT
+18 ; question number
SET NUM=+$PIECE($PIECE(^YTT(601.76,QID,0),U,5),"Q",2)
+19 ; legacy value (score)
SET LEG=$PIECE(^YTT(601.75,CID,0),U,2)
+20 ; choice text as stmt
SET CTXT=$TRANSLATE(^YTT(601.75,CID,1),"?",".")
+21 ; * already added to LEG
IF $EXTRACT(CTXT,1,2)="* "
SET CTXT=$EXTRACT(CTXT,3,$LENGTH(CTXT))
+22 ; wrap longer choices
IF $LENGTH(CTXT)>69
SET CTXT=$$WRAP(CTXT,68)
+23 ; mark dependencies
+24 ; Q1-Q8, except Q3
IF QID<8543
IF (QID'=8537)
IF (LEG>1)
SET LEG="*"_LEG
+25 ; Q3 (bathing)
IF QID=8537
IF (LEG>3)
SET LEG="*"_LEG
+26 ; Q10 (toileting)
IF QID=8544
IF (LEG>0)
SET LEG="*"_LEG
+27 ; set up question, score, & response
+28 SET LEG=$SELECT($LENGTH(LEG)=2:LEG,1:" "_LEG)
+29 SET QTXT(NUM)=$PIECE($TEXT(QUESTIONS+NUM),";;",2)_" "_LEG_" "_CTXT
End DoDot:1
+30 ; add special tx if any
IF $LENGTH(SPTX)
Begin DoDot:1
+31 SET SPTX="One or more TX such as: "_SPTX
+32 IF $LENGTH(SPTX)>69
SET SPTX=$$WRAP(SPTX,68)
+33 SET QTXT(13)=QTXT(13)_$PIECE(SPTX,"One or more TX such as:",2)
End DoDot:1
+34 ; make one string
FOR I=1:1:14
SET QTXT=QTXT_QTXT(I)
+35 SET I=$ORDER(YSDATA(""),-1)+1
+36 ; scoring text
SET YSDATA(I)="7771^9999;1^"_STXT
+37 ; question text (1-14)
SET YSDATA(I+1)="7772^9999;1^"_QTXT
+38 QUIT
WRAP(IN,MAX) ; Return with | and spacing in correct place
+1 NEW X,I,J,TXT,WORD
+2 SET J=1
SET TXT(J)=$PIECE(IN," ")
+3 FOR I=2:1:$LENGTH(IN," ")
SET WORD=$PIECE(IN," ",I)
Begin DoDot:1
+4 IF ($LENGTH(TXT(J))+$LENGTH(WORD)+1)<MAX
SET TXT(J)=TXT(J)_" "_WORD
IF 1
+5 IF '$TEST
SET J=J+1
SET TXT(J)=WORD
End DoDot:1
+6 SET X=TXT(1)
SET I=1
FOR
SET I=$ORDER(TXT(I))
if 'I
QUIT
SET X=X_"| "_TXT(I)
+7 QUIT X
+8 ;
QUESTIONS ; question number and header text
+1 ;;|Q1. DRESSING|
+2 ;;|Q2. GROOMING|
+3 ;;|Q3. BATHING|
+4 ;;|Q4. EATING|
+5 ;;|Q5. BED MOBILITY|
+6 ;;|Q6. TRANSFERRING|
+7 ;;|Q7. WALKING|
+8 ;;|Q8. BEHAVIOR|
+9 ;;|Q9. COMMUNICATION|
+10 ;;|Q10. TOILETING|
+11 ;;|Q11. MDS HC 2.0/CPS Cognitive Skill for Daily Decision Making|
+12 ;;|Q12. MDS 2.0/CPS: Short Term Memory (recall of what was learned or known)|
+13 ;;|Q13. SPECIAL TREATMENTS|
+14 ;;|Q14. CLINICAL MONITORING|
+15 ;;zzzzz
