BQI23P4 ;VNGT/HS/ALA-Install Program v 2.3 Patch 4 ; 25 May 2011 7:31 AM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
PRE ; Pre-install
NEW DA,DIK
S DIK="^BQI(90506,",DA=0
F S DA=$O(^BQI(90506,DA)) Q:'DA D ^DIK
S DIK="^BQI(90506.3,",DA=0
F S DA=$O(^BQI(90506.3,DA)) Q:'DA D ^DIK
S DIK="^BQI(90506.5,",DA=0
F S DA=$O(^BQI(90506.5,DA)) Q:'DA D ^DIK
S DIK="^BQI(90506.9,",DA=0
F S DA=$O(^BQI(90506.9,DA)) Q:'DA D ^DIK
S DIK="^BQI(90506.71,",DA=0
F S DA=$O(^BQI(90506.71,DA)) Q:'DA D ^DIK
S DIK="^BQI(90507.1,",DA=0
F S DA=$O(^BQI(90507.1,DA)) Q:'DA D ^DIK
S DA=0,DIK="^BQI(90509.9,"
F S DA=$O(^BQI(90509.9,DA)) Q:'DA D ^DIK
;
PF ; Fix 90506.4
NEW DDATA
S DDATA=$P($G(^DD(90509.4,.02,0)),U,3)
I DDATA["M:MAIL" D
. S N=0
. F S N=$O(^BQI(90509.4,N)) Q:'N D
.. I $P(^BQI(90509.4,N,0),U,3)="M" S $P(^BQI(90509.4,N,0),U,3)="L"
.. I $P(^BQI(90509.4,N,0),U,2)="M" S $P(^BQI(90509.4,N,0),U,2)="L"
;
Q
;
POS ; Post-Install
;
;Set the version number
NEW DA
S DA=$O(^BQI(90508,0))
S BQIUPD(90508,DA_",",.08)="2.3.4.0"
S BQIUPD(90508,DA_",",.09)="2.3.4.0"
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
NEW TAX,TXN,BQIUP
S TAX="BQI PNUEMOCOCCAL DXS"
S TXN=$O(^ATXAX("B",TAX,"")) I TXN'="" D
. S BQIUP(9002226,TXN_",",.01)="BQI PNEUMOCOCCAL DXS"
. D FILE^DIE("","BQIUP","ERROR")
;
D ^BQIIPCFX
;
GLS ;EP Update glossary
NEW GN,GNM,GSN,BQIUPD
S GN=0
F S GN=$O(^BQI(90509.9,GN)) Q:'GN D
. S GNM=$P(^BQI(90509.9,GN,0),U,1)
. S GSN=$O(^BQI(90508.2,"B",GNM,"")) Q:GSN=""
. S BQIUPD(90508.2,GSN_",",1)="@"
. D FILE^DIE("","BQIUPD","ERROR")
. M ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
;
; Set BUSARPC into BQIRPC
NEW IEN,DA,X,DIC,Y
S DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR"),DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMNZ"
I $G(^DIC(19,DA(1),10,0))="" S ^DIC(19,DA(1),10,0)="^19.01IP^^"
S X="BUSARPC"
D ^DIC I +Y<1 K DO,DD D FILE^DICN
;
; Find divisions
D FND^BQISYDIV
; Clean out immunizations
NEW DA,DIK
S DA=0,DA(1)=8,DIK="^BQI(90506.5,"_DA(1)_",10,"
F S DA=$O(^BQI(90506.5,8,10,DA)) Q:'DA D ^DIK
;
; Set up immunizations
NEW BN,CT,CD
S BN=0,CT=0
F S BN=$O(^AUTTIMM(BN)) Q:'BN D
. I $P(^AUTTIMM(BN,0),U,7)=1 Q
. S NM=$P(^AUTTIMM(BN,0),U,2)
. S CT=CT+1
. S CD="I_"_$E("0000",$L(CT),2)_CT
. S ^BQI(90506.5,8,10,CT,0)=CD_"^8^"_NM_U_BN_"^D^D^^A"
. S ^BQI(90506.5,8,10,"B",CD,CT)=""
;
S ^BQI(90506.5,8,10,0)="^90506.51^"_CT_U_CT
;
D ^BQI23PU3
;
HP ; Change HPV back to Cervical
NEW IEN,BQIUPD
F IEN=16 S BQIUPD(90621,IEN_",",.1)=2
D FILE^DIE("","BQIUPD","ERROR")
NEW IEN,EVT,BQIUPD
F EVT=16 D
. S IEN=""
. F S IEN=$O(^BTPWQ("B",EVT,IEN)) Q:IEN="" S BQIUPD(90629,IEN_",",.13)=2
. F S IEN=$O(^BTPWP("B",EVT,IEN)) Q:IEN="" S BQIUPD(90620,IEN_",",.12)=2
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
MU ; Run MU Provider data for first Monthly periods
NEW CDTM,CURR,BI
S CURR=$P($G(^BQI(90508,1,9)),U,3)
I CURR="" D
. ; Clean up old data
. S PRV=0 F S PRV=$O(^BQIPROV(PRV)) Q:'PRV K ^BQIPROV(PRV,10),^BQIPROV(PRV,20),^BQIPROV(PRV,40),^BQIPROV("AC")
. S FAC=$$HME^BQIGPUTL() I FAC'="" K ^BQIFAC(FAC,10),^BQIFAC(FAC,20),^BQIFAC(FAC,40),^BQIFAC("AC")
. ;
. D
.. S ^XTMP("BQIMMONP",0)=$$FMADD^XLFDT(DT,365)_U_DT_U_"Month list"
.. S CDTM=$E(DT,4,5)
.. I $E(DT,1,3)=313 F BI=1:1:CDTM S ^XTMP("BQIMMONP","313"_$S(BI<10:"0"_BI,1:BI)_"01")="" Q
.. I $E(DT,1,3)=314 D
... F BI=1:1:12 S ^XTMP("BQIMMONP","313"_$S(BI<10:"0"_BI,1:BI)_"01")=""
... F BI=1:1:CDTM S ^XTMP("BQIMMONP","314"_$S(BI<10:"0"_BI,1:BI)_"01")=""
. D EN^BQIMUUPD
; Fix CQ data by division
D P3^BQIMUUPD
; update any missing months
NEW PROV,DTN,BQDATE,ID
S PROV=0
F S PROV=$O(^BQIPROV(PROV)) Q:'PROV D
. S DTN=0 F S DTN=$O(^BQIPROV(PROV,50,DTN)) Q:'DTN D
.. S BQDATE=$P(^BQIPROV(PROV,50,DTN,0),"^",1),ID=$O(^BQIPROV(PROV,50,DTN,1,1))
.. I $G(^XTMP("BQIMMON",0))="" S ^XTMP("BQIMMON",0)=$$FMADD^XLFDT(DT,365)_U_DT_U_"Month list"
.. I 'ID S ^XTMP("BQIMMON",BQDATE)=""
;
RSC ; Remove the scheduled tasks
NEW RPC,OPTN,OPN,LIST,ZTSK
F RPC="BQI UPDATE MEAN USE 1 YEAR","BQI UPDATE MEAN USE 90 DAYS" D
. S OPTN=$$FIND^BQISCHED(RPC)
. I OPTN'>0 Q
. S OPN=$O(^DIC(19.2,"B",OPTN,""))
. I OPN'="" D
.. NEW DA,DIK
.. S DIK="^DIC(19.2,",DA=OPN D ^DIK
. NEW DA,DIK
. S DA=OPTN,DIK="^DIC(19," D ^DIK
. K LIST
. D OPTION^%ZTLOAD(RPC,.LIST)
. S ZTSK=""
. F S ZTSK=$O(@LIST@(ZTSK)) Q:ZTSK="" D
.. D PCLEAR^%ZTLOAD(ZTSK)
.. D KILL^%ZTLOAD
S $P(^BQI(90508,1,12),"^",4)=0,$P(^BQI(90508,1,12),"^",6)=""
D NJBY^BQINIGH3
;
; Turn on and export MU data
S BQIUPD(90508,"1,",.07)="@"
S BQIUPD(90508,"1,",.25)=1
D FILE^DIE("","BQIUPD","ERROR")
D EN^BQIMUEXP(1)
D HOS^BQIMUEXP(1)
;I '$$PROD^XUPROD() D
;. S BQIUPD(90508,"1,",.07)=1
;. D FILE^DIE("","BQIUPD","ERROR")
;
PER ; Check for Persistent
NEW BI,OPT,OPTION,OPTN,DA
F BI=1:1 S OPT=$P($T(TSK+BI^BQISCHED)," ;;",2,99) Q:OPT="" D
. S OPTION=$P(OPT,U,1) I OPTION'["UPDATE" Q
. S OPTN=$$FIND^BQISCHED(OPTION) Q:OPTN'>0
. S DA=$O(^DIC(19.2,"B",OPTN,"")) I DA'="" D Q
.. I $P(^DIC(19.2,DA,0),U,9)'="SP" Q
.. S BQIUPD(19.2,DA_",",9)="P"
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
CLN ; Clean up old notifications greater than 2 years old
NEW DZ,DIK,DA,NN,DATE,NDATE
S DZ=0,DATE=$$DATE^BQIUL1("T-24M")
F S DZ=$O(^BQICARE(DZ)) Q:'DZ D
. S NN=0
. F S NN=$O(^BQICARE(DZ,3,NN)) Q:'NN D
.. S NDATE=$P(^BQICARE(DZ,3,NN,0),U,1)\1
.. I NDATE>DATE Q
.. S DA(1)=DZ,DA=NN,DIK="^BQICARE("_DA(1)_",3," D ^DIK
;
TX ; Fix iCare NDC taxonomies to point to 50.67 instead of 2
NEW TAX,DA,BQUP
F TAX="BKM TB MED NDCS","BKMV EI MED NDCS","BKMV II MED NDCS","BKMV MAC PROPH MED NDCS" D UP
F TAX="BKMV NNRTI MED NDCS","BKMV NRTI COMBO MED NDCS","BKMV NRTI MED NDCS","BKMV NRTI/NNRTI MED NDCS" D UP
F TAX="BKMV PCP PROPH MED NDCS","BKMV PI BOOSTER MED NDCS","BKMV PI MED NDCS","BQI STATIN NDC" D UP
D FILE^DIE("","BQUP","ERROR")
;
APT ; Update Appointment to APRANGE
NEW DZ,PL,PN,MN,QFL,NVALUE
S DZ=0
F S DZ=$O(^BQICARE(DZ)) Q:'DZ D
. ; Update MU view
. NEW MUV,NMV
. S MUV=$$GET1^DIQ(90505,DZ_",",.16,"I")
. S NMV=$$FIND1^DIC(90506.71,,"X",MUV,"B","","ERROR")
. S BQIUPD(90505,DZ_",",14.01)=$S(NMV'=0:NMV,1:"@")
. S PL=0
. F S PL=$O(^BQICARE(DZ,1,PL)) Q:'PL D
.. S SOURCE=$P(^BQICARE(DZ,1,PL,0),U,11)
.. I SOURCE["APPT" D
... S PN=$O(^BQICARE(DZ,1,PL,10,"B","APRANGE","")) I PN'="" Q
... S PN=$O(^BQICARE(DZ,1,PL,10,"B","RFROM","")) D
.... I PN="" Q
.... S PN1=PN,PN2=$O(^BQICARE(DZ,1,PL,10,"B","RTHRU","")) I PN2="" Q
.... NEW DA,IENS,VN,DA,IENS2,VALUE2
.... S DA(2)=DZ,DA(1)=PL,DA=PN1,IENS=$$IENS^DILF(.DA)
.... S VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
.... I VALUE'["T-",VALUE'="T",VALUE'["T+" Q
.... S DA(2)=DZ,DA(1)=PL,DA=PN2,IENS2=$$IENS^DILF(.DA)
.... S VALUE2=$$GET1^DIQ(90505.02,IENS2,.02,"E")
.... S VN=""
.... F S VN=$O(^BQI(90506.9,"F",VALUE,VN)) Q:VN="" D
..... I '$D(^BQI(90506.9,VN,1,"B","APRANGE")) Q
..... I $P(^BQI(90506.9,VN,0),"^",3)'=VALUE!($P(^(0),"^",4)'=VALUE2) Q
..... S BQIUPD(90505.02,IENS,.01)="APRANGE"
..... S BQIUPD(90505.02,IENS,.02)=$P(^BQI(90506.9,VN,0),U,1)
.... S DA(2)=DZ,DA(1)=PL,DA=PN2
.... S DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",10,"
.... D ^DIK
... I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
.. I SOURCE["ASSIGN" D
... S PN=$O(^BQICARE(DZ,1,PL,10,"B","PTMFRAME",""))
... I PN'="" D
.... NEW DA,IENS,VN
.... S DA(2)=DZ,DA(1)=PL,DA=PN,IENS=$$IENS^DILF(.DA)
.... S VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E") I VALUE'["T-",VALUE'["T+",VALUE'="T" Q
.... S VN=$O(^BQI(90506.9,"E",VALUE,"")) I VN="" Q
.... S BQIUPD(90505.02,IENS,.02)=$P(^BQI(90506.9,VN,0),U,1)
... S PN=$O(^BQICARE(DZ,1,PL,10,"B","PSTMFRAM",""))
... I PN'="" D
.... NEW DA,IENS,VN
.... S DA(2)=DZ,DA(1)=PL,DA=PN,IENS=$$IENS^DILF(.DA)
.... S VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E") I VALUE'["T-",VALUE'["T+",VALUE'="T" Q
.... S VN=$O(^BQI(90506.9,"E",VALUE,"")) I VN="" Q
.... S BQIUPD(90505.02,IENS,.02)=$P(^BQI(90506.9,VN,0),U,1)
... S PN=$O(^BQICARE(DZ,1,PL,10,"B","SPEC",""))
... I PN'="" D
.... I $P(^BQICARE(DZ,1,PL,10,PN,0),U,2)'="",$P(^(0),U,3)="" S $P(^BQICARE(DZ,1,PL,10,PN,0),U,3)=$P(^(0),U,2)
. ;
. S MN=0
. F S MN=$O(^BQICARE(DZ,7,MN)) Q:'MN D
.. S PN=0
.. F S PN=$O(^BQICARE(DZ,7,MN,10,PN)) Q:'PN D
... I $P(^BQICARE(DZ,7,MN,10,PN,0),U,1)'="TMFRAME" Q
... S VALUE=$P(^BQICARE(DZ,7,MN,10,PN,0),U,2) I VALUE'["T-",VALUE'["T+",VALUE'="T" Q
... S TN="",QFL=0 F S TN=$O(^BQI(90506.9,"C","TMFRAME",TN)) Q:TN="" D Q:QFL
.... I $P(^BQI(90506.9,TN,0),U,3)=VALUE S NVALUE=$P(^BQI(90506.9,TN,0),U,1),QFL=1
.... ;S NVALUE=$P(^BQI(90506.9,TN,0),U,3),QFL=1
... NEW DA,IENS
... S DA(2)=DZ,DA(1)=MN,DA=PN,IENS=$$IENS^DILF(.DA)
... S BQIUPD(90505.08,IENS,.02)=NVALUE
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
NEW DA,BI,WORD
S DA=$O(^BQI(90508,0))
K ^BQI(90508,DA,5),^BQI(90508,DA,6),^BQI(90508,DA,7)
F BI=1:1 S TEXT=$P($T(TP5+BI),";;",2) Q:TEXT="" S WORD(BI)=TEXT
D WP^DIE(90508,DA_",",5,"","WORD","ERROR") K WORD
F BI=1:1 S TEXT=$P($T(TP6+BI),";;",2) Q:TEXT="" S WORD(BI)=TEXT
D WP^DIE(90508,DA_",",6,"","WORD","ERROR") K WORD
F BI=1:1 S TEXT=$P($T(TP7+BI),";;",2) Q:TEXT="" S WORD(BI)=TEXT
D WP^DIE(90508,DA_",",7,"","WORD","ERROR") K WORD
;
D PDESC
Q
;
UP ;EP
S DA=$O(^ATXAX("B",TAX,"")) I DA="" Q
S BQUP(9002226,DA_",",.15)=50.57
Q
;
PDESC ;EP - Regenerate Panel Descriptions
NEW USER,PLIEN
S USER=0 F S USER=$O(^BQICARE(USER)) Q:'USER D
. S PLIEN=0 F S PLIEN=$O(^BQICARE(USER,1,PLIEN)) Q:'PLIEN D
.. NEW DESC,DA,IENS
.. S DA(1)=USER,DA=PLIEN,IENS=$$IENS^DILF(.DA)
.. D DESC^BQIPDSCM(USER,PLIEN,.DESC)
.. D WP^DIE(90505.01,IENS,5,"","DESC")
.. K DESC
Q
;
TP5 ;tooltip update
;;Weekly Job: Preset to run search logic once a week. Applies search logic
;;to all RPMS patients data.
;;
;;Nightly Job: Preset to run search logic each night on any new RPMS
;;visit data.
;;
;;Monthly Job: Preset to run every month. Currently this would be around
;;the first of the month and the jobs are started by the Nightly Job.
;;
;;The Site Manager can change the frequency and time for any background
;;Job except the Monthly jobs.
Q
;
TP6 ;tooltip update
;;IPC Update: Calculates the IPC measures for all primary care providers
;;for a one month timeframe.
;;
;;MU Clinical Quality: Calculates the MU Clinical Quality Measure for
;;providers who have been identified in the MU Site Parameters for a one
;;month timeframe.
;;
;;MU Performance: Calculates the MU Performance Measures for providers
;;who have been identified in the MU Site Parameters for a one month
;;timeframe.
;;
;;Best Practice Prompts: Identifies appropriate Best Practice Prompts for
;;patients.
;;
;;Best Practice Prompts: Identifies appropriate Best Practice Prompts for
;;patients.
;;
;;Care Mgmt: Updates Allergy, COPD, and Diabetes data for the Care Mgmt tab
;;for all patients.
;;
;;CMET Data Mining: Finds all CMET events and puts them in the 'Pending'
;;queue.
;;
;;Comm Alerts: Identifies patients who have a specific condition.
;;
;;DX Tags: Identifies ("tags") patients with key chronic condition
;;categories.
;;
;;Flags: Identifies any of 4 alerts related to Abnormal Labs, ER visits and
;;hospitalization for all patients.
;;
;;Natl Measures: Updates status of GPRA and other National performance
;;measures for all patients.
;;
;;Panel Autopopulate: Updates all panels who have been identified as
;;Automatic nightly updates. This is the final portion of the Nightly
;;Job. It locks those panels until completed.
;;
;;Reminders: Updates PCC Health Maintenance, EHR Clinical Reminders and
;;other key care management (HMS and CMET) Reminders due/overdue data for
;;all patients.
Q
;
TP7 ;tooltip update
;;The End date and time of the most recent job type.
;;
;;If the End date is older than the Start date, the job may still be
;;running, OR it may have "errored out", OR the system may have been
;;restarted. You may need to consult your Site Manager to check the
;;error log to make sure there is no error.
Q
BQI23P4 ;VNGT/HS/ALA-Install Program v 2.3 Patch 4 ; 25 May 2011 7:31 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
PRE ; Pre-install
+1 NEW DA,DIK
+2 SET DIK="^BQI(90506,"
SET DA=0
+3 FOR
SET DA=$ORDER(^BQI(90506,DA))
IF 'DA
QUIT
DO ^DIK
+4 SET DIK="^BQI(90506.3,"
SET DA=0
+5 FOR
SET DA=$ORDER(^BQI(90506.3,DA))
IF 'DA
QUIT
DO ^DIK
+6 SET DIK="^BQI(90506.5,"
SET DA=0
+7 FOR
SET DA=$ORDER(^BQI(90506.5,DA))
IF 'DA
QUIT
DO ^DIK
+8 SET DIK="^BQI(90506.9,"
SET DA=0
+9 FOR
SET DA=$ORDER(^BQI(90506.9,DA))
IF 'DA
QUIT
DO ^DIK
+10 SET DIK="^BQI(90506.71,"
SET DA=0
+11 FOR
SET DA=$ORDER(^BQI(90506.71,DA))
IF 'DA
QUIT
DO ^DIK
+12 SET DIK="^BQI(90507.1,"
SET DA=0
+13 FOR
SET DA=$ORDER(^BQI(90507.1,DA))
IF 'DA
QUIT
DO ^DIK
+14 SET DA=0
SET DIK="^BQI(90509.9,"
+15 FOR
SET DA=$ORDER(^BQI(90509.9,DA))
IF 'DA
QUIT
DO ^DIK
+16 ;
PF ; Fix 90506.4
+1 NEW DDATA
+2 SET DDATA=$PIECE($GET(^DD(90509.4,.02,0)),U,3)
+3 IF DDATA["M:MAIL"
Begin DoDot:1
+4 SET N=0
+5 FOR
SET N=$ORDER(^BQI(90509.4,N))
IF 'N
QUIT
Begin DoDot:2
+6 IF $PIECE(^BQI(90509.4,N,0),U,3)="M"
SET $PIECE(^BQI(90509.4,N,0),U,3)="L"
+7 IF $PIECE(^BQI(90509.4,N,0),U,2)="M"
SET $PIECE(^BQI(90509.4,N,0),U,2)="L"
End DoDot:2
End DoDot:1
+8 ;
+9 QUIT
+10 ;
POS ; Post-Install
+1 ;
+2 ;Set the version number
+3 NEW DA
+4 SET DA=$ORDER(^BQI(90508,0))
+5 SET BQIUPD(90508,DA_",",.08)="2.3.4.0"
+6 SET BQIUPD(90508,DA_",",.09)="2.3.4.0"
+7 DO FILE^DIE("","BQIUPD","ERROR")
+8 KILL BQIUPD
+9 ;
+10 NEW TAX,TXN,BQIUP
+11 SET TAX="BQI PNUEMOCOCCAL DXS"
+12 SET TXN=$ORDER(^ATXAX("B",TAX,""))
IF TXN'=""
Begin DoDot:1
+13 SET BQIUP(9002226,TXN_",",.01)="BQI PNEUMOCOCCAL DXS"
+14 DO FILE^DIE("","BQIUP","ERROR")
End DoDot:1
+15 ;
+16 DO ^BQIIPCFX
+17 ;
GLS ;EP Update glossary
+1 NEW GN,GNM,GSN,BQIUPD
+2 SET GN=0
+3 FOR
SET GN=$ORDER(^BQI(90509.9,GN))
IF 'GN
QUIT
Begin DoDot:1
+4 SET GNM=$PIECE(^BQI(90509.9,GN,0),U,1)
+5 SET GSN=$ORDER(^BQI(90508.2,"B",GNM,""))
IF GSN=""
QUIT
+6 SET BQIUPD(90508.2,GSN_",",1)="@"
+7 DO FILE^DIE("","BQIUPD","ERROR")
+8 MERGE ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
End DoDot:1
+9 ;
+10 ; Set BUSARPC into BQIRPC
+11 NEW IEN,DA,X,DIC,Y
+12 SET DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR")
SET DIC="^DIC(19,"_DA(1)_",10,"
SET DIC(0)="LMNZ"
+13 IF $GET(^DIC(19,DA(1),10,0))=""
SET ^DIC(19,DA(1),10,0)="^19.01IP^^"
+14 SET X="BUSARPC"
+15 DO ^DIC
IF +Y<1
KILL DO,DD
DO FILE^DICN
+16 ;
+17 ; Find divisions
+18 DO FND^BQISYDIV
+19 ; Clean out immunizations
+20 NEW DA,DIK
+21 SET DA=0
SET DA(1)=8
SET DIK="^BQI(90506.5,"_DA(1)_",10,"
+22 FOR
SET DA=$ORDER(^BQI(90506.5,8,10,DA))
IF 'DA
QUIT
DO ^DIK
+23 ;
+24 ; Set up immunizations
+25 NEW BN,CT,CD
+26 SET BN=0
SET CT=0
+27 FOR
SET BN=$ORDER(^AUTTIMM(BN))
IF 'BN
QUIT
Begin DoDot:1
+28 IF $PIECE(^AUTTIMM(BN,0),U,7)=1
QUIT
+29 SET NM=$PIECE(^AUTTIMM(BN,0),U,2)
+30 SET CT=CT+1
+31 SET CD="I_"_$EXTRACT("0000",$LENGTH(CT),2)_CT
+32 SET ^BQI(90506.5,8,10,CT,0)=CD_"^8^"_NM_U_BN_"^D^D^^A"
+33 SET ^BQI(90506.5,8,10,"B",CD,CT)=""
End DoDot:1
+34 ;
+35 SET ^BQI(90506.5,8,10,0)="^90506.51^"_CT_U_CT
+36 ;
+37 DO ^BQI23PU3
+38 ;
HP ; Change HPV back to Cervical
+1 NEW IEN,BQIUPD
+2 FOR IEN=16
SET BQIUPD(90621,IEN_",",.1)=2
+3 DO FILE^DIE("","BQIUPD","ERROR")
+4 NEW IEN,EVT,BQIUPD
+5 FOR EVT=16
Begin DoDot:1
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^BTPWQ("B",EVT,IEN))
IF IEN=""
QUIT
SET BQIUPD(90629,IEN_",",.13)=2
+8 FOR
SET IEN=$ORDER(^BTPWP("B",EVT,IEN))
IF IEN=""
QUIT
SET BQIUPD(90620,IEN_",",.12)=2
End DoDot:1
+9 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+10 ;
MU ; Run MU Provider data for first Monthly periods
+1 NEW CDTM,CURR,BI
+2 SET CURR=$PIECE($GET(^BQI(90508,1,9)),U,3)
+3 IF CURR=""
Begin DoDot:1
+4 ; Clean up old data
+5 SET PRV=0
FOR
SET PRV=$ORDER(^BQIPROV(PRV))
IF 'PRV
QUIT
KILL ^BQIPROV(PRV,10),^BQIPROV(PRV,20),^BQIPROV(PRV,40),^BQIPROV("AC")
+6 SET FAC=$$HME^BQIGPUTL()
IF FAC'=""
KILL ^BQIFAC(FAC,10),^BQIFAC(FAC,20),^BQIFAC(FAC,40),^BQIFAC("AC")
+7 ;
+8 Begin DoDot:2
+9 SET ^XTMP("BQIMMONP",0)=$$FMADD^XLFDT(DT,365)_U_DT_U_"Month list"
+10 SET CDTM=$EXTRACT(DT,4,5)
+11 IF $EXTRACT(DT,1,3)=313
FOR BI=1:1:CDTM
SET ^XTMP("BQIMMONP","313"_$SELECT(BI<10:"0"_BI,1:BI)_"01")=""
QUIT
+12 IF $EXTRACT(DT,1,3)=314
Begin DoDot:3
+13 FOR BI=1:1:12
SET ^XTMP("BQIMMONP","313"_$SELECT(BI<10:"0"_BI,1:BI)_"01")=""
+14 FOR BI=1:1:CDTM
SET ^XTMP("BQIMMONP","314"_$SELECT(BI<10:"0"_BI,1:BI)_"01")=""
End DoDot:3
End DoDot:2
+15 DO EN^BQIMUUPD
End DoDot:1
+16 ; Fix CQ data by division
+17 DO P3^BQIMUUPD
+18 ; update any missing months
+19 NEW PROV,DTN,BQDATE,ID
+20 SET PROV=0
+21 FOR
SET PROV=$ORDER(^BQIPROV(PROV))
IF 'PROV
QUIT
Begin DoDot:1
+22 SET DTN=0
FOR
SET DTN=$ORDER(^BQIPROV(PROV,50,DTN))
IF 'DTN
QUIT
Begin DoDot:2
+23 SET BQDATE=$PIECE(^BQIPROV(PROV,50,DTN,0),"^",1)
SET ID=$ORDER(^BQIPROV(PROV,50,DTN,1,1))
+24 IF $GET(^XTMP("BQIMMON",0))=""
SET ^XTMP("BQIMMON",0)=$$FMADD^XLFDT(DT,365)_U_DT_U_"Month list"
+25 IF 'ID
SET ^XTMP("BQIMMON",BQDATE)=""
End DoDot:2
End DoDot:1
+26 ;
RSC ; Remove the scheduled tasks
+1 NEW RPC,OPTN,OPN,LIST,ZTSK
+2 FOR RPC="BQI UPDATE MEAN USE 1 YEAR","BQI UPDATE MEAN USE 90 DAYS"
Begin DoDot:1
+3 SET OPTN=$$FIND^BQISCHED(RPC)
+4 IF OPTN'>0
QUIT
+5 SET OPN=$ORDER(^DIC(19.2,"B",OPTN,""))
+6 IF OPN'=""
Begin DoDot:2
+7 NEW DA,DIK
+8 SET DIK="^DIC(19.2,"
SET DA=OPN
DO ^DIK
End DoDot:2
+9 NEW DA,DIK
+10 SET DA=OPTN
SET DIK="^DIC(19,"
DO ^DIK
+11 KILL LIST
+12 DO OPTION^%ZTLOAD(RPC,.LIST)
+13 SET ZTSK=""
+14 FOR
SET ZTSK=$ORDER(@LIST@(ZTSK))
IF ZTSK=""
QUIT
Begin DoDot:2
+15 DO PCLEAR^%ZTLOAD(ZTSK)
+16 DO KILL^%ZTLOAD
End DoDot:2
End DoDot:1
+17 SET $PIECE(^BQI(90508,1,12),"^",4)=0
SET $PIECE(^BQI(90508,1,12),"^",6)=""
+18 DO NJBY^BQINIGH3
+19 ;
+20 ; Turn on and export MU data
+21 SET BQIUPD(90508,"1,",.07)="@"
+22 SET BQIUPD(90508,"1,",.25)=1
+23 DO FILE^DIE("","BQIUPD","ERROR")
+24 DO EN^BQIMUEXP(1)
+25 DO HOS^BQIMUEXP(1)
+26 ;I '$$PROD^XUPROD() D
+27 ;. S BQIUPD(90508,"1,",.07)=1
+28 ;. D FILE^DIE("","BQIUPD","ERROR")
+29 ;
PER ; Check for Persistent
+1 NEW BI,OPT,OPTION,OPTN,DA
+2 FOR BI=1:1
SET OPT=$PIECE($TEXT(TSK+BI^BQISCHED)," ;;",2,99)
IF OPT=""
QUIT
Begin DoDot:1
+3 SET OPTION=$PIECE(OPT,U,1)
IF OPTION'["UPDATE"
QUIT
+4 SET OPTN=$$FIND^BQISCHED(OPTION)
IF OPTN'>0
QUIT
+5 SET DA=$ORDER(^DIC(19.2,"B",OPTN,""))
IF DA'=""
Begin DoDot:2
+6 IF $PIECE(^DIC(19.2,DA,0),U,9)'="SP"
QUIT
+7 SET BQIUPD(19.2,DA_",",9)="P"
End DoDot:2
QUIT
End DoDot:1
+8 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+9 ;
CLN ; Clean up old notifications greater than 2 years old
+1 NEW DZ,DIK,DA,NN,DATE,NDATE
+2 SET DZ=0
SET DATE=$$DATE^BQIUL1("T-24M")
+3 FOR
SET DZ=$ORDER(^BQICARE(DZ))
IF 'DZ
QUIT
Begin DoDot:1
+4 SET NN=0
+5 FOR
SET NN=$ORDER(^BQICARE(DZ,3,NN))
IF 'NN
QUIT
Begin DoDot:2
+6 SET NDATE=$PIECE(^BQICARE(DZ,3,NN,0),U,1)\1
+7 IF NDATE>DATE
QUIT
+8 SET DA(1)=DZ
SET DA=NN
SET DIK="^BQICARE("_DA(1)_",3,"
DO ^DIK
End DoDot:2
End DoDot:1
+9 ;
TX ; Fix iCare NDC taxonomies to point to 50.67 instead of 2
+1 NEW TAX,DA,BQUP
+2 FOR TAX="BKM TB MED NDCS","BKMV EI MED NDCS","BKMV II MED NDCS","BKMV MAC PROPH MED NDCS"
DO UP
+3 FOR TAX="BKMV NNRTI MED NDCS","BKMV NRTI COMBO MED NDCS","BKMV NRTI MED NDCS","BKMV NRTI/NNRTI MED NDCS"
DO UP
+4 FOR TAX="BKMV PCP PROPH MED NDCS","BKMV PI BOOSTER MED NDCS","BKMV PI MED NDCS","BQI STATIN NDC"
DO UP
+5 DO FILE^DIE("","BQUP","ERROR")
+6 ;
APT ; Update Appointment to APRANGE
+1 NEW DZ,PL,PN,MN,QFL,NVALUE
+2 SET DZ=0
+3 FOR
SET DZ=$ORDER(^BQICARE(DZ))
IF 'DZ
QUIT
Begin DoDot:1
+4 ; Update MU view
+5 NEW MUV,NMV
+6 SET MUV=$$GET1^DIQ(90505,DZ_",",.16,"I")
+7 SET NMV=$$FIND1^DIC(90506.71,,"X",MUV,"B","","ERROR")
+8 SET BQIUPD(90505,DZ_",",14.01)=$SELECT(NMV'=0:NMV,1:"@")
+9 SET PL=0
+10 FOR
SET PL=$ORDER(^BQICARE(DZ,1,PL))
IF 'PL
QUIT
Begin DoDot:2
+11 SET SOURCE=$PIECE(^BQICARE(DZ,1,PL,0),U,11)
+12 IF SOURCE["APPT"
Begin DoDot:3
+13 SET PN=$ORDER(^BQICARE(DZ,1,PL,10,"B","APRANGE",""))
IF PN'=""
QUIT
+14 SET PN=$ORDER(^BQICARE(DZ,1,PL,10,"B","RFROM",""))
Begin DoDot:4
+15 IF PN=""
QUIT
+16 SET PN1=PN
SET PN2=$ORDER(^BQICARE(DZ,1,PL,10,"B","RTHRU",""))
IF PN2=""
QUIT
+17 NEW DA,IENS,VN,DA,IENS2,VALUE2
+18 SET DA(2)=DZ
SET DA(1)=PL
SET DA=PN1
SET IENS=$$IENS^DILF(.DA)
+19 SET VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
+20 IF VALUE'["T-"
IF VALUE'="T"
IF VALUE'["T+"
QUIT
+21 SET DA(2)=DZ
SET DA(1)=PL
SET DA=PN2
SET IENS2=$$IENS^DILF(.DA)
+22 SET VALUE2=$$GET1^DIQ(90505.02,IENS2,.02,"E")
+23 SET VN=""
+24 FOR
SET VN=$ORDER(^BQI(90506.9,"F",VALUE,VN))
IF VN=""
QUIT
Begin DoDot:5
+25 IF '$DATA(^BQI(90506.9,VN,1,"B","APRANGE"))
QUIT
+26 IF $PIECE(^BQI(90506.9,VN,0),"^",3)'=VALUE!($PIECE(^(0),"^",4)'=VALUE2)
QUIT
+27 SET BQIUPD(90505.02,IENS,.01)="APRANGE"
+28 SET BQIUPD(90505.02,IENS,.02)=$PIECE(^BQI(90506.9,VN,0),U,1)
End DoDot:5
+29 SET DA(2)=DZ
SET DA(1)=PL
SET DA=PN2
+30 SET DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",10,"
+31 DO ^DIK
End DoDot:4
+32 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:3
+33 IF SOURCE["ASSIGN"
Begin DoDot:3
+34 SET PN=$ORDER(^BQICARE(DZ,1,PL,10,"B","PTMFRAME",""))
+35 IF PN'=""
Begin DoDot:4
+36 NEW DA,IENS,VN
+37 SET DA(2)=DZ
SET DA(1)=PL
SET DA=PN
SET IENS=$$IENS^DILF(.DA)
+38 SET VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
IF VALUE'["T-"
IF VALUE'["T+"
IF VALUE'="T"
QUIT
+39 SET VN=$ORDER(^BQI(90506.9,"E",VALUE,""))
IF VN=""
QUIT
+40 SET BQIUPD(90505.02,IENS,.02)=$PIECE(^BQI(90506.9,VN,0),U,1)
End DoDot:4
+41 SET PN=$ORDER(^BQICARE(DZ,1,PL,10,"B","PSTMFRAM",""))
+42 IF PN'=""
Begin DoDot:4
+43 NEW DA,IENS,VN
+44 SET DA(2)=DZ
SET DA(1)=PL
SET DA=PN
SET IENS=$$IENS^DILF(.DA)
+45 SET VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
IF VALUE'["T-"
IF VALUE'["T+"
IF VALUE'="T"
QUIT
+46 SET VN=$ORDER(^BQI(90506.9,"E",VALUE,""))
IF VN=""
QUIT
+47 SET BQIUPD(90505.02,IENS,.02)=$PIECE(^BQI(90506.9,VN,0),U,1)
End DoDot:4
+48 SET PN=$ORDER(^BQICARE(DZ,1,PL,10,"B","SPEC",""))
+49 IF PN'=""
Begin DoDot:4
+50 IF $PIECE(^BQICARE(DZ,1,PL,10,PN,0),U,2)'=""
IF $PIECE(^(0),U,3)=""
SET $PIECE(^BQICARE(DZ,1,PL,10,PN,0),U,3)=$PIECE(^(0),U,2)
End DoDot:4
End DoDot:3
End DoDot:2
+51 ;
+52 SET MN=0
+53 FOR
SET MN=$ORDER(^BQICARE(DZ,7,MN))
IF 'MN
QUIT
Begin DoDot:2
+54 SET PN=0
+55 FOR
SET PN=$ORDER(^BQICARE(DZ,7,MN,10,PN))
IF 'PN
QUIT
Begin DoDot:3
+56 IF $PIECE(^BQICARE(DZ,7,MN,10,PN,0),U,1)'="TMFRAME"
QUIT
+57 SET VALUE=$PIECE(^BQICARE(DZ,7,MN,10,PN,0),U,2)
IF VALUE'["T-"
IF VALUE'["T+"
IF VALUE'="T"
QUIT
+58 SET TN=""
SET QFL=0
FOR
SET TN=$ORDER(^BQI(90506.9,"C","TMFRAME",TN))
IF TN=""
QUIT
Begin DoDot:4
+59 IF $PIECE(^BQI(90506.9,TN,0),U,3)=VALUE
SET NVALUE=$PIECE(^BQI(90506.9,TN,0),U,1)
SET QFL=1
+60 ;S NVALUE=$P(^BQI(90506.9,TN,0),U,3),QFL=1
End DoDot:4
IF QFL
QUIT
+61 NEW DA,IENS
+62 SET DA(2)=DZ
SET DA(1)=MN
SET DA=PN
SET IENS=$$IENS^DILF(.DA)
+63 SET BQIUPD(90505.08,IENS,.02)=NVALUE
End DoDot:3
End DoDot:2
End DoDot:1
+64 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+65 ;
+66 NEW DA,BI,WORD
+67 SET DA=$ORDER(^BQI(90508,0))
+68 KILL ^BQI(90508,DA,5),^BQI(90508,DA,6),^BQI(90508,DA,7)
+69 FOR BI=1:1
SET TEXT=$PIECE($TEXT(TP5+BI),";;",2)
IF TEXT=""
QUIT
SET WORD(BI)=TEXT
+70 DO WP^DIE(90508,DA_",",5,"","WORD","ERROR")
KILL WORD
+71 FOR BI=1:1
SET TEXT=$PIECE($TEXT(TP6+BI),";;",2)
IF TEXT=""
QUIT
SET WORD(BI)=TEXT
+72 DO WP^DIE(90508,DA_",",6,"","WORD","ERROR")
KILL WORD
+73 FOR BI=1:1
SET TEXT=$PIECE($TEXT(TP7+BI),";;",2)
IF TEXT=""
QUIT
SET WORD(BI)=TEXT
+74 DO WP^DIE(90508,DA_",",7,"","WORD","ERROR")
KILL WORD
+75 ;
+76 DO PDESC
+77 QUIT
+78 ;
UP ;EP
+1 SET DA=$ORDER(^ATXAX("B",TAX,""))
IF DA=""
QUIT
+2 SET BQUP(9002226,DA_",",.15)=50.57
+3 QUIT
+4 ;
PDESC ;EP - Regenerate Panel Descriptions
+1 NEW USER,PLIEN
+2 SET USER=0
FOR
SET USER=$ORDER(^BQICARE(USER))
IF 'USER
QUIT
Begin DoDot:1
+3 SET PLIEN=0
FOR
SET PLIEN=$ORDER(^BQICARE(USER,1,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:2
+4 NEW DESC,DA,IENS
+5 SET DA(1)=USER
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+6 DO DESC^BQIPDSCM(USER,PLIEN,.DESC)
+7 DO WP^DIE(90505.01,IENS,5,"","DESC")
+8 KILL DESC
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
TP5 ;tooltip update
+1 ;;Weekly Job: Preset to run search logic once a week. Applies search logic
+2 ;;to all RPMS patients data.
+3 ;;
+4 ;;Nightly Job: Preset to run search logic each night on any new RPMS
+5 ;;visit data.
+6 ;;
+7 ;;Monthly Job: Preset to run every month. Currently this would be around
+8 ;;the first of the month and the jobs are started by the Nightly Job.
+9 ;;
+10 ;;The Site Manager can change the frequency and time for any background
+11 ;;Job except the Monthly jobs.
+12 QUIT
+13 ;
TP6 ;tooltip update
+1 ;;IPC Update: Calculates the IPC measures for all primary care providers
+2 ;;for a one month timeframe.
+3 ;;
+4 ;;MU Clinical Quality: Calculates the MU Clinical Quality Measure for
+5 ;;providers who have been identified in the MU Site Parameters for a one
+6 ;;month timeframe.
+7 ;;
+8 ;;MU Performance: Calculates the MU Performance Measures for providers
+9 ;;who have been identified in the MU Site Parameters for a one month
+10 ;;timeframe.
+11 ;;
+12 ;;Best Practice Prompts: Identifies appropriate Best Practice Prompts for
+13 ;;patients.
+14 ;;
+15 ;;Best Practice Prompts: Identifies appropriate Best Practice Prompts for
+16 ;;patients.
+17 ;;
+18 ;;Care Mgmt: Updates Allergy, COPD, and Diabetes data for the Care Mgmt tab
+19 ;;for all patients.
+20 ;;
+21 ;;CMET Data Mining: Finds all CMET events and puts them in the 'Pending'
+22 ;;queue.
+23 ;;
+24 ;;Comm Alerts: Identifies patients who have a specific condition.
+25 ;;
+26 ;;DX Tags: Identifies ("tags") patients with key chronic condition
+27 ;;categories.
+28 ;;
+29 ;;Flags: Identifies any of 4 alerts related to Abnormal Labs, ER visits and
+30 ;;hospitalization for all patients.
+31 ;;
+32 ;;Natl Measures: Updates status of GPRA and other National performance
+33 ;;measures for all patients.
+34 ;;
+35 ;;Panel Autopopulate: Updates all panels who have been identified as
+36 ;;Automatic nightly updates. This is the final portion of the Nightly
+37 ;;Job. It locks those panels until completed.
+38 ;;
+39 ;;Reminders: Updates PCC Health Maintenance, EHR Clinical Reminders and
+40 ;;other key care management (HMS and CMET) Reminders due/overdue data for
+41 ;;all patients.
+42 QUIT
+43 ;
TP7 ;tooltip update
+1 ;;The End date and time of the most recent job type.
+2 ;;
+3 ;;If the End date is older than the Start date, the job may still be
+4 ;;running, OR it may have "errored out", OR the system may have been
+5 ;;restarted. You may need to consult your Site Manager to check the
+6 ;;error log to make sure there is no error.
+7 QUIT
