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

BQI26POS.m

Go to the documentation of this file. 
  1. BQI26POS ;GDHS/HCS/ALA-iCare Version 2.6 PostInstall ; 28 Oct 2016  3:01 PM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;;
  1.  ;
  1. EN ;EP
  1.  ;Set the version number
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0))
  1.  S BQIUPD(90508,DA_",",.08)="2.6.0.8"
  1.  S BQIUPD(90508,DA_",",.09)="2.6.0.8"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  NEW IEN
  1.  S IEN=$O(^DIC(19.1,"B","BQIZCMED",""))
  1.  I IEN'="" S BQIUPD(19.1,IEN_",",.02)="iCare Case Management Editor"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; Set BTPWRPC and 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="BTPWRPC"
  1.  D ^DIC I +Y<1 K DO,DD D FILE^DICN
  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.  NEW BQIDA
  1.  S BQIDA=1 D LTAX^BQITAXXU
  1.  D ^BQIULAY
  1.  S $P(^BQI(90506.5,24,10,14,0),"^",9)=""
  1.  ;
  1.  D ^BQIBTX
  1.  ;
  1. CM ; Update Care Mgmt
  1.  K ^BQI(90506.5,24,10,"C","TB Quantiferon",14)
  1.  S ^BQI(90506.5,24,10,14,0)="EY_14^3^TB Lab^^D^O^^A^"
  1.  S ^BQI(90506.5,24,10,14,2)="D TB^BQICMUTL"
  1.  S ^BQI(90506.5,24,10,14,4,0)="^^2^2^3160913^"
  1.  S ^BQI(90506.5,24,10,14,4,1,0)="Most recent TB blood lab test or refusal from taxonomy BQI TB "
  1.  S ^BQI(90506.5,24,10,14,4,2,0)="QUANTIFERON LOINC or BQI TB QUANTIFERON TEST."
  1.  S ^BQI(90506.5,24,10,"B","EY_14",14)=""
  1.  S ^BQI(90506.5,24,10,"C","TB Lab",14)=""
  1.  ;
  1.  D ^BQIUSRC
  1.  S BQIDA=1 D LTAX^BQITAXXU
  1.  ; Set up DX tags
  1.  D JBAD^BQITASK4
  1.  ;
  1.  ; Update treatment prompts in APCHSURV
  1.  D ^BQITRUPD
  1.  NEW NAME,TEXT
  1.  S NAME="Missing ASCVD Risk" D
  1.  . S TEXT(1)="Denominator:  All patients."
  1.  . S TEXT(2)="Numerator: Patient has an ACC 10 Year ASCVD Risk Calculation recorded in "
  1.  . S TEXT(3)="the V Measurement file."
  1.  . D DESC^BQITRUPD(NAME,.TEXT)
  1.  ;
  1. GLS ;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 up POVs and SNOMED Subsets
  1.  D JBB^BQINIGH3("POV")
  1.  D JBB^BQINIGH3("SNO")
  1.  ;
  1. DM ; Redo Dm Audit
  1.  NEW PRVY,DN
  1.  S PRVY=$P($G(^BQI(90508,1,"DM")),U,1)
  1.  I PRVY=2017 D
  1.  . S DN=$O(^BQI(90506.1,"B","DM_ACAR",""))
  1.  . I $P($G(^BQI(90506.1,DN,3)),U,5)'="" Q
  1.  . S $P(^BQI(90508,1,"DM"),U,1)=2016 D EN^BQIRGDMA
  1.  ;
  1. MEAS ; Check the pointer to the Measurement file
  1.  NEW N,COD,PAR
  1.  S N=0
  1.  F  S N=$O(^BQI(90507.2,N)) Q:'N  D
  1.  . S COD=$P(^BQI(90507.2,N,0),"^",2),PAR=$P(^(0),"^",5)
  1.  . S IEN=$O(^AUTTMSR("B",COD,""))
  1.  . I IEN'="",$P(^BQI(90507.2,N,0),"^",3)'=IEN S BQIUPD(90507.2,N_",",.03)=IEN
  1.  . I IEN="",PAR'="" D
  1.  .. S COD=$P(^BQI(90507.2,PAR,0),"^",2),IEN=$O(^AUTTMSR("B",COD,""))
  1.  .. I IEN'="",$P(^BQI(90507.2,N,0),"^",3)'=IEN S BQIUPD(90507.2,N_",",.03)=IEN
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1. NLAY ;EP - Update default templates
  1.  NEW DZZ,LOG
  1.  S DZZ=0
  1.  F  S DZZ=$O(^BQICARE(DZZ)) Q:'DZZ  D
  1.  . I DZZ=.5 Q
  1.  . S LOG=$P(^BQICARE(DZZ,0),"^",6) I $E(LOG,1,3)<316 Q
  1.  . D DEF^BQIULAY1("Q",DZZ)
  1.  . D DEF^BQIULAY1("P",DZZ)
  1.  . D DEF^BQIULAY1("DX",DZZ)
  1.  Q