| [613] | 1 | YTBSI18 ;ALB/ASF-BRIEF SYMPTOM INVENTORY 18 ;8/1/02 12:24
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**76**;Dec 30, 1994
|
|---|
| 3 | MAIN ;
|
|---|
| 4 | N X,T,J,RR,T,X,X1,YSAVE,YSINV
|
|---|
| 5 | S (T,X1,YSINV)=0
|
|---|
| 6 | S R="^^^^^^",S=R
|
|---|
| 7 | D RD
|
|---|
| 8 | D SOM
|
|---|
| 9 | D DEP
|
|---|
| 10 | D ANX
|
|---|
| 11 | I ($P(R,U,1)=-1)!($P(R,U,2)=-1)!($P(R,U,3)=-1) S YSINV=1
|
|---|
| 12 | S $P(R,U,4)=$P(R,U,1)+$P(R,U,2)+$P(R,U,3)
|
|---|
| 13 | F I=1:1:4 S $P(R,U,I+4)=$P(R,U,I) ;duplicate scales 1-4 TO 5-8
|
|---|
| 14 | D:YSINV=0 TSCOR
|
|---|
| 15 | D:YSTY["*" REPT
|
|---|
| 16 | Q
|
|---|
| 17 | RD S X=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1)
|
|---|
| 18 | F I=1:1:18 S T=T+$E(X,I) S:$E(X,I)="X" X1=X1+1
|
|---|
| 19 | S YSAVE=$J(T/(18-X1),1,0)
|
|---|
| 20 | Q
|
|---|
| 21 | SOM ;
|
|---|
| 22 | S X1=0
|
|---|
| 23 | F I=1,4,7,10,13,16 D
|
|---|
| 24 | . S RR=$E(X,I)
|
|---|
| 25 | . S:RR="X" X1=X1+1,RR=YSAVE
|
|---|
| 26 | . S $P(R,U,1)=$P(R,U,1)+RR
|
|---|
| 27 | . S:X1>2 $P(R,U,1)=-1
|
|---|
| 28 | Q
|
|---|
| 29 | DEP ;
|
|---|
| 30 | S X1=0
|
|---|
| 31 | F I=2,5,8,11,14,17 D
|
|---|
| 32 | . S RR=$E(X,I)
|
|---|
| 33 | . S:RR="X" X1=X1+1,RR=YSAVE
|
|---|
| 34 | . S $P(R,U,2)=$P(R,U,2)+RR
|
|---|
| 35 | . S:X1>2 $P(R,U,2)=-1
|
|---|
| 36 | Q
|
|---|
| 37 | ANX ;
|
|---|
| 38 | S X1=0
|
|---|
| 39 | F I=3,6,9,12,15,18 D
|
|---|
| 40 | . S RR=$E(X,I)
|
|---|
| 41 | . S:RR="X" X1=X1+1,RR=YSAVE
|
|---|
| 42 | . S $P(R,U,3)=$P(R,U,3)+RR
|
|---|
| 43 | . S:X1>2 $P(R,U,1)=-1
|
|---|
| 44 | Q
|
|---|
| 45 | TSCOR ;
|
|---|
| 46 | F I=1:1:8 S $P(S,U,I)=$P(^YTT(601,YSTEST,"S",I,YSSX),U,$P(R,U,I)+1)
|
|---|
| 47 | Q
|
|---|
| 48 | REPT ;
|
|---|
| 49 | D DTA^YTREPT
|
|---|
| 50 | S X=$P(^YTT(601,YSTEST,"P"),U)
|
|---|
| 51 | W !!?(72-$L(X)\2),X
|
|---|
| 52 | I YSINV W !!,"Invaild administration: too many ommisions" Q ;--> out
|
|---|
| 53 | W !!?10,"Community Norms"
|
|---|
| 54 | W !?31,"Raw Tscore",!
|
|---|
| 55 | 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)
|
|---|
| 56 | W !!?10,"Oncology Norms"
|
|---|
| 57 | W !?31,"Raw Tscore",!
|
|---|
| 58 | 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)
|
|---|
| 59 | Q
|
|---|
| 60 | TEST S YS("DFN")=YSDFN,YS("ADATE")=DT,YS("CODE")="BSI18" D SCOREIT^YTAPI2(.YSDATA,.YS)
|
|---|
