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

BQINIGHT.m

Go to the documentation of this file. 
  1. BQINIGHT ;PRXM/HC/ALA-Nightly Background Job ; 05 Jan 2006  1:31 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
  1.  ;
  1.  ;
  1. EN ;EP - Entry point
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB"
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  ;
  1.  S BQIUPD(90508,"1,",24.01)=$G(ZTSK)
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ;D EN^BQIMUUPD
  1.  D ARM^BQINIGH2
  1.  D IMM^BQINIGH2
  1.  D PRN^BQINIGH2
  1.  D PED^BQINIGH2
  1.  D HCV^BQINIGH2
  1.  D DMA^BQINIGH2
  1.  ;D CQ^BQIMUMON("")
  1.  ;D PF^BQIMUMON("")
  1.  ;D JBC^BQINIGH3
  1.  D MEAS^BQINIGH1
  1.  D PRF^BQINIGH2
  1.  D FLG
  1.  D CMA^BQINIGH2
  1.  D DXC
  1.  D CRS
  1.  ;Run IPC
  1.  D IJB^BQINIGH3("")
  1.  D WK^BQINIGH3
  1.  ;D NUM^BQIMUSIT
  1.  ; Reminders
  1.  D REM
  1.  K DLAYGO
  1.  ; Best Practice prompts
  1.  D TRT
  1.  ; Register updates
  1.  D REG^BQINIGH4
  1.  ; Care Mgmt
  1.  D AST^BQINIGH1
  1.  ; Run CMET
  1.  D EN^BTPWPFND("Nightly")
  1.  ; Run Autopopulate
  1.  D NGHT^BQINIGH2
  1.  ;
  1.  S BQIUPD(90508,"1,",24.01)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; Clean up any remaining TMPs
  1.  NEW BQTSK,TSK,TUID
  1.  S TSK="BQI",BQTSK=TSK
  1.  F  S BQTSK=$O(^TMP(BQTSK)) Q:$E(BQTSK,1,3)'=TSK  S TUID="" F  S TUID=$O(^TMP(BQTSK,TUID)) Q:TUID=""  I $E(TUID,1,1)="Z" K ^TMP(BQTSK,TUID)
  1.  Q
  1.  ;
  1. FLG ;EP - Flag updates
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ;
  1.  ;  Set the DATE/TIME FLAG STARTED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.01)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.03)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ; Find all flags for patients
  1.  D FND^BQIFLG
  1.  ;
  1.  ;  Set the DATE/TIME FLAG STOPPED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.02)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.03)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ;  Get a list of all patients who have had visits or problems
  1.  ;  entered into RPMS since the last visit or problem IENs.
  1.  ;  Set into temporary global XTMP. This list is the subset of
  1.  ;  patients used to update.
  1.  ; 
  1.  NEW BQIDA,VLIEN,PRIEN,DFN,LMDT
  1.  S BQIDA=$$SPM^BQIGPUTL()
  1.  S VLIEN=$$GET1^DIQ(90508,BQIDA,1,"E")
  1.  S PRIEN=$$GET1^DIQ(90508,BQIDA,3,"E")
  1.  S BQIUPD(90508,BQIDA_",",1)=$O(^AUPNVSIT("A"),-1)
  1.  S BQIUPD(90508,BQIDA_",",3)=$O(^AUPNPROB("A"),-1)
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  K ^XTMP("BQINIGHT")
  1.  S ^XTMP("BQINIGHT",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT()
  1.  F  S VLIEN=$O(^AUPNVSIT(VLIEN)) Q:'VLIEN  D
  1.  . ; If visit has been deleted, don't include
  1.  . I $P($G(^AUPNVSIT(VLIEN,0)),"^",11)=1 Q
  1.  . I $P($G(^AUPNVSIT(VLIEN,0)),"^",9)=1 Q
  1.  . Q:"DXCTI"[$P(^AUPNVSIT(VLIEN,0),U,7)
  1.  . S DFN=$P(^AUPNVSIT(VLIEN,0),U,5) I DFN="" Q
  1.  . S ^XTMP("BQINIGHT",DFN)=""
  1.  ;
  1.  F  S PRIEN=$O(^AUPNPROB(PRIEN)) Q:'PRIEN  D
  1.  . S DFN=$P(^AUPNPROB(PRIEN,0),U,2)
  1.  . I $P(^AUPNPROB(PRIEN,0),U,12)'="A" Q
  1.  . S ^XTMP("BQINIGHT",DFN)=""
  1.  ;
  1.  Q
  1.  ;
  1. DXC ;EP - Update Diagnosis Categories
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ;
  1.  ;  Set the DATE/TIME DXN CATEGORY STARTED field
  1.  NEW DA,DATA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.04)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.06)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^XTMP("BQINIGHT",DFN)) Q:'DFN  D
  1.  . D PAT^BQITDPAT(.DATA,DFN)
  1.  . Q
  1.  ;
  1.  I $G(BQGLB)'="" K @BQGLB,BQGLB
  1.  I $G(BQPGLB)'="" K @BQPGLB,BQPGLB
  1.  K AGE,BQEXEC,BQDEF,BQPRG,DFN,PRGM,SEX,TXDXCN,TXDXCT,TXT,Y
  1.  ;
  1.  ;  Set the DATE/TIME DXN CATEGORY STOPPED field
  1.  NEW DA,BQTSK
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.05)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.06)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  F BQTSK="BQIBMI","BQIBP","BQIPREG","BQITAX","BQITAX1","BQITDPRC","BQITMPO","BQITDPAT" K ^TMP(BQTSK,UID)
  1.  Q
  1.  ;
  1. CRS ;EP - Find all GPRA indicators
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ;
  1.  ; Check if new version of CRS has been loaded
  1.  D GCHK^BQIGPUPD()
  1.  ;
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.07)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.09)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  NEW DFN,GPMEAS,CT
  1.  S BQIGREF=$NA(^TMP(UID,"BQIGPRA"))
  1.  K @BQIGREF
  1.  S BQIDATA=$NA(^BQIPAT)
  1.  ;
  1.  D INP
  1.  ;  If the routine is not defined, quit
  1.  I $G(BQIROU)="" Q
  1.  ;
  1.  ;  If the tag is not defined, quit
  1.  I $T(@("BQI^"_BQIROU))="" Q
  1.  ;
  1.  ;  Initialize GPRA variables
  1.  NEW VER,BQX,XN
  1.  S VER=$$VERSION^XPDUTL("BGP")
  1.  ;
  1.  I VER>7.0 D
  1.  . S BQX=""
  1.  . F  S BQX=$O(^BQI(90506.1,"AC","G",BQX)) Q:BQX=""  D
  1.  .. I $P(^BQI(90506.1,BQX,0),U,10)=1 Q
  1.  .. S X=$P(^BQI(90506.1,BQX,0),U,1),XN=$P(X,"_",2)
  1.  .. S X=$P($G(@BQIMEASG@(XN,0)),U,1) I X'="" S BGPIND(X)=""
  1.  ;
  1.  ; Define the time frame for the patient
  1.  S BGPBD=$$DATE^BQIUL1("T-12M"),BGPED=DT
  1.  S BGPBBD="300"_$E(BGPBD,4,7),BGPBED="300"_$E(BGPED,4,7)
  1.  S BGPPBD=$$DATE^BQIUL1("T-24M"),BGPPED=$$DATE^BQIUL1("T-12M")
  1.  S BGPPER=$E($$DT^XLFDT(),1,3)_"0000"
  1.  S BGPQTR=$S(BGPBD>($E(BGPBD,1,3)_"0101")&(BGPBD<($E(BGPBD,1,3)_"0331")):1,BGPBD>($E(BGPBD,1,3)_"0401")&(BGPBD<($E(BGPBD,1,3)_"0630")):2,BGPBD>($E(BGPBD,1,3)_"0701")&(BGPBD<($E(BGPBD,1,3)_"0930")):3,1:4)
  1.  S BGPRTYPE=4,BGPRPT=4
  1.  S BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
  1.  S BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
  1.  S BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
  1.  ;
  1.  ; Setup taxonomies
  1.  I VER>14.1 D
  1.  . I $T(UNFOLDTX^BGP8UTL2)="" Q
  1.  . D UNFOLDTX^BGP8UTL2
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^XTMP("BQINIGHT",DFN)) Q:'DFN  D
  1.  . ; Remove any previous GPRA data
  1.  . K @BQIDATA@(DFN,30)
  1.  . S @BQIDATA@(DFN,30,0)="^90507.53^^"
  1.  . ; If patient is deceased, don't calculate
  1.  . I $P($G(^DPT(DFN,.35)),U,1)'="" Q
  1.  . ; If patient has no active HRNs, quit
  1.  . I '$$HRN^BQIUL1(DFN) Q
  1.  . ; If patient has no visit in last 2 years, quit
  1.  . ;I '$$VTHR^BQIUL1(DFN) Q
  1.  . I '$$VTWR^BQIUL1(DFN) Q
  1.  . ; If new patient add to BQIPAT
  1.  . I $G(^BQIPAT(DFN,0))="" D NPT^BQITASK(DFN)
  1.  . I $P($G(^BQIPAT(DFN,0)),"^",1)="" S $P(^BQIPAT(DFN,0),"^",1)=DFN,^BQIPAT("B",DFN,DFN)=""
  1.  . S BQIPUP(90507.5,DFN_",",.02)=BQIYR
  1.  . S BQIPUP(90507.5,DFN_",",.03)=BGPBD
  1.  . S BQIPUP(90507.5,DFN_",",.04)=BGPED
  1.  . S BQIPUP(90507.5,DFN_",",.05)=$$NOW^XLFDT()
  1.  . D FILE^DIE("","BQIPUP","ERROR")
  1.  . K BQIPUP
  1.  . D @("BQI^"_BQIROU_"(DFN,.BQIGREF)")
  1.  . ;
  1.  . NEW DA
  1.  . S DA(1)=DFN,DA=0,DIK="^BQIPAT("_DA(1)_",30,"
  1.  . F  S DA=$O(@BQIDATA@(DFN,30,DA)) Q:'DA  D ^DIK
  1.  . ;
  1.  . ; if the patient doesn't meet any GPRA logic, quit
  1.  . I '$D(@BQIGREF@(DFN)) Q
  1.  . ;
  1.  . I '$D(@BQIDATA@(DFN,30,0)) S @BQIDATA@(DFN,30,0)="^90507.53^^"
  1.  . ;
  1.  . S SIND="",CT=0
  1.  . F  S SIND=$O(^BQI(90506.1,"AC","G",SIND)) Q:SIND=""  D
  1.  .. S CT=CT+1
  1.  .. I $P(^BQI(90506.1,SIND,0),U,10)=1 Q
  1.  .. S @BQIDATA@(DFN,30,CT,0)=$P(^BQI(90506.1,SIND,0),U,1)
  1.  .. S @BQIDATA@(DFN,30,"B",$P(^BQI(90506.1,SIND,0),U,1),CT)=""
  1.  . ;
  1.  . S IND=0
  1.  . F  S IND=$O(@BQIGREF@(DFN,IND)) Q:IND=""  D
  1.  .. S MEAS=0
  1.  .. F  S MEAS=$O(@BQIGREF@(DFN,IND,MEAS)) Q:MEAS=""  D
  1.  ... ;Q:'$$SUM^BQIGPUTL(BQIYR,MEAS)
  1.  ... S GPMEAS=BQIYR_"_"_MEAS
  1.  ... S MCT=$O(^BQIPAT(DFN,30,"B",GPMEAS,"")) I MCT="" Q
  1.  ... S $P(@BQIDATA@(DFN,30,MCT,0),U,2)=$P(@BQIGREF@(DFN,IND),U,2)
  1.  ... S $P(@BQIDATA@(DFN,30,MCT,0),U,3)=$P(@BQIGREF@(DFN,IND,MEAS),U,2)
  1.  ... S $P(@BQIDATA@(DFN,30,MCT,0),U,4)=$P(@BQIGREF@(DFN,IND,MEAS),U,3)
  1.  . K @BQIGREF
  1.  . NEW DA,DIK
  1.  . S DA=DFN,DIK="^BQIPAT(" D IX1^DIK
  1.  ;
  1.  K ^XTMP("BGP15TAX",$J),^XTMP("BGPSNOMEDSUBSET",$J)
  1.  ;
  1.  ; Compile Main view data
  1.  D COMP^BQIGPRA5
  1.  ;
  1.  ; Set the DATE/TIME GPRA STOPPED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.08)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.09)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  K MEAS,DFN,IND,BGPIND,BGPBD,BGPED,BGPBBD,BGPBED,BGPPBD,BGPPED
  1.  K BGPQTR,BGPRTYPE,BGPRPT,BGP3YE,BGPP3YE,BGPB3YE,BGPHOME,BHM
  1.  K BQIDATA,BQIH,BQIINDF,BQIINDG,BQIMEASF,BQIMEASG,BQIROU,BQIY,BQIYR
  1.  K @BQIGREF,BQIUPD,MCT,SIND,VLIEN,VOK,X,BQIGREF,BGPPER
  1.  ;
  1.  Q
  1.  ;
  1. REM ;EP - Find any new reminders
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ;
  1.  ; Set the DATE/TIME REMINDERS STARTED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.1)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.12)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ; Re-evaluate reminders
  1.  D CHK^BQIRMDR("Nightly")
  1.  ; Check for new CMET followups and recalculate their reminders
  1.  NEW CMDT,IEN,BKDFN
  1.  S CMDT=$$FMADD^XLFDT(DT,-1)-.005
  1.  F  S CMDT=$O(^BTPWP("AU",CMDT)) Q:CMDT=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BTPWP("AU",CMDT,IEN)) Q:IEN=""  D
  1.  .. S BKDFN=$P(^BTPWP(IEN,0),U,2),^XTMP("BQINIGHT",BKDFN)=""
  1.  ; Check for DUZ
  1.  D DZ^BQITASK1
  1.  ;
  1.  ; Check for Appointments
  1.  D APT^BQIRMIZ
  1.  ; Reset Reminders
  1.  NEW BKDFN
  1.  S BKDFN=0,ERRCNT=0
  1.  F  S BKDFN=$O(^XTMP("BQINIGHT",BKDFN)) Q:'BKDFN  D  Q:ERRCNT>100
  1.  . I $G(^BQIPAT(BKDFN,0))="" D NPT^BQITASK(BKDFN)
  1.  . I $P($G(^BQIPAT(BKDFN,0)),"^",1)="" S $P(^BQIPAT(BKDFN,0),"^",1)=BKDFN,^BQIPAT("B",BKDFN,BKDFN)=""
  1.  . D PAT^BQIRMDR(BKDFN)
  1.  ;
  1.  ; Set the DATE/TIME REMINDERS STOPPED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.11)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.12)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD,ERRCNT
  1.  Q
  1.  ;
  1. TRT ;EP - Update treatment prompts
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ; Set the DATE/TIME TREATMENT STARTED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.13)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.15)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  NEW BKDFN
  1.  S BKDFN=0
  1.  F  S BKDFN=$O(^XTMP("BQINIGHT",BKDFN)) Q:'BKDFN  D
  1.  . I $G(^BQIPAT(BKDFN,0))="" D NPT^BQITASK(BKDFN)
  1.  . I $P($G(^BQIPAT(BKDFN,0)),"^",1)="" S $P(^BQIPAT(BKDFN,0),"^",1)=BKDFN,^BQIPAT("B",BKDFN,BKDFN)=""
  1.  . D PAT^BQITRMT(BKDFN)
  1.  ; Set the DATE/TIME TREATMENT STOPPED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.14)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.15)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. INP ;EP - Initialize GPRA variables
  1.  NEW DA,IENS
  1.  I $G(U)="" D DT^DICRW
  1.  ;
  1.  ; Get the internal entry value from the site parameters
  1.  S BQIH=$$SPM^BQIGPUTL()
  1.  S BGPHOME=$$HME^BQIGPUTL()
  1.  ;
  1.  ;  get the current year for CRS
  1.  S BQIYR=$$GET1^DIQ(90508,BQIH,2,"E")
  1.  I BQIYR="" S BQIYR=$P($$FMTE^XLFDT(DT,7),"/",1)
  1.  S BQIY=$$LKP^BQIGPUTL(BQIYR)
  1.  ;  if the current year is not defined yet, get the previous year
  1.  I BQIY=-1 S BQIYR=BQIYR-1,BQIY=$$LKP^BQIGPUTL(BQIYR) I BQIY=-1 Q
  1.  ;
  1.  ;  get the global references for the corresponding CRS year
  1.  S DA(1)=BQIH,DA=BQIY
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BQIINDF=$$GET1^DIQ(90508.01,IENS,.02,"E")
  1.  S BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
  1.  S BQIMEASF=$$GET1^DIQ(90508.01,IENS,.03,"E")
  1.  S BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
  1.  S BQIROU=$$GET1^DIQ(90508.01,IENS,.04,"E")
  1.  Q