BQITRCKN.m

BQITRCKN ;VNGT/HS/ALA-CVD Known Treatment Prompts ; 02 Sep 2008  11:51 AM

 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17

 ;

 ;

ASA(BQDFN) ; EP  CVD.TP-1 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

 ;

STAT(BQDFN) ; EP  CVD.TP-2 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

 ;

BETA(BQDFN,ONF) ;EP CVD.TP-3 No Beta Blocker

 ; Input parameter

 ;   BQDFN - Patient internal entry number

 ;   ONF   - 'On' flag 1=if on medication, 0=if not on medication

 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED

 S MEET=0,DESC=""

 S ONF=$G(ONF,0)

 ;

 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130

 ; or Diastolic >80

 S RESULT=$$BP(BQDFN)

 I $P(RESULT,U,1)=0 Q RESULT

 ; And not on Beta Blocker and not contraindicated

 I 'ONF S RESULT=$$BETAN(BQDFN)

 ; And on Beta Blocker and not contraindicated

 I ONF S RESULT=$$BETAO(BQDFN)

 Q RESULT

 ;

BETAN(BQDFN) ;EP - Not on Beta Blocker

 NEW X,MEET,DESC,TAX,TREF

 S MEET=0,DESC=""

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 F TAX="BGP CMS BETA BLOCKER CLASS","BGP HEDIS BETA BLOCKER MEDS","BGP HEDIS BETA BLOCKER 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 Beta Blocker 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="Not on Beta Blocker Meds"

 D

 . S X=$$BETA^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)

 . S X=$$BETA^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

 ;

BETAO(BQDFN) ;EP - On Beta Blocker

 NEW X,MEET,DESC,TAX,TREF

 S MEET=0,DESC=""

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 F TAX="BGP CMS BETA BLOCKER CLASS","BGP HEDIS BETA BLOCKER MEDS","BGP HEDIS BETA BLOCKER 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=1,DESC=DESC_"On Beta Blocker 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=0,DESC="Not on Beta Blocker Meds"

 K @TREF

 D

 . S X=$$BETA^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)

 . S X=$$BETA^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

 ;

ACEI(BQDFN) ;EP CVD.TP-4 (TP-5) No ACEI

 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130

 ; or Diastolic >80 and not on ACEI or ARB and not contraindicated

 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF,GREF,IEN

 NEW ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF,TEXT,BQI,QFL

 S MEET=0,DESC="",TEXT=""

 S X=$$BP^BQITRUTL("T-24M",BQDFN,130,80,">")

 I $P(X,U,2)'="" D

 . NEW NDATE

 . S QFL=0

 . F BQI=1:1:3 D  Q:QFL

 .. I $P($P(X,U,2),";",BQI)="No BPs in timeframe" S TEXT=$P($P(X,U,2),";",BQI),QFL=1 Q

 .. S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_"("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"

 I $P(X,U,1)=0 S MEET=0,DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]" Q MEET_U_DESC

 I $P(X,U,1)=1 S MEET=1,DESC=DESC_$$PBP(DESC,X)

 I 'MEET Q MEET_U_DESC

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 F TAX="BGP CMS ACEI MEDS CLASS","BGP HEDIS ACEI MEDS","BGP HEDIS ACEI 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 ACEI 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_" and Not on ACEI Meds"

 I MEET D ACCON

 K @TREF

 I MEET Q MEET_U_DESC

 F TAX="BGP CMS ARB MEDS CLASS","BGP HEDIS ARB MEDS","BGP HEDIS ARB 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 ARB 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="Not on ARB Meds"

 I MEET D ACCON

 K @TREF

 Q MEET_U_DESC

 ;

ACCON ; Check for ACEI contraindication

 S X=$$ACEI^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)

 S X=$$ACEI^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

 ;

HBP(BQDFN) ;EP  CVD.TP-5 High BP

 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130

 ; or Diastolic >80 and on beta blocker and on ACEI or ARB and not

 ; contraindicated

 NEW RESULT1,RESULT2,X,MEET,DESC

 S MEET=0,DESC=""

 S RESULT1=$$BETA(BQDFN,1)

 ; If '0', not on Beta Blocker

 I $P(RESULT1,U,1)=0 Q RESULT1

 S RESULT2=$$ACEI(BQDFN)

 ; If '1', not on ACEI

 I $P(RESULT2,U,1)=1 Q RESULT2

 S MEET=1,DESC=DESC_$P(RESULT1,U,2)_" and "_$P(RESULT2,U,2)

 Q MEET_U_DESC

 ;

