Routine: BQITRCMD

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=""

 . ; 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

 . ; 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

 . ; 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

 . ; 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"

 . ; 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

BQITRCMD.m