YTSNUDEC ;SLC/BLD- MHAX ANSWERS SPECIAL HANDLING FOR: Nursing Delirium Screening Scale - (NuDESC)
;;5.01;MENTAL HEALTH;**150**;DEC 30,1994;Build 210
;
;Public, Supported ICRs
; #2056 - Fileman API - $$GET1^DIQ
;
;
DLLSTR(YSDATA,YS,YSTRNG) ;
; YSTRNG = 1 Score Instrument
; YSTRNG = 2 get Report Answers and Text
N DATA,YSSCALIEN,TOTSCORE,YSINSNAM,STRING,TOTSCORE,CNT
;
; returns a scale score which is calculated and stored, no special text in report
I YSTRNG=1 D SCORESV Q
I YSTRNG=2 D STRING Q
;
Q
;
STRING ;
;
N YSCHOICE,YSTEXT,YSMAXLL
D DATA1
S N=N+1
I TOTSCORE>1 S YSDATA(N)="7771^9999;1^POSITIVE" S N=N+1
E S YSDATA(N)="7771^9999;1^NEGATIVE" S N=N+1
S YSMAXLL=76 ;Maximum line length to display
F I=3:1:7 Q:'YSDATA(I) D ;5035,5038,5041,5044,5047 D
.S YSCHOICE=$P(YSDATA(I),"^",3)
.S YSTEXT=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",3,"E")
.I YSCHOICE=5036 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5037 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5039 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5040 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5042 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5043 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5045 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5046 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5048 D WRAPTEXT(YSMAXLL)
.I YSCHOICE=5049 D WRAPTEXT(YSMAXLL)
.I I=3 S YSDATA(N)="7772^9999;1^"_YSTEXT S N=N+1
.I I=4 S YSDATA(N)="7773^9999;1^"_YSTEXT S N=N+1
.I I=5 S YSDATA(N)="7774^9999;1^"_YSTEXT S N=N+1
.I I=6 S YSDATA(N)="7775^9999;1^"_YSTEXT S N=N+1
.I I=7 S YSDATA(N)="7776^9999;1^"_YSTEXT S N=N+1
;
;F I=5036,5039,5042,5045,5048 D
;.S YSTEXT=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",3,"E")
;.I I=5036 D
;..S YSDATA(N)="7773^999;1^Mild to moderate. Barely expressed and noticeable through to being present and undeniable. Patient still can provide some orientating information to time, place and/or person." S N=N+1
;
Q
;
DATA1 ;
;
N I,II,UNANS,MEAN
S (TOTSCORE,CNT,UNANS)=0
F I=3:1 Q:'$D(YSDATA(I)) S TOTSCORE=$G(TOTSCORE)+$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")
Q
;
SCORESV ;
N YSSCGROUP,I
D DATA1
I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
.K ^TMP($J,"YSCOR")
.S ^TMP($J,"YSCOR",1)="[ERROR]"
.S ^TMP($J,"YSCOR",2)=$G(YSINSNAM)_" Scale not found"
;
K ^TMP($J,"YSCOR")
;
S ^TMP($J,"YSCOR",1)="[DATA]"
S YSSCALIEN=$P($P(^TMP($J,"YSG",3),"^",1),"=",2)
S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,YSSCALIEN_",",3,"I")_"="_TOTSCORE
Q
;
WRAPTEXT(YSMAXLL) ; Parses text and creats line feeds that does not split words
N YSPOS,YSTEMP,YSSPOS,YSEPOS ;YSSPOS & YSEPOS are starting and ending position
S YSPOS="" ;YSPOS is the position of the line break within the line
S YSTEMP=YSTEXT
S YSSPOS=1,YSEPOS=YSMAXLL ;YSMAXLL is the maximum line length
S YSPOS=$$POSITION(YSTEMP,YSSPOS,YSEPOS)
S YSTEXT=$E(YSTEMP,YSSPOS,YSPOS)_"| "
S YSSPOS=YSPOS+1,YSEPOS=YSPOS+YSMAXLL
S YSPOS=$$POSITION(YSTEMP,YSSPOS,YSEPOS)
I $E(YSTEMP,YSSPOS)=" " S YSSPOS=YSSPOS+1
S YSTEXT=YSTEXT_$E(YSTEMP,YSSPOS,YSPOS)_"| "
I $L(YSTEXT)<$L(YSTEMP) D
. S YSPOS=YSPOS+1
. I $E(YSTEMP,YSPOS)=" " S YSPOS=YSPOS+1
. S YSTEXT=YSTEXT_$E(YSTEMP,YSPOS,999)
Q
;
POSITION(YSTEXT,YSSPOS,YSEPOS) ;
N TEMPS
S TEMPS=$E(YSTEXT,YSSPOS,YSEPOS)
I $L(TEMPS)<YSMAXLL S YSPOS=$L(TEMPS)+YSSPOS-1 Q YSPOS
I $E(YSTEMP,YSEPOS,YSEPOS+1)[" " S YSPOS=YSEPOS Q YSPOS
S YSPOS=$L(TEMPS)+2-$F($RE(TEMPS)," ")
S YSPOS=YSPOS+YSSPOS-1
Q YSPOS
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSNUDEC 3492 printed Oct 16, 2024@18:21:09 Page 2
YTSNUDEC ;SLC/BLD- MHAX ANSWERS SPECIAL HANDLING FOR: Nursing Delirium Screening Scale - (NuDESC)
+1 ;;5.01;MENTAL HEALTH;**150**;DEC 30,1994;Build 210
+2 ;
+3 ;Public, Supported ICRs
+4 ; #2056 - Fileman API - $$GET1^DIQ
+5 ;
+6 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ; YSTRNG = 1 Score Instrument
+2 ; YSTRNG = 2 get Report Answers and Text
+3 NEW DATA,YSSCALIEN,TOTSCORE,YSINSNAM,STRING,TOTSCORE,CNT
+4 ;
+5 ; returns a scale score which is calculated and stored, no special text in report
+6 IF YSTRNG=1
DO SCORESV
QUIT
+7 IF YSTRNG=2
DO STRING
QUIT
+8 ;
+9 QUIT
+10 ;
STRING ;
+1 ;
+2 NEW YSCHOICE,YSTEXT,YSMAXLL
+3 DO DATA1
+4 SET N=N+1
+5 IF TOTSCORE>1
SET YSDATA(N)="7771^9999;1^POSITIVE"
SET N=N+1
+6 IF '$TEST
SET YSDATA(N)="7771^9999;1^NEGATIVE"
SET N=N+1
+7 ;Maximum line length to display
SET YSMAXLL=76
+8 ;5035,5038,5041,5044,5047 D
FOR I=3:1:7
if 'YSDATA(I)
QUIT
Begin DoDot:1
+9 SET YSCHOICE=$PIECE(YSDATA(I),"^",3)
+10 SET YSTEXT=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",3,"E")
+11 IF YSCHOICE=5036
DO WRAPTEXT(YSMAXLL)
+12 IF YSCHOICE=5037
DO WRAPTEXT(YSMAXLL)
+13 IF YSCHOICE=5039
DO WRAPTEXT(YSMAXLL)
+14 IF YSCHOICE=5040
DO WRAPTEXT(YSMAXLL)
+15 IF YSCHOICE=5042
DO WRAPTEXT(YSMAXLL)
+16 IF YSCHOICE=5043
DO WRAPTEXT(YSMAXLL)
+17 IF YSCHOICE=5045
DO WRAPTEXT(YSMAXLL)
+18 IF YSCHOICE=5046
DO WRAPTEXT(YSMAXLL)
+19 IF YSCHOICE=5048
DO WRAPTEXT(YSMAXLL)
+20 IF YSCHOICE=5049
DO WRAPTEXT(YSMAXLL)
+21 IF I=3
SET YSDATA(N)="7772^9999;1^"_YSTEXT
SET N=N+1
+22 IF I=4
SET YSDATA(N)="7773^9999;1^"_YSTEXT
SET N=N+1
+23 IF I=5
SET YSDATA(N)="7774^9999;1^"_YSTEXT
SET N=N+1
+24 IF I=6
SET YSDATA(N)="7775^9999;1^"_YSTEXT
SET N=N+1
+25 IF I=7
SET YSDATA(N)="7776^9999;1^"_YSTEXT
SET N=N+1
End DoDot:1
+26 ;
+27 ;F I=5036,5039,5042,5045,5048 D
+28 ;.S YSTEXT=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",3,"E")
+29 ;.I I=5036 D
+30 ;..S YSDATA(N)="7773^999;1^Mild to moderate. Barely expressed and noticeable through to being present and undeniable. Patient still can provide some orientating information to time, place and/or person." S N=N+1
+31 ;
+32 QUIT
+33 ;
DATA1 ;
+1 ;
+2 NEW I,II,UNANS,MEAN
+3 SET (TOTSCORE,CNT,UNANS)=0
+4 FOR I=3:1
if '$DATA(YSDATA(I))
QUIT
SET TOTSCORE=$GET(TOTSCORE)+$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")
+5 QUIT
+6 ;
SCORESV ;
+1 NEW YSSCGROUP,I
+2 DO DATA1
+3 ;-->out
IF $DATA(^TMP($JOB,"YSG",1))
IF ^TMP($JOB,"YSG",1)="[ERROR]"
Begin DoDot:1
+4 KILL ^TMP($JOB,"YSCOR")
+5 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
+6 SET ^TMP($JOB,"YSCOR",2)=$GET(YSINSNAM)_" Scale not found"
End DoDot:1
QUIT
+7 ;
+8 KILL ^TMP($JOB,"YSCOR")
+9 ;
+10 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+11 SET YSSCALIEN=$PIECE($PIECE(^TMP($JOB,"YSG",3),"^",1),"=",2)
+12 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,YSSCALIEN_",",3,"I")_"="_TOTSCORE
+13 QUIT
+14 ;
WRAPTEXT(YSMAXLL) ; Parses text and creats line feeds that does not split words
+1 ;YSSPOS & YSEPOS are starting and ending position
NEW YSPOS,YSTEMP,YSSPOS,YSEPOS
+2 ;YSPOS is the position of the line break within the line
SET YSPOS=""
+3 SET YSTEMP=YSTEXT
+4 ;YSMAXLL is the maximum line length
SET YSSPOS=1
SET YSEPOS=YSMAXLL
+5 SET YSPOS=$$POSITION(YSTEMP,YSSPOS,YSEPOS)
+6 SET YSTEXT=$EXTRACT(YSTEMP,YSSPOS,YSPOS)_"| "
+7 SET YSSPOS=YSPOS+1
SET YSEPOS=YSPOS+YSMAXLL
+8 SET YSPOS=$$POSITION(YSTEMP,YSSPOS,YSEPOS)
+9 IF $EXTRACT(YSTEMP,YSSPOS)=" "
SET YSSPOS=YSSPOS+1
+10 SET YSTEXT=YSTEXT_$EXTRACT(YSTEMP,YSSPOS,YSPOS)_"| "
+11 IF $LENGTH(YSTEXT)<$LENGTH(YSTEMP)
Begin DoDot:1
+12 SET YSPOS=YSPOS+1
+13 IF $EXTRACT(YSTEMP,YSPOS)=" "
SET YSPOS=YSPOS+1
+14 SET YSTEXT=YSTEXT_$EXTRACT(YSTEMP,YSPOS,999)
End DoDot:1
+15 QUIT
+16 ;
POSITION(YSTEXT,YSSPOS,YSEPOS) ;
+1 NEW TEMPS
+2 SET TEMPS=$EXTRACT(YSTEXT,YSSPOS,YSEPOS)
+3 IF $LENGTH(TEMPS)<YSMAXLL
SET YSPOS=$LENGTH(TEMPS)+YSSPOS-1
QUIT YSPOS
+4 IF $EXTRACT(YSTEMP,YSEPOS,YSEPOS+1)[" "
SET YSPOS=YSEPOS
QUIT YSPOS
+5 SET YSPOS=$LENGTH(TEMPS)+2-$FIND($REVERSE(TEMPS)," ")
+6 SET YSPOS=YSPOS+YSSPOS-1
+7 QUIT YSPOS
+8 ;
