BQIDCABK ;PRXM/HC/ALA-Kernel Alerts for Abnormal Labs ; 14 Jul 2006 4:44 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
ALR(DATA,PARMS,MPARMS) ;EP
;
;Description
; Executable that determines abnormal lab Kernal alerts
;Input
; PARMS = Array of parameters and their values
; MPARMS = Multiple array of a parameter
;Parameters
; TMFRAME = Relative time frame
; FDT = Starting date for the time frame
; TDT = Ending date for the time frame
; IEN = Lab record internal entry number
; VIEN = Visit record internal entry number
; ABNFL = Abnormal lab result
;Output
; All records found will be put into ^TMP by patient and Alert internal entry
; numbers. The patient will be checked against the patients found in all the
; panels and added to the ICARE PATIENT INDEX file.
;
NEW UID,TDATA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIDCABK",UID))
S TDATA=$NA(^TMP("BQITMP",UID))
K @DATA,@TDATA
;
NEW IEN,NM,FDT,TDT,VTYP,X,DIC,Y,RSTM,VIEN,DFN,USR,ALRT,ALRIEN
NEW LRDFN,TYP,LDT,LREC,ACC,LIEN,TMFRAME,%DT,LDATA,ALDATA
S NM=""
F S NM=$O(PARMS(NM)) Q:NM="" S @NM=PARMS(NM)
;
I $G(TMFRAME)="" S TMFRAME="T-6M"
I TMFRAME["T-" D
. S %DT="",X=TMFRAME D ^%DT S FDT=Y
I $G(DT)="" D DT^DICRW
S TDT=DT
;
; Go through the Alert file for the designated time frame to find any
; abnormal lab results
S USR=0
F S USR=$O(^XTV(8992,USR)) Q:'USR D
. S RSTM=FDT
. F S RSTM=$O(^XTV(8992,USR,"XQA",RSTM)) Q:RSTM=""!(RSTM\1>TDT) D
.. I $G(^XTV(8992,USR,"XQA",RSTM,0))'["Abnormal lab" Q
.. S ALRT=$P(^XTV(8992,USR,"XQA",RSTM,0),U,2)
.. S ALRIEN=$O(^XTV(8992.1,"B",ALRT,"")) I ALRIEN="" Q
.. ;S DFN=$P($P(ALRT,";"),",",2)
.. S DFN=$P($G(^XTV(8992.1,ALRIEN,0)),U,4) I DFN="" Q
.. S ALDATA=$G(^XTV(8992.1,ALRIEN,2))
.. S LDATA=$P(ALDATA,"@",2)
.. S LRDFN=$P($G(^DPT(DFN,"LR")),U,1) I LRDFN="" Q
.. S TYP=$P(LDATA,";",4) I TYP="" Q
.. S LDT=$P(LDATA,";",5) I LDT="" Q
.. S LREC=$G(^LR(LRDFN,TYP,LDT,0)),ACC=$P(LREC,U,6) I ACC="" Q
.. S LIEN=""
.. F S LIEN=$O(^AUPNVLAB("AC",DFN,LIEN)) Q:LIEN="" D
... I $P(^AUPNVLAB(LIEN,0),U,6)'=ACC Q
... S VIEN=$$GET1^DIQ(9000010.09,LIEN_",",.03,"I")
... I VIEN="" Q
... I $$GET1^DIQ(9000010,VIEN,.11,"I")=1 Q
... S @TDATA@(DFN,VIEN)=ALRIEN_U_$$GET1^DIQ(9000010,VIEN,.01,"I")
;
S DFN=""
F S DFN=$O(@TDATA@(DFN)) Q:DFN="" D
. S VIEN=""
. F S VIEN=$O(@TDATA@(DFN,VIEN)) Q:VIEN="" D
.. S ALRIEN=$P(@TDATA@(DFN,VIEN),U,1),VSDTM=$P(@TDATA@(DFN,VIEN),U,2)
.. S @DATA@(DFN,ALRIEN)=VIEN_U_VSDTM
K @TDATA
Q
BQIDCABK ;PRXM/HC/ALA-Kernel Alerts for Abnormal Labs ; 14 Jul 2006 4:44 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
ALR(DATA,PARMS,MPARMS) ;EP
+1 ;
+2 ;Description
+3 ; Executable that determines abnormal lab Kernal alerts
+4 ;Input
+5 ; PARMS = Array of parameters and their values
+6 ; MPARMS = Multiple array of a parameter
+7 ;Parameters
+8 ; TMFRAME = Relative time frame
+9 ; FDT = Starting date for the time frame
+10 ; TDT = Ending date for the time frame
+11 ; IEN = Lab record internal entry number
+12 ; VIEN = Visit record internal entry number
+13 ; ABNFL = Abnormal lab result
+14 ;Output
+15 ; All records found will be put into ^TMP by patient and Alert internal entry
+16 ; numbers. The patient will be checked against the patients found in all the
+17 ; panels and added to the ICARE PATIENT INDEX file.
+18 ;
+19 NEW UID,TDATA
+20 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+21 SET DATA=$NAME(^TMP("BQIDCABK",UID))
+22 SET TDATA=$NAME(^TMP("BQITMP",UID))
+23 KILL @DATA,@TDATA
+24 ;
+25 NEW IEN,NM,FDT,TDT,VTYP,X,DIC,Y,RSTM,VIEN,DFN,USR,ALRT,ALRIEN
+26 NEW LRDFN,TYP,LDT,LREC,ACC,LIEN,TMFRAME,%DT,LDATA,ALDATA
+27 SET NM=""
+28 FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
SET @NM=PARMS(NM)
+29 ;
+30 IF $GET(TMFRAME)=""
SET TMFRAME="T-6M"
+31 IF TMFRAME["T-"
Begin DoDot:1
+32 SET %DT=""
SET X=TMFRAME
DO ^%DT
SET FDT=Y
End DoDot:1
+33 IF $GET(DT)=""
DO DT^DICRW
+34 SET TDT=DT
+35 ;
+36 ; Go through the Alert file for the designated time frame to find any
+37 ; abnormal lab results
+38 SET USR=0
+39 FOR
SET USR=$ORDER(^XTV(8992,USR))
IF 'USR
QUIT
Begin DoDot:1
+40 SET RSTM=FDT
+41 FOR
SET RSTM=$ORDER(^XTV(8992,USR,"XQA",RSTM))
IF RSTM=""!(RSTM\1>TDT)
QUIT
Begin DoDot:2
+42 IF $GET(^XTV(8992,USR,"XQA",RSTM,0))'["Abnormal lab"
QUIT
+43 SET ALRT=$PIECE(^XTV(8992,USR,"XQA",RSTM,0),U,2)
+44 SET ALRIEN=$ORDER(^XTV(8992.1,"B",ALRT,""))
IF ALRIEN=""
QUIT
+45 ;S DFN=$P($P(ALRT,";"),",",2)
+46 SET DFN=$PIECE($GET(^XTV(8992.1,ALRIEN,0)),U,4)
IF DFN=""
QUIT
+47 SET ALDATA=$GET(^XTV(8992.1,ALRIEN,2))
+48 SET LDATA=$PIECE(ALDATA,"@",2)
+49 SET LRDFN=$PIECE($GET(^DPT(DFN,"LR")),U,1)
IF LRDFN=""
QUIT
+50 SET TYP=$PIECE(LDATA,";",4)
IF TYP=""
QUIT
+51 SET LDT=$PIECE(LDATA,";",5)
IF LDT=""
QUIT
+52 SET LREC=$GET(^LR(LRDFN,TYP,LDT,0))
SET ACC=$PIECE(LREC,U,6)
IF ACC=""
QUIT
+53 SET LIEN=""
+54 FOR
SET LIEN=$ORDER(^AUPNVLAB("AC",DFN,LIEN))
IF LIEN=""
QUIT
Begin DoDot:3
+55 IF $PIECE(^AUPNVLAB(LIEN,0),U,6)'=ACC
QUIT
+56 SET VIEN=$$GET1^DIQ(9000010.09,LIEN_",",.03,"I")
+57 IF VIEN=""
QUIT
+58 IF $$GET1^DIQ(9000010,VIEN,.11,"I")=1
QUIT
+59 SET @TDATA@(DFN,VIEN)=ALRIEN_U_$$GET1^DIQ(9000010,VIEN,.01,"I")
End DoDot:3
End DoDot:2
End DoDot:1
+60 ;
+61 SET DFN=""
+62 FOR
SET DFN=$ORDER(@TDATA@(DFN))
IF DFN=""
QUIT
Begin DoDot:1
+63 SET VIEN=""
+64 FOR
SET VIEN=$ORDER(@TDATA@(DFN,VIEN))
IF VIEN=""
QUIT
Begin DoDot:2
+65 SET ALRIEN=$PIECE(@TDATA@(DFN,VIEN),U,1)
SET VSDTM=$PIECE(@TDATA@(DFN,VIEN),U,2)
+66 SET @DATA@(DFN,ALRIEN)=VIEN_U_VSDTM
End DoDot:2
End DoDot:1
+67 KILL @TDATA
+68 QUIT
