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

BQI23P4.m

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