YTAPI ;ALB/ASF- PSYCH TEST API ;2/27/04 15:44
;;5.01;MENTAL HEALTH;**53,71,76,77**;Dec 30, 1994
PARSE(YS) ; -- array parsing
S DFN=$G(YS("DFN"))
S YSCODE=$G(YS("CODE"))
S:YSCODE?1N.N YSCODE=$P($G(^YTT(601,YSCODE,0),"ERROR"),U)
S YSADATE=$G(YS("ADATE")) S X=YSADATE,%DT="T" D ^%DT S YSADATE=Y
S YSSCALE=$G(YS("SCALE"))
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
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
S YSLIMIT=$G(YS("LIMIT"),999)
S YSSTAFF=$G(YS("STAFF"))
S R1=$G(YS("R1"))
S R2=$G(YS("R2"))
S R3=$G(YS("R3"))
K %DT
Q
LISTALL(YSDATA,YS) ;
N N,N2,N4,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND,YSJJ,YSLIMIT
N IFN,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSONE,YSSTAFF,YSTYPE
D PARSE(.YS)
I DFN'>0!('$D(^DPT(DFN))) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN" Q
K YSDATA S YSDATA(1)="[DATA]"
S N=0 F S N=$O(^YTD(601.2,DFN,1,N)) Q:N'>0 D
. I $P(^YTT(601,N,0),U,9)="I" QUIT
. 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
.. S X=^YTT(601,N,0),N4=$P(X,U)
.. I N4="MMPI",$D(^YTD(601.2,DFN,1,N,1,N2,99)),^(99)="MMPIR" S N4="MMPR"
.. S YSPRIV="P" S:$P(X,U,10)="Y" YSPRIV="E" S:$P(X,U,9)="I" YSPRIV="E" ;ASF 4/18/01
.. S YSAA(9999999-N2,N4)=YSPRIV_U_N ;ASF 9/9/03
.. Q
I YSCODE="GAF" D GAF
I YSCODE="ASI" D ASI ;ASF 9/9/03
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
Q
GAF ;
N YSJJ,YSDD,X,Y,YSX,YSN
S YSDD=9999999-YSEND-.00001
F YSJJ=1:1:YSLIMIT S YSDD=$O(^YSD(627.8,"AX5",DFN,YSDD)) Q:YSDD'>0!(YSDD>(9999999-YSBEG)) D
. S YSN=0 F S YSN=$O(^YSD(627.8,"AX5",DFN,YSDD,YSN)) Q:YSN'>0 D
.. 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))
.. S YSAA(YSDD,"GAF")=9999999-YSDD_"^GAF^"_YSX
Q
ASI ;
Q:'$D(^YSTX(604,"C",DFN))
S IFN="A" F YSJJ=1:1:YSLIMIT S IFN=$O(^YSTX(604,"C",DFN,IFN),-1) Q:IFN'>0 D
. Q:'$D(^YSTX(604,IFN,.5)) ; no sig
. S N2=$P($G(^YSTX(604,IFN,0)),U,5)
. I N2>YSEND!(N2<YSBEG) Q ;not in range
. S YSSONE="^^^"
. S:YSSCALE=1 YSSONE="^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
. S:YSSCALE=2 YSSONE="^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
. S:YSSCALE=3 YSSONE="^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
. S:YSSCALE=4 YSSONE="^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
. S:YSSCALE=5 YSSONE="^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
. S:YSSCALE=6 YSSONE="^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
. S:YSSCALE=7 YSSONE="^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
. S YSAA(9999999-N2,"ASI")=N2_U_$$FMTE^XLFDT(N2,"5ZD")_YSSONE_U_IFN
Q
SET(X) ;
S N=N+1
S YSDATA(N)=X
Q
LISTONE(YSDATA,YS) ;
N YSLIMIT,YSJJ,YSSONE,S,R,N,YSN2,N4,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND,YSAA
N IFN,R1,R2,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSET
D PARSE(.YS)
K YSDATA
I DFN'>0!('$D(^DPT(DFN))) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN" Q
I '$D(^YTT(601,"B",YSCODE))&(YSCODE'="ASI")&(YSCODE'="GAF") S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
S YSET=-1 S:YSCODE'="ASI"&(YSCODE'="GAF") YSET=$O(^YTT(601,"B",YSCODE,""))
S YSDATA(1)="[DATA]"
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
. K YSSONE S YSSONE=""
. D PRIV^YTAPI2
. I YSSCALE'=""&(YSPRIV=1) D
.. S YSADATE=YSN2
.. D SCOR1^YTAPI2
.. D SF^YTAPI2
.. S YSSCALE=$G(YS("SCALE"))
. S:$D(YSSCALE)&(YSSCALE'="") YSSONE=$S($D(YSSONE(YSSCALE)):U_$P(YSSONE(YSSCALE),U,2,99),1:"")
. S YSAA(9999999-YSN2,YSCODE)=YSN2_YSSONE
. Q
I YSCODE="ASI" D ASI
I YSCODE="GAF" D GAF
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
. S X=$P(YSAA(I,II),U)_U_$$FMTE^XLFDT($P(YSAA(I,II),U),"5ZD")_U_II
. S:$P(YSAA(I,II),U,2)'="" X=X_U_$P(YSAA(I,II),U,2,9)
. D SET(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI 4352 printed Apr 09, 2024@21:20:38 Page 2
YTAPI ;ALB/ASF- PSYCH TEST API ;2/27/04 15:44
+1 ;;5.01;MENTAL HEALTH;**53,71,76,77**;Dec 30, 1994
PARSE(YS) ; -- array parsing
+1 SET DFN=$GET(YS("DFN"))
+2 SET YSCODE=$GET(YS("CODE"))
+3 if YSCODE?1N.N
SET YSCODE=$PIECE($GET(^YTT(601,YSCODE,0),"ERROR"),U)
+4 SET YSADATE=$GET(YS("ADATE"))
SET X=YSADATE
SET %DT="T"
DO ^%DT
SET YSADATE=Y
+5 SET YSSCALE=$GET(YS("SCALE"))
+6 ;ASF 1/30/04
SET YSBEG=$GET(YS("BEGIN"))
if YSBEG=""
SET YSBEG="01/01/1970"
SET X=YSBEG
SET %DT="T"
DO ^%DT
SET YSBEG=Y
+7 ;ASF 1/30/04
SET YSEND=$GET(YS("END"))
if YSEND=""
SET YSEND="01/01/2099"
SET X=YSEND
SET %DT="T"
DO ^%DT
SET YSEND=Y
+8 SET YSLIMIT=$GET(YS("LIMIT"),999)
+9 SET YSSTAFF=$GET(YS("STAFF"))
+10 SET R1=$GET(YS("R1"))
+11 SET R2=$GET(YS("R2"))
+12 SET R3=$GET(YS("R3"))
+13 KILL %DT
+14 QUIT
LISTALL(YSDATA,YS) ;
+1 NEW N,N2,N4,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND,YSJJ,YSLIMIT
+2 NEW IFN,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSONE,YSSTAFF,YSTYPE
+3 DO PARSE(.YS)
+4 IF DFN'>0!('$DATA(^DPT(DFN)))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD DFN"
QUIT
+5 KILL YSDATA
SET YSDATA(1)="[DATA]"
+6 SET N=0
FOR
SET N=$ORDER(^YTD(601.2,DFN,1,N))
if N'>0
QUIT
Begin DoDot:1
+7 IF $PIECE(^YTT(601,N,0),U,9)="I"
QUIT
+8 IF $DATA(^YTT(601,N))
SET N2=YSBEG-.1
FOR
SET N2=$ORDER(^YTD(601.2,DFN,1,N,1,N2))
if N2'>0!(N2>YSEND)
QUIT
Begin DoDot:2
+9 SET X=^YTT(601,N,0)
SET N4=$PIECE(X,U)
+10 IF N4="MMPI"
IF $DATA(^YTD(601.2,DFN,1,N,1,N2,99))
IF ^(99)="MMPIR"
SET N4="MMPR"
+11 ;ASF 4/18/01
SET YSPRIV="P"
if $PIECE(X,U,10)="Y"
SET YSPRIV="E"
if $PIECE(X,U,9)="I"
SET YSPRIV="E"
+12 ;ASF 9/9/03
SET YSAA(9999999-N2,N4)=YSPRIV_U_N
+13 QUIT
End DoDot:2
End DoDot:1
+14 IF YSCODE="GAF"
DO GAF
+15 ;ASF 9/9/03
IF YSCODE="ASI"
DO ASI
+16 ;ASF 4/18/01
SET I=0
SET N=1
FOR
SET I=$ORDER(YSAA(I))
if I'>0
QUIT
SET II=""
FOR
SET II=$ORDER(YSAA(I,II))
if II=""
QUIT
DO SET(9999999-I_U_$$FMTE^XLFDT(9999999-I,"5ZD")_U_II_U_YSAA(I,II))
+17 QUIT
GAF ;
+1 NEW YSJJ,YSDD,X,Y,YSX,YSN
+2 SET YSDD=9999999-YSEND-.00001
+3 FOR YSJJ=1:1:YSLIMIT
SET YSDD=$ORDER(^YSD(627.8,"AX5",DFN,YSDD))
if YSDD'>0!(YSDD>(9999999-YSBEG))
QUIT
Begin DoDot:1
+4 SET YSN=0
FOR
SET YSN=$ORDER(^YSD(627.8,"AX5",DFN,YSDD,YSN))
if YSN'>0
QUIT
Begin DoDot:2
+5 SET YSX=$PIECE($GET(^YSD(627.8,YSN,60)),U,3)_"^^"_$$EXTERNAL^DILFD(627.8,.04,"",$PIECE($GET(^YSD(627.8,YSN,0)),U,4))_U_$GET(^YSD(627.8,YSN,80,1,0))
+6 SET YSAA(YSDD,"GAF")=9999999-YSDD_"^GAF^"_YSX
End DoDot:2
End DoDot:1
+7 QUIT
ASI ;
+1 if '$DATA(^YSTX(604,"C",DFN))
QUIT
+2 SET IFN="A"
FOR YSJJ=1:1:YSLIMIT
SET IFN=$ORDER(^YSTX(604,"C",DFN,IFN),-1)
if IFN'>0
QUIT
Begin DoDot:1
+3 ; no sig
if '$DATA(^YSTX(604,IFN,.5))
QUIT
+4 SET N2=$PIECE($GET(^YSTX(604,IFN,0)),U,5)
+5 ;not in range
IF N2>YSEND!(N2<YSBEG)
QUIT
+6 SET YSSONE="^^^"
+7 if YSSCALE=1
SET YSSONE="^Medical^"_$$GET1^DIQ(604,IFN_",",8.12)_U_$$GET1^DIQ(604,IFN_",",.61)
+8 if YSSCALE=2
SET YSSONE="^Employment^"_$$GET1^DIQ(604,IFN_",",9.34)_U_$$GET1^DIQ(604,IFN_",",.62)
+9 if YSSCALE=3
SET YSSONE="^Alcohol^"_$$GET1^DIQ(604,IFN_",",11.18)_U_$$GET1^DIQ(604,IFN_",",.63)
+10 if YSSCALE=4
SET YSSONE="^Drug^"_$$GET1^DIQ(604,IFN_",",11.185)_U_$$GET1^DIQ(604,IFN_",",.635)
+11 if YSSCALE=5
SET YSSONE="^Legal^"_$$GET1^DIQ(604,IFN_",",14.34)_U_$$GET1^DIQ(604,IFN_",",.64)
+12 if YSSCALE=6
SET YSSONE="^Family^"_$$GET1^DIQ(604,IFN_",",18.29)_U_$$GET1^DIQ(604,IFN_",",.65)
+13 if YSSCALE=7
SET YSSONE="^Psychiatric^"_$$GET1^DIQ(604,IFN_",",19.33)_U_$$GET1^DIQ(604,IFN_",",.66)
+14 SET YSAA(9999999-N2,"ASI")=N2_U_$$FMTE^XLFDT(N2,"5ZD")_YSSONE_U_IFN
End DoDot:1
+15 QUIT
SET(X) ;
+1 SET N=N+1
+2 SET YSDATA(N)=X
+3 QUIT
LISTONE(YSDATA,YS) ;
+1 NEW YSLIMIT,YSJJ,YSSONE,S,R,N,YSN2,N4,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND,YSAA
+2 NEW IFN,R1,R2,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSET
+3 DO PARSE(.YS)
+4 KILL YSDATA
+5 IF DFN'>0!('$DATA(^DPT(DFN)))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD DFN"
QUIT
+6 IF '$DATA(^YTT(601,"B",YSCODE))&(YSCODE'="ASI")&(YSCODE'="GAF")
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="INCORRECT TEST CODE"
QUIT
+7 SET YSET=-1
if YSCODE'="ASI"&(YSCODE'="GAF")
SET YSET=$ORDER(^YTT(601,"B",YSCODE,""))
+8 SET YSDATA(1)="[DATA]"
+9 IF $DATA(^YTT(601,YSET))
SET YSN2=YSEND+.1
FOR YSJJ=1:1:YSLIMIT
SET YSN2=$ORDER(^YTD(601.2,DFN,1,YSET,1,YSN2),-1)
if YSN2'>0!(YSN2<YSBEG)
QUIT
Begin DoDot:1
+10 KILL YSSONE
SET YSSONE=""
+11 DO PRIV^YTAPI2
+12 IF YSSCALE'=""&(YSPRIV=1)
Begin DoDot:2
+13 SET YSADATE=YSN2
+14 DO SCOR1^YTAPI2
+15 DO SF^YTAPI2
+16 SET YSSCALE=$GET(YS("SCALE"))
End DoDot:2
+17 if $DATA(YSSCALE)&(YSSCALE'="")
SET YSSONE=$SELECT($DATA(YSSONE(YSSCALE)):U_$PIECE(YSSONE(YSSCALE),U,2,99),1:"")
+18 SET YSAA(9999999-YSN2,YSCODE)=YSN2_YSSONE
+19 QUIT
End DoDot:1
+20 IF YSCODE="ASI"
DO ASI
+21 IF YSCODE="GAF"
DO GAF
+22 SET I=0
SET N=1
FOR
SET I=$ORDER(YSAA(I))
if I'>0
QUIT
SET II=""
FOR
SET II=$ORDER(YSAA(I,II))
if II=""
QUIT
Begin DoDot:1
+23 SET X=$PIECE(YSAA(I,II),U)_U_$$FMTE^XLFDT($PIECE(YSAA(I,II),U),"5ZD")_U_II
+24 if $PIECE(YSAA(I,II),U,2)'=""
SET X=X_U_$PIECE(YSAA(I,II),U,2,9)
+25 DO SET(X)
End DoDot:1
+26 QUIT