HLDL(BQDFN,TMFRAME) ;EP  CVD.TP-6 High LDL

 ; If most recent LDL in past year >100 and on Statin Medication

 NEW X,MEET,DESC,TAX,TREF,X1

 S MEET=0,DESC=""

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)

 S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",100,">","","",.TREF)

 I $P(X,U,1)=0 S MEET=0,DESC="Most recent LDL not greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"

 I $P(X,U,1)=1 S MEET=1,DESC="Most recent LDL greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_") and ",X1=X

 I 'MEET Q MEET_U_DESC

 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)=0 S MEET=0,DESC=DESC_"Not on Statin Meds "

 I $P(X,U,1)=1 S MEET=1,DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"

 K @TREF

 Q MEET_U_DESC_U_$P(X1,U,2,5)

 ;

LHDL(BQDFN) ;EP  CVD.TP-7 Low HDL

 ; If most recent LDL in past year is <=100 AND HDL in past year is <40

 NEW MEET,DESC,X,HDL,LDL,TAX,TREF

 S MEET=0,DESC=""

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 F TAX="DM AUDIT HDL TAX","BGP HDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)

 S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",40,"<","","",.TREF)

 I $P(X,U,1)=1 S HDL=X,MEET=1,DESC="HDL in past year less than 40 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_") and "

 I $P(X,U,1)=0 S MEET=0,DESC="HDL in past year not less than 40 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"

 I 'MEET Q MEET_U_DESC

 ;

 K @TREF

 F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)

 S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",100,"'>","","",.TREF)

 I $P(X,U,1)=1 S LDL=X,MEET=1,DESC=DESC_"LDL in past year not greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)

 I $P(X,U,1)=0 S MEET=0,DESC=DESC_"LDL in past year greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)

 K @TREF

 Q MEET_U_DESC

 ;

NLDL(BQDFN) ;EP  CVD.TP-8 No LDL

 ; No LDL in past year

 NEW MEET,DESC,X,TAX,TREF

 S MEET=0,DESC=""

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)

 S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",0,">","","",.TREF)

 I $P(X,U,1)=1 S MEET=0,DESC="Has LDL in past year ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)

 I $P(X,U,1)=0 S MEET=1,DESC="No LDL in past year"

 K @TREF

 Q MEET_U_DESC

 ;

HTG(BQDFN,TMFRAME) ;EP  CVD.TP-9  High TG

 ; Most recent TG in past year >150

 NEW MEET,DESC,X,TAX,TREF

 S MEET=0,DESC=""

 S TMFRAME=$G(TMFRAME,"")

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 F TAX="DM AUDIT TRIGLYCERIDE TAX","BGP TRIGLYCERIDE LOINC CODES" D BLD^BQITUTL(TAX,TREF)

 S X=$$LAB^BQITRUTL(TMFRAME,1,BQDFN,"",150,">","","",.TREF)

 I $P(X,U,2)'="" S $P(X,U,2)=$$DATE^BQIUL1($P(X,U,2))

 I $P(X,U,1)=1 S MEET=1,DESC="Most recent Triglyceride in past year greater than 150 ("_$$FMTMDY^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$$FMTMDY^BQIUL1($P(X,U,2))_U_$P(X,U,3,5)

 I $P(X,U,1)=0 S MEET=0,DESC="Most recent Triglyceride in past year is not greater than 150 ("_$$FMTMDY^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$$FMTMDY^BQIUL1($P(X,U,2))_U_$P(X,U,3,5)

 K @TREF

 Q MEET_U_DESC

 ;

