BGP0CU6 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2009 2:38 PM 30 Oct 2008 11:26 AM ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
ANGIOED(P,BDATE,EDATE,BGPY,BGPC) ;EP
NEW X,Y,I,T,V,BGPG
K BGPG
I $G(BGPC)="" S BGPC=0
S X=P_"^ALL DX [BGP CMS ANGIOEDEMA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
S X=0 F S X=$O(BGPG(X)) Q:X'=+X D
.S BGPC=BGPC+1,BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($P(BGPG(X),U,1))_" ["_$P(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(X),U,4),.04)
.Q
Q
HYPERKAL(P,BDATE,EDATE,BGPY,BGPC) ;EP
NEW X,Y,I,T,V,BGPG
K BGPG
I $G(BGPC)="" S BGPC=0
S X=P_"^ALL DX [BGP CMS HYPERKALEMIA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
S X=0 F S X=$O(BGPG(X)) Q:X'=+X D
.S BGPC=BGPC+1,BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($P(BGPG(X),U,1))_" ["_$P(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(X),U,4),.04)
.Q
Q
HYPOTEN(P,BDATE,EDATE,BGPY,BGPC) ;EP
NEW X,Y,I,T,V,BGPG
K BGPG
I $G(BGPC)="" S BGPC=0
S X=P_"^ALL DX [BGP CMS HYPOTENSION DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
S X=0 F S X=$O(BGPG(X)) Q:X'=+X D
.S BGPC=BGPC+1,BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($P(BGPG(X),U,1))_" ["_$P(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(X),U,4),.04)
.Q
Q
RENART(P,BDATE,EDATE,BGPY,BGPC) ;EP
NEW X,Y,I,T,V,BGPG
K BGPG
I $G(BGPC)="" S BGPC=0
S X=P_"^ALL DX [BGP CMS RENAL ART STEN DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
S X=0 F S X=$O(BGPG(X)) Q:X'=+X D
.S BGPC=BGPC+1,BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($P(BGPG(X),U,1))_" ["_$P(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(X),U,4),.04)
.Q
Q
RENAL(P,BDATE,EDATE,BGPY,BGPC) ;EP
NEW X,Y,I,T,V,BGPG
K BGPG
I $G(BGPC)="" S BGPC=0
S X=P_"^ALL DX [BGP CMS RENAL DISEASE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
S X=0 F S X=$O(BGPG(X)) Q:X'=+X D
.S BGPC=BGPC+1,BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($P(BGPG(X),U,1))_" ["_$P(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(X),U,4),.04)
.Q
Q
BGP0CU6 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2009 2:38 PM 30 Oct 2008 11:26 AM ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;
ANGIOED(P,BDATE,EDATE,BGPY,BGPC) ;EP
+1 NEW X,Y,I,T,V,BGPG
+2 KILL BGPG
+3 IF $GET(BGPC)=""
SET BGPC=0
+4 SET X=P_"^ALL DX [BGP CMS ANGIOEDEMA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+5 ;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
+6 SET X=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET BGPC=BGPC+1
SET BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)
+8 QUIT
End DoDot:1
+9 QUIT
HYPERKAL(P,BDATE,EDATE,BGPY,BGPC) ;EP
+1 NEW X,Y,I,T,V,BGPG
+2 KILL BGPG
+3 IF $GET(BGPC)=""
SET BGPC=0
+4 SET X=P_"^ALL DX [BGP CMS HYPERKALEMIA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+5 ;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
+6 SET X=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET BGPC=BGPC+1
SET BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)
+8 QUIT
End DoDot:1
+9 QUIT
HYPOTEN(P,BDATE,EDATE,BGPY,BGPC) ;EP
+1 NEW X,Y,I,T,V,BGPG
+2 KILL BGPG
+3 IF $GET(BGPC)=""
SET BGPC=0
+4 SET X=P_"^ALL DX [BGP CMS HYPOTENSION DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+5 ;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
+6 SET X=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET BGPC=BGPC+1
SET BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)
+8 QUIT
End DoDot:1
+9 QUIT
RENART(P,BDATE,EDATE,BGPY,BGPC) ;EP
+1 NEW X,Y,I,T,V,BGPG
+2 KILL BGPG
+3 IF $GET(BGPC)=""
SET BGPC=0
+4 SET X=P_"^ALL DX [BGP CMS RENAL ART STEN DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+5 ;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
+6 SET X=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET BGPC=BGPC+1
SET BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)
+8 QUIT
End DoDot:1
+9 QUIT
RENAL(P,BDATE,EDATE,BGPY,BGPC) ;EP
+1 NEW X,Y,I,T,V,BGPG
+2 KILL BGPG
+3 IF $GET(BGPC)=""
SET BGPC=0
+4 SET X=P_"^ALL DX [BGP CMS RENAL DISEASE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BGPG(")
+5 ;S X=$$LASTDXI^BGP0UTL(P,"429.71",BDATE,EDATE) I X]"" D
+6 SET X=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET BGPC=BGPC+1
SET BGPY(BGPC)="POV: "_$$DATE^BGP0UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"] "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)
+8 QUIT
End DoDot:1
+9 QUIT
