BDMDE1J.m

BDMDE1J ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 10 Oct 2014 9:50 AM ; 

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**10,11**;JUN 14, 2007;Build 30

 ;

CUML ;EP

 ;

COMORBID ;USE 400

 S:'$D(BDMCUML(400)) BDMCUML(400)="Comorbidities"

 S $P(BDMCUML(400),U,2)=$P(BDMCUML(400),U,2)+1  ;TOTAL # of patients

 ;active depression piece 3

 S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))

 I $E(V)="1" S $P(BDMCUML(400),U,3)=$P(BDMCUML(400),U,3)+1,BDMCOMOR=BDMCOMOR+1

 ;tobacco use piece 4

 S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))

 I +V=1 S $P(BDMCUML(400),U,4)=$P(BDMCUML(400),U,4)+1,BDMCOMOR=BDMCOMOR+1

 ;SEVERELY OBESE PIECE 5

 I BDMSEVOB S $P(BDMCUML(400),U,5)=$P(BDMCUML(400),U,5)+1,BDMCOMOR=BDMCOMOR+1

 ;HYPERTENSION DIAGNOSED PIECE 6

 S H=$E($G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,34)))

 I $E(H)=1 S $P(BDMCUML(400),U,6)=$P(BDMCUML(400),U,6)+1,BDMCOMOR=BDMCOMOR+1

 ;HTN AND MEAN BP <140/<90 PIECE 7

 I $E(H)=1,BDMBP140 S $P(BDMCUML(400),U,7)=$P(BDMCUML(400),U,7)+1

 ;cvd piece 8

 S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))

 I $E(V)=1 S $P(BDMCUML(400),U,8)=$P(BDMCUML(400),U,8)+1,BDMCOMOR=BDMCOMOR+1

 ;

 ;CVD & BP <140/<90 PIECE 9

 I $E(V)=1,BDMBP140 S $P(BDMCUML(400),U,9)=$P(BDMCUML(400),U,9)+1

 ;CVD AND NOT A TOBACCO USER PIECE 10

 S T=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))

 I $E(T)=2,$E(V)=1 S $P(BDMCUML(400),U,10)=$P(BDMCUML(400),U,10)+1

 ;CVD AND STATIN PRESCRIBED PIECE 11

 S T=+$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,300))

 I $E(V)=1,T=1 S $P(BDMCUML(400),U,11)=$P(BDMCUML(400),U,11)+1

 I $E(V)=1,T'=3 S $P(BDMCUML(400),U,34)=$P(BDMCUML(400),U,34)+1 ;DENOM W/O ALLERGY

 ;CVD AND ASPIRIN PIECE 12

 S T=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))

 I $E(V)=1,$E(T)=1 S $P(BDMCUML(400),U,12)=$P(BDMCUML(400),U,12)+1

 ;

 ;CKD PIECE 13 & 14

 ;CKD IS EGFR <60 OR UACR >=30

 I $$AGE^AUPNPAT(BDMPD,BDMADAT)<18 G N

 S $P(BDMCUML(400),U,13)=$P(BDMCUML(400),U,13)+1  ;over 18 denom

 I BDMCKD S $P(BDMCUML(400),U,14)=$P(BDMCUML(400),U,14)+1,BDMCOMOR=BDMCOMOR+1  ;HAS CKD

 ;CKD AND BP <140/<90 PIECE 15

 I BDMCKD,BDMBP140 S $P(BDMCUML(400),U,15)=$P(BDMCUML(400),U,15)+1

 ;CKD AND ACE PIECE 16

 S A=$E($G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,60)))

 I A=1,BDMCKD S $P(BDMCUML(400),U,16)=$P(BDMCUML(400),U,16)+1

 ;EGFR AND UACR DONE PIECE 17

 S G=0

 I BDMEGFRU S $P(BDMCUML(400),U,17)=$P(BDMCUML(400),U,17)+1 D  I G G N

 .;NORMAL PIECE 18

 .I BDMEGFRV>59,BDMUACRV="<30" S $P(BDMCUML(400),U,18)=$P(BDMCUML(400),U,18)+1 S G=1

 .;STAGE 1/2 EGFR =>60, UACR =>30

 .I BDMEGFRV>59,BDMUACRV=">30" S $P(BDMCUML(400),U,19)=$P(BDMCUML(400),U,19)+1 S G=1

 ;STAGE 3 EGFR 30-59

 I BDMEGFRV]"",BDMEGFRV'<30,BDMEGFRV<60 S $P(BDMCUML(400),U,20)=$P(BDMCUML(400),U,20)+1 G N

 ;STAGE 4 EGFR 15-20 PIECE 21

 I BDMEGFRV]"",BDMEGFRV'<15,BDMEGFRV'>29 S $P(BDMCUML(400),U,21)=$P(BDMCUML(400),U,21)+1 G N

 ;STAGE 5 EGFR <15

 I BDMEGFRV]"",BDMEGFRV<15 S $P(BDMCUML(400),U,22)=$P(BDMCUML(400),U,22)+1 G N

 ;UACR AND EGFR NOT DONE

 S $P(BDMCUML(400),U,23)=$P(BDMCUML(400),U,23)+1

