source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI2.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1YTAPI2 ;ALB/ASF PSYCH TEST API CONT ;3/13/00 17:06
2 ;;5.01;MENTAL HEALTH;**53,62**;Dec 30, 1994
3SCOREIT(YSDATA,YS) ;
4 ;W !,"SCOREIT",$C(7)
5 N N,N2,N4,R,S,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
6 K YSDATA,YSSONE
7 D PARSE^YTAPI(.YS)
8 I '$D(^YTT(601,"B",YSCODE))&(YSCODE'="ASI") S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
9 D:YSCODE="ASI" ASISCR
10 I YSCODE'="ASI" D
11 . D SCOR1
12 . Q:$G(YSDATA(1))?1"[ERROR".E
13 . D SCORSET
14 . D:YSPRIV SF
15 . S N1=0
16 . F S N1=$O(YSSONE(N1)) Q:N1'>0 D SET(YSSONE(N1))
17 D CLEAN^YSMTI5 Q
18SET(X) ;
19 S N=N+1
20 S YSDATA(N)=X
21 Q
22ASISCR ;score ASI
23 K YSSONE
24 ;W $C(7)
25 I '$D(^YSTX(604,"C",DFN)) S YSDATA(1)="[ERROR]",YSDATA(2)="no asi on this pt" Q
26 S (N1,YSIFN,IFN)=0
27 F S YSIFN=$O(^YSTX(604,"C",DFN,YSIFN)) Q:YSIFN'>0 D
28 . S X=$P($G(^YSTX(604,YSIFN,0)),U,5)
29 . I X=YSADATE S IFN=YSIFN,YSDATE=X Q
30 I IFN=0 S YSDATA(1)="[ERROR]",YSDATA(2)="no asi date match" Q
31 S N=0
32 D SET("[DATA]")
33 S X=$P(^DPT(DFN,0),U)_"^ASI^--- Addiction Severity Index ---^"_YSDATE_U_$$FMTE^XLFDT(YSADATE,"5ZD")_U_$$GET1^DIQ(604,IFN_",",.09,"E")
34 D SET(X)
35 S X="R1^"_$$GET1^DIQ(604,IFN_",",.04)_U_$$GET1^DIQ(604,IFN_",",.11)_U_$S($D(^YSTX(604,IFN,.5)):"Signed",1:"Unsigned")
36 D SET(X)
37 D SET("R2")
38 D SET("R3")
39 S X="S1^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
40 D SET(X)
41 S X="S2^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
42 D SET(X)
43 S X="S3^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
44 D SET(X)
45 S X="S4^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
46 D SET(X)
47 S X="S5^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
48 D SET(X)
49 S X="S6^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
50 D SET(X)
51 S X="S7^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
52 D SET(X)
53 Q
54SCOR1 S (YSTEST,YSET)=$O(^YTT(601,"B",YSCODE,0))
55 S YSED=YSADATE
56 S YSDFN=DFN
57 S YSSX=$P(^DPT(DFN,0),U,2)
58 S YSTN=YSCODE
59 IF '$D(^YTD(601.2,YSDFN,1,YSET,1,YSED)) S YSDATA(1)="[ERROR SCORE1+5]",YSDATA(2)="no administration found" Q
60 D PRIV ;check it
61 Q:YSPRIV=0
62 S YSR(0)=$G(^YTT(601.6,YSET,0))
63 I $P(YSR(0),U,2)="Y" S X=^YTT(601.6,YSET,1) X X
64 Q
65SCORSET ;;heading data name^code^title^comp date^ordered by
66 S N=0 D SET("[DATA]")
67 S X=$P($G(^YTD(601.2,YSDFN,1,YSET,1,YSED,0)),U,3)
68 S X=$S(X?1N.N:$P($G(^VA(200,X,0)),U,1),1:"")
69 S X=$P(^DPT(DFN,0),U)_U_YSCODE_U_$P($G(^YTT(601,YSET,"P")),U)_U_YSED_U_$$FMTE^XLFDT(YSADATE,"5ZD")_U_X
70 D SET(X)
71 I YSPRIV=0 D SET("no privilege") Q
72 S X="R1"_U_$G(^YTD(601.2,DFN,1,YSET,1,YSED,1))
73 D SET(X)
74 S X="R2"_U_$G(^YTD(601.2,DFN,1,YSET,1,YSED,2))
75 D SET(X)
76 S X="R3"_U_$G(^YTD(601.2,DFN,1,YSET,1,YSED,3))
77 D SET(X)
78 Q
79SF ; default scale set
80 N SFN1,SFN2
81 Q:'$D(R)
82 S SFN1=0,SFN2=0
83 IF $L(R) F S SFN1=$O(^YTT(601,YSET,"S",SFN1)) Q:SFN1'>0 D
84 . S G=^YTT(601,YSET,"S",SFN1,0)
85 . S SFN2=SFN2+1
86 . S X="S"_SFN2_U_$P(G,U,2)_U_$P($G(R),U,SFN2)_U_$P($G(S),U,SFN2)
87 . S YSSONE(SFN2)=X
88SF2 ;
89 Q:$D(R)<10 F S SFN1=$O(R(SFN1)) Q:SFN1'>0 D
90 . F I=1:1 Q:$P(R(SFN1),U,I)="" D
91 .. S SFN2=SFN2+1
92 .. S G=^YTT(601,YSET,"S",SFN2,0)
93 .. S X="S"_SFN2_U_$P(G,U,2)_U_$P($G(R(SFN1)),U,I)_U_$P($G(S(SFN1)),U,I)
94 .. S YSSONE(SFN2)=X
95 Q
96PRIV ;check privileges
97 S YSPRIV=0
98 I $D(^XUSEC("YSP",DUZ)) S YSPRIV=1 Q ;has key
99 I $P(^YTT(601,YSET,0),U,10)="Y" S YSPRIV=1 Q ;test exempt
100 I $P(^YTT(601,YSET,0),U,9)="I" S YSPRIV=1 Q ;interview
101 Q
Note: See TracBrowser for help on using the repository browser.