- 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
