YTBSI18 ;ALB/ASF-BRIEF SYMPTOM INVENTORY 18 ;8/1/02 12:24
;;5.01;MENTAL HEALTH;**76,234**;Dec 30, 1994;Build 38
;
MAIN ;
N X,T,J,RR,T,X,X1,YSAVE,YSINV
S (T,X1,YSINV)=0
S R="^^^^^^",S=R
D RD
D SOM
D DEP
D ANX
I ($P(R,U,1)=-1)!($P(R,U,2)=-1)!($P(R,U,3)=-1) S YSINV=1
S $P(R,U,4)=$P(R,U,1)+$P(R,U,2)+$P(R,U,3)
F I=1:1:4 S $P(R,U,I+4)=$P(R,U,I) ;duplicate scales 1-4 TO 5-8
D:YSINV=0 TSCOR
D:YSTY["*" REPT
Q
RD S X=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1)
F I=1:1:18 S T=T+$E(X,I) S:$E(X,I)="X" X1=X1+1
S YSAVE=$J(T/(18-X1),1,0)
Q
SOM ;
S X1=0
F I=1,4,7,10,13,16 D
. S RR=$E(X,I)
. S:RR="X" X1=X1+1,RR=YSAVE
. S $P(R,U,1)=$P(R,U,1)+RR
. S:X1>2 $P(R,U,1)=-1
Q
DEP ;
S X1=0
F I=2,5,8,11,14,17 D
. S RR=$E(X,I)
. S:RR="X" X1=X1+1,RR=YSAVE
. S $P(R,U,2)=$P(R,U,2)+RR
. S:X1>2 $P(R,U,2)=-1
Q
ANX ;
S X1=0
F I=3,6,9,12,15,18 D
. S RR=$E(X,I)
. S:RR="X" X1=X1+1,RR=YSAVE
. S $P(R,U,3)=$P(R,U,3)+RR
. S:X1>2 $P(R,U,1)=-1
Q
TSCOR ;
N YSRSX
S YSRSX=$S($L($P($G(VADM(5)),U)):$P(VADM(5),U),1:YSSX)
F I=1:1:8 S $P(S,U,I)=$P(^YTT(601,YSTEST,"S",I,YSRSX),U,$P(R,U,I)+1)
Q
REPT ;
D DTA^YTREPT
S X=$P(^YTT(601,YSTEST,"P"),U)
W !!?(72-$L(X)\2),X
I YSINV W !!,"Invalid administration: too many omissions" Q ;--> out
W !!?10,"Community Norms"
W !?31,"Raw Tscore",!
F J=1:1:4 D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT W !?3,$P(^YTT(601,YSTEST,"S",J,0),U,2),?30,$J($P(R,U,J),4,0),?35,$J($P(S,U,J),4,0)
W !!?10,"Oncology Norms"
W !?31,"Raw Tscore",!
F J=5:1:8 D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT W !?3,$P($P(^YTT(601,YSTEST,"S",J,0),U,2),"("),?30,$J($P(R,U,J),4,0),?35,$J($P(S,U,J),4,0)
Q
TEST ;
N YS,YSDATA
S YS("DFN")=YSDFN,YS("ADATE")=DT,YS("CODE")="BSI18" D SCOREIT^YTAPI2(.YSDATA,.YS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTBSI18 1813 printed Dec 13, 2024@02:17:05 Page 2
YTBSI18 ;ALB/ASF-BRIEF SYMPTOM INVENTORY 18 ;8/1/02 12:24
+1 ;;5.01;MENTAL HEALTH;**76,234**;Dec 30, 1994;Build 38
+2 ;
MAIN ;
+1 NEW X,T,J,RR,T,X,X1,YSAVE,YSINV
+2 SET (T,X1,YSINV)=0
+3 SET R="^^^^^^"
SET S=R
+4 DO RD
+5 DO SOM
+6 DO DEP
+7 DO ANX
+8 IF ($PIECE(R,U,1)=-1)!($PIECE(R,U,2)=-1)!($PIECE(R,U,3)=-1)
SET YSINV=1
+9 SET $PIECE(R,U,4)=$PIECE(R,U,1)+$PIECE(R,U,2)+$PIECE(R,U,3)
+10 ;duplicate scales 1-4 TO 5-8
FOR I=1:1:4
SET $PIECE(R,U,I+4)=$PIECE(R,U,I)
+11 if YSINV=0
DO TSCOR
+12 if YSTY["*"
DO REPT
+13 QUIT
RD SET X=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1)
+1 FOR I=1:1:18
SET T=T+$EXTRACT(X,I)
if $EXTRACT(X,I)="X"
SET X1=X1+1
+2 SET YSAVE=$JUSTIFY(T/(18-X1),1,0)
+3 QUIT
SOM ;
+1 SET X1=0
+2 FOR I=1,4,7,10,13,16
Begin DoDot:1
+3 SET RR=$EXTRACT(X,I)
+4 if RR="X"
SET X1=X1+1
SET RR=YSAVE
+5 SET $PIECE(R,U,1)=$PIECE(R,U,1)+RR
+6 if X1>2
SET $PIECE(R,U,1)=-1
End DoDot:1
+7 QUIT
DEP ;
+1 SET X1=0
+2 FOR I=2,5,8,11,14,17
Begin DoDot:1
+3 SET RR=$EXTRACT(X,I)
+4 if RR="X"
SET X1=X1+1
SET RR=YSAVE
+5 SET $PIECE(R,U,2)=$PIECE(R,U,2)+RR
+6 if X1>2
SET $PIECE(R,U,2)=-1
End DoDot:1
+7 QUIT
ANX ;
+1 SET X1=0
+2 FOR I=3,6,9,12,15,18
Begin DoDot:1
+3 SET RR=$EXTRACT(X,I)
+4 if RR="X"
SET X1=X1+1
SET RR=YSAVE
+5 SET $PIECE(R,U,3)=$PIECE(R,U,3)+RR
+6 if X1>2
SET $PIECE(R,U,1)=-1
End DoDot:1
+7 QUIT
TSCOR ;
+1 NEW YSRSX
+2 SET YSRSX=$SELECT($LENGTH($PIECE($GET(VADM(5)),U)):$PIECE(VADM(5),U),1:YSSX)
+3 FOR I=1:1:8
SET $PIECE(S,U,I)=$PIECE(^YTT(601,YSTEST,"S",I,YSRSX),U,$PIECE(R,U,I)+1)
+4 QUIT
REPT ;
+1 DO DTA^YTREPT
+2 SET X=$PIECE(^YTT(601,YSTEST,"P"),U)
+3 WRITE !!?(72-$LENGTH(X)\2),X
+4 ;--> out
IF YSINV
WRITE !!,"Invalid administration: too many omissions"
QUIT
+5 WRITE !!?10,"Community Norms"
+6 WRITE !?31,"Raw Tscore",!
+7 FOR J=1:1:4
if IOST?1"C-".E&($Y>21)
DO SCR^YTREPT
if YSTOUT!YSUOUT
QUIT
WRITE !?3,$PIECE(^YTT(601,YSTEST,"S",J,0),U,2),?30,$JUSTIFY($PIECE(R,U,J),4,0),?35,$JUSTIFY($PIECE(S,U,J),4,0)
+8 WRITE !!?10,"Oncology Norms"
+9 WRITE !?31,"Raw Tscore",!
+10 FOR J=5:1:8
if IOST?1"C-".E&($Y>21)
DO SCR^YTREPT
if YSTOUT!YSUOUT
QUIT
WRITE !?3,$PIECE($PIECE(^YTT(601,YSTEST,"S",J,0),U,2),"("),?30,$JUSTIFY($PIECE(R,U,J),4,0),?35,$JUSTIFY($PIECE(S,U,J),4,0)
+11 QUIT
TEST ;
+1 NEW YS,YSDATA
+2 SET YS("DFN")=YSDFN
SET YS("ADATE")=DT
SET YS("CODE")="BSI18"
DO SCOREIT^YTAPI2(.YSDATA,.YS)
+3 QUIT
