- YTSMIOSB ;SLC/KCM - Score MIOS+B-IPF ; 10/14/18 2:02pm
- ;;5.01;MENTAL HEALTH;**218**;Dec 30, 1994;Build 9
- ;
- DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
- ; input
- ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
- ; YSDATA(2+n)=questionId^sequence^choiceId
- ; YS("AD")=adminId
- ; YSTRNG=1 for score, 2 for report
- ; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
- ; output if YSTRNG=2: append special "answers" to YSDATA
- ;
- I YSTRNG=1 D SCORESV
- I YSTRNG=2 D
- . N SCOREVAL,CHKTXT,N
- . D LDSCORES^YTSCORE(.YSDATA,.YS) ; puts score into ^TMP($J,"YSCOR",2)
- . D REPORT(.SCOREVAL,.CHKTXT)
- . S N=$O(YSDATA(""),-1) ; get last node
- . S YSDATA(N+1)="7771^9999;1^"_SCOREVAL
- . S YSDATA(N+2)="7772^9999;1^"_CHKTXT
- Q
- ;
- SCORESV ; calculate the score
- ; expects YSDATA from DLLSTR
- N I,J,QSTN,QCNT,CID,TOTAL,SHAME,TRUST,BIPF
- S I=2,QCNT=0 F S I=$O(YSDATA(I)) Q:'I D
- . S CID=$P(YSDATA(I),U,3) Q:'CID ; skip checkbox question (no CID)
- . I CID=1155!(CID=1156)!(CID=1157) Q ; don't include skipped questions
- . S QSTN($P(YSDATA(I),U))=$P($G(^YTT(601.75,CID,0)),U,2),QCNT=QCNT+1
- ;
- I QSTN(8922)=0,(QCNT<14) D ; special case -- (if 1st question negative)
- . S TOTAL=""
- . S SHAME=""
- . S TRUST=""
- . S BIPF=""
- E D ; normal cases --
- . S TOTAL=$$SUM(.QSTN,"8924,8925,8926,8927,8928,8929,8930,8931,8932,8933,8934,8935,8936,8937")
- . S SHAME=$$SUM(.QSTN,"8924,8926,8930,8931,8935,8936,8937") ; Questions 1,3,7,8,12,13,14
- . S TRUST=$$SUM(.QSTN,"8925,8927,8928,8929,8932,8933,8934") ; Questions 2,4,5,6,9,10,11
- . S BIPF=$$BIPF(.QSTN,"8938,8939,8940,8941,8942,8943,8944,8945,8946") ; B-IPF questions
- ;
- ; set scores into ^TMP($J,"YSCOR",n)=scaleId=rawScore^tScore
- 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"
- ;
- N SCLID,SCLNM
- S ^TMP($J,"YSCOR",1)="[DATA]"
- S I=2,J=1 F S I=$O(^TMP($J,"YSG",I)) Q:'I D
- . S SCLID=+$P(^TMP($J,"YSG",I),"=",2)
- . S SCLNM=$P(^TMP($J,"YSG",I),U,4)
- . S J=J+1
- . I SCLID=1475 S ^TMP($J,"YSCOR",J)=SCLNM_"="_SHAME
- . I SCLID=1476 S ^TMP($J,"YSCOR",J)=SCLNM_"="_TRUST
- . I SCLID=1477 S ^TMP($J,"YSCOR",J)=SCLNM_"="_TOTAL
- . I SCLID=1479 S ^TMP($J,"YSCOR",J)=SCLNM_"="_BIPF
- Q
- SUM(QSTN,LIST) ; return sum for questions in LIST
- N I,QID,SUM
- S SUM=0
- F I=1:1:$L(LIST,",") S QID=$P(LIST,",",I) D Q:SUM<0
- . I '$D(QSTN(QID)) S SUM=-1 Q
- . I QSTN(QID)="" S SUM=-1 Q
- . S SUM=SUM+QSTN(QID)
- Q $S(SUM<0:"",1:SUM)
- ;
- BIPF(QSTN,LIST) ; return the B-IPF score from questions in LIST
- ; expects YSDATA
- N I,QID,SUM,CNT
- S SUM=0,CNT=0
- F I=1:1:$L(LIST,",") S QID=$P(LIST,",",I) D Q:SUM<0
- . Q:'$D(QSTN(QID)) ; skipped questions aren't in array
- . Q:QSTN(QID)=99 ; not applicable (N/A) value is 99 (CHC=5508)
- . S CNT=CNT+1,SUM=SUM+QSTN(QID)
- ; score is (raw score / maximum given number answered) * 100
- I CNT=0 Q "" ; everything skipped or N/A
- Q $FN((SUM/(CNT*6))*100,"",0)
- ;
- REPORT(SCORES,CHKTXT) ; build the scoring display for the report
- ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
- ; YSDATA from DLLSTR
- ; YSDATA(2+n)=questionId^sequence^choiceId or text response
- N I,X,NAME,VALUE,TOTAL,SHAME,TRUST,BIPF
- S I=0 F S I=$O(^TMP($J,"YSCOR",I)) Q:'I D
- . S NAME=$P(^TMP($J,"YSCOR",I),"=")
- . S VALUE=$P(^TMP($J,"YSCOR",I),"=",2)
- . I NAME="Shame-related Outcomes" S SHAME=VALUE
- . I NAME="Trust Violation-related Outcomes" S TRUST=VALUE
- . I NAME="MIOS Total" S TOTAL=VALUE
- . I NAME="B-IPF Total" S BIPF=VALUE
- ;
- ; split the checkboxes selected into separate lines <*Answer_8923*>
- S X="",CHKTXT=""
- S I=2 F S I=$O(YSDATA(I)) Q:'I D Q:$L(CHKTXT)
- . I $P(YSDATA(I),U)'=8923 Q
- . S X=X_$P(YSDATA(I),U,3,99)
- I +X=1155 S CHKTXT="| SKIPPED"
- I +X=1156 S CHKTXT="| Not asked (due to responses to other questions)"
- I +X=1157 S CHKTXT="| Skipped but required"
- I CHKTXT="" D
- . I X["1. (A" S CHKTXT=$$WRAP^YTSCAT($G(^YTT(601.75,5493,1)),70,"| ")
- . I X["2. (B" S CHKTXT=CHKTXT_$$WRAP^YTSCAT($G(^YTT(601.75,5494,1)),70,"| ")
- . I X["3. (C" S CHKTXT=CHKTXT_$$WRAP^YTSCAT($G(^YTT(601.75,5495,1)),70,"| ")
- I CHKTXT="" S CHKTXT="| (No selections made)"
- ;
- S X=""
- ; special case -- if first question = NO, all others skipped
- I SHAME="",(TRUST=""),(TOTAL=""),(BIPF="") D QUIT
- . S X=X_"| No scores due to negative answer to the first question."
- . S X=X_"| (Have you had at least one experience like this = NO)"
- . S SCORES=X
- ; normal case
- S BIPF=$S(BIPF="":" no score",1:$J(BIPF,3)) ; ="" if all N/A
- S X=X_"| Shame-related Outcomes: "_$J(SHAME,3)
- S X=X_"| Trust Violation-related Outcomes: "_$J(TRUST,3)
- S X=X_"| MIOS Total: "_$J(TOTAL,3)
- S X=X_"| B-IPF Total: "_BIPF
- S X=X_"|"
- S X=X_"|Higher MIOS scores indicate greater levels of current moral injury."
- S X=X_"|Higher B-IPF scores indicate more functional impairment."
- S SCORES=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSMIOSB 5115 printed Feb 18, 2025@23:46:27 Page 2
- YTSMIOSB ;SLC/KCM - Score MIOS+B-IPF ; 10/14/18 2:02pm
- +1 ;;5.01;MENTAL HEALTH;**218**;Dec 30, 1994;Build 9
- +2 ;
- DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
- +1 ; input
- +2 ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
- +3 ; YSDATA(2+n)=questionId^sequence^choiceId
- +4 ; YS("AD")=adminId
- +5 ; YSTRNG=1 for score, 2 for report
- +6 ; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
- +7 ; output if YSTRNG=2: append special "answers" to YSDATA
- +8 ;
- +9 IF YSTRNG=1
- DO SCORESV
- +10 IF YSTRNG=2
- Begin DoDot:1
- +11 NEW SCOREVAL,CHKTXT,N
- +12 ; puts score into ^TMP($J,"YSCOR",2)
- DO LDSCORES^YTSCORE(.YSDATA,.YS)
- +13 DO REPORT(.SCOREVAL,.CHKTXT)
- +14 ; get last node
- SET N=$ORDER(YSDATA(""),-1)
- +15 SET YSDATA(N+1)="7771^9999;1^"_SCOREVAL
- +16 SET YSDATA(N+2)="7772^9999;1^"_CHKTXT
- End DoDot:1
- +17 QUIT
- +18 ;
- SCORESV ; calculate the score
- +1 ; expects YSDATA from DLLSTR
- +2 NEW I,J,QSTN,QCNT,CID,TOTAL,SHAME,TRUST,BIPF
- +3 SET I=2
- SET QCNT=0
- FOR
- SET I=$ORDER(YSDATA(I))
- if 'I
- QUIT
- Begin DoDot:1
- +4 ; skip checkbox question (no CID)
- SET CID=$PIECE(YSDATA(I),U,3)
- if 'CID
- QUIT
- +5 ; don't include skipped questions
- IF CID=1155!(CID=1156)!(CID=1157)
- QUIT
- +6 SET QSTN($PIECE(YSDATA(I),U))=$PIECE($GET(^YTT(601.75,CID,0)),U,2)
- SET QCNT=QCNT+1
- End DoDot:1
- +7 ;
- +8 ; special case -- (if 1st question negative)
- IF QSTN(8922)=0
- IF (QCNT<14)
- Begin DoDot:1
- +9 SET TOTAL=""
- +10 SET SHAME=""
- +11 SET TRUST=""
- +12 SET BIPF=""
- End DoDot:1
- +13 ; normal cases --
- IF '$TEST
- Begin DoDot:1
- +14 SET TOTAL=$$SUM(.QSTN,"8924,8925,8926,8927,8928,8929,8930,8931,8932,8933,8934,8935,8936,8937")
- +15 ; Questions 1,3,7,8,12,13,14
- SET SHAME=$$SUM(.QSTN,"8924,8926,8930,8931,8935,8936,8937")
- +16 ; Questions 2,4,5,6,9,10,11
- SET TRUST=$$SUM(.QSTN,"8925,8927,8928,8929,8932,8933,8934")
- +17 ; B-IPF questions
- SET BIPF=$$BIPF(.QSTN,"8938,8939,8940,8941,8942,8943,8944,8945,8946")
- End DoDot:1
- +18 ;
- +19 ; set scores into ^TMP($J,"YSCOR",n)=scaleId=rawScore^tScore
- +20 KILL ^TMP($JOB,"YSCOR")
- +21 ;-->out
- IF $DATA(^TMP($JOB,"YSG",1))
- IF ^TMP($JOB,"YSG",1)="[ERROR]"
- Begin DoDot:1
- +22 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
- +23 SET ^TMP($JOB,"YSCOR",2)="No Scale found for ADMIN"
- End DoDot:1
- QUIT
- +24 ;
- +25 NEW SCLID,SCLNM
- +26 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
- +27 SET I=2
- SET J=1
- FOR
- SET I=$ORDER(^TMP($JOB,"YSG",I))
- if 'I
- QUIT
- Begin DoDot:1
- +28 SET SCLID=+$PIECE(^TMP($JOB,"YSG",I),"=",2)
- +29 SET SCLNM=$PIECE(^TMP($JOB,"YSG",I),U,4)
- +30 SET J=J+1
- +31 IF SCLID=1475
- SET ^TMP($JOB,"YSCOR",J)=SCLNM_"="_SHAME
- +32 IF SCLID=1476
- SET ^TMP($JOB,"YSCOR",J)=SCLNM_"="_TRUST
- +33 IF SCLID=1477
- SET ^TMP($JOB,"YSCOR",J)=SCLNM_"="_TOTAL
- +34 IF SCLID=1479
- SET ^TMP($JOB,"YSCOR",J)=SCLNM_"="_BIPF
- End DoDot:1
- +35 QUIT
- SUM(QSTN,LIST) ; return sum for questions in LIST
- +1 NEW I,QID,SUM
- +2 SET SUM=0
- +3 FOR I=1:1:$LENGTH(LIST,",")
- SET QID=$PIECE(LIST,",",I)
- Begin DoDot:1
- +4 IF '$DATA(QSTN(QID))
- SET SUM=-1
- QUIT
- +5 IF QSTN(QID)=""
- SET SUM=-1
- QUIT
- +6 SET SUM=SUM+QSTN(QID)
- End DoDot:1
- if SUM<0
- QUIT
- +7 QUIT $SELECT(SUM<0:"",1:SUM)
- +8 ;
- BIPF(QSTN,LIST) ; return the B-IPF score from questions in LIST
- +1 ; expects YSDATA
- +2 NEW I,QID,SUM,CNT
- +3 SET SUM=0
- SET CNT=0
- +4 FOR I=1:1:$LENGTH(LIST,",")
- SET QID=$PIECE(LIST,",",I)
- Begin DoDot:1
- +5 ; skipped questions aren't in array
- if '$DATA(QSTN(QID))
- QUIT
- +6 ; not applicable (N/A) value is 99 (CHC=5508)
- if QSTN(QID)=99
- QUIT
- +7 SET CNT=CNT+1
- SET SUM=SUM+QSTN(QID)
- End DoDot:1
- if SUM<0
- QUIT
- +8 ; score is (raw score / maximum given number answered) * 100
- +9 ; everything skipped or N/A
- IF CNT=0
- QUIT ""
- +10 QUIT $FNUMBER((SUM/(CNT*6))*100,"",0)
- +11 ;
- REPORT(SCORES,CHKTXT) ; build the scoring display for the report
- +1 ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
- +2 ; YSDATA from DLLSTR
- +3 ; YSDATA(2+n)=questionId^sequence^choiceId or text response
- +4 NEW I,X,NAME,VALUE,TOTAL,SHAME,TRUST,BIPF
- +5 SET I=0
- FOR
- SET I=$ORDER(^TMP($JOB,"YSCOR",I))
- if 'I
- QUIT
- Begin DoDot:1
- +6 SET NAME=$PIECE(^TMP($JOB,"YSCOR",I),"=")
- +7 SET VALUE=$PIECE(^TMP($JOB,"YSCOR",I),"=",2)
- +8 IF NAME="Shame-related Outcomes"
- SET SHAME=VALUE
- +9 IF NAME="Trust Violation-related Outcomes"
- SET TRUST=VALUE
- +10 IF NAME="MIOS Total"
- SET TOTAL=VALUE
- +11 IF NAME="B-IPF Total"
- SET BIPF=VALUE
- End DoDot:1
- +12 ;
- +13 ; split the checkboxes selected into separate lines <*Answer_8923*>
- +14 SET X=""
- SET CHKTXT=""
- +15 SET I=2
- FOR
- SET I=$ORDER(YSDATA(I))
- if 'I
- QUIT
- Begin DoDot:1
- +16 IF $PIECE(YSDATA(I),U)'=8923
- QUIT
- +17 SET X=X_$PIECE(YSDATA(I),U,3,99)
- End DoDot:1
- if $LENGTH(CHKTXT)
- QUIT
- +18 IF +X=1155
- SET CHKTXT="| SKIPPED"
- +19 IF +X=1156
- SET CHKTXT="| Not asked (due to responses to other questions)"
- +20 IF +X=1157
- SET CHKTXT="| Skipped but required"
- +21 IF CHKTXT=""
- Begin DoDot:1
- +22 IF X["1. (A"
- SET CHKTXT=$$WRAP^YTSCAT($GET(^YTT(601.75,5493,1)),70,"| ")
- +23 IF X["2. (B"
- SET CHKTXT=CHKTXT_$$WRAP^YTSCAT($GET(^YTT(601.75,5494,1)),70,"| ")
- +24 IF X["3. (C"
- SET CHKTXT=CHKTXT_$$WRAP^YTSCAT($GET(^YTT(601.75,5495,1)),70,"| ")
- End DoDot:1
- +25 IF CHKTXT=""
- SET CHKTXT="| (No selections made)"
- +26 ;
- +27 SET X=""
- +28 ; special case -- if first question = NO, all others skipped
- +29 IF SHAME=""
- IF (TRUST="")
- IF (TOTAL="")
- IF (BIPF="")
- Begin DoDot:1
- +30 SET X=X_"| No scores due to negative answer to the first question."
- +31 SET X=X_"| (Have you had at least one experience like this = NO)"
- +32 SET SCORES=X
- End DoDot:1
- QUIT
- +33 ; normal case
- +34 ; ="" if all N/A
- SET BIPF=$SELECT(BIPF="":" no score",1:$JUSTIFY(BIPF,3))
- +35 SET X=X_"| Shame-related Outcomes: "_$JUSTIFY(SHAME,3)
- +36 SET X=X_"| Trust Violation-related Outcomes: "_$JUSTIFY(TRUST,3)
- +37 SET X=X_"| MIOS Total: "_$JUSTIFY(TOTAL,3)
- +38 SET X=X_"| B-IPF Total: "_BIPF
- +39 SET X=X_"|"
- +40 SET X=X_"|Higher MIOS scores indicate greater levels of current moral injury."
- +41 SET X=X_"|Higher B-IPF scores indicate more functional impairment."
- +42 SET SCORES=X
- +43 QUIT