Routine: BQITRREF

BQITRREF ;APTIV/HC/ALA-Treatment Prompts Refusal ; 29 Feb 2008  4:17 PM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

STAT(BQDFN,BDATE,EDATE) ;EP - Statin

 NEW BQGPYR,BQGPIN

 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))

 I BQGPYR<2008 D

 . S PRGM="S BQX=$$STATREF^BGP7D722(BQDFN,$G(BDATE,""),$G(EDATE,""))"

 I BQGPYR>2007 D

 . S QFL=0

 . I $$VFIELD^DILFD(90241.01,.19) D  Q:QFL

 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 .. I $T(@("STATIN^"_BQGPRG))="" Q

 .. S PRGM="S BQX=$$STATIN^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 .. ;S PRGM="S BQX=""$$STATIN^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 .. S QFL=1

 . S PRGM="S BQX=$$STATREF^BGP8D722(BQDFN,BDATE,EDATE)"

 X PRGM

 Q BQX

BETA(BQDFN,BDATE,EDATE) ;EP - Beta Blocker

 NEW BQGPYR,BQGPIN

 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))

 I BQGPYR<2008 D

 . S PRGM="S BQX=$$BETAREF^BGP7D721(BQDFN,BDATE,EDATE)"

 I BQGPYR>2007 D

 . S QFL=0

 . I $$VFIELD^DILFD(90241.01,.19) D  Q:QFL

 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 .. I $T(@("BETA^"_BQGPRG))="" Q

 .. S PRGM="S BQX=$$BETA^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 .. ;S PRGM="S BQX=""$$BETA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 .. S QFL=1

 . S PRGM="S BQX=$$BETAREF^BGP8D721(BQDFN,BDATE,EDATE)"

 X PRGM

 Q BQX

ASA(BQDFN,BDATE,EDATE) ;EP - Asa/Warfarin

 NEW BQGPYR,BQGPIN,BQX

 ;S BDATE=$G(BDATE,""),EDATE=$G(EDATE,"")

 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))

 I BQGPYR<2008 D

 . S PRGM="S BQX=$$ASAREF^BGP7D721(BQDFN,BDATE,EDATE)"

 I BQGPYR>2007 D

 . S QFL=0

 . I $$VFIELD^DILFD(90241.01,.19) D  Q:QFL

 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 .. I $T(@("ASA^"_BQGPRG))="" Q

 .. S PRGM="S BQX=$$ASA^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 .. ;S PRGM="S BQX=""$$ASA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 .. S QFL=1

 . S PRGM="S BQX=$$ASAREF^BGP8D721(BQDFN,BDATE,EDATE)"

 X PRGM

 Q BQX

ACEI(BQDFN,BDATE,EDATE) ;EP - ACEI/ARB

 NEW BQGPYR,BQGPIN

 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))

 I BQGPYR<2008 D

 . S PRGM="S BQX=$$ACEREF^BGP7D732(BQDFN,BDATE,EDATE)"

 I BQGPYR>2007 D

 . S QFL=0

 . I $$VFIELD^DILFD(90241.01,.19) D  Q:QFL

 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 .. I $T(@("ACEI^"_BQGPRG))="" Q

 .. S PRGM="S BQX=$$ACEI^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 .. ;S PRGM="S BQX=""$$ACEI^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 .. S QFL=1

 . S PRGM="S BQX=$$ACEREF^BGP8D732(BQDFN,BDATE,EDATE)"

 X PRGM

 Q BQX

ACE(BQDFN,BDATE,EDATE) ;EP - ACE

 NEW BQGPYR,BQGPIN

 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))

 I BQGPYR<2008 D

 . S PRGM="S BQX=$$ACEREF^BGP7D722(BQDFN,$G(BDATE,""),$G(EDATE,""))"

 I BQGPYR>2007 D

 . S QFL=0

 . I $$VFIELD^DILFD(90241.01,.19) D  Q:QFL

 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 .. I $T(@("ACE^"_BQGPRG))="" Q

 .. S PRGM="S BQX=$$ACE^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 .. ;S PRGM="S BQX=""$$ACE^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 .. S QFL=1

 . S PRGM="S BQX=$$ACEREF^BGP8D722(BQDFN,BDATE,EDATE)"

 X PRGM

 Q BQX

BQITRREF  ;APTIV/HC/ALA-Treatment Prompts Refusal ; 29 Feb 2008  4:17 PM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

STAT(BQDFN,BDATE,EDATE) ;EP - Statin

 +1        NEW BQGPYR,BQGPIN

 +2        SET BQGPYR=$ORDER(^BGPCTRL("B",""),-1)

           SET BQGPIN=$ORDER(^BGPCTRL("B",BQGPYR,0))

 +3        IF BQGPYR<2008

               Begin DoDot:1

 +4                SET PRGM="S BQX=$$STATREF^BGP7D722(BQDFN,$G(BDATE,""),$G(EDATE,""))"

               End DoDot:1

 +5        IF BQGPYR>2007

               Begin DoDot:1

 +6                SET QFL=0

 +7                IF $$VFIELD^DILFD(90241.01,.19)

                       Begin DoDot:2

 +8                        SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 +9                        IF $TEXT(@("STATIN^"_BQGPRG))=""

                               QUIT

 +10                       SET PRGM="S BQX=$$STATIN^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 +11      ;S PRGM="S BQX=""$$STATIN^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 +12                       SET QFL=1

                       End DoDot:2

                       IF QFL

                           QUIT

 +13               SET PRGM="S BQX=$$STATREF^BGP8D722(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +14      ;

 +15       XECUTE PRGM

 +16       QUIT BQX

 +17      ;

