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

BQITRALG.m

Go to the documentation of this file.
BQITRALG ;APTIV/HC/ALA-Treatment Prompts Allergy ; 29 Feb 2008  4:18 PM
 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
 ;
STAT(BQDFN,BDATE,EDATE) ;EP - Statin
 NEW BQGPYR,BQGPIN,DFN
 S DFN=BQDFN
 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))
 I BQGPYR<2008 D
 . S PRGM="S BQX=$$STATALG^BGP7D722(BQDFN,BDATE,EDATE,BDATE,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.18) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"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=$$STATALG^BGP8D722(BQDFN,BDATE,EDATE,BDATE,EDATE)"
 ;
 X PRGM
 Q BQX
 ;
BETA(BQDFN,BDATE,EDATE) ;EP - Beta Blocker
 NEW BQGPYR,BQGPIN,DFN
 S DFN=BQDFN
 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))
 I BQGPYR<2008 D
 . S PRGM="S BQX=$$BETAALG1^BGP7D72(BQDFN,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.18) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
 .. I $T(@("BETA^"_BQGPRG))="" Q
 .. S PRGM="S BQX=$$BETA^"_BQGPRG_"(BQDFN,EDATE)"
 .. ;S PRGM="S BQX=""$$BETA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
 .. S QFL=1
 . S PRGM="S BQX=$$BETAALG1^BGP8D72(BQDFN,EDATE)"
 ;
 X PRGM
 Q BQX
 ;
ASA(BQDFN,BDATE,EDATE) ;EP - Asa/Warfarin
 NEW BQGPYR,BQGPIN,BQX,DFN
 S DFN=BQDFN
 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=$$ASAALLEG^BGP7D721(BQDFN,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.18) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
 .. I $T(@("ASA^"_BQGPRG))="" Q
 .. S PRGM="S BQX=$$ASA^"_BQGPRG_"(BQDFN,EDATE)"
 .. ;S PRGM="S BQX=""$$ASA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
 .. S QFL=1
 . S PRGM="S BQX=$$ASAALLEG^BGP8D721(BQDFN,EDATE)"
 ;
 X PRGM
 Q BQX
 ;
ACEI(BQDFN,BDATE,EDATE) ;EP - ACEI/ARB
 NEW BQGPYR,BQGPIN,DFN
 S DFN=BQDFN
 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))
 I BQGPYR<2008 D
 . S PRGM="S BQX=$$ACEALG^BGP7D732(BQDFN,BDATE,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.18) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
 .. I $T(@("ACEI^"_BQGPRG))="" Q
 .. S PRGM="S BQX=$$ACEI^"_BQGPRG_"(BQDFN,EDATE)"
 .. ;S PRGM="S BQX=""$$ACEI^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
 .. S QFL=1
 . S PRGM="S BQX=$$ACEALG^BGP8D732(BQDFN,BDATE,EDATE)"
 ;
 X PRGM
 Q BQX
 ;
ACE(BQDFN,BDATE,EDATE) ;EP - ACE
 NEW BQGPYR,BQGPIN,DFN
 S DFN=BQDFN
 S BQGPYR=$O(^BGPCTRL("B",""),-1),BQGPIN=$O(^BGPCTRL("B",BQGPYR,0))
 I BQGPYR<2008 D
 . S PRGM="S BQX=$$ACEALG^BGP7D722(BQDFN,BDATE,EDATE)"
 I BQGPYR>2007 D
 . S QFL=0
 . I $$VFIELD^DILFD(90241.01,.18) D  Q:QFL
 .. S BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"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=$$ACEALG^BGP8D722(BQDFN,BDATE,EDATE)"
 ;
 X PRGM
 Q BQX