Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQITRCON

BQITRCON.m

Go to the documentation of this file.
BQITRCON ;APTIV/HC/ALA-Treatment Prompts Contraindication ; 29 Feb 2008  2:57 PM
 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
 ;
 ;
STAT(BQDFN,BDATE,EDATE) ;EP - Statin
 NEW BQGPYR,BQGPIN
 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=$$STATCON^BGP7D722(BQDFN,BDATE,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.17) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.17,"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=$$STATCON^BGP8D722(BQDFN,BDATE,EDATE)"
 ;
 X PRGM
 Q BQX
 ;
BETA(BQDFN,BDATE,EDATE) ;EP - Beta Blocker
 NEW BQGPYR,BQGPIN
 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=$$BETACONT^BGP7D721(BQDFN,$$DOB^AUPNPAT(BQDFN),EDATE,BDATE,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.17) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.17,"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=$$BETACONT^BGP8D721(BQDFN,$$DOB^AUPNPAT(BQDFN),EDATE,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=$$ASACONTR^BGP7D721(BQDFN,BDATE,EDATE,179)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.17) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.17,"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=$$ASACONTR^BGP8D721(BQDFN,BDATE,EDATE,179)"
 ;
 X PRGM
 Q BQX
 ;
ACEI(BQDFN,BDATE,EDATE) ;EP - ACEI/ARB
 NEW BQGPYR,BQGPIN,DFN
 S BDATE=$G(BDATE,""),EDATE=$G(EDATE,"")
 S DFN=BQDFN
 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))
 I BQGPYR<2008 D
 . S PRGM="S BQX=$$ACECONT^BGP7D732(BQDFN,BDATE,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.17) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.17,"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=$$ACECONT^BGP8D732(BQDFN,BDATE,EDATE)"
 ;
 X PRGM
 Q BQX
 ;
ACE(BQDFN,BDATE,EDATE) ;EP - ACE
 NEW BQGPYR,BQGPIN
 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=$$ACECONT^BGP7D722(BQDFN,BDATE,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.17) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.17,"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=$$ACECONT^BGP8D722(BQDFN,BDATE,EDATE)"
 ;
 X PRGM
 Q BQX