| [613] | 1 | YTQPXRM7 ;ALB/ASF- PSYCH TEST API FOR CLINICAL REMINDERS ; 7/12/07 5:07pm
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
|
|---|
| 3 | ;Reference to ^PXRMINDX(601.2, supported by DBIA #4114
|
|---|
| 4 | SET(X) ;
|
|---|
| 5 | S N=N+1
|
|---|
| 6 | S YSDATA(N)=X
|
|---|
| 7 | Q
|
|---|
| 8 | DASASI ;
|
|---|
| 9 | K YSSONE
|
|---|
| 10 | S N=0,N2=0,IFN=$P(DAS,";",5)
|
|---|
| 11 | I '$D(^YSTX(604,IFN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="no asi match" Q
|
|---|
| 12 | D SET("[DATA]")
|
|---|
| 13 | S YSADATE=$P(^YSTX(604,IFN,0),U,5)
|
|---|
| 14 | S X=$P(^DPT(DFN,0),U)_"^ASI^--- Addiction Severity Index ---^"_YSADATE_U_$$FMTE^XLFDT(YSADATE,"5ZD")_U_$$GET1^DIQ(604,IFN_",",.09,"E")
|
|---|
| 15 | D SET(X)
|
|---|
| 16 | S YSDATA("S",1)="S1^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
|
|---|
| 17 | S YSDATA("S",2)="S2^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
|
|---|
| 18 | S YSDATA("S",3)="S3^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
|
|---|
| 19 | S YSDATA("S",4)="S4^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
|
|---|
| 20 | S YSDATA("S",5)="S5^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
|
|---|
| 21 | S YSDATA("S",6)="S6^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
|
|---|
| 22 | S YSDATA("S",7)="S7^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
|
|---|
| 23 | Q
|
|---|
| 24 | LEGDAS(YSDATA,DAS) ;scoring for clinical reminder DAS entry
|
|---|
| 25 | N R,S,A,B,C,G,H,I,I1,J,K,L,L1,L2,M,N,N1,N2,P,P3,P4,P5,T,T1,V,W,X,X1,X2,X3,X4,Y,Y1,Y2,YS10,YS25,YS50,YS75,YS90,YSAD,YSAGE,YSANLL,YSAS,YSAST,YSAU,YSB1,YSB2,YSBOX,YSBR
|
|---|
| 26 | N YSBV,YSCALEN,YSCALET,YSCF,YSCF1,YSCNT,YSDAT,YSDATES,YSDOB,YSDS,YSED,YSED1,YSEP,YSET,YSF,YSFC,YSFR,YSHP1,YSHP2,YSHS,YSII,YSIN2,YSINC,YSIO,YSIT,YSIT1,YSIT2,YSIX,YSJJ,YSKC,YSKK,YSKY,YSLB,YSLE,YSLL
|
|---|
| 27 | N YSLM,YSLN,YSLNE,YSLV,YSMA,YSMF,YSMMPI,YSMMPR,YSMX,YSN,YSNAM,YSND,YSNM,YSNS,YSNS26,YSNS39,YSNS9,YSNSCALE,YSNSS,YSOCAT,YSOCNM,YSOCP,YSOCSX,YSOFF,YSPD,YSPS,YSPT,YSQ,YSQR,YSRAW,YSRH,YSRM,YSRP,YSRR,YSRS,YSRT,YSS,YSS1,YSS2
|
|---|
| 28 | N YSSC,YSSCALE,YSSCALEB,YSSEX,YSSH,YSSI,YSSK,YSSNM,YSSNM1,YSSNUMB,YSSP,YSSP4,YSSR,YSSS,YSSSN,YSSX,YSTAR,YSTEST,YSTESTA,YSTL,YSTN,YSTR,YSTTL,YSTV,YSTVL,YSTY,YSULOF,YSULON,YSVS,YSWF,YSX,YSXN,YSXR,YSXX,YSZ,Z,Z1,Z2
|
|---|
| 29 | N IFN,N4,R3,SFN1,SFN2,YSAA,YSADATE,YSBED,YSBEG,YSCK,YSCODE,YSED,YSEND,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSONE,YSSTAFF,YSTYPE
|
|---|
| 30 | S DAS=$P(DAS,U)
|
|---|
| 31 | S YSCODE=$P(DAS,";",3)
|
|---|
| 32 | I YSCODE'?1N.N D ERR("bad test code") Q ;-->OUT
|
|---|
| 33 | S YSCODEN=$P(^YTT(601,YSCODE,0),U)
|
|---|
| 34 | S DFN=$P(DAS,";")
|
|---|
| 35 | I DFN'?1N.N D ERR("bad dfn") Q ;--> OUT
|
|---|
| 36 | S (IFN,YSADATE)=$P(DAS,";",5)
|
|---|
| 37 | I IFN'>0 D ERR("bad IFN") Q ;-->out
|
|---|
| 38 | I YSCODEN="GAF" D GAF Q ;--> out
|
|---|
| 39 | I YSCODEN="ASI" D DASASI Q ;-->out
|
|---|
| 40 | I YSADATE'?7N.E D ERR("bad date") Q ;-->OUT
|
|---|
| 41 | ;;score me
|
|---|
| 42 | SCOR1 S (YSTEST,YSET)=YSCODE
|
|---|
| 43 | S YSED=YSADATE
|
|---|
| 44 | S YSDFN=DFN
|
|---|
| 45 | S YSSX=$P(^DPT(DFN,0),U,2)
|
|---|
| 46 | S YSTN=YSCODEN
|
|---|
| 47 | IF '$D(^YTD(601.2,YSDFN,1,YSET,1,YSED)) S YSDATA(1)="[ERROR SCORE1 NEW]",YSDATA(2)="no administration found" Q
|
|---|
| 48 | D PRIV ;check it
|
|---|
| 49 | Q:YSPRIV=0
|
|---|
| 50 | S YSR(0)=$G(^YTT(601.6,YSET,0))
|
|---|
| 51 | I $P(YSR(0),U,2)="Y" S X=^YTT(601.6,YSET,1) X X
|
|---|
| 52 | Q:$G(YSDATA(1))?1"[ERROR".E
|
|---|
| 53 | ;;
|
|---|
| 54 | SCORSET ;;heading data name^code^title^comp date^ordered by
|
|---|
| 55 | S N=0 D SET("[DATA]")
|
|---|
| 56 | S X=$P($G(^YTD(601.2,YSDFN,1,YSET,1,YSED,0)),U,3)
|
|---|
| 57 | S X=$S(X?1N.N:$P($G(^VA(200,X,0)),U,1),1:"")
|
|---|
| 58 | 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
|
|---|
| 59 | D SET(X)
|
|---|
| 60 | I YSPRIV=0 D SET("no privilege") Q
|
|---|
| 61 | ;no return of responses for legacy tests ASF 2/22/07
|
|---|
| 62 | ;S G=$G(^YTD(601.2,DFN,1,YSET,1,YSED,1)) F I=1:1 S A=$E(G,I) Q:A="" S N1=N1+1,YSDATA("R",N1)="^^^^"_A_U_A
|
|---|
| 63 | D:YSPRIV SF^YTAPI2
|
|---|
| 64 | S N1=0
|
|---|
| 65 | F S N1=$O(YSSONE(N1)) Q:N1'>0 S YSDATA("S",N1)=YSSONE(N1)
|
|---|
| 66 | Q
|
|---|
| 67 | GAF ;score gafs
|
|---|
| 68 | I '$D(^YSD(627.8,IFN,60)) D ERR("no ax5 ifn") Q ;-->out
|
|---|
| 69 | S N=0,G=^YSD(627.8,IFN,0) D SET("[DATA]")
|
|---|
| 70 | S X=$P($G(^DPT(DFN,0)),U)_"^GAF^GAF^"_$P(G,U,3)_U_$$EXTERNAL^DILFD(627.8,.03,"",$P(G,U,3))_U_$$EXTERNAL^DILFD(627.8,.04,"",$P(G,U,4)) ;asf 2/13/04
|
|---|
| 71 | D SET(X)
|
|---|
| 72 | ;S YSDATA("R",1)="^^^^^"_$P($G(^YSD(627.8,IFN,60)),U,3)
|
|---|
| 73 | S YSDATA("S",1)="S1^GAF^"_$P($G(^YSD(627.8,IFN,60)),U,3)_U_$G(^YSD(627.8,IFN,80,1,0))
|
|---|
| 74 | Q
|
|---|
| 75 | ERR(YSX) ;errors
|
|---|
| 76 | S YSDATA(0)="[ERROR]",YSDATA(1)=YSX
|
|---|
| 77 | Q
|
|---|
| 78 | PRIV ;check privileges
|
|---|
| 79 | N YS71,YSKEY
|
|---|
| 80 | S YSPRIV=0
|
|---|
| 81 | S YS71=$O(^YTT(601.71,"B",YSCODEN,0))
|
|---|
| 82 | Q:YS71="" ;-->out error
|
|---|
| 83 | S YSKEY=$$GET1^DIQ(601.71,YS71_",",9)
|
|---|
| 84 | I YSKEY="" S YSPRIV=1 Q ;-->out exempt
|
|---|
| 85 | I $D(^XUSEC(YSKEY,DUZ)) S YSPRIV=1 Q ;-->out has key
|
|---|
| 86 | Q
|
|---|
