- 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
