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
