YTQPXRM2 ;ALB/ASF- MHA3 API FOR CLINICAL REMINDERS ; 7/27/07 1:25pm
;;5.01;MENTAL HEALTH;**85,119**;Dec 30, 1994;Build 40
;Reference to ^PXRMINDX(601.2, supported by DBIA #4114
;Reference to ^PXRMINDX(601.84, supported by DBIA #4290
;
;The following entry points are documented in ICR 5035:
; PTTEST
Q
PTTEST(YSDATA,YS) ;all data scores for a specific patient
;Input:
;YS("DFN"): Patient IFN from file2
;YS("CODE"): Test code NUMBER from file 601.71 including "ASI","GAF"
;YS("BEGIN"): inclusive date in %DT acceptable format (11/11/2011) to begin search [optional]
;YS("END"): inclusive date in %DT acceptable format (11/11/2011) to end search [optional]
;YS("LIMIT"): Last N administrations [optional]
;Output
;YSDATA(1)=[DATA]^NUMBER FOUND
;YSDATA(OCCURRENCE,1:999) most recent to least recent occurrence for this test for this patient
N YSBEG,YSCODE,R1,R2,R3,YSADATE,YSEND,YSLIMIT,YSLM,YSOCC,YSSCALE,YSSTAFF,YSZ,YSZN,G,YSORT,YSCODEN,YS601,%DT,DAS,DFN,IFN,NI,N,N1,N2,YSID,X,Y,YSNEG,YSDFN
K ^TMP($J,"YSG"),YSDATA
D PARSE(.YS)
I YSLM'?1NP.N!(YSLM=0) S YSDATA(1)="[ERROR]",YSDATA(2)="bad limit" Q ;-->out
I YSLM>0 S YSNEG=0,YSORT=-1
E S YSLM=YSLM*-1,YSNEG=1,YSORT=1
I YSCODE="ASI" D ASIPT Q ;-->out
I YSCODE="GAF" D GAFPT Q ;-->out
D P1,PA
S NI=0
I YSNEG=0 S N=9999999 F S N=$O(^TMP($J,"YSG",N),-1) Q:N=""!(NI=YSLM) D
. S N2=9999999 F S N2=$O(^TMP($J,"YSG",N,N2),-1) Q:N2=""!(NI=YSLM) S NI=NI+1,YSDATA(NI+1)=^TMP($J,"YSG",N,N2)
I YSNEG=1 S N=0 F S N=$O(^TMP($J,"YSG",N)) Q:N=""!(NI=YSLM) D
. S N2=0 F S N2=$O(^TMP($J,"YSG",N,N2)) Q:N2="" S NI=NI+1,YSDATA(NI+1)=^TMP($J,"YSG",N,N2)
S YSDATA(1)="[DATA]"_U_NI
K ^TMP($J,"YSG"),YS
Q
PA ;MHA3 DATA
I YSNEG=0 S YSID=YSEND+.00001
E S YSID=YSBEG-.00001
S NI=0
F S YSID=$O(^PXRMINDX(601.84,"PI",DFN,YSCODEN,YSID),YSORT) Q:(YSID'>0)!(YSID<YSBEG)!(YSID>YSEND) D
. S DAS=0 F S DAS=$O(^PXRMINDX(601.84,"PI",DFN,YSCODEN,YSID,DAS)) Q:DAS'>0!(NI=YSLM) D
.. S NI=NI+1
.. S ^TMP($J,"YSG",YSID,NI)=DAS_U_YSID_"^601.84"
Q
P1 ;old 601.2 data
I YSNEG=0 S YSID=YSEND+.00001
E S YSID=YSBEG-.00001
S NI=0
S YS601=$O(^YTT(601,"B",YSCODE,0))
Q:YS601="" ;-->out ASF 2/23/07
F S YSID=$O(^PXRMINDX(601.2,"PI",DFN,YS601,YSID),YSORT) Q:(YSID'>0)!(YSID<YSBEG)!(YSID>YSEND)!(NI=YSLM) D
. S DAS=DFN_";1;"_YS601_";1;"_YSID
. S NI=NI+1
. S ^TMP($J,"YSG",YSID,NI)=DAS_U_YSID_"^601.2"
Q
PARSE(YS) ; -- array parsing
S DFN=$G(YS("DFN"))
S (YSCODEN,YSCODE)=$G(YS("CODE"))
S YSCODE=$P($G(^YTT(601.71,YSCODEN,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\1
S YSEND=$G(YS("END")) S:YSEND="" YSEND="01/01/2099" S X=YSEND,%DT="T" D ^%DT S YSEND=Y
S YSLM=$G(YS("LIMIT"),1)
Q
GAFPT ;gaf for pt IN time
S YS601=$O(^YTT(601,"B","GAF",0))
S IFN=$S(YSORT=1:0,1:9999999),NI=0
K ^TMP($J,"YSGAF")
F S IFN=$O(^YSD(627.8,"C",DFN,IFN),YSORT) Q:(IFN'>0)!(NI=YSLM) D
. S X=$P($G(^YSD(627.8,IFN,60)),U,3)
. Q:X=""
. S X=+$P($G(^YSD(627.8,IFN,0)),U,3) ;FT 6/7/12 Remedy #391317
. Q:(X<YSBEG)!(X>YSEND)
. S NI=NI+1
. S ^TMP($J,"YSGAF",X,IFN)=""
S X=$S(YSORT=1:0,1:9999999)
F S X=$O(^TMP($J,"YSGAF",X),YSORT) Q:X'>0 S IFN=0 F S IFN=$O(^TMP($J,"YSGAF",X,IFN)) Q:IFN'>0 D
. S YSOCC=$O(YSDATA(9999999),-1)+1 S:YSOCC<2 YSOCC=2
. S DAS=DFN_";1;"_YS601_";1;"_IFN
. S YSDATA(YSOCC)=DAS_U_X_"^627.8"
S YSDATA(1)="[DATA]"_U_NI
Q
ASIPT ;asis for pt IN time
S YS601=$O(^YTT(601,"B","ASI",0))
S IFN=$S(YSORT=1:0,1:9999999),NI=0
F S IFN=$O(^YSTX(604,"C",DFN,IFN),YSORT) Q:IFN'>0!(NI=YSLM) D
. Q:'$D(^YSTX(604,IFN,.5)) ; no sig
. S X=$P($G(^YSTX(604,IFN,0)),U,5)
. Q:X=""
. Q:(X<YSBEG)!(X>YSEND)
. S YSOCC=$O(YSDATA(9999999),-1)+1 S:YSOCC<2 YSOCC=2
. S NI=NI+1
. S DAS=DFN_";1;"_YS601_";1;"_IFN
. S YSDATA(YSOCC)=DAS_U_X_"^604"
S YSDATA(1)="[DATA]"_U_NI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQPXRM2 4023 printed Apr 09, 2024@21:19:55 Page 2
YTQPXRM2 ;ALB/ASF- MHA3 API FOR CLINICAL REMINDERS ; 7/27/07 1:25pm
+1 ;;5.01;MENTAL HEALTH;**85,119**;Dec 30, 1994;Build 40
+2 ;Reference to ^PXRMINDX(601.2, supported by DBIA #4114
+3 ;Reference to ^PXRMINDX(601.84, supported by DBIA #4290
+4 ;
+5 ;The following entry points are documented in ICR 5035:
+6 ; PTTEST
+7 QUIT
PTTEST(YSDATA,YS) ;all data scores for a specific patient
+1 ;Input:
+2 ;YS("DFN"): Patient IFN from file2
+3 ;YS("CODE"): Test code NUMBER from file 601.71 including "ASI","GAF"
+4 ;YS("BEGIN"): inclusive date in %DT acceptable format (11/11/2011) to begin search [optional]
+5 ;YS("END"): inclusive date in %DT acceptable format (11/11/2011) to end search [optional]
+6 ;YS("LIMIT"): Last N administrations [optional]
+7 ;Output
+8 ;YSDATA(1)=[DATA]^NUMBER FOUND
+9 ;YSDATA(OCCURRENCE,1:999) most recent to least recent occurrence for this test for this patient
+10 NEW YSBEG,YSCODE,R1,R2,R3,YSADATE,YSEND,YSLIMIT,YSLM,YSOCC,YSSCALE,YSSTAFF,YSZ,YSZN,G,YSORT,YSCODEN,YS601,%DT,DAS,DFN,IFN,NI,N,N1,N2,YSID,X,Y,YSNEG,YSDFN
+11 KILL ^TMP($JOB,"YSG"),YSDATA
+12 DO PARSE(.YS)
+13 ;-->out
IF YSLM'?1NP.N!(YSLM=0)
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad limit"
QUIT
+14 IF YSLM>0
SET YSNEG=0
SET YSORT=-1
+15 IF '$TEST
SET YSLM=YSLM*-1
SET YSNEG=1
SET YSORT=1
+16 ;-->out
IF YSCODE="ASI"
DO ASIPT
QUIT
+17 ;-->out
IF YSCODE="GAF"
DO GAFPT
QUIT
+18 DO P1
DO PA
+19 SET NI=0
+20 IF YSNEG=0
SET N=9999999
FOR
SET N=$ORDER(^TMP($JOB,"YSG",N),-1)
if N=""!(NI=YSLM)
QUIT
Begin DoDot:1
+21 SET N2=9999999
FOR
SET N2=$ORDER(^TMP($JOB,"YSG",N,N2),-1)
if N2=""!(NI=YSLM)
QUIT
SET NI=NI+1
SET YSDATA(NI+1)=^TMP($JOB,"YSG",N,N2)
End DoDot:1
+22 IF YSNEG=1
SET N=0
FOR
SET N=$ORDER(^TMP($JOB,"YSG",N))
if N=""!(NI=YSLM)
QUIT
Begin DoDot:1
+23 SET N2=0
FOR
SET N2=$ORDER(^TMP($JOB,"YSG",N,N2))
if N2=""
QUIT
SET NI=NI+1
SET YSDATA(NI+1)=^TMP($JOB,"YSG",N,N2)
End DoDot:1
+24 SET YSDATA(1)="[DATA]"_U_NI
+25 KILL ^TMP($JOB,"YSG"),YS
+26 QUIT
PA ;MHA3 DATA
+1 IF YSNEG=0
SET YSID=YSEND+.00001
+2 IF '$TEST
SET YSID=YSBEG-.00001
+3 SET NI=0
+4 FOR
SET YSID=$ORDER(^PXRMINDX(601.84,"PI",DFN,YSCODEN,YSID),YSORT)
if (YSID'>0)!(YSID<YSBEG)!(YSID>YSEND)
QUIT
Begin DoDot:1
+5 SET DAS=0
FOR
SET DAS=$ORDER(^PXRMINDX(601.84,"PI",DFN,YSCODEN,YSID,DAS))
if DAS'>0!(NI=YSLM)
QUIT
Begin DoDot:2
+6 SET NI=NI+1
+7 SET ^TMP($JOB,"YSG",YSID,NI)=DAS_U_YSID_"^601.84"
End DoDot:2
End DoDot:1
+8 QUIT
P1 ;old 601.2 data
+1 IF YSNEG=0
SET YSID=YSEND+.00001
+2 IF '$TEST
SET YSID=YSBEG-.00001
+3 SET NI=0
+4 SET YS601=$ORDER(^YTT(601,"B",YSCODE,0))
+5 ;-->out ASF 2/23/07
if YS601=""
QUIT
+6 FOR
SET YSID=$ORDER(^PXRMINDX(601.2,"PI",DFN,YS601,YSID),YSORT)
if (YSID'>0)!(YSID<YSBEG)!(YSID>YSEND)!(NI=YSLM)
QUIT
Begin DoDot:1
+7 SET DAS=DFN_";1;"_YS601_";1;"_YSID
+8 SET NI=NI+1
+9 SET ^TMP($JOB,"YSG",YSID,NI)=DAS_U_YSID_"^601.2"
End DoDot:1
+10 QUIT
PARSE(YS) ; -- array parsing
+1 SET DFN=$GET(YS("DFN"))
+2 SET (YSCODEN,YSCODE)=$GET(YS("CODE"))
+3 SET YSCODE=$PIECE($GET(^YTT(601.71,YSCODEN,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 SET YSBEG=$GET(YS("BEGIN"))
if YSBEG=""
SET YSBEG="01/01/1970"
SET X=YSBEG
SET %DT="T"
DO ^%DT
SET YSBEG=Y\1
+7 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 YSLM=$GET(YS("LIMIT"),1)
+9 QUIT
GAFPT ;gaf for pt IN time
+1 SET YS601=$ORDER(^YTT(601,"B","GAF",0))
+2 SET IFN=$SELECT(YSORT=1:0,1:9999999)
SET NI=0
+3 KILL ^TMP($JOB,"YSGAF")
+4 FOR
SET IFN=$ORDER(^YSD(627.8,"C",DFN,IFN),YSORT)
if (IFN'>0)!(NI=YSLM)
QUIT
Begin DoDot:1
+5 SET X=$PIECE($GET(^YSD(627.8,IFN,60)),U,3)
+6 if X=""
QUIT
+7 ;FT 6/7/12 Remedy #391317
SET X=+$PIECE($GET(^YSD(627.8,IFN,0)),U,3)
+8 if (X<YSBEG)!(X>YSEND)
QUIT
+9 SET NI=NI+1
+10 SET ^TMP($JOB,"YSGAF",X,IFN)=""
End DoDot:1
+11 SET X=$SELECT(YSORT=1:0,1:9999999)
+12 FOR
SET X=$ORDER(^TMP($JOB,"YSGAF",X),YSORT)
if X'>0
QUIT
SET IFN=0
FOR
SET IFN=$ORDER(^TMP($JOB,"YSGAF",X,IFN))
if IFN'>0
QUIT
Begin DoDot:1
+13 SET YSOCC=$ORDER(YSDATA(9999999),-1)+1
if YSOCC<2
SET YSOCC=2
+14 SET DAS=DFN_";1;"_YS601_";1;"_IFN
+15 SET YSDATA(YSOCC)=DAS_U_X_"^627.8"
End DoDot:1
+16 SET YSDATA(1)="[DATA]"_U_NI
+17 QUIT
ASIPT ;asis for pt IN time
+1 SET YS601=$ORDER(^YTT(601,"B","ASI",0))
+2 SET IFN=$SELECT(YSORT=1:0,1:9999999)
SET NI=0
+3 FOR
SET IFN=$ORDER(^YSTX(604,"C",DFN,IFN),YSORT)
if IFN'>0!(NI=YSLM)
QUIT
Begin DoDot:1
+4 ; no sig
if '$DATA(^YSTX(604,IFN,.5))
QUIT
+5 SET X=$PIECE($GET(^YSTX(604,IFN,0)),U,5)
+6 if X=""
QUIT
+7 if (X<YSBEG)!(X>YSEND)
QUIT
+8 SET YSOCC=$ORDER(YSDATA(9999999),-1)+1
if YSOCC<2
SET YSOCC=2
+9 SET NI=NI+1
+10 SET DAS=DFN_";1;"_YS601_";1;"_IFN
+11 SET YSDATA(YSOCC)=DAS_U_X_"^604"
End DoDot:1
+12 SET YSDATA(1)="[DATA]"_U_NI
+13 QUIT
