source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI.m@ 1582

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1YTAPI ;ALB/ASF- PSYCH TEST API ;2/27/04 15:44
2 ;;5.01;MENTAL HEALTH;**53,71,76,77**;Dec 30, 1994
3PARSE(YS) ; -- array parsing
4 S DFN=$G(YS("DFN"))
5 S YSCODE=$G(YS("CODE"))
6 S:YSCODE?1N.N YSCODE=$P($G(^YTT(601,YSCODE,0),"ERROR"),U)
7 S YSADATE=$G(YS("ADATE")) S X=YSADATE,%DT="T" D ^%DT S YSADATE=Y
8 S YSSCALE=$G(YS("SCALE"))
9 S YSBEG=$G(YS("BEGIN")) S:YSBEG="" YSBEG="01/01/1970" S X=YSBEG,%DT="T" D ^%DT S YSBEG=Y ;ASF 1/30/04
10 S YSEND=$G(YS("END")) S:YSEND="" YSEND="01/01/2099" S X=YSEND,%DT="T" D ^%DT S YSEND=Y ;ASF 1/30/04
11 S YSLIMIT=$G(YS("LIMIT"),999)
12 S YSSTAFF=$G(YS("STAFF"))
13 S R1=$G(YS("R1"))
14 S R2=$G(YS("R2"))
15 S R3=$G(YS("R3"))
16 K %DT
17 Q
18LISTALL(YSDATA,YS) ;
19 N N,N2,N4,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND,YSJJ,YSLIMIT
20 N IFN,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSONE,YSSTAFF,YSTYPE
21 D PARSE(.YS)
22 I DFN'>0!('$D(^DPT(DFN))) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN" Q
23 K YSDATA S YSDATA(1)="[DATA]"
24 S N=0 F S N=$O(^YTD(601.2,DFN,1,N)) Q:N'>0 D
25 . I $P(^YTT(601,N,0),U,9)="I" QUIT
26 . I $D(^YTT(601,N)) S N2=YSBEG-.1 F S N2=$O(^YTD(601.2,DFN,1,N,1,N2)) Q:N2'>0!(N2>YSEND) D
27 .. S X=^YTT(601,N,0),N4=$P(X,U)
28 .. I N4="MMPI",$D(^YTD(601.2,DFN,1,N,1,N2,99)),^(99)="MMPIR" S N4="MMPR"
29 .. S YSPRIV="P" S:$P(X,U,10)="Y" YSPRIV="E" S:$P(X,U,9)="I" YSPRIV="E" ;ASF 4/18/01
30 .. S YSAA(9999999-N2,N4)=YSPRIV_U_N ;ASF 9/9/03
31 .. Q
32 I YSCODE="GAF" D GAF
33 I YSCODE="ASI" D ASI ;ASF 9/9/03
34 S I=0,N=1 F S I=$O(YSAA(I)) Q:I'>0 S II="" F S II=$O(YSAA(I,II)) Q:II="" D SET(9999999-I_U_$$FMTE^XLFDT(9999999-I,"5ZD")_U_II_U_YSAA(I,II)) ;ASF 4/18/01
35 Q
36GAF ;
37 N YSJJ,YSDD,X,Y,YSX,YSN
38 S YSDD=9999999-YSEND-.00001
39 F YSJJ=1:1:YSLIMIT S YSDD=$O(^YSD(627.8,"AX5",DFN,YSDD)) Q:YSDD'>0!(YSDD>(9999999-YSBEG)) D
40 . S YSN=0 F S YSN=$O(^YSD(627.8,"AX5",DFN,YSDD,YSN)) Q:YSN'>0 D
41 .. S YSX=$P($G(^YSD(627.8,YSN,60)),U,3)_"^^"_$$EXTERNAL^DILFD(627.8,.04,"",$P($G(^YSD(627.8,YSN,0)),U,4))_U_$G(^YSD(627.8,YSN,80,1,0))
42 .. S YSAA(YSDD,"GAF")=9999999-YSDD_"^GAF^"_YSX
43 Q
44ASI ;
45 Q:'$D(^YSTX(604,"C",DFN))
46 S IFN="A" F YSJJ=1:1:YSLIMIT S IFN=$O(^YSTX(604,"C",DFN,IFN),-1) Q:IFN'>0 D
47 . Q:'$D(^YSTX(604,IFN,.5)) ; no sig
48 . S N2=$P($G(^YSTX(604,IFN,0)),U,5)
49 . I N2>YSEND!(N2<YSBEG) Q ;not in range
50 . S YSSONE="^^^"
51 . S:YSSCALE=1 YSSONE="^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
52 . S:YSSCALE=2 YSSONE="^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
53 . S:YSSCALE=3 YSSONE="^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
54 . S:YSSCALE=4 YSSONE="^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
55 . S:YSSCALE=5 YSSONE="^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
56 . S:YSSCALE=6 YSSONE="^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
57 . S:YSSCALE=7 YSSONE="^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
58 . S YSAA(9999999-N2,"ASI")=N2_U_$$FMTE^XLFDT(N2,"5ZD")_YSSONE_U_IFN
59 Q
60SET(X) ;
61 S N=N+1
62 S YSDATA(N)=X
63 Q
64LISTONE(YSDATA,YS) ;
65 N YSLIMIT,YSJJ,YSSONE,S,R,N,YSN2,N4,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND,YSAA
66 N IFN,R1,R2,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSET
67 D PARSE(.YS)
68 K YSDATA
69 I DFN'>0!('$D(^DPT(DFN))) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN" Q
70 I '$D(^YTT(601,"B",YSCODE))&(YSCODE'="ASI")&(YSCODE'="GAF") S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
71 S YSET=-1 S:YSCODE'="ASI"&(YSCODE'="GAF") YSET=$O(^YTT(601,"B",YSCODE,""))
72 S YSDATA(1)="[DATA]"
73 I $D(^YTT(601,YSET)) S YSN2=YSEND+.1 F YSJJ=1:1:YSLIMIT S YSN2=$O(^YTD(601.2,DFN,1,YSET,1,YSN2),-1) Q:YSN2'>0!(YSN2<YSBEG) D
74 . K YSSONE S YSSONE=""
75 . D PRIV^YTAPI2
76 . I YSSCALE'=""&(YSPRIV=1) D
77 .. S YSADATE=YSN2
78 .. D SCOR1^YTAPI2
79 .. D SF^YTAPI2
80 .. S YSSCALE=$G(YS("SCALE"))
81 . S:$D(YSSCALE)&(YSSCALE'="") YSSONE=$S($D(YSSONE(YSSCALE)):U_$P(YSSONE(YSSCALE),U,2,99),1:"")
82 . S YSAA(9999999-YSN2,YSCODE)=YSN2_YSSONE
83 . Q
84 I YSCODE="ASI" D ASI
85 I YSCODE="GAF" D GAF
86 S I=0,N=1 F S I=$O(YSAA(I)) Q:I'>0 S II="" F S II=$O(YSAA(I,II)) Q:II="" D
87 . S X=$P(YSAA(I,II),U)_U_$$FMTE^XLFDT($P(YSAA(I,II),U),"5ZD")_U_II
88 . S:$P(YSAA(I,II),U,2)'="" X=X_U_$P(YSAA(I,II),U,2,9)
89 . D SET(X)
90 Q
Note: See TracBrowser for help on using the repository browser.