BQITASK1 ;PRXM/HC/ALA-Reminders Update Task ; 24 May 2007 1:10 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
EN ;EP - Entry point
;NEW UID
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMDR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
REM ;EP - Redo reminders
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
S BQIUPD(90508,DA_",",4.07)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.09)=1
S BQIUPD(90508,DA_",",24.06)=$G(ZTSK)
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
; Re-evaluate Reminders
D CHK^BQIRMDR("Weekly")
;
D DZ
;
S BQDFN=0,ERRCNT=0
F S BQDFN=$O(^AUPNPAT(BQDFN)) Q:'BQDFN D Q:ERRCNT>100
. NEW CRMDT
. S CRMDT=$P($G(^BQIPAT(BQDFN,0)),"^",8)
. I $$FMDIFF^XLFDT(DT,CRMDT\1)<7 Q
. NEW BQIDATA
. S BQIDATA=$NA(^BQIPAT)
. K @BQIDATA@(BQDFN,40)
. ; If deceased, don't include
. I $P($G(^DPT(BQDFN,.35)),U,1)'="" Q
. ; If no active HRN, don't include
. I '$$HRN^BQIUL1(BQDFN) Q
. ; If no visit in last 3 years, quit
. I '$$VTHR^BQIUL1(BQDFN) Q
. ; If no visit in last 2 years, quit
. ;I '$$VTWR^BQIUL1(BQDFN) Q
. D PAT^BQIRMDR(BQDFN)
;
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
I ERRCNT'>100 S BQIUPD(90508,DA_",",4.08)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.09)="@"
S BQIUPD(90508,DA_",",24.06)="@"
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD,ERRCNT,BQDFN
Q
;
ORM ; EP - Update all patients for one reminder
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMDR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
; Create a reminder record for every patient with new reminder
S BQDFN=0,ERRCNT=0
F S BQDFN=$O(^BQIPAT(BQDFN)) Q:'BQDFN D Q:ERRCNT>100
. ; If deceased, don't include
. I $P($G(^DPT(BQDFN,.35)),U,1)'="" Q
. ; If no active HRN, don't include
. I '$$HRN^BQIUL1(BQDFN) Q
. ; If no visit in last 3 years, quit
. ;I '$$VTHR^BQIUL1(BQDFN) Q
. ; If no visit in last 2 years, quit
. I '$$VTWR^BQIUL1(BQDFN) Q
. S IEN=0
. F S IEN=$O(^XTMP("BQIRMOM",IEN)) Q:IEN="" D
.. S RCAT=$P(^XTMP("BQIRMOM",IEN),U,1)
.. S HIEN=$P(^XTMP("BQIRMOM",IEN),U,2)
.. S CODE=$P(^XTMP("BQIRMOM",IEN),U,3)
.. ;I RCAT["EHR" D EMR^BQIRMDR1(BQDFN,CODE) Q
.. I RCAT'="Care Management" D RMR^BQIRMDR(BQDFN,HIEN) Q
.. I RCAT="Care Management" D REG^BQIRMDR1(BQDFN,CODE)
K HIEN,RCAT,BQDFN,CODE,IEN
Q
;
DZ ;EP - Check for DUZ(2), it is usually missing for Postmaster
K ^XTMP("BQIRMDR")
S ^XTMP("BQIRMDR",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()
M ^XTMP("BQIRMDR","DUZ")=DUZ
I $G(^XTMP("BQIRMDR","DUZ",2))=0 D
. NEW FAC,BQIHM
. D GETFCRS^BMXRPC3(.FAC,$G(^XTMP("BQIRMDR","DUZ")))
. I $P(FAC,U,4)'=0 S ^XTMP("BQIRMDR","DUZ",2)=$P(FAC,U,4) Q
. S BQIHM=$O(^BQI(90508,0)) I BQIHM'="" S FAC=$P($G(^BQI(90508,BQIHM,0)),U,1)
. S ^XTMP("BQIRMDR","DUZ",2)=$G(FAC)
Q
BQITASK1 ;PRXM/HC/ALA-Reminders Update Task ; 24 May 2007 1:10 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
EN ;EP - Entry point
+1 ;NEW UID
+2 ;
+3 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRMDR D UNWIND^%ZTER"
+4 ;
REM ;EP - Redo reminders
+1 NEW DA
+2 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+3 SET BQIUPD(90508,DA_",",4.07)=$$NOW^XLFDT()
+4 SET BQIUPD(90508,DA_",",4.09)=1
+5 SET BQIUPD(90508,DA_",",24.06)=$GET(ZTSK)
+6 DO FILE^DIE("","BQIUPD","ERROR")
+7 KILL BQIUPD
+8 ;
+9 ; Re-evaluate Reminders
+10 DO CHK^BQIRMDR("Weekly")
+11 ;
+12 DO DZ
+13 ;
+14 SET BQDFN=0
SET ERRCNT=0
+15 FOR
SET BQDFN=$ORDER(^AUPNPAT(BQDFN))
IF 'BQDFN
QUIT
Begin DoDot:1
+16 NEW CRMDT
+17 SET CRMDT=$PIECE($GET(^BQIPAT(BQDFN,0)),"^",8)
+18 IF $$FMDIFF^XLFDT(DT,CRMDT\1)<7
QUIT
+19 NEW BQIDATA
+20 SET BQIDATA=$NAME(^BQIPAT)
+21 KILL @BQIDATA@(BQDFN,40)
+22 ; If deceased, don't include
+23 IF $PIECE($GET(^DPT(BQDFN,.35)),U,1)'=""
QUIT
+24 ; If no active HRN, don't include
+25 IF '$$HRN^BQIUL1(BQDFN)
QUIT
+26 ; If no visit in last 3 years, quit
+27 IF '$$VTHR^BQIUL1(BQDFN)
QUIT
+28 ; If no visit in last 2 years, quit
+29 ;I '$$VTWR^BQIUL1(BQDFN) Q
+30 DO PAT^BQIRMDR(BQDFN)
End DoDot:1
IF ERRCNT>100
QUIT
+31 ;
+32 NEW DA
+33 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+34 IF ERRCNT'>100
SET BQIUPD(90508,DA_",",4.08)=$$NOW^XLFDT()
+35 SET BQIUPD(90508,DA_",",4.09)="@"
+36 SET BQIUPD(90508,DA_",",24.06)="@"
+37 DO FILE^DIE("","BQIUPD","ERROR")
+38 KILL BQIUPD,ERRCNT,BQDFN
+39 QUIT
+40 ;
ORM ; EP - Update all patients for one reminder
+1 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRMDR D UNWIND^%ZTER"
+2 ; Create a reminder record for every patient with new reminder
+3 SET BQDFN=0
SET ERRCNT=0
+4 FOR
SET BQDFN=$ORDER(^BQIPAT(BQDFN))
IF 'BQDFN
QUIT
Begin DoDot:1
+5 ; If deceased, don't include
+6 IF $PIECE($GET(^DPT(BQDFN,.35)),U,1)'=""
QUIT
+7 ; If no active HRN, don't include
+8 IF '$$HRN^BQIUL1(BQDFN)
QUIT
+9 ; If no visit in last 3 years, quit
+10 ;I '$$VTHR^BQIUL1(BQDFN) Q
+11 ; If no visit in last 2 years, quit
+12 IF '$$VTWR^BQIUL1(BQDFN)
QUIT
+13 SET IEN=0
+14 FOR
SET IEN=$ORDER(^XTMP("BQIRMOM",IEN))
IF IEN=""
QUIT
Begin DoDot:2
+15 SET RCAT=$PIECE(^XTMP("BQIRMOM",IEN),U,1)
+16 SET HIEN=$PIECE(^XTMP("BQIRMOM",IEN),U,2)
+17 SET CODE=$PIECE(^XTMP("BQIRMOM",IEN),U,3)
+18 ;I RCAT["EHR" D EMR^BQIRMDR1(BQDFN,CODE) Q
+19 IF RCAT'="Care Management"
DO RMR^BQIRMDR(BQDFN,HIEN)
QUIT
+20 IF RCAT="Care Management"
DO REG^BQIRMDR1(BQDFN,CODE)
End DoDot:2
End DoDot:1
IF ERRCNT>100
QUIT
+21 KILL HIEN,RCAT,BQDFN,CODE,IEN
+22 QUIT
+23 ;
DZ ;EP - Check for DUZ(2), it is usually missing for Postmaster
+1 KILL ^XTMP("BQIRMDR")
+2 SET ^XTMP("BQIRMDR",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()
+3 MERGE ^XTMP("BQIRMDR","DUZ")=DUZ
+4 IF $GET(^XTMP("BQIRMDR","DUZ",2))=0
Begin DoDot:1
+5 NEW FAC,BQIHM
+6 DO GETFCRS^BMXRPC3(.FAC,$GET(^XTMP("BQIRMDR","DUZ")))
+7 IF $PIECE(FAC,U,4)'=0
SET ^XTMP("BQIRMDR","DUZ",2)=$PIECE(FAC,U,4)
QUIT
+8 SET BQIHM=$ORDER(^BQI(90508,0))
IF BQIHM'=""
SET FAC=$PIECE($GET(^BQI(90508,BQIHM,0)),U,1)
+9 SET ^XTMP("BQIRMDR","DUZ",2)=$GET(FAC)
End DoDot:1
+10 QUIT