BETA(BQDFN,BDATE,EDATE) ;EP - Beta Blocker

 +1        NEW BQGPYR,BQGPIN

 +2        SET BQGPYR=$ORDER(^BGPCTRL("B",""),-1)

           SET BQGPIN=$ORDER(^BGPCTRL("B",BQGPYR,0))

 +3        IF BQGPYR<2008

               Begin DoDot:1

 +4                SET PRGM="S BQX=$$BETAREF^BGP7D721(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +5        IF BQGPYR>2007

               Begin DoDot:1

 +6                SET QFL=0

 +7                IF $$VFIELD^DILFD(90241.01,.19)

                       Begin DoDot:2

 +8                        SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 +9                        IF $TEXT(@("BETA^"_BQGPRG))=""

                               QUIT

 +10                       SET PRGM="S BQX=$$BETA^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 +11      ;S PRGM="S BQX=""$$BETA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 +12                       SET QFL=1

                       End DoDot:2

                       IF QFL

                           QUIT

 +13               SET PRGM="S BQX=$$BETAREF^BGP8D721(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +14      ;

 +15       XECUTE PRGM

 +16       QUIT BQX

 +17      ;

ASA(BQDFN,BDATE,EDATE) ;EP - Asa/Warfarin

 +1        NEW BQGPYR,BQGPIN,BQX

 +2       ;S BDATE=$G(BDATE,""),EDATE=$G(EDATE,"")

 +3        SET BQGPYR=$ORDER(^BGPCTRL("B",""),-1)

           SET BQGPIN=$ORDER(^BGPCTRL("B",BQGPYR,0))

 +4        IF BQGPYR<2008

               Begin DoDot:1

 +5                SET PRGM="S BQX=$$ASAREF^BGP7D721(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +6        IF BQGPYR>2007

               Begin DoDot:1

 +7                SET QFL=0

 +8                IF $$VFIELD^DILFD(90241.01,.19)

                       Begin DoDot:2

 +9                        SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 +10                       IF $TEXT(@("ASA^"_BQGPRG))=""

                               QUIT

 +11                       SET PRGM="S BQX=$$ASA^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 +12      ;S PRGM="S BQX=""$$ASA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 +13                       SET QFL=1

                       End DoDot:2

                       IF QFL

                           QUIT

 +14               SET PRGM="S BQX=$$ASAREF^BGP8D721(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +15      ;

 +16       XECUTE PRGM

 +17       QUIT BQX

 +18      ;

ACEI(BQDFN,BDATE,EDATE) ;EP - ACEI/ARB

 +1        NEW BQGPYR,BQGPIN

 +2        SET BQGPYR=$ORDER(^BGPCTRL("B",""),-1)

           SET BQGPIN=$ORDER(^BGPCTRL("B",BQGPYR,0))

 +3        IF BQGPYR<2008

               Begin DoDot:1

 +4                SET PRGM="S BQX=$$ACEREF^BGP7D732(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +5        IF BQGPYR>2007

               Begin DoDot:1

 +6                SET QFL=0

 +7                IF $$VFIELD^DILFD(90241.01,.19)

                       Begin DoDot:2

 +8                        SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 +9                        IF $TEXT(@("ACEI^"_BQGPRG))=""

                               QUIT

 +10                       SET PRGM="S BQX=$$ACEI^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 +11      ;S PRGM="S BQX=""$$ACEI^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 +12                       SET QFL=1

                       End DoDot:2

                       IF QFL

                           QUIT

 +13               SET PRGM="S BQX=$$ACEREF^BGP8D732(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +14      ;

 +15       XECUTE PRGM

 +16       QUIT BQX

 +17      ;

ACE(BQDFN,BDATE,EDATE) ;EP - ACE

 +1        NEW BQGPYR,BQGPIN

 +2        SET BQGPYR=$ORDER(^BGPCTRL("B",""),-1)

           SET BQGPIN=$ORDER(^BGPCTRL("B",BQGPYR,0))

 +3        IF BQGPYR<2008

               Begin DoDot:1

 +4                SET PRGM="S BQX=$$ACEREF^BGP7D722(BQDFN,$G(BDATE,""),$G(EDATE,""))"

               End DoDot:1

 +5        IF BQGPYR>2007

               Begin DoDot:1

 +6                SET QFL=0

 +7                IF $$VFIELD^DILFD(90241.01,.19)

                       Begin DoDot:2

 +8                        SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.19,"E")

 +9                        IF $TEXT(@("ACE^"_BQGPRG))=""

                               QUIT

 +10                       SET PRGM="S BQX=$$ACE^"_BQGPRG_"(BQDFN,BDATE,EDATE)"

 +11      ;S PRGM="S BQX=""$$ACE^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""

 +12                       SET QFL=1

                       End DoDot:2

                       IF QFL

                           QUIT

 +13               SET PRGM="S BQX=$$ACEREF^BGP8D722(BQDFN,BDATE,EDATE)"

               End DoDot:1

 +14      ;

 +15       XECUTE PRGM

 +16       QUIT BQX

BQITRREF.m