BQIFLAG.m

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