BQIDCERV ;GDIT/HCSD/ALA-Emergency Room Visits (Pt List) ; 25 Feb 2013 4:09 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
Q
;
EN(DATA,PARMS,MPARMS) ;EP
;
;Description
; Executable to retrieve inpatients for the specified parameters
;Input
; PARMS = Array of parameters and their values
; MPARMS = Multiple array of a parameter
;Output
; ^TMP("BQIDCINP",UID,DFN,VISIT IEN)=""
;
NEW UID,IEN,EAFROM,EATHRU,EARANGE,EDFROM,EDTHRU,EDRANGE,EDTYP,EDACU,EVTYP
NEW AFDT,AEDT,RFROM,RTHRU,DFDT,DEDT,IEN,DFN,CT,MCT,PCT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIDCINP",UID))
S DCRIT=$NA(^TMP("BQICRIT",UID))
K @DATA,@DCRIT
;
; Set the parameters into variables
I '$D(PARMS) Q
S PCT=0
;
S NM="" F S NM=$O(PARMS(NM)) Q:NM="" S @NM=PARMS(NM)
S EAFROM=$G(EAFROM,""),EATHRU=$G(EATHRU,""),EARANGE=$G(EARANGE,"")
S EDFROM=$G(EDFROM,""),EDTHRU=$G(EDTHRU,""),EDRANGE=$G(EDRANGE,"")
S EDTYP=$G(EDTYP,""),EDACU=$G(EDACU,""),EVTYP=$G(EVTYP,"")
S CURERV=$G(CURERV,"N")
I $G(EDTYP)'=""!($D(MPARMS("EDTYP"))) S PCT=PCT+1
I $G(EDACU)'=""!($D(MPARMS("EDACU"))) S PCT=PCT+1
I $G(EVTYP)'=""!($D(MPARMS("EVTYP"))) S PCT=PCT+1
;
I $G(EARANGE)'="" D
. I $G(PPIEN)'="" D RANGE^BQIDCAH1(EARANGE,PPIEN,"EARANGE")
. S AFDT=$S($G(RFROM)'="":RFROM,1:$G(EAFROM))
. S AEDT=$S($G(RTHRU)'="":RTHRU,1:$G(EATHRU))
I $G(EAFROM)'="" S AFDT=EAFROM,AEDT=$G(EATHRU)
;
I $G(EDRANGE)'="" D
. I $G(PPIEN)'="" D RANGE^BQIDCAH1(EDRANGE,PPIEN,"EDRANGE")
. S DFDT=$S($G(RFROM)'="":RFROM,1:$G(EDFROM))
. S DEDT=$S($G(RTHRU)'="":RTHRU,1:$G(EDTHRU))
I $G(EDFROM)'="" S DFDT=EDFROM,DEDT=$G(EDTHRU)
;
I $G(CURERV)="Y" D
. S DFN=0
. F S DFN=$O(^AMERADM(DFN)) Q:'DFN D
.. S IEN=DFN,PCT=1
.. D UPD(1,0)
.. S ADM=$P(^AMERADM(DFN,0),U,2)\1
.. I $G(AFDT)'="",(ADM<AFDT)!(ADM>AEDT) Q
.. D UPD(1,1)
;
I $G(CURERV)="N" D
. I $G(AFDT)'="" S PCT=PCT+1 D
.. S AFDT=AFDT-.0001
.. F S AFDT=$O(^AMERVSIT("B",AFDT)) Q:AFDT=""!(AFDT\1>AEDT) D
... S IEN=""
... F S IEN=$O(^AMERVSIT("B",AFDT,IEN)) Q:IEN="" D
.... S DFN=$P(^AMERVSIT(IEN,0),U,2) D UPD(1,0)
.... D UPD(1,1)
.... D OTH
. ;
. I $G(DFDT)'="" S PCT=PCT+1 D
.. NEW BGDT
.. S BGDT=$$FMADD^XLFDT(DFDT,-120)
.. F S BGDT=$O(^AMERVSIT("B",BGDT)) Q:BGDT=""!(BGDT\1>DEDT) D
... S IEN=""
... F S IEN=$O(^AMERVSIT("B",BGDT,IEN)) Q:IEN="" D
.... S DEPDT=$P($G(^AMERVSIT(IEN,6)),U,2)\1
.... S DFN=$P(^AMERVSIT(IEN,0),U,2) D UPD(4,0)
.... I DEPDT<DFDT!(DEPDT>DEDT) D UPD(4,0) Q
.... D UPD(4,1)
.... D OTH
;
S DFN=""
F S DFN=$O(@DCRIT@("ERV",DFN)) Q:DFN="" D
. S IEN=""
. F S IEN=$O(@DCRIT@("ERV",DFN,IEN)) Q:IEN="" D CNF
Q
;
CNF ;EP - confirm
S CT=0,MCT=0
F I=1:1:$L(@DCRIT@("ERV",DFN,IEN),U) D
. ;I $P(@DCRIT@("ERV",DFN,IEN),U,I)'="" S CT=CT+1
. I $P(@DCRIT@("ERV",DFN,IEN),U,I)'="",$P(@DCRIT@("ERV",DFN,IEN),U,I)=1 S MCT=MCT+1
I MCT=0 K @DCRIT@("ERV",DFN,IEN) Q
I PCT'=MCT K @DCRIT@("ERV",DFN,IEN) Q
I PCT=MCT S @DATA@(DFN)=""
Q
;
UPD(PEC,VAL) ;EP
S $P(@DCRIT@("ERV",DFN,IEN),U,PEC)=VAL
Q
;
OTH ;EP
I $G(EVTYP)="",'$D(MPARMS("EVTYP")) D UPD(2,"")
I $G(EVTYP)'="" D UPD(2,0) I $P(^AMERVSIT(IEN,0),U,5)=EVTYP D UPD(2,1)
I $G(EVTYP)="",$D(MPARMS("EVTYP")) D
. S EVTYP="" D UPD(2,0)
. F S EVTYP=$O(MPARMS("EVTYP",EVTYP)) Q:EVTYP="" I $P(^AMERVSIT(IEN,0),U,5)=EVTYP D UPD(2,1)
I $G(EDTYP)="",'$D(MPARMS("EDTYP")) D UPD(3,"")
I $G(EDTYP)'="" D UPD(3,0) I $P($G(^AMERVSIT(IEN,6)),U,1)=EDTYP D UPD(3,1)
I $G(EDTYP)="",$D(MPARMS("EDTYP")) D
. S EDTYP="" D UPD(3,0)
. F S EDTYP=$O(MPARMS("EDTYP",EDTYP)) Q:EDTYP="" I $P($G(^AMERVSIT(IEN,6)),U,1)=EDTYP D UPD(3,1)
I $G(EDACU)="",'$D(MPARMS("EDACU")) D UPD(5,"")
I $G(EDACU)'="" D UPD(5,0) I $P($G(^AMERVSIT(IEN,5.1)),U,4)=EDACU D UPD(5,1)
I $G(EDACU)="",$D(MPARMS("EDACU")) D
. S EDACU="" D UPD(5,0)
. F S EDACU=$O(MPARMS("EDACU",EDACU)) Q:EDACU="" I $P($G(^AMERVSIT(IEN,5.1)),U,4)=EDACU D UPD(5,1)
Q
BQIDCERV ;GDIT/HCSD/ALA-Emergency Room Visits (Pt List) ; 25 Feb 2013 4:09 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 QUIT
+4 ;
EN(DATA,PARMS,MPARMS) ;EP
+1 ;
+2 ;Description
+3 ; Executable to retrieve inpatients for the specified parameters
+4 ;Input
+5 ; PARMS = Array of parameters and their values
+6 ; MPARMS = Multiple array of a parameter
+7 ;Output
+8 ; ^TMP("BQIDCINP",UID,DFN,VISIT IEN)=""
+9 ;
+10 NEW UID,IEN,EAFROM,EATHRU,EARANGE,EDFROM,EDTHRU,EDRANGE,EDTYP,EDACU,EVTYP
+11 NEW AFDT,AEDT,RFROM,RTHRU,DFDT,DEDT,IEN,DFN,CT,MCT,PCT
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("BQIDCINP",UID))
+14 SET DCRIT=$NAME(^TMP("BQICRIT",UID))
+15 KILL @DATA,@DCRIT
+16 ;
+17 ; Set the parameters into variables
+18 IF '$DATA(PARMS)
QUIT
+19 SET PCT=0
+20 ;
+21 SET NM=""
FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
SET @NM=PARMS(NM)
+22 SET EAFROM=$GET(EAFROM,"")
SET EATHRU=$GET(EATHRU,"")
SET EARANGE=$GET(EARANGE,"")
+23 SET EDFROM=$GET(EDFROM,"")
SET EDTHRU=$GET(EDTHRU,"")
SET EDRANGE=$GET(EDRANGE,"")
+24 SET EDTYP=$GET(EDTYP,"")
SET EDACU=$GET(EDACU,"")
SET EVTYP=$GET(EVTYP,"")
+25 SET CURERV=$GET(CURERV,"N")
+26 IF $GET(EDTYP)'=""!($DATA(MPARMS("EDTYP")))
SET PCT=PCT+1
+27 IF $GET(EDACU)'=""!($DATA(MPARMS("EDACU")))
SET PCT=PCT+1
+28 IF $GET(EVTYP)'=""!($DATA(MPARMS("EVTYP")))
SET PCT=PCT+1
+29 ;
+30 IF $GET(EARANGE)'=""
Begin DoDot:1
+31 IF $GET(PPIEN)'=""
DO RANGE^BQIDCAH1(EARANGE,PPIEN,"EARANGE")
+32 SET AFDT=$SELECT($GET(RFROM)'="":RFROM,1:$GET(EAFROM))
+33 SET AEDT=$SELECT($GET(RTHRU)'="":RTHRU,1:$GET(EATHRU))
End DoDot:1
+34 IF $GET(EAFROM)'=""
SET AFDT=EAFROM
SET AEDT=$GET(EATHRU)
+35 ;
+36 IF $GET(EDRANGE)'=""
Begin DoDot:1
+37 IF $GET(PPIEN)'=""
DO RANGE^BQIDCAH1(EDRANGE,PPIEN,"EDRANGE")
+38 SET DFDT=$SELECT($GET(RFROM)'="":RFROM,1:$GET(EDFROM))
+39 SET DEDT=$SELECT($GET(RTHRU)'="":RTHRU,1:$GET(EDTHRU))
End DoDot:1
+40 IF $GET(EDFROM)'=""
SET DFDT=EDFROM
SET DEDT=$GET(EDTHRU)
+41 ;
+42 IF $GET(CURERV)="Y"
Begin DoDot:1
+43 SET DFN=0
+44 FOR
SET DFN=$ORDER(^AMERADM(DFN))
IF 'DFN
QUIT
Begin DoDot:2
+45 SET IEN=DFN
SET PCT=1
+46 DO UPD(1,0)
+47 SET ADM=$PIECE(^AMERADM(DFN,0),U,2)\1
+48 IF $GET(AFDT)'=""
IF (ADM<AFDT)!(ADM>AEDT)
QUIT
+49 DO UPD(1,1)
End DoDot:2
End DoDot:1
+50 ;
+51 IF $GET(CURERV)="N"
Begin DoDot:1
+52 IF $GET(AFDT)'=""
SET PCT=PCT+1
Begin DoDot:2
+53 SET AFDT=AFDT-.0001
+54 FOR
SET AFDT=$ORDER(^AMERVSIT("B",AFDT))
IF AFDT=""!(AFDT\1>AEDT)
QUIT
Begin DoDot:3
+55 SET IEN=""
+56 FOR
SET IEN=$ORDER(^AMERVSIT("B",AFDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+57 SET DFN=$PIECE(^AMERVSIT(IEN,0),U,2)
DO UPD(1,0)
+58 DO UPD(1,1)
+59 DO OTH
End DoDot:4
End DoDot:3
End DoDot:2
+60 ;
+61 IF $GET(DFDT)'=""
SET PCT=PCT+1
Begin DoDot:2
+62 NEW BGDT
+63 SET BGDT=$$FMADD^XLFDT(DFDT,-120)
+64 FOR
SET BGDT=$ORDER(^AMERVSIT("B",BGDT))
IF BGDT=""!(BGDT\1>DEDT)
QUIT
Begin DoDot:3
+65 SET IEN=""
+66 FOR
SET IEN=$ORDER(^AMERVSIT("B",BGDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+67 SET DEPDT=$PIECE($GET(^AMERVSIT(IEN,6)),U,2)\1
+68 SET DFN=$PIECE(^AMERVSIT(IEN,0),U,2)
DO UPD(4,0)
+69 IF DEPDT<DFDT!(DEPDT>DEDT)
DO UPD(4,0)
QUIT
+70 DO UPD(4,1)
+71 DO OTH
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+72 ;
+73 SET DFN=""
+74 FOR
SET DFN=$ORDER(@DCRIT@("ERV",DFN))
IF DFN=""
QUIT
Begin DoDot:1
+75 SET IEN=""
+76 FOR
SET IEN=$ORDER(@DCRIT@("ERV",DFN,IEN))
IF IEN=""
QUIT
DO CNF
End DoDot:1
+77 QUIT
+78 ;
CNF ;EP - confirm
+1 SET CT=0
SET MCT=0
+2 FOR I=1:1:$LENGTH(@DCRIT@("ERV",DFN,IEN),U)
Begin DoDot:1
+3 ;I $P(@DCRIT@("ERV",DFN,IEN),U,I)'="" S CT=CT+1
+4 IF $PIECE(@DCRIT@("ERV",DFN,IEN),U,I)'=""
IF $PIECE(@DCRIT@("ERV",DFN,IEN),U,I)=1
SET MCT=MCT+1
End DoDot:1
+5 IF MCT=0
KILL @DCRIT@("ERV",DFN,IEN)
QUIT
+6 IF PCT'=MCT
KILL @DCRIT@("ERV",DFN,IEN)
QUIT
+7 IF PCT=MCT
SET @DATA@(DFN)=""
+8 QUIT
+9 ;
UPD(PEC,VAL) ;EP
+1 SET $PIECE(@DCRIT@("ERV",DFN,IEN),U,PEC)=VAL
+2 QUIT
+3 ;
OTH ;EP
+1 IF $GET(EVTYP)=""
IF '$DATA(MPARMS("EVTYP"))
DO UPD(2,"")
+2 IF $GET(EVTYP)'=""
DO UPD(2,0)
IF $PIECE(^AMERVSIT(IEN,0),U,5)=EVTYP
DO UPD(2,1)
+3 IF $GET(EVTYP)=""
IF $DATA(MPARMS("EVTYP"))
Begin DoDot:1
+4 SET EVTYP=""
DO UPD(2,0)
+5 FOR
SET EVTYP=$ORDER(MPARMS("EVTYP",EVTYP))
IF EVTYP=""
QUIT
IF $PIECE(^AMERVSIT(IEN,0),U,5)=EVTYP
DO UPD(2,1)
End DoDot:1
+6 IF $GET(EDTYP)=""
IF '$DATA(MPARMS("EDTYP"))
DO UPD(3,"")
+7 IF $GET(EDTYP)'=""
DO UPD(3,0)
IF $PIECE($GET(^AMERVSIT(IEN,6)),U,1)=EDTYP
DO UPD(3,1)
+8 IF $GET(EDTYP)=""
IF $DATA(MPARMS("EDTYP"))
Begin DoDot:1
+9 SET EDTYP=""
DO UPD(3,0)
+10 FOR
SET EDTYP=$ORDER(MPARMS("EDTYP",EDTYP))
IF EDTYP=""
QUIT
IF $PIECE($GET(^AMERVSIT(IEN,6)),U,1)=EDTYP
DO UPD(3,1)
End DoDot:1
+11 IF $GET(EDACU)=""
IF '$DATA(MPARMS("EDACU"))
DO UPD(5,"")
+12 IF $GET(EDACU)'=""
DO UPD(5,0)
IF $PIECE($GET(^AMERVSIT(IEN,5.1)),U,4)=EDACU
DO UPD(5,1)
+13 IF $GET(EDACU)=""
IF $DATA(MPARMS("EDACU"))
Begin DoDot:1
+14 SET EDACU=""
DO UPD(5,0)
+15 FOR
SET EDACU=$ORDER(MPARMS("EDACU",EDACU))
IF EDACU=""
QUIT
IF $PIECE($GET(^AMERVSIT(IEN,5.1)),U,4)=EDACU
DO UPD(5,1)
End DoDot:1
+16 QUIT
