Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTSCMIXG

YTSCMIXG.m

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