BQIDCEUA ;PRXM/HC/ALA-Unanticipated Emergency Room Revisits ; 12 Dec 2005 1:07 PM
;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10
;
Q
;
VIS(DATA,PARMS,MPARMS) ;EP
;
;Description
; Executable to retrieve unanticipated emergency room visits flags
;Input
; PARMS = Array of parameters and their values
; MPARMS = Multiple array of a parameter
;Output
;
NEW UID
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP(UID,"BQIDCEUA"))
K @DATA
;
NEW IEN,NM,FDT,TDT,VTYP,X,DIC,Y,ADDTM,VIEN,DFN,%DT,TMFRAME,ER
S NM=""
F S NM=$O(PARMS(NM)) Q:NM="" S @NM=PARMS(NM)
;
I $G(TMFRAME)="" Q
I TMFRAME["T-" D
. S %DT="",X=TMFRAME D ^%DT S FDT=Y
I $G(DT)="" D DT^DICRW
S TDT=DT
;
;S VTYP=$$FIND1^DIC(9009083,"","Q","UNSCHEDULED REVISIT","B","","ERROR")
S VTYP=$O(^AMER(3,"B","UNSCHEDULED REVISIT",""))
;I 'VTYP Q
I VTYP="" Q
;
;S ER=$$FIND1^DIC(40.7,"","Q","EMERGENCY","B","","ERROR")
;I 'ER Q
S ER=$O(^DIC(40.7,"B","EMERGENCY MEDICINE",""))
I ER="" Q
;
; Check the ER Visit File
S ADDTM=FDT
F S ADDTM=$O(^AMERVSIT("B",ADDTM)) Q:ADDTM=""!(ADDTM\1>TDT) D
. S IEN=""
. F S IEN=$O(^AMERVSIT("B",ADDTM,IEN)) Q:IEN="" D
.. ;I $$GET1^DIQ(9009080,IEN_",",.05,"I")'=VTYP Q
.. I $P($G(^AMERVSIT(IEN,0)),"^",5)'=VTYP Q
.. ;S DFN=$$GET1^DIQ(9009080,IEN_",",.02,"I") I DFN="" Q
.. S DFN=$P($G(^AMERVSIT(IEN,0)),"^",2) I DFN="" Q
.. ; Exclude deceased patients
.. I $P($G(^DPT(DFN,.35)),U,1)'="" Q
.. ; If patient has no active HRNs, quit
.. I '$$HRN^BQIUL1(DFN) Q
.. ; If patient has no visit in last 3 years, quit
.. I '$$VTHR^BQIUL1(DFN) Q
.. S VIEN=$$GET1^DIQ(9009080,IEN_",",.03,"I")
.. I VIEN="" Q
.. ;I $$GET1^DIQ(9000010,VIEN,.11,"I")=1 Q
.. I $P($G(^AUPNVSIT(VIEN,0)),"^",11)=1 Q
.. ;I $$GET1^DIQ(9000010,VIEN,.08,"I")'=ER Q
.. I $P($G(^AUPNVSIT(VIEN,0)),"^",8)'=ER Q
.. I $D(^BQIPAT(DFN,10,"AC",VIEN))>0 Q
.. ;S @DATA@(DFN,IEN)=VIEN_U_$$GET1^DIQ(9000010,VIEN,.01,"I")
.. S @DATA@(DFN,IEN)=VIEN_U_$P($G(^AUPNVSIT(VIEN,0)),"^",1)
;
Q
; Check the ER Admission File
S DFN=0
F S DFN=$O(^AMERADM(DFN)) Q:'DFN D
. S ADDTM=$$GET1^DIQ(9009081,DFN,1,"I")\1
. I ADDTM<FDT Q
. I $$GET1^DIQ(9009081,DFN,3,"I")'=VTYP Q
. S @DATA@(DFN,DFN)=U_ADDTM
Q
BQIDCEUA ;PRXM/HC/ALA-Unanticipated Emergency Room Revisits ; 12 Dec 2005 1:07 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10
+2 ;
+3 QUIT
+4 ;
VIS(DATA,PARMS,MPARMS) ;EP
+1 ;
+2 ;Description
+3 ; Executable to retrieve unanticipated emergency room visits flags
+4 ;Input
+5 ; PARMS = Array of parameters and their values
+6 ; MPARMS = Multiple array of a parameter
+7 ;Output
+8 ;
+9 NEW UID
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP(UID,"BQIDCEUA"))
+12 KILL @DATA
+13 ;
+14 NEW IEN,NM,FDT,TDT,VTYP,X,DIC,Y,ADDTM,VIEN,DFN,%DT,TMFRAME,ER
+15 SET NM=""
+16 FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
SET @NM=PARMS(NM)
+17 ;
+18 IF $GET(TMFRAME)=""
QUIT
+19 IF TMFRAME["T-"
Begin DoDot:1
+20 SET %DT=""
SET X=TMFRAME
DO ^%DT
SET FDT=Y
End DoDot:1
+21 IF $GET(DT)=""
DO DT^DICRW
+22 SET TDT=DT
+23 ;
+24 ;S VTYP=$$FIND1^DIC(9009083,"","Q","UNSCHEDULED REVISIT","B","","ERROR")
+25 SET VTYP=$ORDER(^AMER(3,"B","UNSCHEDULED REVISIT",""))
+26 ;I 'VTYP Q
+27 IF VTYP=""
QUIT
+28 ;
+29 ;S ER=$$FIND1^DIC(40.7,"","Q","EMERGENCY","B","","ERROR")
+30 ;I 'ER Q
+31 SET ER=$ORDER(^DIC(40.7,"B","EMERGENCY MEDICINE",""))
+32 IF ER=""
QUIT
+33 ;
+34 ; Check the ER Visit File
+35 SET ADDTM=FDT
+36 FOR
SET ADDTM=$ORDER(^AMERVSIT("B",ADDTM))
IF ADDTM=""!(ADDTM\1>TDT)
QUIT
Begin DoDot:1
+37 SET IEN=""
+38 FOR
SET IEN=$ORDER(^AMERVSIT("B",ADDTM,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+39 ;I $$GET1^DIQ(9009080,IEN_",",.05,"I")'=VTYP Q
+40 IF $PIECE($GET(^AMERVSIT(IEN,0)),"^",5)'=VTYP
QUIT
+41 ;S DFN=$$GET1^DIQ(9009080,IEN_",",.02,"I") I DFN="" Q
+42 SET DFN=$PIECE($GET(^AMERVSIT(IEN,0)),"^",2)
IF DFN=""
QUIT
+43 ; Exclude deceased patients
+44 IF $PIECE($GET(^DPT(DFN,.35)),U,1)'=""
QUIT
+45 ; If patient has no active HRNs, quit
+46 IF '$$HRN^BQIUL1(DFN)
QUIT
+47 ; If patient has no visit in last 3 years, quit
+48 IF '$$VTHR^BQIUL1(DFN)
QUIT
+49 SET VIEN=$$GET1^DIQ(9009080,IEN_",",.03,"I")
+50 IF VIEN=""
QUIT
+51 ;I $$GET1^DIQ(9000010,VIEN,.11,"I")=1 Q
+52 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),"^",11)=1
QUIT
+53 ;I $$GET1^DIQ(9000010,VIEN,.08,"I")'=ER Q
+54 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),"^",8)'=ER
QUIT
+55 IF $DATA(^BQIPAT(DFN,10,"AC",VIEN))>0
QUIT
+56 ;S @DATA@(DFN,IEN)=VIEN_U_$$GET1^DIQ(9000010,VIEN,.01,"I")
+57 SET @DATA@(DFN,IEN)=VIEN_U_$PIECE($GET(^AUPNVSIT(VIEN,0)),"^",1)
End DoDot:2
End DoDot:1
+58 ;
+59 QUIT
+60 ; Check the ER Admission File
+61 SET DFN=0
+62 FOR
SET DFN=$ORDER(^AMERADM(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+63 SET ADDTM=$$GET1^DIQ(9009081,DFN,1,"I")\1
+64 IF ADDTM<FDT
QUIT
+65 IF $$GET1^DIQ(9009081,DFN,3,"I")'=VTYP
QUIT
+66 SET @DATA@(DFN,DFN)=U_ADDTM
End DoDot:1
+67 QUIT
