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