BGP3CU6.m

BGP3CU6 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2010 2:38 PM 30 Oct 2009 11:26 AM ;

 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 ;

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=0 F  S X=$O(BGPG(X)) Q:X'=+X  D

 .S BGPC=BGPC+1,BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($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=0 F  S X=$O(BGPG(X)) Q:X'=+X  D

 .S BGPC=BGPC+1,BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($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=0 F  S X=$O(BGPG(X)) Q:X'=+X  D

 .S BGPC=BGPC+1,BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($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=0 F  S X=$O(BGPG(X)) Q:X'=+X  D

 .S BGPC=BGPC+1,BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($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=0 F  S X=$O(BGPG(X)) Q:X'=+X  D

 .S BGPC=BGPC+1,BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($P(BGPG(X),U,1))_" ["_$P(BGPG(X),U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,+$P(BGPG(X),U,4),.04)

 .Q

 Q

BGP3CU6   ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2010 2:38 PM 30 Oct 2009 11:26 AM ;

 +1       ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 +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        SET X=0

           FOR 

               SET X=$ORDER(BGPG(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET BGPC=BGPC+1

                   SET BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)

 +7                QUIT 

               End DoDot:1

 +8        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        SET X=0

           FOR 

               SET X=$ORDER(BGPG(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET BGPC=BGPC+1

                   SET BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)

 +7                QUIT 

               End DoDot:1

 +8        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        SET X=0

           FOR 

               SET X=$ORDER(BGPG(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET BGPC=BGPC+1

                   SET BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)

 +7                QUIT 

               End DoDot:1

 +8        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        SET X=0

           FOR 

               SET X=$ORDER(BGPG(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET BGPC=BGPC+1

                   SET BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)

 +7                QUIT 

               End DoDot:1

 +8        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        SET X=0

           FOR 

               SET X=$ORDER(BGPG(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET BGPC=BGPC+1

                   SET BGPY(BGPC)="POV:  "_$$DATE^BGP3UTL($PIECE(BGPG(X),U,1))_" ["_$PIECE(BGPG(X),U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,+$PIECE(BGPG(X),U,4),.04)

 +7                QUIT 

               End DoDot:1

 +8        QUIT