- 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
