source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTBSI18.m@ 761

Last change on this file since 761 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1YTBSI18 ;ALB/ASF-BRIEF SYMPTOM INVENTORY 18 ;8/1/02 12:24
2 ;;5.01;MENTAL HEALTH;**76**;Dec 30, 1994
3MAIN ;
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
17RD 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
21SOM ;
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
29DEP ;
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
37ANX ;
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
45TSCOR ;
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
48REPT ;
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
60TEST S YS("DFN")=YSDFN,YS("ADATE")=DT,YS("CODE")="BSI18" D SCOREIT^YTAPI2(.YSDATA,.YS)
Note: See TracBrowser for help on using the repository browser.