- 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
