YTAPI2 ;ALB/ASF PSYCH TEST API CONT ;3/13/00 17:06
;;5.01;MENTAL HEALTH;**53,62**;Dec 30, 1994
SCOREIT(YSDATA,YS) ;
;W !,"SCOREIT",$C(7)
N N,N2,N4,R,S,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
K YSDATA,YSSONE
D PARSE^YTAPI(.YS)
I '$D(^YTT(601,"B",YSCODE))&(YSCODE'="ASI") S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
D:YSCODE="ASI" ASISCR
I YSCODE'="ASI" D
. D SCOR1
. Q:$G(YSDATA(1))?1"[ERROR".E
. D SCORSET
. D:YSPRIV SF
. S N1=0
. F S N1=$O(YSSONE(N1)) Q:N1'>0 D SET(YSSONE(N1))
D CLEAN^YSMTI5 Q
SET(X) ;
S N=N+1
S YSDATA(N)=X
Q
ASISCR ;score ASI
K YSSONE
;W $C(7)
I '$D(^YSTX(604,"C",DFN)) S YSDATA(1)="[ERROR]",YSDATA(2)="no asi on this pt" Q
S (N1,YSIFN,IFN)=0
F S YSIFN=$O(^YSTX(604,"C",DFN,YSIFN)) Q:YSIFN'>0 D
. S X=$P($G(^YSTX(604,YSIFN,0)),U,5)
. I X=YSADATE S IFN=YSIFN,YSDATE=X Q
I IFN=0 S YSDATA(1)="[ERROR]",YSDATA(2)="no asi date match" Q
S N=0
D SET("[DATA]")
S X=$P(^DPT(DFN,0),U)_"^ASI^--- Addiction Severity Index ---^"_YSDATE_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
SCOR1 S (YSTEST,YSET)=$O(^YTT(601,"B",YSCODE,0))
S YSED=YSADATE
S YSDFN=DFN
S YSSX=$P(^DPT(DFN,0),U,2)
S YSTN=YSCODE
IF '$D(^YTD(601.2,YSDFN,1,YSET,1,YSED)) S YSDATA(1)="[ERROR SCORE1+5]",YSDATA(2)="no administration found" Q
D PRIV ;check it
Q:YSPRIV=0
S YSR(0)=$G(^YTT(601.6,YSET,0))
I $P(YSR(0),U,2)="Y" S X=^YTT(601.6,YSET,1) X X
Q
SCORSET ;;heading data name^code^title^comp date^ordered by
S N=0 D SET("[DATA]")
S X=$P($G(^YTD(601.2,YSDFN,1,YSET,1,YSED,0)),U,3)
S X=$S(X?1N.N:$P($G(^VA(200,X,0)),U,1),1:"")
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
D SET(X)
I YSPRIV=0 D SET("no privilege") Q
S X="R1"_U_$G(^YTD(601.2,DFN,1,YSET,1,YSED,1))
D SET(X)
S X="R2"_U_$G(^YTD(601.2,DFN,1,YSET,1,YSED,2))
D SET(X)
S X="R3"_U_$G(^YTD(601.2,DFN,1,YSET,1,YSED,3))
D SET(X)
Q
SF ; default scale set
N SFN1,SFN2
Q:'$D(R)
S SFN1=0,SFN2=0
IF $L(R) F S SFN1=$O(^YTT(601,YSET,"S",SFN1)) Q:SFN1'>0 D
. S G=^YTT(601,YSET,"S",SFN1,0)
. S SFN2=SFN2+1
. S X="S"_SFN2_U_$P(G,U,2)_U_$P($G(R),U,SFN2)_U_$P($G(S),U,SFN2)
. S YSSONE(SFN2)=X
SF2 ;
Q:$D(R)<10 F S SFN1=$O(R(SFN1)) Q:SFN1'>0 D
. F I=1:1 Q:$P(R(SFN1),U,I)="" D
.. S SFN2=SFN2+1
.. S G=^YTT(601,YSET,"S",SFN2,0)
.. S X="S"_SFN2_U_$P(G,U,2)_U_$P($G(R(SFN1)),U,I)_U_$P($G(S(SFN1)),U,I)
.. S YSSONE(SFN2)=X
Q
PRIV ;check privileges
S YSPRIV=0
I $D(^XUSEC("YSP",DUZ)) S YSPRIV=1 Q ;has key
I $P(^YTT(601,YSET,0),U,10)="Y" S YSPRIV=1 Q ;test exempt
I $P(^YTT(601,YSET,0),U,9)="I" S YSPRIV=1 Q ;interview
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI2 3510 printed Apr 09, 2024@21:19:42 Page 2
YTAPI2 ;ALB/ASF PSYCH TEST API CONT ;3/13/00 17:06
+1 ;;5.01;MENTAL HEALTH;**53,62**;Dec 30, 1994
SCOREIT(YSDATA,YS) ;
+1 ;W !,"SCOREIT",$C(7)
+2 NEW N,N2,N4,R,S,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
+3 KILL YSDATA,YSSONE
+4 DO PARSE^YTAPI(.YS)
+5 IF '$DATA(^YTT(601,"B",YSCODE))&(YSCODE'="ASI")
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="INCORRECT TEST CODE"
QUIT
+6 if YSCODE="ASI"
DO ASISCR
+7 IF YSCODE'="ASI"
Begin DoDot:1
+8 DO SCOR1
+9 if $GET(YSDATA(1))?1"[ERROR".E
QUIT
+10 DO SCORSET
+11 if YSPRIV
DO SF
+12 SET N1=0
+13 FOR
SET N1=$ORDER(YSSONE(N1))
if N1'>0
QUIT
DO SET(YSSONE(N1))
End DoDot:1
+14 DO CLEAN^YSMTI5
QUIT
SET(X) ;
+1 SET N=N+1
+2 SET YSDATA(N)=X
+3 QUIT
ASISCR ;score ASI
+1 KILL YSSONE
+2 ;W $C(7)
+3 IF '$DATA(^YSTX(604,"C",DFN))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no asi on this pt"
QUIT
+4 SET (N1,YSIFN,IFN)=0
+5 FOR
SET YSIFN=$ORDER(^YSTX(604,"C",DFN,YSIFN))
if YSIFN'>0
QUIT
Begin DoDot:1
+6 SET X=$PIECE($GET(^YSTX(604,YSIFN,0)),U,5)
+7 IF X=YSADATE
SET IFN=YSIFN
SET YSDATE=X
QUIT
End DoDot:1
+8 IF IFN=0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no asi date match"
QUIT
+9 SET N=0
+10 DO SET("[DATA]")
+11 SET X=$PIECE(^DPT(DFN,0),U)_"^ASI^--- Addiction Severity Index ---^"_YSDATE_U_$$FMTE^XLFDT(YSADATE,"5ZD")_U_$$GET1^DIQ(604,IFN_",",.09,"E")
+12 DO SET(X)
+13 SET X="R1^"_$$GET1^DIQ(604,IFN_",",.04)_U_$$GET1^DIQ(604,IFN_",",.11)_U_$SELECT($DATA(^YSTX(604,IFN,.5)):"Signed",1:"Unsigned")
+14 DO SET(X)
+15 DO SET("R2")
+16 DO SET("R3")
+17 SET X="S1^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
+18 DO SET(X)
+19 SET X="S2^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
+20 DO SET(X)
+21 SET X="S3^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
+22 DO SET(X)
+23 SET X="S4^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
+24 DO SET(X)
+25 SET X="S5^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
+26 DO SET(X)
+27 SET X="S6^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
+28 DO SET(X)
+29 SET X="S7^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
+30 DO SET(X)
+31 QUIT
SCOR1 SET (YSTEST,YSET)=$ORDER(^YTT(601,"B",YSCODE,0))
+1 SET YSED=YSADATE
+2 SET YSDFN=DFN
+3 SET YSSX=$PIECE(^DPT(DFN,0),U,2)
+4 SET YSTN=YSCODE
+5 IF '$DATA(^YTD(601.2,YSDFN,1,YSET,1,YSED))
SET YSDATA(1)="[ERROR SCORE1+5]"
SET YSDATA(2)="no administration found"
QUIT
+6 ;check it
DO PRIV
+7 if YSPRIV=0
QUIT
+8 SET YSR(0)=$GET(^YTT(601.6,YSET,0))
+9 IF $PIECE(YSR(0),U,2)="Y"
SET X=^YTT(601.6,YSET,1)
XECUTE X
+10 QUIT
SCORSET ;;heading data name^code^title^comp date^ordered by
+1 SET N=0
DO SET("[DATA]")
+2 SET X=$PIECE($GET(^YTD(601.2,YSDFN,1,YSET,1,YSED,0)),U,3)
+3 SET X=$SELECT(X?1N.N:$PIECE($GET(^VA(200,X,0)),U,1),1:"")
+4 SET X=$PIECE(^DPT(DFN,0),U)_U_YSCODE_U_$PIECE($GET(^YTT(601,YSET,"P")),U)_U_YSED_U_$$FMTE^XLFDT(YSADATE,"5ZD")_U_X
+5 DO SET(X)
+6 IF YSPRIV=0
DO SET("no privilege")
QUIT
+7 SET X="R1"_U_$GET(^YTD(601.2,DFN,1,YSET,1,YSED,1))
+8 DO SET(X)
+9 SET X="R2"_U_$GET(^YTD(601.2,DFN,1,YSET,1,YSED,2))
+10 DO SET(X)
+11 SET X="R3"_U_$GET(^YTD(601.2,DFN,1,YSET,1,YSED,3))
+12 DO SET(X)
+13 QUIT
SF ; default scale set
+1 NEW SFN1,SFN2
+2 if '$DATA(R)
QUIT
+3 SET SFN1=0
SET SFN2=0
+4 IF $LENGTH(R)
FOR
SET SFN1=$ORDER(^YTT(601,YSET,"S",SFN1))
if SFN1'>0
QUIT
Begin DoDot:1
+5 SET G=^YTT(601,YSET,"S",SFN1,0)
+6 SET SFN2=SFN2+1
+7 SET X="S"_SFN2_U_$PIECE(G,U,2)_U_$PIECE($GET(R),U,SFN2)_U_$PIECE($GET(S),U,SFN2)
+8 SET YSSONE(SFN2)=X
End DoDot:1
SF2 ;
+1 if $DATA(R)<10
QUIT
FOR
SET SFN1=$ORDER(R(SFN1))
if SFN1'>0
QUIT
Begin DoDot:1
+2 FOR I=1:1
if $PIECE(R(SFN1),U,I)=""
QUIT
Begin DoDot:2
+3 SET SFN2=SFN2+1
+4 SET G=^YTT(601,YSET,"S",SFN2,0)
+5 SET X="S"_SFN2_U_$PIECE(G,U,2)_U_$PIECE($GET(R(SFN1)),U,I)_U_$PIECE($GET(S(SFN1)),U,I)
+6 SET YSSONE(SFN2)=X
End DoDot:2
End DoDot:1
+7 QUIT
PRIV ;check privileges
+1 SET YSPRIV=0
+2 ;has key
IF $DATA(^XUSEC("YSP",DUZ))
SET YSPRIV=1
QUIT
+3 ;test exempt
IF $PIECE(^YTT(601,YSET,0),U,10)="Y"
SET YSPRIV=1
QUIT
+4 ;interview
IF $PIECE(^YTT(601,YSET,0),U,9)="I"
SET YSPRIV=1
QUIT
+5 QUIT
