Routine: BGPMUDCI

BGPMUDCI ; IHS/MSC/MMT - IHS Meaningful Use Reports   ;01-Mar-2011 17:01;MGH

 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

CALCMEAS ;EP - CALCULATE SELECTED MEASURES

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

 .K BGPSTOP,BGPVAL,BGPVALUE,BGPVALUD,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,BGPVALUD

 .K BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30

 .K BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13

 .K BGPNUMV

 .I $D(^BGPMUIND(BGPMUYF,BGPIC,1)) X ^BGPMUIND(BGPMUYF,BGPIC,1)

 .I $D(BGPLIST(BGPIC)),$D(^BGPMUIND(BGPMUYF,BGPIC,2)) X ^BGPMUIND(BGPMUYF,BGPIC,2) ;Add to pt list if flagged for listing

.Q

 K BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26

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

D(D) ;

 I D="" Q ""

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

BGPMUDCI  ; IHS/MSC/MMT - IHS Meaningful Use Reports   ;01-Mar-2011 17:01;MGH

 +1       ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 +2       ;

CALCMEAS  ;EP - CALCULATE SELECTED MEASURES

 +1        SET BGPIC=0

FOR

               SET BGPIC=$ORDER(BGPIND(BGPIC))

               IF BGPIC'=+BGPIC

                   QUIT

               Begin DoDot:1

 +2                KILL BGPSTOP,BGPVAL,BGPVALUE,BGPVALUD,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,BGPVALUD

 +3                KILL BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30

 +4                KILL BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13

 +5                KILL BGPNUMV

 +6                IF $DATA(^BGPMUIND(BGPMUYF,BGPIC,1))

                       XECUTE ^BGPMUIND(BGPMUYF,BGPIC,1)

 +7       ;Add to pt list if flagged for listing

                   IF $DATA(BGPLIST(BGPIC))

                       IF $DATA(^BGPMUIND(BGPMUYF,BGPIC,2))

                           XECUTE ^BGPMUIND(BGPMUYF,BGPIC,2)

 +8                QUIT

               End DoDot:1

 +9        KILL BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26

 +10       QUIT

 +11      ;

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))

BGPMUDCI.m