BQIFLFLG ;PRXM/HC/ALA-Determine Flag Indicator ; 15 Dec 2005 2:33 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
FND(BQIUSR,PDFN,ADIEN) ;EP - Find for each iCare user whether their patient has active flags
;
;Processing variables
; BQIUSR = User signed into the system
; PDFN = Patient internal entry number (DFN)
; ADN = User Flag definition internal entry number
; ADESC = Flag definition description
; ADIEN = iCare definition internal entry number
;
NEW VALUE,FLAGG,BQIFLAG
I $G(DT)="" D DT^DICRW
; For each user and their flag definitions
S FLAGG=0
D RET^BQIFLAG(BQIUSR,.BQIPREF)
S ADIEN=""
F S ADIEN=$O(BQIPREF(ADIEN)) Q:ADIEN="" D
. ; For each patient in all of a user's panels, see if there are active flags
. S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
. I PDFN'="" D
.. I '$$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR) D FLG("R") Q
.. ;
.. ; If the patient has active alerts based on the user's criteria, set the alert flag
.. ; for each panel belonging to the user that the patient is found.
.. I $$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR) D FLG("A")
. ;
. I PDFN="",PLIEN'="" D
.. S PDFN=0,BQIFLAG=0
.. F S PDFN=$O(^BQICARE(BQIUSR,1,PLIEN,40,PDFN)) Q:'PDFN D Q:BQIFLAG
... I '$$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR) D FLG("R") Q
... I $$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR) D FLG("A") S BQIFLAG=1
;
K ADESC,ADIEN,ADN,ADTM,AIEN,ALIEN,BQIUSR,FDT,FLAG,NAME,NM
K PARMS,PDFN,PIEN,PMIEN,PTYP,SOURCE,STAT,TDT,TMFRAME,X,Y,%DT
Q
;
PAT(DFN,ADIEN,SDT,EDT,USR) ;EP - Check for active flags
;
;Input
; DFN = Patient internal entry number
; ADIEN = iCare definition internal entry number
; SDT = Start date range for the user preferences time frame
; EDT = End date (which is today)
; USR = User whose flag preferences are being checked
;Output
; FLAG = If flag is 1, then active; if 0, is not active for this user (opposite of STAT)
;Processing Variables
; ADTM = Time Frame starting date
; EDT = Time Frame ending date
; ALIEN = Patient flag record internal entry number
; STAT = Status of the record by this user. If the user has set the
; status to 1=Don't Show, then it is considered no longer active.
;
;Check in the ICARE PATIENT INDEX File (#90507.5) for any flags that meet
;the user's defined criteria
;
S ADTM=SDT,FLAG=0
F S ADTM=$O(^BQIPAT(DFN,10,ADIEN,5,"AC",ADTM)) Q:ADTM=""!(ADTM\1>EDT) D Q:FLAG
. S ALIEN=0
. F S ALIEN=$O(^BQIPAT(DFN,10,ADIEN,5,"AC",ADTM,ALIEN)) Q:'ALIEN D Q:FLAG
.. Q:'$D(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,USR))
.. S STAT=+$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,USR,0),U,2)
.. I STAT'=1 S FLAG=1
Q FLAG
;
FLG(ACT) ;EP - Set or Remove flag indicator
;
;Input
; ACT = Action flag "R" is remove flag and "A" is add flag
;
NEW PLIEN
S PLIEN=0
F S PLIEN=$O(^BQICARE(BQIUSR,1,"AB",PDFN,PLIEN)) Q:'PLIEN D
. I $G(^BQICARE(BQIUSR,1,PLIEN,40,PDFN,0))="" K ^BQICARE(BQIUSR,1,"AB",PDFN,PLIEN) Q
. NEW DA,IENS
. S DA(2)=BQIUSR,DA(1)=PLIEN,DA=PDFN,IENS=$$IENS^DILF(.DA)
. ;
. ; Set patient record in panel with 1=Yes, has active flags or 0=No, has no active flags
. I ACT="R" S BQIUPD(90505.04,IENS,.08)=0 Q
. I ACT="A" S BQIUPD(90505.04,IENS,.08)=1
I '$D(BQIUPD(90505.04)) D ; Check shared panels if patient is not in owner's panel
. N BQISHR
. S (BQISHR,PLIEN)=""
. F S BQISHR=$O(^BQICARE("C",BQIUSR,BQISHR)) Q:BQISHR="" D Q:$D(BQIUPD(90505.04))
.. F S PLIEN=$O(^BQICARE("C",BQIUSR,BQISHR,PLIEN)) Q:PLIEN="" D Q:$D(BQIUPD(90505.04))
... I $D(^BQICARE(BQISHR,1,PLIEN,40,PDFN)) D
.... NEW DA,IENS
.... S DA(2)=BQISHR,DA(1)=PLIEN,DA=PDFN,IENS=$$IENS^DILF(.DA)
.... ;
.... ; Set patient record in panel with 1=Yes, has active flags or 0=No, has no active flags
.... I ACT="R" S BQIUPD(90505.04,IENS,.08)=0 Q
.... I ACT="A" S BQIUPD(90505.04,IENS,.08)=1
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
Q
;
PMS(USER,FLGN,PDFN) ;EP - Get parameter values
;
;Input Parameters
; USER - User
; FLGN - Flag internal entry number
; For each user and their flag definition
NEW ADIEN,BQIPREF
D RET^BQIFLAG(USER,.BQIPREF)
S ADIEN=FLGN
S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
;
I $$PAT(PDFN,ADIEN,FDT,TDT,USER) Q 1
Q 0
BQIFLFLG ;PRXM/HC/ALA-Determine Flag Indicator ; 15 Dec 2005 2:33 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
FND(BQIUSR,PDFN,ADIEN) ;EP - Find for each iCare user whether their patient has active flags
+1 ;
+2 ;Processing variables
+3 ; BQIUSR = User signed into the system
+4 ; PDFN = Patient internal entry number (DFN)
+5 ; ADN = User Flag definition internal entry number
+6 ; ADESC = Flag definition description
+7 ; ADIEN = iCare definition internal entry number
+8 ;
+9 NEW VALUE,FLAGG,BQIFLAG
+10 IF $GET(DT)=""
DO DT^DICRW
+11 ; For each user and their flag definitions
+12 SET FLAGG=0
+13 DO RET^BQIFLAG(BQIUSR,.BQIPREF)
+14 SET ADIEN=""
+15 FOR
SET ADIEN=$ORDER(BQIPREF(ADIEN))
IF ADIEN=""
QUIT
Begin DoDot:1
+16 ; For each patient in all of a user's panels, see if there are active flags
+17 SET FDT=$PIECE(BQIPREF(ADIEN),U,1)
SET TDT=$PIECE(BQIPREF(ADIEN),U,2)
+18 IF PDFN'=""
Begin DoDot:2
+19 IF '$$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR)
DO FLG("R")
QUIT
+20 ;
+21 ; If the patient has active alerts based on the user's criteria, set the alert flag
+22 ; for each panel belonging to the user that the patient is found.
+23 IF $$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR)
DO FLG("A")
End DoDot:2
+24 ;
+25 IF PDFN=""
IF PLIEN'=""
Begin DoDot:2
+26 SET PDFN=0
SET BQIFLAG=0
+27 FOR
SET PDFN=$ORDER(^BQICARE(BQIUSR,1,PLIEN,40,PDFN))
IF 'PDFN
QUIT
Begin DoDot:3
+28 IF '$$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR)
DO FLG("R")
QUIT
+29 IF $$PAT(PDFN,ADIEN,FDT,TDT,BQIUSR)
DO FLG("A")
SET BQIFLAG=1
End DoDot:3
IF BQIFLAG
QUIT
End DoDot:2
End DoDot:1
+30 ;
+31 KILL ADESC,ADIEN,ADN,ADTM,AIEN,ALIEN,BQIUSR,FDT,FLAG,NAME,NM
+32 KILL PARMS,PDFN,PIEN,PMIEN,PTYP,SOURCE,STAT,TDT,TMFRAME,X,Y,%DT
+33 QUIT
+34 ;
PAT(DFN,ADIEN,SDT,EDT,USR) ;EP - Check for active flags
+1 ;
+2 ;Input
+3 ; DFN = Patient internal entry number
+4 ; ADIEN = iCare definition internal entry number
+5 ; SDT = Start date range for the user preferences time frame
+6 ; EDT = End date (which is today)
+7 ; USR = User whose flag preferences are being checked
+8 ;Output
+9 ; FLAG = If flag is 1, then active; if 0, is not active for this user (opposite of STAT)
+10 ;Processing Variables
+11 ; ADTM = Time Frame starting date
+12 ; EDT = Time Frame ending date
+13 ; ALIEN = Patient flag record internal entry number
+14 ; STAT = Status of the record by this user. If the user has set the
+15 ; status to 1=Don't Show, then it is considered no longer active.
+16 ;
+17 ;Check in the ICARE PATIENT INDEX File (#90507.5) for any flags that meet
+18 ;the user's defined criteria
+19 ;
+20 SET ADTM=SDT
SET FLAG=0
+21 FOR
SET ADTM=$ORDER(^BQIPAT(DFN,10,ADIEN,5,"AC",ADTM))
IF ADTM=""!(ADTM\1>EDT)
QUIT
Begin DoDot:1
+22 SET ALIEN=0
+23 FOR
SET ALIEN=$ORDER(^BQIPAT(DFN,10,ADIEN,5,"AC",ADTM,ALIEN))
IF 'ALIEN
QUIT
Begin DoDot:2
+24 IF '$DATA(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,USR))
QUIT
+25 SET STAT=+$PIECE(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,USR,0),U,2)
+26 IF STAT'=1
SET FLAG=1
End DoDot:2
IF FLAG
QUIT
End DoDot:1
IF FLAG
QUIT
+27 QUIT FLAG
+28 ;
FLG(ACT) ;EP - Set or Remove flag indicator
+1 ;
+2 ;Input
+3 ; ACT = Action flag "R" is remove flag and "A" is add flag
+4 ;
+5 NEW PLIEN
+6 SET PLIEN=0
+7 FOR
SET PLIEN=$ORDER(^BQICARE(BQIUSR,1,"AB",PDFN,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:1
+8 IF $GET(^BQICARE(BQIUSR,1,PLIEN,40,PDFN,0))=""
KILL ^BQICARE(BQIUSR,1,"AB",PDFN,PLIEN)
QUIT
+9 NEW DA,IENS
+10 SET DA(2)=BQIUSR
SET DA(1)=PLIEN
SET DA=PDFN
SET IENS=$$IENS^DILF(.DA)
+11 ;
+12 ; Set patient record in panel with 1=Yes, has active flags or 0=No, has no active flags
+13 IF ACT="R"
SET BQIUPD(90505.04,IENS,.08)=0
QUIT
+14 IF ACT="A"
SET BQIUPD(90505.04,IENS,.08)=1
End DoDot:1
+15 ; Check shared panels if patient is not in owner's panel
IF '$DATA(BQIUPD(90505.04))
Begin DoDot:1
+16 NEW BQISHR
+17 SET (BQISHR,PLIEN)=""
+18 FOR
SET BQISHR=$ORDER(^BQICARE("C",BQIUSR,BQISHR))
IF BQISHR=""
QUIT
Begin DoDot:2
+19 FOR
SET PLIEN=$ORDER(^BQICARE("C",BQIUSR,BQISHR,PLIEN))
IF PLIEN=""
QUIT
Begin DoDot:3
+20 IF $DATA(^BQICARE(BQISHR,1,PLIEN,40,PDFN))
Begin DoDot:4
+21 NEW DA,IENS
+22 SET DA(2)=BQISHR
SET DA(1)=PLIEN
SET DA=PDFN
SET IENS=$$IENS^DILF(.DA)
+23 ;
+24 ; Set patient record in panel with 1=Yes, has active flags or 0=No, has no active flags
+25 IF ACT="R"
SET BQIUPD(90505.04,IENS,.08)=0
QUIT
+26 IF ACT="A"
SET BQIUPD(90505.04,IENS,.08)=1
End DoDot:4
End DoDot:3
IF $DATA(BQIUPD(90505.04))
QUIT
End DoDot:2
IF $DATA(BQIUPD(90505.04))
QUIT
End DoDot:1
+27 DO FILE^DIE("","BQIUPD","ERROR")
+28 KILL BQIUPD
+29 QUIT
+30 ;
PMS(USER,FLGN,PDFN) ;EP - Get parameter values
+1 ;
+2 ;Input Parameters
+3 ; USER - User
+4 ; FLGN - Flag internal entry number
+5 ; For each user and their flag definition
+6 NEW ADIEN,BQIPREF
+7 DO RET^BQIFLAG(USER,.BQIPREF)
+8 SET ADIEN=FLGN
+9 SET FDT=$PIECE(BQIPREF(ADIEN),U,1)
SET TDT=$PIECE(BQIPREF(ADIEN),U,2)
+10 ;
+11 IF $$PAT(PDFN,ADIEN,FDT,TDT,USER)
QUIT 1
+12 QUIT 0