PBP(NDESC,NX) ;EP - Parse Blood Pressure values

 NEW DATES,MIENS,DDSC,MDT,MVAL,MIEN

 S DATES=$P(NX,U,2),MIENS=$P(NX,U,3),DDSC=""

 F BQJ=1:1:$L(DATES,";") S MDT=$P(DATES,";",BQJ) Q:MDT=""  D

 . S MIEN=$P(MIENS,";",BQJ),MVAL=""

 . I MIEN'="" S MVAL=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")

 . S DDSC=DDSC_$$FMTE^BQIUL1(MDT)_" "_MVAL_" "

 Q NDESC_" "_DDSC

 ;

BP(BQDFN) ;EP

 ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130

 ; or Diastolic >80

 NEW X,DESC,TEXT,BQI,QFL

 S DESC="",TEXT=""

 S X=$$BP^BQITRUTL("T-24M",BQDFN,130,80,">")

 I $P(X,U,2)'="" D

 . NEW NDATE

 . S QFL=0

 . F BQI=1:1:3 D  Q:QFL

 .. I $P($P(X,U,2),";",BQI)="No BPs in timeframe" S TEXT=$P($P(X,U,2),";",BQI),QFL=1 Q

 .. S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_"("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"

 I $P(X,U,1)=0 S DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]" Q $P(X,U,1)_U_DESC

 I $P(X,U,1)=1 S DESC=DESC_$$PBP(DESC,X)

 Q $P(X,U,1)_U_DESC

BQITRCKN  ;VNGT/HS/ALA-CVD Known Treatment Prompts ; 02 Sep 2008  11:51 AM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17

 +2       ;

 +3       ;

ASA(BQDFN) ; EP  CVD.TP-1 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      ;

STAT(BQDFN) ; EP  CVD.TP-2 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

 +24      ;

BETA(BQDFN,ONF) ;EP CVD.TP-3 No Beta Blocker

 +1       ; Input parameter

 +2       ;   BQDFN - Patient internal entry number

 +3       ;   ONF   - 'On' flag 1=if on medication, 0=if not on medication

 +4        NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,GREF,IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED

 +5        SET MEET=0

           SET DESC=""

 +6        SET ONF=$GET(ONF,0)

 +7       ;

 +8       ; If 2 of last 3 non-ER blood pressures in past 2 years are Systolic >130

 +9       ; or Diastolic >80

 +10       SET RESULT=$$BP(BQDFN)

 +11       IF $PIECE(RESULT,U,1)=0

               QUIT RESULT

 +12      ; And not on Beta Blocker and not contraindicated

 +13       IF 'ONF

               SET RESULT=$$BETAN(BQDFN)

 +14      ; And on Beta Blocker and not contraindicated

 +15       IF ONF

               SET RESULT=$$BETAO(BQDFN)

 +16       QUIT RESULT

 +17      ;

BETAN(BQDFN) ;EP - Not on Beta Blocker

 +1        NEW X,MEET,DESC,TAX,TREF

 +2        SET MEET=0

           SET DESC=""

 +3        SET TREF=$NAME(^TMP("BQITAX",UID))

           KILL @TREF

 +4        FOR TAX="BGP CMS BETA BLOCKER CLASS","BGP HEDIS BETA BLOCKER MEDS","BGP HEDIS BETA BLOCKER NDC"

               DO BLD^BQITUTL(TAX,TREF)

 +5        SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)

 +6       ; if returns a found medication, check if it is an active medication

 +7        IF $PIECE(X,U,1)=1

               Begin DoDot:1

 +8                IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))

                       QUIT 

 +9                SET $PIECE(X,U,1)=0

               End DoDot:1

 +10       IF $PIECE(X,U,1)=1

               SET MEET=0

               SET DESC=DESC_"On Beta Blocker Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"

 +11       IF $PIECE(X,U,1)=0

               SET MEET=1

               SET DESC="Not on Beta Blocker Meds"

 +12       Begin DoDot:1

 +13           SET X=$$BETA^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))

 +14           IF $PIECE(X,U,1)=1

                   SET MEET=0

                   SET DESC="Has a contraindication: "_$PIECE(X,U,2)

                   QUIT 

 +15           SET MEET=$SELECT(MEET:0,1:1)

 +16           SET X=$$BETA^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))

 +17           IF $PIECE(X,U,1)=1

                   SET MEET=0

                   SET DESC="Has an allergy: "_$PIECE(X,U,2)