BQITRCMD ;GDHS/HS/ALA-CVD Medications ; 16 Jun 2016 7:52 AM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
ASA(BQDFN) ; EP - No ASA/Antiplatelet
; If NOT on ASA OR Warfarin OR other Anti Platelet Medication or
; NOT contraindicated
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,IEN
NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF
S MEET=0,DESC=""
D
. ; If not on ASA Medications
. S X=$$TAX^BQITRUTL("","DM AUDIT ASPIRIN DRUGS",1,BQDFN,9000010.14)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 D Q
.. S MEET=0,DESC=DESC_"On ASA Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. S MEET=1,DESC=DESC_"Not on ASA Meds; "
. ; If not on Warfarin Medications
. S X=$$TAX^BQITRUTL("","BGP CMS WARFARIN MEDS",1,BQDFN,9000010.14)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 D Q
.. S MEET=0,DESC=DESC_"On Warfarin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. S MEET=1,DESC=DESC_"Not on Warfarin Meds; "
. ; If not on other Anti Platelet Medications
. S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. F TAX="BGP CMS ANTI-PLATELET CLASS","BGP ANTI-PLATELET DRUGS" D BLD^BQITUTL(TAX,TREF)
. S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Anti-Platelet Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on Anti-Platelet Meds"
. K @TREF
D
. ; If ASA/Warfarin/Anti-Platelet Medication contraindication
. S X=$$ASA^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. ; Check for allergy
. S X=$$ASA^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
Q MEET_U_DESC
;
RASA(BQDFN) ;EP - At Risk
; If NOT on ASA OR Warfarin OR other Anti Platelet Medication or
; NOT contraindicated
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,IEN
NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF,AGE,SEX
S MEET=0,DESC=""
S AGE=$$AGE^BQIAGE(BQDFN),SEX=$P($G(^DPT(BQDFN,0)),U,2)
I SEX="M",AGE<50 Q MEET_U_DESC
I SEX="F",AGE<60 Q MEET_U_DESC
D
. ; If not on ASA Medications
. S X=$$TAX^BQITRUTL("","DM AUDIT ASPIRIN DRUGS",1,BQDFN,9000010.14)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 D Q
.. S MEET=0,DESC=DESC_"On ASA Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. S MEET=1,DESC=DESC_"Not on ASA Meds; "
. ; If not on Warfarin Medications
. S X=$$TAX^BQITRUTL("","BGP CMS WARFARIN MEDS",1,BQDFN,9000010.14)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 D Q
.. S MEET=0,DESC=DESC_"On Warfarin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. S MEET=1,DESC=DESC_"Not on Warfarin Meds; "
. ; If not on other Anti Platelet Medications
. S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. F TAX="BGP CMS ANTI-PLATELET CLASS","BGP ANTI-PLATELET DRUGS" D BLD^BQITUTL(TAX,TREF)
. S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
. ; if returns a found medication, check if it is an active medication
. I $P(X,U,1)=1 D
.. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
.. S $P(X,U,1)=0
. I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Anti-Platelet Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
. I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on Anti-Platelet Meds"
. K @TREF
D
. ; If ASA/Warfarin/Anti-Platelet Medication contraindication
. S X=$$ASA^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. ; Check for allergy
. S X=$$ASA^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
Q MEET_U_DESC
;
STAT(BQDFN) ; EP - No Statin
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF
NEW GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on Statin Meds"
D
. ; If Statin Medication is contraindicated
. S X=$$STAT^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. ; Check for allergy
. S X=$$STAT^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
K @TREF
Q MEET_U_DESC
BQITRCMD ;GDHS/HS/ALA-CVD Medications ; 16 Jun 2016 7:52 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
ASA(BQDFN) ; EP - No ASA/Antiplatelet
+1 ; If NOT on ASA OR Warfarin OR other Anti Platelet Medication or
+2 ; NOT contraindicated
+3 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,IEN
+4 NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF
+5 SET MEET=0
SET DESC=""
+6 Begin DoDot:1
+7 ; If not on ASA Medications
+8 SET X=$$TAX^BQITRUTL("","DM AUDIT ASPIRIN DRUGS",1,BQDFN,9000010.14)
+9 ; if returns a found medication, check if it is an active medication
+10 IF $PIECE(X,U,1)=1
Begin DoDot:2
+11 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+12 SET $PIECE(X,U,1)=0
End DoDot:2
+13 IF $PIECE(X,U,1)=1
Begin DoDot:2
+14 SET MEET=0
SET DESC=DESC_"On ASA Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
End DoDot:2
QUIT
+15 SET MEET=1
SET DESC=DESC_"Not on ASA Meds; "
+16 ; If not on Warfarin Medications
+17 SET X=$$TAX^BQITRUTL("","BGP CMS WARFARIN MEDS",1,BQDFN,9000010.14)
+18 ; if returns a found medication, check if it is an active medication
+19 IF $PIECE(X,U,1)=1
Begin DoDot:2
+20 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+21 SET $PIECE(X,U,1)=0
End DoDot:2
+22 IF $PIECE(X,U,1)=1
Begin DoDot:2
+23 SET MEET=0
SET DESC=DESC_"On Warfarin Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
End DoDot:2
QUIT
+24 SET MEET=1
SET DESC=DESC_"Not on Warfarin Meds; "
+25 ; If not on other Anti Platelet Medications
+26 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+27 FOR TAX="BGP CMS ANTI-PLATELET CLASS","BGP ANTI-PLATELET DRUGS"
DO BLD^BQITUTL(TAX,TREF)
+28 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+29 ; if returns a found medication, check if it is an active medication
+30 IF $PIECE(X,U,1)=1
Begin DoDot:2
+31 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+32 SET $PIECE(X,U,1)=0
End DoDot:2
+33 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On Anti-Platelet Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+34 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC=DESC_"Not on Anti-Platelet Meds"
+35 KILL @TREF
End DoDot:1
+36 Begin DoDot:1
+37 ; If ASA/Warfarin/Anti-Platelet Medication contraindication
+38 SET X=$$ASA^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+39 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+40 SET MEET=$SELECT(MEET:0,1:1)
+41 ; Check for allergy
+42 SET X=$$ASA^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+43 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+44 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+45 QUIT MEET_U_DESC
+46 ;
RASA(BQDFN) ;EP - At Risk
+1 ; If NOT on ASA OR Warfarin OR other Anti Platelet Medication or
+2 ; NOT contraindicated
+3 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,IEN
+4 NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF,AGE,SEX
+5 SET MEET=0
SET DESC=""
+6 SET AGE=$$AGE^BQIAGE(BQDFN)
SET SEX=$PIECE($GET(^DPT(BQDFN,0)),U,2)
+7 IF SEX="M"
IF AGE<50
QUIT MEET_U_DESC
+8 IF SEX="F"
IF AGE<60
QUIT MEET_U_DESC
+9 Begin DoDot:1
+10 ; If not on ASA Medications
+11 SET X=$$TAX^BQITRUTL("","DM AUDIT ASPIRIN DRUGS",1,BQDFN,9000010.14)
+12 ; if returns a found medication, check if it is an active medication
+13 IF $PIECE(X,U,1)=1
Begin DoDot:2
+14 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+15 SET $PIECE(X,U,1)=0
End DoDot:2
+16 IF $PIECE(X,U,1)=1
Begin DoDot:2
+17 SET MEET=0
SET DESC=DESC_"On ASA Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
End DoDot:2
QUIT
+18 SET MEET=1
SET DESC=DESC_"Not on ASA Meds; "
+19 ; If not on Warfarin Medications
+20 SET X=$$TAX^BQITRUTL("","BGP CMS WARFARIN MEDS",1,BQDFN,9000010.14)
+21 ; if returns a found medication, check if it is an active medication
+22 IF $PIECE(X,U,1)=1
Begin DoDot:2
+23 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+24 SET $PIECE(X,U,1)=0
End DoDot:2
+25 IF $PIECE(X,U,1)=1
Begin DoDot:2
+26 SET MEET=0
SET DESC=DESC_"On Warfarin Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
End DoDot:2
QUIT
+27 SET MEET=1
SET DESC=DESC_"Not on Warfarin Meds; "
+28 ; If not on other Anti Platelet Medications
+29 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+30 FOR TAX="BGP CMS ANTI-PLATELET CLASS","BGP ANTI-PLATELET DRUGS"
DO BLD^BQITUTL(TAX,TREF)
+31 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+32 ; if returns a found medication, check if it is an active medication
+33 IF $PIECE(X,U,1)=1
Begin DoDot:2
+34 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+35 SET $PIECE(X,U,1)=0
End DoDot:2
+36 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On Anti-Platelet Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+37 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC=DESC_"Not on Anti-Platelet Meds"
+38 KILL @TREF
End DoDot:1
+39 Begin DoDot:1
+40 ; If ASA/Warfarin/Anti-Platelet Medication contraindication
+41 SET X=$$ASA^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+42 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+43 SET MEET=$SELECT(MEET:0,1:1)
+44 ; Check for allergy
+45 SET X=$$ASA^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+46 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+47 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+48 QUIT MEET_U_DESC
+49 ;
STAT(BQDFN) ; EP - No Statin
+1 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF
+2 NEW GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+7 ; if returns a found medication, check if it is an active medication
+8 IF $PIECE(X,U,1)=1
Begin DoDot:1
+9 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+10 SET $PIECE(X,U,1)=0
End DoDot:1
+11 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+12 IF $PIECE(X,U,1)=0
SET MEET=1
SET DESC=DESC_"Not on Statin Meds"
+13 Begin DoDot:1
+14 ; If Statin Medication is contraindicated
+15 SET X=$$STAT^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+16 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+17 SET MEET=$SELECT(MEET:0,1:1)
+18 ; Check for allergy
+19 SET X=$$STAT^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+20 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+21 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+22 KILL @TREF
+23 QUIT MEET_U_DESC
