BGP2DCHI.m

BGP2DCHI ; IHS/CMI/LAB - calculate HEDIS measures ;

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;

CALCIND ;EP

 S BGPIC=0 F  S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC'=+BGPIC  D

 .K BGPSTOP,BGPVAL,BGPVALUE,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 .I $D(^BGPHEIB(BGPIC,1)) X ^BGPHEIB(BGPIC,1)

 .K BGPG,BGPC,BGPALLED

 .K BGPVAL,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 .I $D(BGPSTOP) Q  ;no need to set since no num/denom

 .;loop each individual to set numerator and denominator

 .S BGPI=0 F  S BGPI=$O(^BGPHEIIB("B",BGPIC,BGPI)) Q:BGPI'=+BGPI  D

 ..S (BGPNUM,BGPDEN)=0

 ..X ^BGPHEIIB(BGPI,1)

 ..X ^BGPHEIIB(BGPI,2) ;denominator 1 or 0

 ..;set field counter

 ..S BGPNF=$P(^BGPHEIIB(BGPI,0),U,9)

 ..S BGPN=$P(^DD(90546.03,BGPNF,0),U,4),N=$P(BGPN,";"),P=$P(BGPN,";",2)

 ..D S(BGPRPT,BGPGBL,N,P,BGPNUM)

 ..S BGPDF=$P(^BGPHEIIB(BGPI,0),U,8)

 ..S BGPN=$P(^DD(90546.03,BGPDF,0),U,4),N=$P(BGPN,";"),P=$P(BGPN,";",2)

 ..I BGPDEN'="NO" D S(BGPRPT,BGPGBL,N,P,BGPDEN)

 .I $D(BGPLIST(BGPIC)) D STMP^BGP2HUTL

 Q

 ;

S(R,G,N,P,V) ;

 I 'V Q  ;no value to add

 S $P(@(G_R_","_N_")"),U,P)=$P($G(@(G_R_","_N_")")),U,P)+V

 Q

D(D) ;

 I D="" Q ""

 Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))

BGP2DCHI  ; IHS/CMI/LAB - calculate HEDIS measures ;

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 +2       ;

CALCIND   ;EP

 +1        SET BGPIC=0

           FOR 

               SET BGPIC=$ORDER(BGPIND(BGPIC))

               IF BGPIC'=+BGPIC

                   QUIT 

               Begin DoDot:1

 +2                KILL BGPSTOP,BGPVAL,BGPVALUE,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 +3                IF $DATA(^BGPHEIB(BGPIC,1))

                       XECUTE ^BGPHEIB(BGPIC,1)

 +4                KILL BGPG,BGPC,BGPALLED

 +5                KILL BGPVAL,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 +6       ;no need to set since no num/denom

                   IF $DATA(BGPSTOP)

                       QUIT 

 +7       ;loop each individual to set numerator and denominator

 +8                SET BGPI=0

                   FOR 

                       SET BGPI=$ORDER(^BGPHEIIB("B",BGPIC,BGPI))

                       IF BGPI'=+BGPI

                           QUIT 

                       Begin DoDot:2

 +9                        SET (BGPNUM,BGPDEN)=0

 +10                       XECUTE ^BGPHEIIB(BGPI,1)

 +11      ;denominator 1 or 0

                           XECUTE ^BGPHEIIB(BGPI,2)

 +12      ;set field counter

 +13                       SET BGPNF=$PIECE(^BGPHEIIB(BGPI,0),U,9)

 +14                       SET BGPN=$PIECE(^DD(90546.03,BGPNF,0),U,4)

                           SET N=$PIECE(BGPN,";")

                           SET P=$PIECE(BGPN,";",2)

 +15                       DO S(BGPRPT,BGPGBL,N,P,BGPNUM)

 +16                       SET BGPDF=$PIECE(^BGPHEIIB(BGPI,0),U,8)

 +17                       SET BGPN=$PIECE(^DD(90546.03,BGPDF,0),U,4)

                           SET N=$PIECE(BGPN,";")

                           SET P=$PIECE(BGPN,";",2)

 +18                       IF BGPDEN'="NO"

                               DO S(BGPRPT,BGPGBL,N,P,BGPDEN)

                       End DoDot:2

 +19               IF $DATA(BGPLIST(BGPIC))

                       DO STMP^BGP2HUTL

               End DoDot:1

 +20       QUIT 

 +21      ;

S(R,G,N,P,V) ;

 +1       ;no value to add

           IF 'V

               QUIT 

 +2        SET $PIECE(@(G_R_","_N_")"),U,P)=$PIECE($GET(@(G_R_","_N_")")),U,P)+V

 +3        QUIT 

D(D)      ;

 +1        IF D=""

               QUIT ""

 +2        QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_(1700+$EXTRACT(D,1,3))