- 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 Feb 18, 2025@23:43:05 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