BQIDCAPH ;GDIT/HS/ALA-Scheduled Visits by Hospital location ; 17 Nov 2005 6:04 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
Q
;
APT(DATA,PARMS,MPARMS) ;EP
;
;Description
; Executable to retrieves appointments for the specified hospital location
;Input
; PARMS = Array of parameters and their values
; MPARMS = Multiple array of a parameter
;Expected to return DATA
;Parameters
; HLOC = Hosp Location internal entry number
; FDT = Starting date for the FROM date parameter
; EDT = Ending date for the THRU date parameter
; DFN = Patient internal entry number
; APSTAT = Appointment status
;
NEW UID
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIDCAPH",UID))
K @DATA
;
FND ; Find the patients with appts for one or more hospital locations
NEW HLOC,FROM,THRU,NM,N,FRDT,ENDT,LABEL,APST,STOP,FDT,EDT,DFN,STR,LOC,STAT
NEW APSTAT,APTYPE,APRANGE,RFROM,RTHRU
S NM=""
F S NM=$O(PARMS(NM)) Q:NM="" S @NM=PARMS(NM)
I $G(APTYPE)'="" D
. NEW MIEN,MAPS
. S MIEN=$O(^BQI(90506,11,3,8,3,"B",APTYPE,"")) I MIEN="" Q
. S MAPS=$P(^BQI(90506,11,3,8,3,MIEN,0),U,2)
. F N=1:1:$L(MAPS,"~") S NM=$P($P(MAPS,"~",N),"=",1),MPARMS(NM,$P($P(MAPS,"~",N),"=",2))=""
;
I $D(MPARMS("APTYPE"))>0 D
. NEW MPM,MIEN,MAPS
. S MPM=""
. F S MPM=$O(MPARMS("APTYPE",MPM)) Q:MPM="" D
.. S MIEN=$O(^BQI(90506,11,3,8,3,"B",MPM,"")) I MIEN="" Q
.. S MAPS=$P(^BQI(90506,11,3,8,3,MIEN,0),U,2)
.. F N=1:1:$L(MAPS,"~") S NM=$P($P(MAPS,"~",N),"=",1),MPARMS(NM,$P($P(MAPS,"~",N),"=",2))=""
;
; If selected non-AC status(es) includes a "C" (cancelled appointment)
; ^SC is deleted and schedule nodes in ^DPT must be examined
;
S LABEL="FND1" D
. I $G(APSTAT)="",'$D(MPARMS("APSTAT")) S LABEL="FNDALL"
. I $G(APSTAT)'="",APSTAT'="AC",APSTAT["C" S LABEL="FNDALL" Q
. I $D(MPARMS("APSTAT")) D Q
.. S APST="",STOP=""
.. F S APST=$O(MPARMS("APSTAT",APST)) Q:APST="" D Q:STOP
... I APST'="AC",APST["C" S LABEL="FNDALL",STOP=1 Q
I LABEL="FNDALL" D FNDALL Q
I $G(HLOC)]"" D FND1
I $D(MPARMS("HLOC")) S HLOC="" F S HLOC=$O(MPARMS("HLOC",HLOC)) Q:HLOC="" D FND1
Q
;
FND1 ; Check one hospital location
; If timeframe is selected populate start and end dates
I $G(APRANGE)'="",$G(PPIEN)'="" D RANGE^BQIDCAH1(APRANGE,PPIEN,"APRANGE")
S FDT=$S($G(RFROM)'="":RFROM,1:$G(FROM))
S EDT=$S($G(RTHRU)'="":RTHRU,1:$G(THRU))
NEW APCHK
F S FDT=$O(^SC(HLOC,"S",FDT)) Q:FDT=""!(FDT\1>EDT) D
. S N=0
. F S N=$O(^SC(HLOC,"S",FDT,1,N)) Q:'N D
.. NEW DA,IENS
.. S DA(2)=HLOC,DA(1)=FDT,DA=N,IENS=$$IENS^DILF(.DA)
.. S DFN=$$GET1^DIQ(44.003,IENS,.01,"I") I DFN="" Q
.. ; User may now select Living, Deceased or both as a filter so
.. ; if no filters defined assume living patients otherwise let filter decide
.. ;I $O(^BQICARE(OWNR,1,PLIEN,15,0))="",$P($G(^DPT(DFN,.35)),U,1)'="" Q
.. I '$$HRN^BQIUL1(DFN) Q
.. ; If patient has no visit in last 3 years, quit
.. ;I '$$VTHR^BQIUL1(DFN) Q
.. I $G(APSTAT)'="" D Q
... I $G(APSTAT)="AC" S APCHK=""
... I $G(APSTAT)'="AC" S APCHK=APSTAT
... I $P($G(^DPT(DFN,"S",FDT,0)),U,2)'=APCHK Q
... S @DATA@(DFN)=""
.. I $D(MPARMS("APSTAT")) D Q
... S APST=""
... F S APST=$O(MPARMS("APSTAT",APST)) Q:APST="" D
.... I $G(APST)="AC" S APCHK=""
.... I $G(APST)'="AC" S APCHK=APST
.... I $P($G(^DPT(DFN,"S",FDT,0)),U,2)'=APCHK Q
.... S @DATA@(DFN)=""
.. ;S @DATA@(DFN)=""
Q
;
FNDALL ; Loop through all patients since cancelled status selected
; If timeframe is selected populate start and end dates
I $G(APRANGE)'="",$G(PPIEN)'="" D RANGE^BQIDCAH1(APRANGE,PPIEN,"APRANGE")
S FRDT=$S($G(RFROM)'="":RFROM,1:$G(FROM))
S ENDT=$S($G(RTHRU)'="":RTHRU,1:$G(THRU))
NEW APCHK
S DFN=0
F S DFN=$O(^DPT(DFN)) Q:'DFN D
. ; *disabled* since user may now select Living, Deceased or both as a filter
. ;I $P($G(^DPT(DFN,.35)),U,1)'="" Q
. I '$$HRN^BQIUL1(DFN) Q
. ; If patient has no visit in last 3 years, quit
. ;I '$$VTHR^BQIUL1(DFN) Q
. S FDT=FRDT,EDT=ENDT
. F S FDT=$O(^DPT(DFN,"S",FDT)) Q:'FDT!(FDT\1>EDT) D
.. S STR=$G(^DPT(DFN,"S",FDT,0)) I STR="" Q
.. S LOC=$P(STR,U),STAT=$P(STR,U,2)
.. I $G(HLOC)]"",LOC'=HLOC Q
.. I LOC'="",$D(MPARMS("HLOC")),'$D(MPARMS("HLOC",LOC)) Q
.. I LOC="",$D(MPARMS("HLOC")) Q
.. I $D(APSTAT) D Q
... I APSTAT="AC",STAT'="" Q
... I STAT'=APSTAT Q
... S @DATA@(DFN)=""
.. I $D(MPARMS("APSTAT")) D Q
... I STAT'="",'$D(MPARMS("APSTAT",STAT)) Q
... I STAT="",'$D(MPARMS("APSTAT","AC")) Q
... S @DATA@(DFN)=""
.. S @DATA@(DFN)=""
Q
BQIDCAPH ;GDIT/HS/ALA-Scheduled Visits by Hospital location ; 17 Nov 2005 6:04 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 QUIT
+4 ;
APT(DATA,PARMS,MPARMS) ;EP
+1 ;
+2 ;Description
+3 ; Executable to retrieves appointments for the specified hospital location
+4 ;Input
+5 ; PARMS = Array of parameters and their values
+6 ; MPARMS = Multiple array of a parameter
+7 ;Expected to return DATA
+8 ;Parameters
+9 ; HLOC = Hosp Location internal entry number
+10 ; FDT = Starting date for the FROM date parameter
+11 ; EDT = Ending date for the THRU date parameter
+12 ; DFN = Patient internal entry number
+13 ; APSTAT = Appointment status
+14 ;
+15 NEW UID
+16 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+17 SET DATA=$NAME(^TMP("BQIDCAPH",UID))
+18 KILL @DATA
+19 ;
FND ; Find the patients with appts for one or more hospital locations
+1 NEW HLOC,FROM,THRU,NM,N,FRDT,ENDT,LABEL,APST,STOP,FDT,EDT,DFN,STR,LOC,STAT
+2 NEW APSTAT,APTYPE,APRANGE,RFROM,RTHRU
+3 SET NM=""
+4 FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
SET @NM=PARMS(NM)
+5 IF $GET(APTYPE)'=""
Begin DoDot:1
+6 NEW MIEN,MAPS
+7 SET MIEN=$ORDER(^BQI(90506,11,3,8,3,"B",APTYPE,""))
IF MIEN=""
QUIT
+8 SET MAPS=$PIECE(^BQI(90506,11,3,8,3,MIEN,0),U,2)
+9 FOR N=1:1:$LENGTH(MAPS,"~")
SET NM=$PIECE($PIECE(MAPS,"~",N),"=",1)
SET MPARMS(NM,$PIECE($PIECE(MAPS,"~",N),"=",2))=""
End DoDot:1
+10 ;
+11 IF $DATA(MPARMS("APTYPE"))>0
Begin DoDot:1
+12 NEW MPM,MIEN,MAPS
+13 SET MPM=""
+14 FOR
SET MPM=$ORDER(MPARMS("APTYPE",MPM))
IF MPM=""
QUIT
Begin DoDot:2
+15 SET MIEN=$ORDER(^BQI(90506,11,3,8,3,"B",MPM,""))
IF MIEN=""
QUIT
+16 SET MAPS=$PIECE(^BQI(90506,11,3,8,3,MIEN,0),U,2)
+17 FOR N=1:1:$LENGTH(MAPS,"~")
SET NM=$PIECE($PIECE(MAPS,"~",N),"=",1)
SET MPARMS(NM,$PIECE($PIECE(MAPS,"~",N),"=",2))=""
End DoDot:2
End DoDot:1
+18 ;
+19 ; If selected non-AC status(es) includes a "C" (cancelled appointment)
+20 ; ^SC is deleted and schedule nodes in ^DPT must be examined
+21 ;
+22 SET LABEL="FND1"
Begin DoDot:1
+23 IF $GET(APSTAT)=""
IF '$DATA(MPARMS("APSTAT"))
SET LABEL="FNDALL"
+24 IF $GET(APSTAT)'=""
IF APSTAT'="AC"
IF APSTAT["C"
SET LABEL="FNDALL"
QUIT
+25 IF $DATA(MPARMS("APSTAT"))
Begin DoDot:2
+26 SET APST=""
SET STOP=""
+27 FOR
SET APST=$ORDER(MPARMS("APSTAT",APST))
IF APST=""
QUIT
Begin DoDot:3
+28 IF APST'="AC"
IF APST["C"
SET LABEL="FNDALL"
SET STOP=1
QUIT
End DoDot:3
IF STOP
QUIT
End DoDot:2
QUIT
End DoDot:1
+29 IF LABEL="FNDALL"
DO FNDALL
QUIT
+30 IF $GET(HLOC)]""
DO FND1
+31 IF $DATA(MPARMS("HLOC"))
SET HLOC=""
FOR
SET HLOC=$ORDER(MPARMS("HLOC",HLOC))
IF HLOC=""
QUIT
DO FND1
+32 QUIT
+33 ;
FND1 ; Check one hospital location
+1 ; If timeframe is selected populate start and end dates
+2 IF $GET(APRANGE)'=""
IF $GET(PPIEN)'=""
DO RANGE^BQIDCAH1(APRANGE,PPIEN,"APRANGE")
+3 SET FDT=$SELECT($GET(RFROM)'="":RFROM,1:$GET(FROM))
+4 SET EDT=$SELECT($GET(RTHRU)'="":RTHRU,1:$GET(THRU))
+5 NEW APCHK
+6 FOR
SET FDT=$ORDER(^SC(HLOC,"S",FDT))
IF FDT=""!(FDT\1>EDT)
QUIT
Begin DoDot:1
+7 SET N=0
+8 FOR
SET N=$ORDER(^SC(HLOC,"S",FDT,1,N))
IF 'N
QUIT
Begin DoDot:2
+9 NEW DA,IENS
+10 SET DA(2)=HLOC
SET DA(1)=FDT
SET DA=N
SET IENS=$$IENS^DILF(.DA)
+11 SET DFN=$$GET1^DIQ(44.003,IENS,.01,"I")
IF DFN=""
QUIT
+12 ; User may now select Living, Deceased or both as a filter so
+13 ; if no filters defined assume living patients otherwise let filter decide
+14 ;I $O(^BQICARE(OWNR,1,PLIEN,15,0))="",$P($G(^DPT(DFN,.35)),U,1)'="" Q
+15 IF '$$HRN^BQIUL1(DFN)
QUIT
+16 ; If patient has no visit in last 3 years, quit
+17 ;I '$$VTHR^BQIUL1(DFN) Q
+18 IF $GET(APSTAT)'=""
Begin DoDot:3
+19 IF $GET(APSTAT)="AC"
SET APCHK=""
+20 IF $GET(APSTAT)'="AC"
SET APCHK=APSTAT
+21 IF $PIECE($GET(^DPT(DFN,"S",FDT,0)),U,2)'=APCHK
QUIT
+22 SET @DATA@(DFN)=""
End DoDot:3
QUIT
+23 IF $DATA(MPARMS("APSTAT"))
Begin DoDot:3
+24 SET APST=""
+25 FOR
SET APST=$ORDER(MPARMS("APSTAT",APST))
IF APST=""
QUIT
Begin DoDot:4
+26 IF $GET(APST)="AC"
SET APCHK=""
+27 IF $GET(APST)'="AC"
SET APCHK=APST
+28 IF $PIECE($GET(^DPT(DFN,"S",FDT,0)),U,2)'=APCHK
QUIT
+29 SET @DATA@(DFN)=""
End DoDot:4
End DoDot:3
QUIT
+30 ;S @DATA@(DFN)=""
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
FNDALL ; Loop through all patients since cancelled status selected
+1 ; If timeframe is selected populate start and end dates
+2 IF $GET(APRANGE)'=""
IF $GET(PPIEN)'=""
DO RANGE^BQIDCAH1(APRANGE,PPIEN,"APRANGE")
+3 SET FRDT=$SELECT($GET(RFROM)'="":RFROM,1:$GET(FROM))
+4 SET ENDT=$SELECT($GET(RTHRU)'="":RTHRU,1:$GET(THRU))
+5 NEW APCHK
+6 SET DFN=0
+7 FOR
SET DFN=$ORDER(^DPT(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+8 ; *disabled* since user may now select Living, Deceased or both as a filter
+9 ;I $P($G(^DPT(DFN,.35)),U,1)'="" Q
+10 IF '$$HRN^BQIUL1(DFN)
QUIT
+11 ; If patient has no visit in last 3 years, quit
+12 ;I '$$VTHR^BQIUL1(DFN) Q
+13 SET FDT=FRDT
SET EDT=ENDT
+14 FOR
SET FDT=$ORDER(^DPT(DFN,"S",FDT))
IF 'FDT!(FDT\1>EDT)
QUIT
Begin DoDot:2
+15 SET STR=$GET(^DPT(DFN,"S",FDT,0))
IF STR=""
QUIT
+16 SET LOC=$PIECE(STR,U)
SET STAT=$PIECE(STR,U,2)
+17 IF $GET(HLOC)]""
IF LOC'=HLOC
QUIT
+18 IF LOC'=""
IF $DATA(MPARMS("HLOC"))
IF '$DATA(MPARMS("HLOC",LOC))
QUIT
+19 IF LOC=""
IF $DATA(MPARMS("HLOC"))
QUIT
+20 IF $DATA(APSTAT)
Begin DoDot:3
+21 IF APSTAT="AC"
IF STAT'=""
QUIT
+22 IF STAT'=APSTAT
QUIT
+23 SET @DATA@(DFN)=""
End DoDot:3
QUIT
+24 IF $DATA(MPARMS("APSTAT"))
Begin DoDot:3
+25 IF STAT'=""
IF '$DATA(MPARMS("APSTAT",STAT))
QUIT
+26 IF STAT=""
IF '$DATA(MPARMS("APSTAT","AC"))
QUIT
+27 SET @DATA@(DFN)=""
End DoDot:3
QUIT
+28 SET @DATA@(DFN)=""
End DoDot:2
End DoDot:1
+29 QUIT