N ;NONE PIECE 25

 I BDMCOMOR=0 S $P(BDMCUML(400),U,25)=$P(BDMCUML(400),U,25)+1

 I BDMCOMOR=1 S $P(BDMCUML(400),U,26)=$P(BDMCUML(400),U,26)+1

 I BDMCOMOR=2 S $P(BDMCUML(400),U,27)=$P(BDMCUML(400),U,27)+1

 I BDMCOMOR=3 S $P(BDMCUML(400),U,28)=$P(BDMCUML(400),U,28)+1

 I BDMCOMOR=4 S $P(BDMCUML(400),U,29)=$P(BDMCUML(400),U,29)+1

 I BDMCOMOR=5 S $P(BDMCUML(400),U,30)=$P(BDMCUML(400),U,30)+1

 I BDMCOMOR=6 S $P(BDMCUML(400),U,31)=$P(BDMCUML(400),U,31)+1

 Q

BDMDE1J   ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 10 Oct 2014 9:50 AM ; 

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**10,11**;JUN 14, 2007;Build 30

 +2       ;

CUML      ;EP

 +1       ;

COMORBID  ;USE 400

 +1        IF '$DATA(BDMCUML(400))

               SET BDMCUML(400)="Comorbidities"

 +2       ;TOTAL # of patients

           SET $PIECE(BDMCUML(400),U,2)=$PIECE(BDMCUML(400),U,2)+1

 +3       ;active depression piece 3

 +4        SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))

 +5        IF $EXTRACT(V)="1"

               SET $PIECE(BDMCUML(400),U,3)=$PIECE(BDMCUML(400),U,3)+1

               SET BDMCOMOR=BDMCOMOR+1

 +6       ;tobacco use piece 4

 +7        SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))

 +8        IF +V=1

               SET $PIECE(BDMCUML(400),U,4)=$PIECE(BDMCUML(400),U,4)+1

               SET BDMCOMOR=BDMCOMOR+1

 +9       ;SEVERELY OBESE PIECE 5

 +10       IF BDMSEVOB

               SET $PIECE(BDMCUML(400),U,5)=$PIECE(BDMCUML(400),U,5)+1

               SET BDMCOMOR=BDMCOMOR+1

 +11      ;HYPERTENSION DIAGNOSED PIECE 6

 +12       SET H=$EXTRACT($GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,34)))

 +13       IF $EXTRACT(H)=1

               SET $PIECE(BDMCUML(400),U,6)=$PIECE(BDMCUML(400),U,6)+1

               SET BDMCOMOR=BDMCOMOR+1

 +14      ;HTN AND MEAN BP <140/<90 PIECE 7

 +15       IF $EXTRACT(H)=1

               IF BDMBP140

                   SET $PIECE(BDMCUML(400),U,7)=$PIECE(BDMCUML(400),U,7)+1

 +16      ;cvd piece 8

 +17       SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))

 +18       IF $EXTRACT(V)=1

               SET $PIECE(BDMCUML(400),U,8)=$PIECE(BDMCUML(400),U,8)+1

               SET BDMCOMOR=BDMCOMOR+1

 +19      ;

 +20      ;CVD & BP <140/<90 PIECE 9

 +21       IF $EXTRACT(V)=1

               IF BDMBP140

                   SET $PIECE(BDMCUML(400),U,9)=$PIECE(BDMCUML(400),U,9)+1

 +22      ;CVD AND NOT A TOBACCO USER PIECE 10

 +23       SET T=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))

 +24       IF $EXTRACT(T)=2

               IF $EXTRACT(V)=1

                   SET $PIECE(BDMCUML(400),U,10)=$PIECE(BDMCUML(400),U,10)+1

 +25      ;CVD AND STATIN PRESCRIBED PIECE 11

 +26       SET T=+$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,300))

 +27       IF $EXTRACT(V)=1

               IF T=1

                   SET $PIECE(BDMCUML(400),U,11)=$PIECE(BDMCUML(400),U,11)+1

 +28      ;DENOM W/O ALLERGY

           IF $EXTRACT(V)=1

               IF T'=3

                   SET $PIECE(BDMCUML(400),U,34)=$PIECE(BDMCUML(400),U,34)+1

 +29      ;CVD AND ASPIRIN PIECE 12

 +30       SET T=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))

 +31       IF $EXTRACT(V)=1

               IF $EXTRACT(T)=1

                   SET $PIECE(BDMCUML(400),U,12)=$PIECE(BDMCUML(400),U,12)+1

 +32      ;

 +33      ;CKD PIECE 13 & 14

 +34      ;CKD IS EGFR <60 OR UACR >=30

 +35       IF $$AGE^AUPNPAT(BDMPD,BDMADAT)<18

               GOTO N

 +36      ;over 18 denom

           SET $PIECE(BDMCUML(400),U,13)=$PIECE(BDMCUML(400),U,13)+1

 +37      ;HAS CKD

           IF BDMCKD

               SET $PIECE(BDMCUML(400),U,14)=$PIECE(BDMCUML(400),U,14)+1

               SET BDMCOMOR=BDMCOMOR+1

 +38      ;CKD AND BP <140/<90 PIECE 15

 +39       IF BDMCKD

               IF BDMBP140

                   SET $PIECE(BDMCUML(400),U,15)=$PIECE(BDMCUML(400),U,15)+1

 +40      ;CKD AND ACE PIECE 16

 +41       SET A=$EXTRACT($GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,60)))

 +42       IF A=1

               IF BDMCKD

                   SET $PIECE(BDMCUML(400),U,16)=$PIECE(BDMCUML(400),U,16)+1

 +43      ;EGFR AND UACR DONE PIECE 17

 +44       SET G=0

 +45       IF BDMEGFRU

               SET $PIECE(BDMCUML(400),U,17)=$PIECE(BDMCUML(400),U,17)+1

               Begin DoDot:1

 +46      ;NORMAL PIECE 18

 +47               IF BDMEGFRV>59

                       IF BDMUACRV="<30"

                           SET $PIECE(BDMCUML(400),U,18)=$PIECE(BDMCUML(400),U,18)+1

                           SET G=1

 +48      ;STAGE 1/2 EGFR =>60, UACR =>30

 +49               IF BDMEGFRV>59

                       IF BDMUACRV=">30"

                           SET $PIECE(BDMCUML(400),U,19)=$PIECE(BDMCUML(400),U,19)+1

                           SET G=1

               End DoDot:1

               IF G

                   GOTO N

 +50      ;STAGE 3 EGFR 30-59

 +51       IF BDMEGFRV]""

               IF BDMEGFRV'<30

                   IF BDMEGFRV<60

                       SET $PIECE(BDMCUML(400),U,20)=$PIECE(BDMCUML(400),U,20)+1

                       GOTO N

 +52      ;STAGE 4 EGFR 15-20 PIECE 21

 +53       IF BDMEGFRV]""

               IF BDMEGFRV'<15

                   IF BDMEGFRV'>29

                       SET $PIECE(BDMCUML(400),U,21)=$PIECE(BDMCUML(400),U,21)+1

                       GOTO N

 +54      ;STAGE 5 EGFR <15

 +55       IF BDMEGFRV]""

               IF BDMEGFRV<15

                   SET $PIECE(BDMCUML(400),U,22)=$PIECE(BDMCUML(400),U,22)+1

                   GOTO N

 +56      ;UACR AND EGFR NOT DONE

 +57       SET $PIECE(BDMCUML(400),U,23)=$PIECE(BDMCUML(400),U,23)+1

N         ;NONE PIECE 25

 +1        IF BDMCOMOR=0

               SET $PIECE(BDMCUML(400),U,25)=$PIECE(BDMCUML(400),U,25)+1

 +2        IF BDMCOMOR=1

               SET $PIECE(BDMCUML(400),U,26)=$PIECE(BDMCUML(400),U,26)+1

 +3        IF BDMCOMOR=2

               SET $PIECE(BDMCUML(400),U,27)=$PIECE(BDMCUML(400),U,27)+1

 +4        IF BDMCOMOR=3

               SET $PIECE(BDMCUML(400),U,28)=$PIECE(BDMCUML(400),U,28)+1

 +5        IF BDMCOMOR=4

               SET $PIECE(BDMCUML(400),U,29)=$PIECE(BDMCUML(400),U,29)+1

 +6        IF BDMCOMOR=5

               SET $PIECE(BDMCUML(400),U,30)=$PIECE(BDMCUML(400),U,30)+1

 +7        IF BDMCOMOR=6

               SET $PIECE(BDMCUML(400),U,31)=$PIECE(BDMCUML(400),U,31)+1

 +8        QUIT