BGP9CU6.m

BGP9CU6 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2008 2:38 PM 30 Oct 2007 11:26 AM ;

 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 ;

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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($P(BGPG(X),U,1))_" ["_$P(BGPG(X),U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(X),U,4),.04)

 .Q

 Q

BGP9CU6   ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2008 2:38 PM 30 Oct 2007 11:26 AM ;

 +1       ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 +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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($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^BGP9UTL(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^BGP9UTL($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