YTSNSI ;BAL/KTL - Report for NSI FOR TBI ;Mar 27, 2025@08:59:02
;;5.01;MENTAL HEALTH;**255**;Dec 30, 1994;Build 13
;
;
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
;
N YSN,YSTEXT
;
I YSTRNG=1 D BYKEY^YTSCORE(.YSDATA) ; just use "regular" scoring
;
I YSTRNG=2 D
. N SCOREVAL,N
. D LDSCORES^YTSCORE(.YSDATA,.YS) ; puts score into ^TMP($J,"YSCOR",2)
. D REPORT
Q
;
REPORT ; build the numerical answer array for the report
; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
; YSDATA from DLLSTR
; Question IEN = 9567-9588
; Answer array = 7771-7781
N YTI,YTRAW,YTCNT,YTCHC,YTQUE,YTANS,TMPYS,II
N YSTEXT
S YTRAW=0,YTCNT=0
S YTI=$O(YSDATA(""),-1)
S II=2 F S II=$O(YSDATA(II)) Q:'II D
. S YTQUE=$P(YSDATA(II),U)
. S YTCHC=$P(YSDATA(II),U,3)
. S YSTEXT=$G(^YTT(601.75,YTCHC,1))
. S YTANS=YTQUE-1796 ;e.g. 9567-1796=7771
. I (YTCHC=1155)!(YTCHC=1156)!(YTCHC=1157) D Q ; N/A or skipped
.. S YTI=YTI+1,TMPYS(YTI)=YTANS_"^9999;1^"_$S(YTCHC=1155:"Skipped",YTCHC=1156:"Not asked (due to responses on other questions)",1:"Missing")
. S YSTEXT=$$WRAP(YSTEXT,70," ")
. S YTI=YTI+1,TMPYS(YTI)=YTANS_"^9999;1^"_YSTEXT
M YSDATA=TMPYS
Q
;
WRAP(TX,MAX,IND) ; If length of TX > MAX, wrap by adding LF and INDent
N OUT,I,J,X,Y,YNEW,LF
S LF="|"
F I=1:1:$L(TX,LF) S X=$P(TX,LF,I) D
. I $L(X)'>MAX D ADDOUT(X) QUIT
. S Y=""
. F J=1:1:$L(X," ") D
. . S YNEW=Y_$S(J=1:"",1:" ")_$P(X," ",J)
. . I $L(YNEW)>MAX D ADDOUT(Y) S Y=$P(X," ",J) I 1
. . E S Y=YNEW
. D ADDOUT(Y) ; add any remaining
S X="",I=0 F S I=$O(OUT(I)) Q:'I S X=X_$S(I=1:"",1:LF_IND)_OUT(I)
Q X
;
ADDOUT(S) ; add string to out array (expects OUT)
S OUT=+$G(OUT)+1,OUT(OUT)=S
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSNSI 2086 printed Aug 26, 2025@22:36:19 Page 2
YTSNSI ;BAL/KTL - Report for NSI FOR TBI ;Mar 27, 2025@08:59:02
+1 ;;5.01;MENTAL HEALTH;**255**;Dec 30, 1994;Build 13
+2 ;
+3 ;
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 NEW YSN,YSTEXT
+10 ;
+11 ; just use "regular" scoring
IF YSTRNG=1
DO BYKEY^YTSCORE(.YSDATA)
+12 ;
+13 IF YSTRNG=2
Begin DoDot:1
+14 NEW SCOREVAL,N
+15 ; puts score into ^TMP($J,"YSCOR",2)
DO LDSCORES^YTSCORE(.YSDATA,.YS)
+16 DO REPORT
End DoDot:1
+17 QUIT
+18 ;
REPORT ; build the numerical answer array for the report
+1 ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
+2 ; YSDATA from DLLSTR
+3 ; Question IEN = 9567-9588
+4 ; Answer array = 7771-7781
+5 NEW YTI,YTRAW,YTCNT,YTCHC,YTQUE,YTANS,TMPYS,II
+6 NEW YSTEXT
+7 SET YTRAW=0
SET YTCNT=0
+8 SET YTI=$ORDER(YSDATA(""),-1)
+9 SET II=2
FOR
SET II=$ORDER(YSDATA(II))
if 'II
QUIT
Begin DoDot:1
+10 SET YTQUE=$PIECE(YSDATA(II),U)
+11 SET YTCHC=$PIECE(YSDATA(II),U,3)
+12 SET YSTEXT=$GET(^YTT(601.75,YTCHC,1))
+13 ;e.g. 9567-1796=7771
SET YTANS=YTQUE-1796
+14 ; N/A or skipped
IF (YTCHC=1155)!(YTCHC=1156)!(YTCHC=1157)
Begin DoDot:2
+15 SET YTI=YTI+1
SET TMPYS(YTI)=YTANS_"^9999;1^"_$SELECT(YTCHC=1155:"Skipped",YTCHC=1156:"Not asked (due to responses on other questions)",1:"Missing")
End DoDot:2
QUIT
+16 SET YSTEXT=$$WRAP(YSTEXT,70," ")
+17 SET YTI=YTI+1
SET TMPYS(YTI)=YTANS_"^9999;1^"_YSTEXT
End DoDot:1
+18 MERGE YSDATA=TMPYS
+19 QUIT
+20 ;
WRAP(TX,MAX,IND) ; If length of TX > MAX, wrap by adding LF and INDent
+1 NEW OUT,I,J,X,Y,YNEW,LF
+2 SET LF="|"
+3 FOR I=1:1:$LENGTH(TX,LF)
SET X=$PIECE(TX,LF,I)
Begin DoDot:1
+4 IF $LENGTH(X)'>MAX
DO ADDOUT(X)
QUIT
+5 SET Y=""
+6 FOR J=1:1:$LENGTH(X," ")
Begin DoDot:2
+7 SET YNEW=Y_$SELECT(J=1:"",1:" ")_$PIECE(X," ",J)
+8 IF $LENGTH(YNEW)>MAX
DO ADDOUT(Y)
SET Y=$PIECE(X," ",J)
IF 1
+9 IF '$TEST
SET Y=YNEW
End DoDot:2
+10 ; add any remaining
DO ADDOUT(Y)
End DoDot:1
+11 SET X=""
SET I=0
FOR
SET I=$ORDER(OUT(I))
if 'I
QUIT
SET X=X_$SELECT(I=1:"",1:LF_IND)_OUT(I)
+12 QUIT X
+13 ;
ADDOUT(S) ; add string to out array (expects OUT)
+1 SET OUT=+$GET(OUT)+1
SET OUT(OUT)=S
+2 QUIT
+3 ;
