- YTAPI10 ;ALB/ASF- PSYCH TEST API FOR CLINICAL REMINDERS ; 2/13/04 1:54pm
- ;;5.01;MENTAL HEALTH;**77**;Dec 30, 1994
- ;Reference to ^PXRMINDX(601.2, supported by DBIA #4114
- SET(X) ;
- S N=N+1
- S YSDATA(N)=X
- Q
- DASASI ;
- K YSSONE
- S N=0,IFN=$P(DAS,";",5)
- I '$D(^YSTX(604,IFN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="no asi match" Q
- D SET("[DATA]")
- S YSADATE=$P(^YSTX(604,IFN,0),U,5)
- S X=$P(^DPT(DFN,0),U)_"^ASI^--- Addiction Severity Index ---^"_YSADATE_U_$$FMTE^XLFDT(YSADATE,"5ZD")_U_$$GET1^DIQ(604,IFN_",",.09,"E")
- D SET(X)
- S X="R1^"_$$GET1^DIQ(604,IFN_",",.04)_U_$$GET1^DIQ(604,IFN_",",.11)_U_$S($D(^YSTX(604,IFN,.5)):"Signed",1:"Unsigned")
- D SET(X)
- D SET("R2")
- D SET("R3")
- S X="S1^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
- D SET(X)
- S X="S2^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
- D SET(X)
- S X="S3^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
- D SET(X)
- S X="S4^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
- D SET(X)
- S X="S5^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
- D SET(X)
- S X="S6^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
- D SET(X)
- S X="S7^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
- D SET(X)
- Q
- ENDAS(YSDATA,DAS) ;scoring for clinical reminder DAS entry
- ;Input
- ;DAS from ^PXRMINDX(
- ;Output:
- ;Array(1)=[DATA]
- ;Array(2)= Patient Name^Test Code^Test Title^Internal Admin date^External Admin Date ^Ordered by
- ;Array(3)=R1^Responses 1-200 undelimited
- ;Array(4)=R2^ Responses 201-400 undelimited (even if less than 200)
- ;Array(5)=R3^ Responses 401-600 undelimited
- ;Array(6)=S1^Scale Name^Raw Score^Transformed Score
- ;Array(7)=S2^ Scale Name^Raw Score^Transformed Score And onward as needed
- 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
- 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
- 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
- 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
- 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
- S YSCODE=$P(DAS,";",3)
- I YSCODE'?1N.N D ERR("bad test code") Q ;-->OUT
- S YSCODE=$P(^YTT(601,YSCODE,0),U)
- S DFN=$P(DAS,";")
- I DFN'?1N.N D ERR("bad dfn") Q ;--> OUT
- S (IFN,YSADATE)=$P(DAS,";",5)
- I IFN'>0 D ERR("bad IFN") Q ;-->out
- I YSCODE="GAF" D GAF Q ;--> out
- I YSCODE="ASI" D DASASI Q ;-->out
- I YSADATE'?7N.E D ERR("bad date") Q ;-->OUT
- D SCOR1^YTAPI2
- Q:$G(YSDATA(1))?1"[ERROR".E
- D SCORSET^YTAPI2
- D:YSPRIV SF^YTAPI2
- S N1=0
- F S N1=$O(YSSONE(N1)) Q:N1'>0 D SET(YSSONE(N1))
- Q
- GAF ;score gafs
- I '$D(^YSD(627.8,IFN,60)) D ERR("no ax5 ifn") Q ;-->out
- S N=0,G=^YSD(627.8,IFN,0) D SET("[DATA]")
- S X=$P(^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
- D SET(X)
- S X="R1^"_$P($G(^YSD(627.8,IFN,60)),U,3) D SET(X)
- S X="R2^"_$G(^YSD(627.8,IFN,80,1,0)) D SET(X)
- D SET("R3^")
- Q
- ERR(YSX) ;errors
- S YSDATA(0)="[ERROR]",YSDATA(1)=YSX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI10 3764 printed Feb 18, 2025@23:43:03 Page 2
- YTAPI10 ;ALB/ASF- PSYCH TEST API FOR CLINICAL REMINDERS ; 2/13/04 1:54pm
- +1 ;;5.01;MENTAL HEALTH;**77**;Dec 30, 1994
- +2 ;Reference to ^PXRMINDX(601.2, supported by DBIA #4114
- SET(X) ;
- +1 SET N=N+1
- +2 SET YSDATA(N)=X
- +3 QUIT
- DASASI ;
- +1 KILL YSSONE
- +2 SET N=0
- SET IFN=$PIECE(DAS,";",5)
- +3 IF '$DATA(^YSTX(604,IFN,0))
- SET YSDATA(1)="[ERROR]"
- SET YSDATA(2)="no asi match"
- QUIT
- +4 DO SET("[DATA]")
- +5 SET YSADATE=$PIECE(^YSTX(604,IFN,0),U,5)
- +6 SET X=$PIECE(^DPT(DFN,0),U)_"^ASI^--- Addiction Severity Index ---^"_YSADATE_U_$$FMTE^XLFDT(YSADATE,"5ZD")_U_$$GET1^DIQ(604,IFN_",",.09,"E")
- +7 DO SET(X)
- +8 SET X="R1^"_$$GET1^DIQ(604,IFN_",",.04)_U_$$GET1^DIQ(604,IFN_",",.11)_U_$SELECT($DATA(^YSTX(604,IFN,.5)):"Signed",1:"Unsigned")
- +9 DO SET(X)
- +10 DO SET("R2")
- +11 DO SET("R3")
- +12 SET X="S1^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
- +13 DO SET(X)
- +14 SET X="S2^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
- +15 DO SET(X)
- +16 SET X="S3^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
- +17 DO SET(X)
- +18 SET X="S4^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
- +19 DO SET(X)
- +20 SET X="S5^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
- +21 DO SET(X)
- +22 SET X="S6^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
- +23 DO SET(X)
- +24 SET X="S7^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
- +25 DO SET(X)
- +26 QUIT
- ENDAS(YSDATA,DAS) ;scoring for clinical reminder DAS entry
- +1 ;Input
- +2 ;DAS from ^PXRMINDX(
- +3 ;Output:
- +4 ;Array(1)=[DATA]
- +5 ;Array(2)= Patient Name^Test Code^Test Title^Internal Admin date^External Admin Date ^Ordered by
- +6 ;Array(3)=R1^Responses 1-200 undelimited
- +7 ;Array(4)=R2^ Responses 201-400 undelimited (even if less than 200)
- +8 ;Array(5)=R3^ Responses 401-600 undelimited
- +9 ;Array(6)=S1^Scale Name^Raw Score^Transformed Score
- +10 ;Array(7)=S2^ Scale Name^Raw Score^Transformed Score And onward as needed
- +11 NEW 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
- +12 NEW 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
- +13 NEW 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
- +14 NEW 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
- +15 NEW IFN,N4,R3,SFN1,SFN2,YSAA,YSADATE,YSBED,YSBEG,YSCK,YSCODE,YSED,YSEND,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSONE,YSSTAFF,YSTYPE
- +16 SET YSCODE=$PIECE(DAS,";",3)
- +17 ;-->OUT
- IF YSCODE'?1N.N
- DO ERR("bad test code")
- QUIT
- +18 SET YSCODE=$PIECE(^YTT(601,YSCODE,0),U)
- +19 SET DFN=$PIECE(DAS,";")
- +20 ;--> OUT
- IF DFN'?1N.N
- DO ERR("bad dfn")
- QUIT
- +21 SET (IFN,YSADATE)=$PIECE(DAS,";",5)
- +22 ;-->out
- IF IFN'>0
- DO ERR("bad IFN")
- QUIT
- +23 ;--> out
- IF YSCODE="GAF"
- DO GAF
- QUIT
- +24 ;-->out
- IF YSCODE="ASI"
- DO DASASI
- QUIT
- +25 ;-->OUT
- IF YSADATE'?7N.E
- DO ERR("bad date")
- QUIT
- +26 DO SCOR1^YTAPI2
- +27 if $GET(YSDATA(1))?1"[ERROR".E
- QUIT
- +28 DO SCORSET^YTAPI2
- +29 if YSPRIV
- DO SF^YTAPI2
- +30 SET N1=0
- +31 FOR
- SET N1=$ORDER(YSSONE(N1))
- if N1'>0
- QUIT
- DO SET(YSSONE(N1))
- +32 QUIT
- GAF ;score gafs
- +1 ;-->out
- IF '$DATA(^YSD(627.8,IFN,60))
- DO ERR("no ax5 ifn")
- QUIT
- +2 SET N=0
- SET G=^YSD(627.8,IFN,0)
- DO SET("[DATA]")
- +3 ;asf 2/13/04
- SET X=$PIECE(^DPT(DFN,0),U)_"^GAF^GAF^"_$PIECE(G,U,3)_U_$$EXTERNAL^DILFD(627.8,.03,"",$PIECE(G,U,3))_U_$$EXTERNAL^DILFD(627.8,.04,"",$PIECE(G,U,4))
- +4 DO SET(X)
- +5 SET X="R1^"_$PIECE($GET(^YSD(627.8,IFN,60)),U,3)
- DO SET(X)
- +6 SET X="R2^"_$GET(^YSD(627.8,IFN,80,1,0))
- DO SET(X)
- +7 DO SET("R3^")
- +8 QUIT
- ERR(YSX) ;errors
- +1 SET YSDATA(0)="[ERROR]"
- SET YSDATA(1)=YSX
- +2 QUIT