- 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
- BQITRALG ;APTIV/HC/ALA-Treatment Prompts Allergy ; 29 Feb 2008 4:18 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- STAT(BQDFN,BDATE,EDATE) ;EP - Statin
- +1 NEW BQGPYR,BQGPIN,DFN
- +2 SET DFN=BQDFN
- +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=$$STATALG^BGP7D722(BQDFN,BDATE,EDATE,BDATE,EDATE)"
- End DoDot:1
- +6 IF BQGPYR>2007
- Begin DoDot:1
- +7 SET QFL=0
- +8 IF $$VFIELD^DILFD(90241.01,.18)
- Begin DoDot:2
- +9 SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
- +10 IF $TEXT(@("STATIN^"_BQGPRG))=""
- QUIT
- +11 SET PRGM="S BQX=$$STATIN^"_BQGPRG_"(BQDFN,BDATE,EDATE)"
- +12 ;S PRGM="S BQX=""$$STATIN^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
- +13 SET QFL=1
- End DoDot:2
- IF QFL
- QUIT
- +14 SET PRGM="S BQX=$$STATALG^BGP8D722(BQDFN,BDATE,EDATE,BDATE,EDATE)"
- End DoDot:1
- +15 ;
- +16 XECUTE PRGM
- +17 QUIT BQX
- +18 ;
- BETA(BQDFN,BDATE,EDATE) ;EP - Beta Blocker
- +1 NEW BQGPYR,BQGPIN,DFN
- +2 SET DFN=BQDFN
- +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=$$BETAALG1^BGP7D72(BQDFN,EDATE)"
- End DoDot:1
- +6 IF BQGPYR>2007
- Begin DoDot:1
- +7 SET QFL=0
- +8 IF $$VFIELD^DILFD(90241.01,.18)
- Begin DoDot:2
- +9 SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
- +10 IF $TEXT(@("BETA^"_BQGPRG))=""
- QUIT
- +11 SET PRGM="S BQX=$$BETA^"_BQGPRG_"(BQDFN,EDATE)"
- +12 ;S PRGM="S BQX=""$$BETA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
- +13 SET QFL=1
- End DoDot:2
- IF QFL
- QUIT
- +14 SET PRGM="S BQX=$$BETAALG1^BGP8D72(BQDFN,EDATE)"
- End DoDot:1
- +15 ;
- +16 XECUTE PRGM
- +17 QUIT BQX
- +18 ;
- ASA(BQDFN,BDATE,EDATE) ;EP - Asa/Warfarin
- +1 NEW BQGPYR,BQGPIN,BQX,DFN
- +2 SET DFN=BQDFN
- +3 SET BDATE=$GET(BDATE,"")
- SET EDATE=$GET(EDATE,"")
- +4 SET BQGPYR=$ORDER(^BGPCTRL("B",""),-1)
- SET BQGPIN=$ORDER(^BGPCTRL("B",BQGPYR,0))
- +5 IF BQGPYR<2008
- Begin DoDot:1
- +6 SET PRGM="S BQX=$$ASAALLEG^BGP7D721(BQDFN,EDATE)"
- End DoDot:1
- +7 IF BQGPYR>2007
- Begin DoDot:1
- +8 SET QFL=0
- +9 IF $$VFIELD^DILFD(90241.01,.18)
- Begin DoDot:2
- +10 SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
- +11 IF $TEXT(@("ASA^"_BQGPRG))=""
- QUIT
- +12 SET PRGM="S BQX=$$ASA^"_BQGPRG_"(BQDFN,EDATE)"
- +13 ;S PRGM="S BQX=""$$ASA^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
- +14 SET QFL=1
- End DoDot:2
- IF QFL
- QUIT
- +15 SET PRGM="S BQX=$$ASAALLEG^BGP8D721(BQDFN,EDATE)"
- End DoDot:1
- +16 ;
- +17 XECUTE PRGM
- +18 QUIT BQX
- +19 ;
- ACEI(BQDFN,BDATE,EDATE) ;EP - ACEI/ARB
- +1 NEW BQGPYR,BQGPIN,DFN
- +2 SET DFN=BQDFN
- +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=$$ACEALG^BGP7D732(BQDFN,BDATE,EDATE)"
- End DoDot:1
- +6 IF BQGPYR>2007
- Begin DoDot:1
- +7 SET QFL=0
- +8 IF $$VFIELD^DILFD(90241.01,.18)
- Begin DoDot:2
- +9 SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
- +10 IF $TEXT(@("ACEI^"_BQGPRG))=""
- QUIT
- +11 SET PRGM="S BQX=$$ACEI^"_BQGPRG_"(BQDFN,EDATE)"
- +12 ;S PRGM="S BQX=""$$ACEI^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
- +13 SET QFL=1
- End DoDot:2
- IF QFL
- QUIT
- +14 SET PRGM="S BQX=$$ACEALG^BGP8D732(BQDFN,BDATE,EDATE)"
- End DoDot:1
- +15 ;
- +16 XECUTE PRGM
- +17 QUIT BQX
- +18 ;
- ACE(BQDFN,BDATE,EDATE) ;EP - ACE
- +1 NEW BQGPYR,BQGPIN,DFN
- +2 SET DFN=BQDFN
- +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=$$ACEALG^BGP7D722(BQDFN,BDATE,EDATE)"
- End DoDot:1
- +6 IF BQGPYR>2007
- Begin DoDot:1
- +7 SET QFL=0
- +8 IF $$VFIELD^DILFD(90241.01,.18)
- Begin DoDot:2
- +9 SET BQGPRG=$$GET1^DIQ(90241.01,BQGPIN_",",.18,"E")
- +10 IF $TEXT(@("ACE^"_BQGPRG))=""
- QUIT
- +11 SET PRGM="S BQX=$$ACE^"_BQGPRG_"(BQDFN,BDATE,EDATE)"
- +12 ;S PRGM="S BQX=""$$ACE^""_BQGPRG_""(BQDFN,BDATE,EDATE)"""
- +13 SET QFL=1
- End DoDot:2
- IF QFL
- QUIT
- +14 SET PRGM="S BQX=$$ACEALG^BGP8D722(BQDFN,BDATE,EDATE)"
- End DoDot:1
- +15 ;
- +16 XECUTE PRGM
- +17 QUIT BQX