BQI25P1 ;GDHS/HCS/ALA-Version 2.5 Patch 1 ; 13 Apr 2016 9:14 AM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
;
PRE ;EP
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(90507.8,",DA=0
F S DA=$O(^BQI(90507.8,DA)) Q:'DA D ^DIK
S DIK="^BQI(90509.9,",DA=0
F S DA=$O(^BQI(90509.9,DA)) Q:'DA D ^DIK
S DIK="^BQI(90505.2,",DA=0
F S DA=$O(^BQI(90505.2,DA)) Q:'DA D ^DIK
;
; Move Accepted CVD Known patients
K ^XTMP("BQITMP")
D MOV
; Inactivate the 4 current CVD tags
D IAC
;
NEW DA,DIK
S DIK="^BQI(90506.2,",DA=0
F S DA=$O(^BQI(90506.2,DA)) Q:'DA D ^DIK
S DIK="^BQI(90508.5,",DA=0
F S DA=$O(^BQI(90508.5,DA)) Q:'DA D ^DIK
Q
;
MOV ;EP Move Accepted CVD Known to ASCVD Known
NEW OTAG,NTAG,RIEN,RSTAT,DFN
S OTAG=6,NTAG=17
S RIEN=""
F S RIEN=$O(^BQIREG("B",OTAG,RIEN)) Q:RIEN="" D
. S RSTAT=$P(^BQIREG(RIEN,0),U,3),DFN=$P(^BQIREG(RIEN,0),"^",2)
. I RSTAT'="A" Q
. M ^XTMP("BQITMP","REG",RIEN)=^BQIREG(RIEN)
Q
;
IAC ;EP Inactivate CVD
NEW BQITAG,BQIDFN,MESG
; Inactivate the 4 current tags
F BQITAG=6,7,8,9 S BQIUPD(90506.2,BQITAG_",",.03)=1
; Inactivate the Best Practice Prompts
S N=0 F S N=$O(^BQI(90508.5,N)) Q:'N S BQIUPD(90508.5,N_",",.04)=1
D FILE^DIE("","BQIUPD","ERROR")
; Set to NLV (no longer valid, CVD Significant Risk, CVD Highest Risk and CVD At Risk
F BQITAG=6,7,8,9 D
. S THCFL=+$P(^BQI(90506.2,BQITAG,0),U,10)
. S RIEN=""
. F S RIEN=$O(^BQIREG("B",BQITAG,RIEN)) Q:RIEN="" D
.. S RSTAT=$P(^BQIREG(RIEN,0),U,3),BQIDFN=$P(^BQIREG(RIEN,0),"^",2)
.. ; If status is Not Accepted or No Longer Valid or Superceded, quit
.. I RSTAT="N"!(RSTAT="V")!(RSTAT="S") Q
.. ; if the current status is 'Proposed', move the factors before setting the
.. ; current status to 'No Longer Valid' or 'Superseded'
.. I RSTAT="P" D MOV^BQITDPRC(BQIDFN,BQITAG)
.. S MESG="CVD LOGIC UPDATE"
.. D EN^BQITDPRC(.TGDATA,BQIDFN,BQITAG,"V",,MESG,3)
;
; Delete Best Practice Prompts
S DFN=0
F S DFN=$O(^BQIPAT(DFN)) Q:'DFN K ^BQIPAT(DFN,50)
;
NOT ;Send notification if a panel is using one of the CVD tags
NEW PDZ,PL,DN,DCAT,CT,BTEXT,PLNM
S PDZ=0 F S PDZ=$O(^BQICARE(PDZ)) Q:'PDZ D
. S PL=0,CT=2 K BTEXT
. S BTEXT(1,0)="CVD Tags have changed. You may need to update the following"
. S BTEXT(2,0)="panels which use CVD Tag in the panel definition."_$C(10)_$C(13)
. F S PL=$O(^BQICARE(PDZ,1,PL)) Q:'PL D
.. S DN=$O(^BQICARE(PDZ,1,PL,15,"B","DXCAT","")) I DN="" Q
.. S DCAT=$P(^BQICARE(PDZ,1,PL,15,DN,0),"^",3)
.. I DCAT'=6,DCAT'=7,DCAT'=8,DCAT'=9 Q
.. S PLNM=$P(^BQICARE(PDZ,1,PL,0),"^",1)
.. S CT=CT+1,BTEXT(CT,0)=" Panel: "_PLNM_$C(10)_$C(13)
. I CT>2 D ADD^BQINOTF("",PDZ_$C(28),"Correct Panel Definitions",.BTEXT,1)
Q
;
POS ;EP
;Set the version number
NEW DA
S DA=$O(^BQI(90508,0))
S BQIUPD(90508,DA_",",.08)="2.5.1.5"
S BQIUPD(90508,DA_",",.09)="2.5.1.5"
D FILE^DIE("","BQIUPD","ERROR")
;
D ^BQIATX
D ^BQITAXXU
D ^BQIUSRC
D ^BQIULAY
;
; Fix if default view is MU
NEW DZ
S DZ=0
F S DZ=$O(^BQICARE(DZ)) Q:'DZ D
. I $$GET1^DIQ(90505,DZ_",",.02,"E")["MU" S BQIUPD(90505,DZ_",",.02)="@"
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
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 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
;
F DA=4,7,25,26 S BQIUP(90506.5,DA_",",.18)=1
D FILE^DIE("","BQIUP","ERROR")
;
; Inactivate the 4 current tags
F BQITAG=6,7,8,9 S BQIUPD(90506.2,BQITAG_",",.03)=1
F BQITAG=17,18 S BQIUPD(90506.2,BQITAG_",",.03)="@"
D FILE^DIE("","BQIUPD","ERROR")
;
;Update any "accepted" CVD Knowns to ASCVD Known
NEW RIEN,NTAG
S NTAG=17,RIEN=""
F S RIEN=$O(^XMP("BQITMP","REG",RIEN)) Q:RIEN="" D
. S BQIUPD(90509,RIEN_",",.01)=NTAG
. S CF=0 F S CF=$O(^BQIREG(RIEN,5,CF)) Q:'CF D
.. S BQIUPD(90509.5,CF_",",.03)=NTAG
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
BP ;Removed from HEALTH SUMMARY MAINT ITEM and add new BPs
D CBP^BQITRUPD
;
NEW NAME,TEXT
S NAME="Missing ASCVD Risk" D
. S TEXT(1)="This patient does not have an ASCVD risk assessment documented. Consider"
. S TEXT(2)="assessing the ASCVD risk at next opportunity."
. D NON^BQITRUPD(NAME,.TEXT)
;
;Update Tags and Best Practice Prompts
NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,NOW
S NOW=$$NOW^XLFDT(),ZTDTH=DT_".19"
I $$FMDIFF^XLFDT(ZTDTH,NOW,2)<60 S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,15)
S ZTDESC="Update CVD Tags/Best Practice",ZTRTN="TAG^BQI25P1",ZTIO=""
D ^%ZTLOAD
K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
;
Q
;
TAG ;EP
NEW TAG
F TAG="ASCVD Known","ASCVD At Risk" D EN^BQITASK4(TAG)
Q
BQI25P1 ;GDHS/HCS/ALA-Version 2.5 Patch 1 ; 13 Apr 2016 9:14 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
+3 ;
PRE ;EP
+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(90507.8,"
SET DA=0
+7 FOR
SET DA=$ORDER(^BQI(90507.8,DA))
IF 'DA
QUIT
DO ^DIK
+8 SET DIK="^BQI(90509.9,"
SET DA=0
+9 FOR
SET DA=$ORDER(^BQI(90509.9,DA))
IF 'DA
QUIT
DO ^DIK
+10 SET DIK="^BQI(90505.2,"
SET DA=0
+11 FOR
SET DA=$ORDER(^BQI(90505.2,DA))
IF 'DA
QUIT
DO ^DIK
+12 ;
+13 ; Move Accepted CVD Known patients
+14 KILL ^XTMP("BQITMP")
+15 DO MOV
+16 ; Inactivate the 4 current CVD tags
+17 DO IAC
+18 ;
+19 NEW DA,DIK
+20 SET DIK="^BQI(90506.2,"
SET DA=0
+21 FOR
SET DA=$ORDER(^BQI(90506.2,DA))
IF 'DA
QUIT
DO ^DIK
+22 SET DIK="^BQI(90508.5,"
SET DA=0
+23 FOR
SET DA=$ORDER(^BQI(90508.5,DA))
IF 'DA
QUIT
DO ^DIK
+24 QUIT
+25 ;
MOV ;EP Move Accepted CVD Known to ASCVD Known
+1 NEW OTAG,NTAG,RIEN,RSTAT,DFN
+2 SET OTAG=6
SET NTAG=17
+3 SET RIEN=""
+4 FOR
SET RIEN=$ORDER(^BQIREG("B",OTAG,RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+5 SET RSTAT=$PIECE(^BQIREG(RIEN,0),U,3)
SET DFN=$PIECE(^BQIREG(RIEN,0),"^",2)
+6 IF RSTAT'="A"
QUIT
+7 MERGE ^XTMP("BQITMP","REG",RIEN)=^BQIREG(RIEN)
End DoDot:1
+8 QUIT
+9 ;
IAC ;EP Inactivate CVD
+1 NEW BQITAG,BQIDFN,MESG
+2 ; Inactivate the 4 current tags
+3 FOR BQITAG=6,7,8,9
SET BQIUPD(90506.2,BQITAG_",",.03)=1
+4 ; Inactivate the Best Practice Prompts
+5 SET N=0
FOR
SET N=$ORDER(^BQI(90508.5,N))
IF 'N
QUIT
SET BQIUPD(90508.5,N_",",.04)=1
+6 DO FILE^DIE("","BQIUPD","ERROR")
+7 ; Set to NLV (no longer valid, CVD Significant Risk, CVD Highest Risk and CVD At Risk
+8 FOR BQITAG=6,7,8,9
Begin DoDot:1
+9 SET THCFL=+$PIECE(^BQI(90506.2,BQITAG,0),U,10)
+10 SET RIEN=""
+11 FOR
SET RIEN=$ORDER(^BQIREG("B",BQITAG,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+12 SET RSTAT=$PIECE(^BQIREG(RIEN,0),U,3)
SET BQIDFN=$PIECE(^BQIREG(RIEN,0),"^",2)
+13 ; If status is Not Accepted or No Longer Valid or Superceded, quit
+14 IF RSTAT="N"!(RSTAT="V")!(RSTAT="S")
QUIT
+15 ; if the current status is 'Proposed', move the factors before setting the
+16 ; current status to 'No Longer Valid' or 'Superseded'
+17 IF RSTAT="P"
DO MOV^BQITDPRC(BQIDFN,BQITAG)
+18 SET MESG="CVD LOGIC UPDATE"
+19 DO EN^BQITDPRC(.TGDATA,BQIDFN,BQITAG,"V",,MESG,3)
End DoDot:2
End DoDot:1
+20 ;
+21 ; Delete Best Practice Prompts
+22 SET DFN=0
+23 FOR
SET DFN=$ORDER(^BQIPAT(DFN))
IF 'DFN
QUIT
KILL ^BQIPAT(DFN,50)
+24 ;
NOT ;Send notification if a panel is using one of the CVD tags
+1 NEW PDZ,PL,DN,DCAT,CT,BTEXT,PLNM
+2 SET PDZ=0
FOR
SET PDZ=$ORDER(^BQICARE(PDZ))
IF 'PDZ
QUIT
Begin DoDot:1
+3 SET PL=0
SET CT=2
KILL BTEXT
+4 SET BTEXT(1,0)="CVD Tags have changed. You may need to update the following"
+5 SET BTEXT(2,0)="panels which use CVD Tag in the panel definition."_$CHAR(10)_$CHAR(13)
+6 FOR
SET PL=$ORDER(^BQICARE(PDZ,1,PL))
IF 'PL
QUIT
Begin DoDot:2
+7 SET DN=$ORDER(^BQICARE(PDZ,1,PL,15,"B","DXCAT",""))
IF DN=""
QUIT
+8 SET DCAT=$PIECE(^BQICARE(PDZ,1,PL,15,DN,0),"^",3)
+9 IF DCAT'=6
IF DCAT'=7
IF DCAT'=8
IF DCAT'=9
QUIT
+10 SET PLNM=$PIECE(^BQICARE(PDZ,1,PL,0),"^",1)
+11 SET CT=CT+1
SET BTEXT(CT,0)=" Panel: "_PLNM_$CHAR(10)_$CHAR(13)
End DoDot:2
+12 IF CT>2
DO ADD^BQINOTF("",PDZ_$CHAR(28),"Correct Panel Definitions",.BTEXT,1)
End DoDot:1
+13 QUIT
+14 ;
POS ;EP
+1 ;Set the version number
+2 NEW DA
+3 SET DA=$ORDER(^BQI(90508,0))
+4 SET BQIUPD(90508,DA_",",.08)="2.5.1.5"
+5 SET BQIUPD(90508,DA_",",.09)="2.5.1.5"
+6 DO FILE^DIE("","BQIUPD","ERROR")
+7 ;
+8 DO ^BQIATX
+9 DO ^BQITAXXU
+10 DO ^BQIUSRC
+11 DO ^BQIULAY
+12 ;
+13 ; Fix if default view is MU
+14 NEW DZ
+15 SET DZ=0
+16 FOR
SET DZ=$ORDER(^BQICARE(DZ))
IF 'DZ
QUIT
Begin DoDot:1
+17 IF $$GET1^DIQ(90505,DZ_",",.02,"E")["MU"
SET BQIUPD(90505,DZ_",",.02)="@"
End DoDot:1
+18 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+19 ;
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 BTPWRPC and 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="BTPWRPC"
+15 DO ^DIC
IF +Y<1
KILL DO,DD
DO FILE^DICN
+16 NEW IEN,DA,X,DIC,Y
+17 SET DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR")
SET DIC="^DIC(19,"_DA(1)_",10,"
SET DIC(0)="LMNZ"
+18 IF $GET(^DIC(19,DA(1),10,0))=""
SET ^DIC(19,DA(1),10,0)="^19.01IP^^"
+19 SET X="BUSARPC"
+20 DO ^DIC
IF +Y<1
KILL DO,DD
DO FILE^DICN
+21 ;
+22 FOR DA=4,7,25,26
SET BQIUP(90506.5,DA_",",.18)=1
+23 DO FILE^DIE("","BQIUP","ERROR")
+24 ;
+25 ; Inactivate the 4 current tags
+26 FOR BQITAG=6,7,8,9
SET BQIUPD(90506.2,BQITAG_",",.03)=1
+27 FOR BQITAG=17,18
SET BQIUPD(90506.2,BQITAG_",",.03)="@"
+28 DO FILE^DIE("","BQIUPD","ERROR")
+29 ;
+30 ;Update any "accepted" CVD Knowns to ASCVD Known
+31 NEW RIEN,NTAG
+32 SET NTAG=17
SET RIEN=""
+33 FOR
SET RIEN=$ORDER(^XMP("BQITMP","REG",RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+34 SET BQIUPD(90509,RIEN_",",.01)=NTAG
+35 SET CF=0
FOR
SET CF=$ORDER(^BQIREG(RIEN,5,CF))
IF 'CF
QUIT
Begin DoDot:2
+36 SET BQIUPD(90509.5,CF_",",.03)=NTAG
End DoDot:2
End DoDot:1
+37 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+38 ;
BP ;Removed from HEALTH SUMMARY MAINT ITEM and add new BPs
+1 DO CBP^BQITRUPD
+2 ;
+3 NEW NAME,TEXT
+4 SET NAME="Missing ASCVD Risk"
Begin DoDot:1
+5 SET TEXT(1)="This patient does not have an ASCVD risk assessment documented. Consider"
+6 SET TEXT(2)="assessing the ASCVD risk at next opportunity."
+7 DO NON^BQITRUPD(NAME,.TEXT)
End DoDot:1
+8 ;
+9 ;Update Tags and Best Practice Prompts
+10 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,NOW
+11 SET NOW=$$NOW^XLFDT()
SET ZTDTH=DT_".19"
+12 IF $$FMDIFF^XLFDT(ZTDTH,NOW,2)<60
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,15)
+13 SET ZTDESC="Update CVD Tags/Best Practice"
SET ZTRTN="TAG^BQI25P1"
SET ZTIO=""
+14 DO ^%ZTLOAD
+15 KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
+16 ;
+17 QUIT
+18 ;
TAG ;EP
+1 NEW TAG
+2 FOR TAG="ASCVD Known","ASCVD At Risk"
DO EN^BQITASK4(TAG)
+3 QUIT
