BQITASK3 ;GDIT/HS/ALA-Weekly Update Tasks ; 03 Aug 2007 1:45 PM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
EN ;EP - Entry point
NEW UID,TTASK
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITASK3 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
TRT ;EP - Find best practices prompts
; Set the date/time started
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
S BQIUPD(90508,DA_",",4.1)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.12)=1
S BQIUPD(90508,DA_",",24.02)=$G(ZTSK)
D FILE^DIE("","BQIUPD")
K BQIUPD
;
D POP^BQITRMT
;
; Set the date/time stopped
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
S BQIUPD(90508,DA_",",4.11)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.12)="@"
S BQIUPD(90508,DA_",",24.02)="@"
D FILE^DIE("","BQIUPD")
K BQIUPD
Q
;
ERR ;
;
NEW DA
S DA=$O(^BQI(90508,0))
I DA="" S DA=1
S BQIUPD(90508,DA_",",3.15)="@"
S BQIUPD(90508,DA_",",4.12)="@"
D FILE^DIE("","BQIUPD")
K BQIUPD
;
D ^%ZTER
Q
;
CMGT ; EP - BQI UPDATE CARE MGMT
NEW UID,TTASK
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITASK3 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
S BQIUPD(90508,DA_",",4.13)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.15)=1
S BQIUPD(90508,DA_",",24.03)=$G(ZTSK)
D FILE^DIE("","BQIUPD")
K BQIUPD
;
NEW SRIEN,SRC,RIEN,STAT,DFN,SRCIEN
S DFN=0
F S DFN=$O(^BQIPAT(DFN)) Q:'DFN D
. K ^BQIPAT(DFN,60)
. ; If flag is set for nightly/weekly
. S SRIEN=""
. F S SRIEN=$O(^BQI(90506.5,"AD",1,SRIEN)) Q:SRIEN="" D
.. I $P($G(^BQI(90506.5,SRIEN,0)),"^",10)=1 Q
.. ;I $P($G(^BQI(90506.5,SRIEN,0)),"^",16)'=1 Q
.. S SOURCE=$P($G(^BQI(90506.5,SRIEN,0)),"^",1)
.. S SRC=$P($G(^BQI(90506.5,SRIEN,0)),U,2)
.. ; If patient is deceased, don't calculate
.. I $P($G(^DPT(DFN,.35)),U,1)'="" Q
.. ; If patient has no active HRNs, quit
.. I '$$HRN^BQIUL1(DFN) Q
.. ; If patient has no visit in past 3 years
.. I '$$VTHR^BQIUL1(DFN) Q
.. I SOURCE="Pediatric",$$AGE^BQIAGE(DFN,"")>21 Q
.. D PAT^BQIRGASP(DFN,SRC)
K BDMDMRG,BDMJOB,BDMBTH,CYR,CIEN,PGTHR,PGRF,BDMRBD,BDMADAT,BDMTYPE,BDMRED,BMDBDAT,BDMPD
;
; Set the date/time stopped
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
S BQIUPD(90508,DA_",",4.14)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.15)="@"
S BQIUPD(90508,DA_",",24.03)="@"
D FILE^DIE("","BQIUPD")
K BQIUPD
Q
;
SRC(SOURCE) ; EP
S SRIEN=$O(^BQI(90506.5,"B",SOURCE,"")) I SRIEN="" Q
I $P(^BQI(90506.5,SRIEN,0),"^",10)=1 Q
S SRC=$P(^BQI(90506.5,SRIEN,0),U,2)
Q
BQITASK3 ;GDIT/HS/ALA-Weekly Update Tasks ; 03 Aug 2007 1:45 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
EN ;EP - Entry point
+1 NEW UID,TTASK
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 ;
+4 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITASK3 D UNWIND^%ZTER"
+5 ;
TRT ;EP - Find best practices prompts
+1 ; Set the date/time started
+2 NEW DA
+3 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+4 SET BQIUPD(90508,DA_",",4.1)=$$NOW^XLFDT()
+5 SET BQIUPD(90508,DA_",",4.12)=1
+6 SET BQIUPD(90508,DA_",",24.02)=$GET(ZTSK)
+7 DO FILE^DIE("","BQIUPD")
+8 KILL BQIUPD
+9 ;
+10 DO POP^BQITRMT
+11 ;
+12 ; Set the date/time stopped
+13 NEW DA
+14 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+15 SET BQIUPD(90508,DA_",",4.11)=$$NOW^XLFDT()
+16 SET BQIUPD(90508,DA_",",4.12)="@"
+17 SET BQIUPD(90508,DA_",",24.02)="@"
+18 DO FILE^DIE("","BQIUPD")
+19 KILL BQIUPD
+20 QUIT
+21 ;
ERR ;
+1 ;
+2 NEW DA
+3 SET DA=$ORDER(^BQI(90508,0))
+4 IF DA=""
SET DA=1
+5 SET BQIUPD(90508,DA_",",3.15)="@"
+6 SET BQIUPD(90508,DA_",",4.12)="@"
+7 DO FILE^DIE("","BQIUPD")
+8 KILL BQIUPD
+9 ;
+10 DO ^%ZTER
+11 QUIT
+12 ;
CMGT ; EP - BQI UPDATE CARE MGMT
+1 NEW UID,TTASK
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 ;
+4 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITASK3 D UNWIND^%ZTER"
+5 ;
+6 NEW DA
+7 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+8 SET BQIUPD(90508,DA_",",4.13)=$$NOW^XLFDT()
+9 SET BQIUPD(90508,DA_",",4.15)=1
+10 SET BQIUPD(90508,DA_",",24.03)=$GET(ZTSK)
+11 DO FILE^DIE("","BQIUPD")
+12 KILL BQIUPD
+13 ;
+14 NEW SRIEN,SRC,RIEN,STAT,DFN,SRCIEN
+15 SET DFN=0
+16 FOR
SET DFN=$ORDER(^BQIPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+17 KILL ^BQIPAT(DFN,60)
+18 ; If flag is set for nightly/weekly
+19 SET SRIEN=""
+20 FOR
SET SRIEN=$ORDER(^BQI(90506.5,"AD",1,SRIEN))
IF SRIEN=""
QUIT
Begin DoDot:2
+21 IF $PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",10)=1
QUIT
+22 ;I $P($G(^BQI(90506.5,SRIEN,0)),"^",16)'=1 Q
+23 SET SOURCE=$PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",1)
+24 SET SRC=$PIECE($GET(^BQI(90506.5,SRIEN,0)),U,2)
+25 ; If patient is deceased, don't calculate
+26 IF $PIECE($GET(^DPT(DFN,.35)),U,1)'=""
QUIT
+27 ; If patient has no active HRNs, quit
+28 IF '$$HRN^BQIUL1(DFN)
QUIT
+29 ; If patient has no visit in past 3 years
+30 IF '$$VTHR^BQIUL1(DFN)
QUIT
+31 IF SOURCE="Pediatric"
IF $$AGE^BQIAGE(DFN,"")>21
QUIT
+32 DO PAT^BQIRGASP(DFN,SRC)
End DoDot:2
End DoDot:1
+33 KILL BDMDMRG,BDMJOB,BDMBTH,CYR,CIEN,PGTHR,PGRF,BDMRBD,BDMADAT,BDMTYPE,BDMRED,BMDBDAT,BDMPD
+34 ;
+35 ; Set the date/time stopped
+36 NEW DA
+37 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+38 SET BQIUPD(90508,DA_",",4.14)=$$NOW^XLFDT()
+39 SET BQIUPD(90508,DA_",",4.15)="@"
+40 SET BQIUPD(90508,DA_",",24.03)="@"
+41 DO FILE^DIE("","BQIUPD")
+42 KILL BQIUPD
+43 QUIT
+44 ;
SRC(SOURCE) ; EP
+1 SET SRIEN=$ORDER(^BQI(90506.5,"B",SOURCE,""))
IF SRIEN=""
QUIT
+2 IF $PIECE(^BQI(90506.5,SRIEN,0),"^",10)=1
QUIT
+3 SET SRC=$PIECE(^BQI(90506.5,SRIEN,0),U,2)
+4 QUIT
