| 1 | YTAPI ;ALB/ASF- PSYCH TEST API ;2/27/04 15:44
|
---|
| 2 | ;;5.01;MENTAL HEALTH;**53,71,76,77**;Dec 30, 1994
|
---|
| 3 | PARSE(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
|
---|
| 18 | LISTALL(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
|
---|
| 36 | GAF ;
|
---|
| 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
|
---|
| 44 | ASI ;
|
---|
| 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
|
---|
| 60 | SET(X) ;
|
---|
| 61 | S N=N+1
|
---|
| 62 | S YSDATA(N)=X
|
---|
| 63 | Q
|
---|
| 64 | LISTONE(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
|
---|