BQIFLAG ;PRXM/HC/ALA-Get Flag indicator ; 06 Sep 2006 2:34 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
RET(OWNR,BQIPREF) ;EP -- Returns the flag preferences for a user
NEW ADIEN,ADESC,PARMS,MPARMS,TMFRAME,NM,NAME,Y,X,TDT,FDT,%DT
S ADIEN=0
F S ADIEN=$O(^BQICARE(OWNR,10,"B",ADIEN)) Q:'ADIEN D
. ; If the flag entry is inactive, quit
. I $P(^BQI(90506,ADIEN,0),U,2)=1 Q
. K PARMS,MPARMS
. S ADESC=$P(^BQI(90506,ADIEN,0),U,1)
. ; Check for the user preferences timeframe for flags
. D GPARMS^BQIPLFLG(DUZ,ADESC,.PARMS,.MPARMS)
. S NM=""
. I $O(PARMS(NM))="",'$D(MPARMS) Q
. F S NM=$O(PARMS(NM)) Q:NM="" S @NM=PARMS(NM)
. I $G(TMFRAME)="" Q
. I TMFRAME["T-" S %DT="",X=TMFRAME D ^%DT S FDT=Y
. I $G(DT)="" D DT^DICRW
. S TDT=DT
. S BQIPREF(ADIEN)=FDT_U_TDT
Q
;
FPAT(PDFN,OWNR,BQIPREF,TYPE) ;EP -- Checks if the patient has an active flag for the user and the user preferences
NEW FLG,QFLG,FDT,FDTM,TDT,REC,STAT
S TYPE=$G(TYPE,"")
S FLG="",QFLG=0
F S FLG=$O(BQIPREF(FLG)) Q:FLG="" D Q:QFLG
. S FDT=$P(BQIPREF(FLG),U,1),TDT=$P(BQIPREF(FLG),U,2)
. S FDTM=FDT
. F S FDTM=$O(^BQIPAT("AF",PDFN,FLG,FDTM)) Q:FDTM=""!(FDTM\1>TDT) D Q:QFLG
.. S REC=0
.. F S REC=$O(^BQIPAT("AF",PDFN,FLG,FDTM,REC)) Q:REC="" D Q:QFLG
... S STAT=+$P($G(^BQIPAT(PDFN,10,FLG,5,REC,1,OWNR,0)),U,2)
... I STAT,TYPE="" Q
... I STAT,TYPE="S" Q
... I STAT,TYPE="A" S QFLG=1 Q
... S QFLG=1
Q QFLG
;
UPU(BDFN,USR) ;EP -- Update user entry
NEW DIC,DA,DLAYGO,X,DINUM,Y,BQIPREF,FLAG,FDTM,RIEN
D RET^BQIFLAG(USR,.BQIPREF)
S FLAG=""
F S FLAG=$O(BQIPREF(FLAG)) Q:FLAG="" D
. S FDTM=""
. F S FDTM=$O(^BQIPAT("AF",BDFN,FLAG,FDTM)) Q:FDTM="" D
.. S RIEN=""
.. F S RIEN=$O(^BQIPAT("AF",BDFN,FLAG,FDTM,RIEN)) Q:RIEN="" D
... I $G(^BQIPAT(BDFN,10,FLAG,5,RIEN,0))="" D Q
.... K ^BQIPAT("AF",BDFN,FLAG,FDTM,RIEN)
.... K ^BQIPAT("AD",FLAG,BDFN,FDTM,RIEN)
.... K ^BQIPAT("AE",FLAG,FDTM,BDFN,RIEN)
... I $P(^BQIPAT(BDFN,10,FLAG,5,RIEN,0),U,2)'=FDTM D
.... K ^BQIPAT("AF",BDFN,FLAG,FDTM,RIEN)
.... K ^BQIPAT("AD",FLAG,BDFN,FDTM,RIEN)
.... K ^BQIPAT("AE",FLAG,FDTM,BDFN,RIEN)
... S DA(3)=BDFN,DA(2)=FLAG,DA(1)=RIEN
... I '$D(^BQIPAT(DA(3),10,DA(2),5,DA(1),1,0)) S ^BQIPAT(DA(3),10,DA(2),5,DA(1),1,0)="^90507.5151P^^"
... ; for each user that has this patient in a panel, add a user record so
... ; that each user's action/status for this patient and flag can be recorded
... I $D(^BQIPAT(DA(3),10,DA(2),5,DA(1),1,USR)) Q
... S (X,DINUM)=USR,DIC="^BQIPAT("_DA(3)_",10,"_DA(2)_",5,"_DA(1)_",1,"
... S DIC(0)="L",DLAYGO=90507.5151
... K DO,DD D FILE^DICN
Q
;
SXAD ; Set the AD cross-reference
;BQIPAT("AD",Flag IEN,Patient IEN,Record DTM,Record IEN)
NEW BQIDTM
S BQIDTM=$P(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
I BQIDTM'="" S ^BQIPAT("AD",DA(1),DA(2),BQIDTM,DA)=""
Q
;
KXAD ; Kill the cross-reference
NEW BQIDTM
S BQIDTM=$P(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
I BQIDTM'="" K ^BQIPAT("AD",DA(1),DA(2),BQIDTM,DA)
Q
;
SXAE ; Set the AE cross-reference
; BQIPAT("AE",Flag IEN,Record DTM,Patient IEN,Record IEN)
NEW BQIDTM
S BQIDTM=$P(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
I BQIDTM'="" S ^BQIPAT("AE",DA(1),BQIDTM,DA(2),DA)=""
Q
;
KXAE ; Kill the AE cross-reference
NEW BQIDTM
S BQIDTM=$P(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
I BQIDTM'="" K ^BQIPAT("AE",DA(1),BQIDTM,DA(2),DA)
Q
;
SXAF ; Set the AF cross-reference
; BQIPAT("AF",Patient IEN,Flag IEN,Record DTM,Record IEN)
NEW BQIDTM
S BQIDTM=$P(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
I BQIDTM'="" S ^BQIPAT("AF",DA(2),DA(1),BQIDTM,DA)=""
Q
;
KXAF ; Kill the AF cross-reference
NEW BQIDTM
S BQIDTM=$P(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
I BQIDTM'="" K ^BQIPAT("AF",DA(2),DA(1),BQIDTM,DA)
Q
BQIFLAG ;PRXM/HC/ALA-Get Flag indicator ; 06 Sep 2006 2:34 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
RET(OWNR,BQIPREF) ;EP -- Returns the flag preferences for a user
+1 NEW ADIEN,ADESC,PARMS,MPARMS,TMFRAME,NM,NAME,Y,X,TDT,FDT,%DT
+2 SET ADIEN=0
+3 FOR
SET ADIEN=$ORDER(^BQICARE(OWNR,10,"B",ADIEN))
IF 'ADIEN
QUIT
Begin DoDot:1
+4 ; If the flag entry is inactive, quit
+5 IF $PIECE(^BQI(90506,ADIEN,0),U,2)=1
QUIT
+6 KILL PARMS,MPARMS
+7 SET ADESC=$PIECE(^BQI(90506,ADIEN,0),U,1)
+8 ; Check for the user preferences timeframe for flags
+9 DO GPARMS^BQIPLFLG(DUZ,ADESC,.PARMS,.MPARMS)
+10 SET NM=""
+11 IF $ORDER(PARMS(NM))=""
IF '$DATA(MPARMS)
QUIT
+12 FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
SET @NM=PARMS(NM)
+13 IF $GET(TMFRAME)=""
QUIT
+14 IF TMFRAME["T-"
SET %DT=""
SET X=TMFRAME
DO ^%DT
SET FDT=Y
+15 IF $GET(DT)=""
DO DT^DICRW
+16 SET TDT=DT
+17 SET BQIPREF(ADIEN)=FDT_U_TDT
End DoDot:1
+18 QUIT
+19 ;
FPAT(PDFN,OWNR,BQIPREF,TYPE) ;EP -- Checks if the patient has an active flag for the user and the user preferences
+1 NEW FLG,QFLG,FDT,FDTM,TDT,REC,STAT
+2 SET TYPE=$GET(TYPE,"")
+3 SET FLG=""
SET QFLG=0
+4 FOR
SET FLG=$ORDER(BQIPREF(FLG))
IF FLG=""
QUIT
Begin DoDot:1
+5 SET FDT=$PIECE(BQIPREF(FLG),U,1)
SET TDT=$PIECE(BQIPREF(FLG),U,2)
+6 SET FDTM=FDT
+7 FOR
SET FDTM=$ORDER(^BQIPAT("AF",PDFN,FLG,FDTM))
IF FDTM=""!(FDTM\1>TDT)
QUIT
Begin DoDot:2
+8 SET REC=0
+9 FOR
SET REC=$ORDER(^BQIPAT("AF",PDFN,FLG,FDTM,REC))
IF REC=""
QUIT
Begin DoDot:3
+10 SET STAT=+$PIECE($GET(^BQIPAT(PDFN,10,FLG,5,REC,1,OWNR,0)),U,2)
+11 IF STAT
IF TYPE=""
QUIT
+12 IF STAT
IF TYPE="S"
QUIT
+13 IF STAT
IF TYPE="A"
SET QFLG=1
QUIT
+14 SET QFLG=1
End DoDot:3
IF QFLG
QUIT
End DoDot:2
IF QFLG
QUIT
End DoDot:1
IF QFLG
QUIT
+15 QUIT QFLG
+16 ;
UPU(BDFN,USR) ;EP -- Update user entry
+1 NEW DIC,DA,DLAYGO,X,DINUM,Y,BQIPREF,FLAG,FDTM,RIEN
+2 DO RET^BQIFLAG(USR,.BQIPREF)
+3 SET FLAG=""
+4 FOR
SET FLAG=$ORDER(BQIPREF(FLAG))
IF FLAG=""
QUIT
Begin DoDot:1
+5 SET FDTM=""
+6 FOR
SET FDTM=$ORDER(^BQIPAT("AF",BDFN,FLAG,FDTM))
IF FDTM=""
QUIT
Begin DoDot:2
+7 SET RIEN=""
+8 FOR
SET RIEN=$ORDER(^BQIPAT("AF",BDFN,FLAG,FDTM,RIEN))
IF RIEN=""
QUIT
Begin DoDot:3
+9 IF $GET(^BQIPAT(BDFN,10,FLAG,5,RIEN,0))=""
Begin DoDot:4
+10 KILL ^BQIPAT("AF",BDFN,FLAG,FDTM,RIEN)
+11 KILL ^BQIPAT("AD",FLAG,BDFN,FDTM,RIEN)
+12 KILL ^BQIPAT("AE",FLAG,FDTM,BDFN,RIEN)
End DoDot:4
QUIT
+13 IF $PIECE(^BQIPAT(BDFN,10,FLAG,5,RIEN,0),U,2)'=FDTM
Begin DoDot:4
+14 KILL ^BQIPAT("AF",BDFN,FLAG,FDTM,RIEN)
+15 KILL ^BQIPAT("AD",FLAG,BDFN,FDTM,RIEN)
+16 KILL ^BQIPAT("AE",FLAG,FDTM,BDFN,RIEN)
End DoDot:4
+17 SET DA(3)=BDFN
SET DA(2)=FLAG
SET DA(1)=RIEN
+18 IF '$DATA(^BQIPAT(DA(3),10,DA(2),5,DA(1),1,0))
SET ^BQIPAT(DA(3),10,DA(2),5,DA(1),1,0)="^90507.5151P^^"
+19 ; for each user that has this patient in a panel, add a user record so
+20 ; that each user's action/status for this patient and flag can be recorded
+21 IF $DATA(^BQIPAT(DA(3),10,DA(2),5,DA(1),1,USR))
QUIT
+22 SET (X,DINUM)=USR
SET DIC="^BQIPAT("_DA(3)_",10,"_DA(2)_",5,"_DA(1)_",1,"
+23 SET DIC(0)="L"
SET DLAYGO=90507.5151
+24 KILL DO,DD
DO FILE^DICN
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
SXAD ; Set the AD cross-reference
+1 ;BQIPAT("AD",Flag IEN,Patient IEN,Record DTM,Record IEN)
+2 NEW BQIDTM
+3 SET BQIDTM=$PIECE(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
+4 IF BQIDTM'=""
SET ^BQIPAT("AD",DA(1),DA(2),BQIDTM,DA)=""
+5 QUIT
+6 ;
KXAD ; Kill the cross-reference
+1 NEW BQIDTM
+2 SET BQIDTM=$PIECE(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
+3 IF BQIDTM'=""
KILL ^BQIPAT("AD",DA(1),DA(2),BQIDTM,DA)
+4 QUIT
+5 ;
SXAE ; Set the AE cross-reference
+1 ; BQIPAT("AE",Flag IEN,Record DTM,Patient IEN,Record IEN)
+2 NEW BQIDTM
+3 SET BQIDTM=$PIECE(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
+4 IF BQIDTM'=""
SET ^BQIPAT("AE",DA(1),BQIDTM,DA(2),DA)=""
+5 QUIT
+6 ;
KXAE ; Kill the AE cross-reference
+1 NEW BQIDTM
+2 SET BQIDTM=$PIECE(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
+3 IF BQIDTM'=""
KILL ^BQIPAT("AE",DA(1),BQIDTM,DA(2),DA)
+4 QUIT
+5 ;
SXAF ; Set the AF cross-reference
+1 ; BQIPAT("AF",Patient IEN,Flag IEN,Record DTM,Record IEN)
+2 NEW BQIDTM
+3 SET BQIDTM=$PIECE(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
+4 IF BQIDTM'=""
SET ^BQIPAT("AF",DA(2),DA(1),BQIDTM,DA)=""
+5 QUIT
+6 ;
KXAF ; Kill the AF cross-reference
+1 NEW BQIDTM
+2 SET BQIDTM=$PIECE(^BQIPAT(DA(2),10,DA(1),5,DA,0),U,2)
+3 IF BQIDTM'=""
KILL ^BQIPAT("AF",DA(2),DA(1),BQIDTM,DA)
+4 QUIT
