Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQITASK1

BQITASK1.m

Go to the documentation of this file. 
  1. BQITASK1 ;PRXM/HC/ALA-Reminders Update Task ; 24 May 2007  1:10 PM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1. EN ;EP - Entry point
  1.  ;NEW UID
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMDR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1. REM ;EP - Redo reminders
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",4.07)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",4.09)=1
  1.  S BQIUPD(90508,DA_",",24.06)=$G(ZTSK)
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ; Re-evaluate Reminders
  1.  D CHK^BQIRMDR("Weekly")
  1.  ;
  1.  D DZ
  1.  ;
  1.  S BQDFN=0,ERRCNT=0
  1.  F  S BQDFN=$O(^AUPNPAT(BQDFN)) Q:'BQDFN  D  Q:ERRCNT>100
  1.  . NEW CRMDT
  1.  . S CRMDT=$P($G(^BQIPAT(BQDFN,0)),"^",8)
  1.  . I $$FMDIFF^XLFDT(DT,CRMDT\1)<7 Q
  1.  . NEW BQIDATA
  1.  . S BQIDATA=$NA(^BQIPAT)
  1.  . K @BQIDATA@(BQDFN,40)
  1.  . ; If deceased, don't include
  1.  . I $P($G(^DPT(BQDFN,.35)),U,1)'="" Q
  1.  . ; If no active HRN, don't include
  1.  . I '$$HRN^BQIUL1(BQDFN) Q
  1.  . ; If no visit in last 3 years, quit
  1.  . I '$$VTHR^BQIUL1(BQDFN) Q
  1.  . ; If no visit in last 2 years, quit
  1.  . ;I '$$VTWR^BQIUL1(BQDFN) Q
  1.  . D PAT^BQIRMDR(BQDFN)
  1.  ;
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  I ERRCNT'>100 S BQIUPD(90508,DA_",",4.08)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",4.09)="@"
  1.  S BQIUPD(90508,DA_",",24.06)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD,ERRCNT,BQDFN
  1.  Q
  1.  ;
  1. ORM ; EP - Update all patients for one reminder
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMDR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ; Create a reminder record for every patient with new reminder
  1.  S BQDFN=0,ERRCNT=0
  1.  F  S BQDFN=$O(^BQIPAT(BQDFN)) Q:'BQDFN  D  Q:ERRCNT>100
  1.  . ; If deceased, don't include
  1.  . I $P($G(^DPT(BQDFN,.35)),U,1)'="" Q
  1.  . ; If no active HRN, don't include
  1.  . I '$$HRN^BQIUL1(BQDFN) Q
  1.  . ; If no visit in last 3 years, quit
  1.  . ;I '$$VTHR^BQIUL1(BQDFN) Q
  1.  . ; If no visit in last 2 years, quit
  1.  . I '$$VTWR^BQIUL1(BQDFN) Q
  1.  . S IEN=0
  1.  . F  S IEN=$O(^XTMP("BQIRMOM",IEN)) Q:IEN=""  D
  1.  .. S RCAT=$P(^XTMP("BQIRMOM",IEN),U,1)
  1.  .. S HIEN=$P(^XTMP("BQIRMOM",IEN),U,2)
  1.  .. S CODE=$P(^XTMP("BQIRMOM",IEN),U,3)
  1.  .. ;I RCAT["EHR" D EMR^BQIRMDR1(BQDFN,CODE) Q
  1.  .. I RCAT'="Care Management" D RMR^BQIRMDR(BQDFN,HIEN) Q
  1.  .. I RCAT="Care Management" D REG^BQIRMDR1(BQDFN,CODE)
  1.  K HIEN,RCAT,BQDFN,CODE,IEN
  1.  Q
  1.  ;
  1. DZ ;EP - Check for DUZ(2), it is usually missing for Postmaster
  1.  K ^XTMP("BQIRMDR")
  1.  S ^XTMP("BQIRMDR",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()
  1.  M ^XTMP("BQIRMDR","DUZ")=DUZ
  1.  I $G(^XTMP("BQIRMDR","DUZ",2))=0 D
  1.  . NEW FAC,BQIHM
  1.  . D GETFCRS^BMXRPC3(.FAC,$G(^XTMP("BQIRMDR","DUZ")))
  1.  . I $P(FAC,U,4)'=0 S ^XTMP("BQIRMDR","DUZ",2)=$P(FAC,U,4) Q
  1.  . S BQIHM=$O(^BQI(90508,0)) I BQIHM'="" S FAC=$P($G(^BQI(90508,BQIHM,0)),U,1)
  1.  . S ^XTMP("BQIRMDR","DUZ",2)=$G(FAC)
  1.  Q