BDMDD15 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 03 Feb 2014 5:38 PM ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
;
;
CUML ;EP
K BDMCUML
S BDMCUML(10)="Gender"
S BDMCUML(20)="Age"
S BDMCUML(25)="Diabetes Type"
S BDMCUML(30)="Duration of Diabetes"
S BDMCUML(40)="BMI Category"
S BDMCUML(50)="Blood Sugar Control"
S BDMCUML(70)="Tuberculosis Status"
S BDMCUML(60)="Mean Blood Pressure (BP) - Mean of last 2, or 3 if available"
S BDMCUML(65)="Tobacco use screening during Audit period:"
S BDMCUML(80)="Tobacco use status:"
S BDMCUML(90)="Diabetes Treatment"
S BDMCUML(100)="Aspirin or Other Antiplatelet/Anticoagulant Therapy Prescribed"
S BDMCUML(110)="ACE Inhibitor or ARB Prescribed"
S BDMCUML(115)="Statin Prescribed"
S BDMCUML(300)="Depression as an Active Problem"
S BDMCUML(301)="Depression Screening?"
S BDMCUML(120)="Exams"
S BDMCUML(130)="Diabetes-Related Education"
S BDMCUML(140)="Immunizations"
S BDMCUML(145)="Laboratory Exams"
S BDMCUML(150)="Electrocardiogram (Age 30 and above)"
S BDMCUML(170)="Creatinine obtained during audit period"
S BDMCUML(175)="Estimated GFR documented during audit period"
S BDMCUML(180)="Total Cholesterol obtained in past 12 months"
S BDMCUML(190)="LDL Cholesterol obtained during audit period"
S BDMCUML(195)="HDL Cholesterol obtained during audit period"
S BDMCUML(200)="Triglycerides obtained during audit period"
S BDMCUML(400)="Comorbidities"
;
PROCESS ;
S BDMNOGO=0
S BDMPD=0 F S BDMPD=$O(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD D CUML1
Q
;
CUML1 ;
S BDMCOMOR=0 ;VARIABLE FOR # OF COMORBIDITIES
S BDMSEVOB=0 ;SEVERELY OBESE
S BDMBP140=0 ;COMORBIDITY SECTION
S BDMCKD=0 ;CKD?
S BDMEGFRU=0 ;BOTH EGFR AND UACR
S BDMEGFRV="" ;EGFR VALUE
S BDMUACRV="" ;UACR VALUE
GENDER ;
I $$DODX^BDMDD16(BDMPD,BDMDMRG,"I")>BDMADAT S BDMNOGO=BDMNOGO+1 Q
;gender BDMCUML(10)="Gender^total^females^males"
S $P(BDMCUML(10),U,2)=$P(BDMCUML(10),U,2)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,20))
S P=$S($E(V)="F":3,$E(V)="M":4,1:5)
S $P(BDMCUML(10),U,P)=$P(BDMCUML(10),U,P)+1
AGE ;
S V=$$AGE^AUPNPAT(BDMPD,BDMADAT)
;BDMCUML(20)="Age^total^<15^15-44^45-64^>65^unknown"
S $P(BDMCUML(20),U,2)=$P(BDMCUML(20),U,2)+1
S P=$S(V<20:3,V>19&(V<45):4,V>44&(V<65):5,V>64:6,1:7)
S $P(BDMCUML(20),U,P)=$P(BDMCUML(20),U,P)+1
TYPE ;
;BDMCUML(25)="Total^Type 1^Type 2"
S X=$$TYPE^BDMDD16(BDMPD,BDMDMRG,BDMADAT)
S $P(BDMCUML(25),U,2)=$P(BDMCUML(25),U,2)+1
S P=$S(X="":4,X=1:3,X=2:4,1:4)
S $P(BDMCUML(25),U,P)=$P(BDMCUML(25),U,P)+1
DURDMC ;
;BDMCUML(30)="Duration of Diabetes^total^<10^10 or more^no date of dx on problem list or cms register^less than 1 year"
S $P(BDMCUML(30),U,2)=$P(BDMCUML(30),U,2)+1
S V=$$DURDM^BDMDD14(BDMPD,BDMDMRG,BDMADAT)
S P=$S(V="":5,V<10:3,1:4)
S $P(BDMCUML(30),U,P)=$P(BDMCUML(30),U,P)+1
I V]"",V<1 S $P(BDMCUML(30),U,6)=$P(BDMCUML(30),U,6)+1
BMI ;
;BDMCUML(40)="Weight Control (BMI) - does not add up to 100%^total^total^overweight^obese^height or weight missing"
;S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,112))
S H=$$LASTHT^BDMDD13(BDMPD,BDMRED,"I") S:H]"" H=$$STRIP^XLFSTR($J(H,5,2)," ")
S W=+$$LASTWT^BDMDD13(BDMPD,BDMBDAT,BDMRED),W=$S(W=0:"",1:W) I W]"" S W=W\1
S V=$$BMIEPI^BDMDD19(H,W)
S $P(BDMCUML(40),U,2)=$P(BDMCUML(40),U,2)+1
D
.I V=""!(H="")!(W="") S $P(BDMCUML(40),U,5)=$P(BDMCUML(40),U,5)+1 Q
.I V<25 S $P(BDMCUML(40),U,6)=$P(BDMCUML(40),U,6)+1 Q
.I $$OW^BDMDD14(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,3)=$P(BDMCUML(40),U,3)+1 Q
.I $$OB^BDMDD14(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,4)=$P(BDMCUML(40),U,4)+1
.I $$SOB^BDMDD14(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,7)=$P(BDMCUML(40),U,7)+1,BDMSEVOB=1 Q
HGB ;
;use last hgba1c value only
;BDMCUML(50)=
S $P(BDMCUML(50),U,2)=$P(BDMCUML(50),U,2)+1
S V=$P($G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,78)),U,2)
S P=""
I V=""!(V="?") S P=9 G HGBS
I V["<" S P=3
I V[">" S P=8
I P G HGBS
S V=$$STV^BDMDD18(V,5)
I V="" S P=9 G HGBS
S V=+V
S P=$S(V="":9,V<7.0:3,V>6.9&(V<8.0):4,V>7.9&(V<9.0):5,V>8.9&(V<10.0):6,V<11.0&(V>9.9):7,V>10.9:8,1:9)
HGBS ;
S $P(BDMCUML(50),U,P)=$P(BDMCUML(50),U,P)+1
BPC ;blood pressure control
;take last 3 bp's and get mean systolic and mean diastolic
S $P(BDMCUML(60),U,2)=$P(BDMCUML(60),U,2)+1
S S=$$SYSMEAN(BDMPD,BDMRBD,BDMRED)
S D=$$DIAMEAN(BDMPD,BDMRBD,BDMRED)
D
.I S=""!(D="") S $P(BDMCUML(60),U,8)=$P(BDMCUML(60),U,8)+1 Q
.I S<120&(D<70) S $P(BDMCUML(60),U,3)=$P(BDMCUML(60),U,3)+1,BDMBP140=1 Q
.I S<130&(D<80) S $P(BDMCUML(60),U,4)=$P(BDMCUML(60),U,4)+1,BDMBP140=1 Q
.I S<140&(D<90) S $P(BDMCUML(60),U,5)=$P(BDMCUML(60),U,5)+1,BDMBP140=1 Q
.I S<160&(D<95) S $P(BDMCUML(60),U,6)=$P(BDMCUML(60),U,6)+1 Q
.S $P(BDMCUML(60),U,7)=$P(BDMCUML(60),U,7)+1
TBSTAT ;
S $P(BDMCUML(70),U,2)=$P(BDMCUML(70),U,2)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,70))
I $E(V)=1!($E(V)=2) S $P(BDMCUML(70),U,3)=$P(BDMCUML(70),U,3)+1
I $E(V)=1 S $P(BDMCUML(70),U,4)=$P(BDMCUML(70),U,4)+1
I $E(V)=2 S $P(BDMCUML(70),U,5)=$P(BDMCUML(70),U,5)+1
I $E($P(V,"||",2))=1 S $P(BDMCUML(70),U,6)=$P(BDMCUML(70),U,6)+1
I $E($P(V,"||",2))=1,$E($G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,72)))=1 S $P(BDMCUML(70),U,7)=$P(BDMCUML(70),U,7)+1
I $E($P(V,"||",2))=2 D
.S $P(BDMCUML(70),U,9)=$P(BDMCUML(70),U,9)+1
.S X=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,114))
.I $$DODX^BDMDD16(BDMPD,BDMDMRG,"I")="" Q
.S D=$$DODX^BDMDD16(BDMPD,BDMDMRG,"I"),E=X I D>E Q
.S $P(BDMCUML(70),U,8)=$P(BDMCUML(70),U,8)+1
TOBACCO ;
S $P(BDMCUML(80),U,2)=$P(BDMCUML(80),U,2)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
S V1=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,28))
I +V=1 S $P(BDMCUML(80),U,3)=$P(BDMCUML(80),U,3)+1 S P=$S($E(V1)="1":4,$E(V1)="2":5,1:6) S $P(BDMCUML(80),U,P)=$P(BDMCUML(80),U,P)+1
I +V=2 S $P(BDMCUML(80),U,7)=$P(BDMCUML(80),U,7)+1
I +V=3 S $P(BDMCUML(80),U,8)=$P(BDMCUML(80),U,8)+1
TOBSCR ;
S $P(BDMCUML(65),U,2)=$P(BDMCUML(65),U,2)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,215))
I +V=1!(+V=2) S $P(BDMCUML(65),U,3)=$P(BDMCUML(65),U,3)+1
I +V=3 S $P(BDMCUML(65),U,4)=$P(BDMCUML(65),U,4)+1
DMTX ;diabetes treatment
S BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31)),BDM6MBD=$$FMTE^XLFDT(BDM6MBD)
S $P(BDMCUML(90),U,2)=$P(BDMCUML(90),U,2)+1
S V=$$THERAPY^BDMDD16(BDMPD,BDM6MBD,BDMRED) ;^ pieced with each item or =1 for diet alone or =14 for refused
I V=1 S $P(BDMCUML(90),U,3)=$P(BDMCUML(90),U,3)+1 G ASPIRIN ;DIET ALONE
F I=1:1 S Q=$P(V,U,I) Q:Q=""!(Q["|") D
. S P=$S(Q=2:4,Q=3:5,Q=4:6,Q=5:7,Q=6:8,Q=7:9,Q=8:10,Q=9:11,Q=10:12,Q=11:14,Q=12:15,Q=13:16,1:"") S $P(BDMCUML(90),U,P)=$P(BDMCUML(90),U,P)+1
S I=$P(V,"|||",2) ;total number
I I=1 S $P(BDMCUML(90),U,17)=$P(BDMCUML(90),U,17)+1 G ASPIRIN
I I=2 S $P(BDMCUML(90),U,18)=$P(BDMCUML(90),U,18)+1 G ASPIRIN
I I=3 S $P(BDMCUML(90),U,19)=$P(BDMCUML(90),U,19)+1 ;
I I>3 S $P(BDMCUML(90),U,20)=$P(BDMCUML(90),U,20)+1
;
ASPIRIN ;
;only tally if patient is 30 and older
;G ACE:$$AGE^AUPNPAT(BDMPD,BDMADAT)<41 ;changed to 41 from 30 with 2010
;I $$SEX^AUPNPAT(BDMPD)="M",$$AGE^AUPNPAT(BDMPD,BDMADAT)<51 G ACE
;I $$SEX^AUPNPAT(BDMPD)="F",$$AGE^AUPNPAT(BDMPD,BDMADAT)<61 G ACE
I $E($G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))'=1 G LIPIDAG ;not cvd
S $P(BDMCUML(100),U,2)=$P(BDMCUML(100),U,2)+1 ;total with cvd
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
S P=$S($E(V)=1:3,$E(V)=3:5,$E(V)=2:4,1:4)
S $P(BDMCUML(100),U,P)=$P(BDMCUML(100),U,P)+1
;
LIPIDAG ;lipid agents
S BDMLPC=0,BDMREF=0
S BDM6M=$$FMADD^XLFDT(BDMADAT,-(6*31))
S $P(BDMCUML(115),U,2)=$P(BDMCUML(115),U,2)+1 ;total # of patients
;total # with CVD ;piece 16
S V=$E($$STATIN^BDMDD16(BDMPD,BDM6M,BDMADAT))
I V=1 S $P(BDMCUML(115),U,6)=$P(BDMCUML(115),U,6)+1 ;
I V=3 S $P(BDMCUML(115),U,7)=$P(BDMCUML(115),U,7)+1
I V'=3 S $P(BDMCUML(115),U,4)=$P(BDMCUML(115),U,4)+1
S C=0
I $E($G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))=1 D
.S C=1,$P(BDMCUML(115),U,16)=$P(BDMCUML(115),U,16)+1
.I V'=3 S $P(BDMCUML(115),U,21)=$P(BDMCUML(115),U,21)+1
.I V=1 S $P(BDMCUML(115),U,22)=$P(BDMCUML(115),U,22)+1
.I V=3 S $P(BDMCUML(115),U,17)=$P(BDMCUML(115),U,17)+1
S A=$$AGE^AUPNPAT(BDMPD,BDMADAT)
I A>39&(A<76) D
.S $P(BDMCUML(115),U,23)=$P(BDMCUML(115),U,23)+1
.I V'=3 S $P(BDMCUML(115),U,8)=$P(BDMCUML(115),U,8)+1
.I V=1 S $P(BDMCUML(115),U,19)=$P(BDMCUML(115),U,19)+1
.I V=3 S $P(BDMCUML(115),U,20)=$P(BDMCUML(115),U,20)+1
I C=1!(A>39&(A<76)) D
.S $P(BDMCUML(115),U,24)=$P(BDMCUML(115),U,24)+1 ;DENOM
.I V'=3 S $P(BDMCUML(115),U,25)=$P(BDMCUML(115),U,25)+1
.I V=1 S $P(BDMCUML(115),U,26)=$P(BDMCUML(115),U,26)+1
.I V=3 S $P(BDMCUML(115),U,27)=$P(BDMCUML(115),U,27)+1
;
LIPID ;115
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,61))
S L=$$LDL^BDMDD18(BDMPD,BDMBDAT,BDMADAT,"I"),L=$P(L,U)
S T=$$CHOL^BDMDD18(BDMPD,BDMBDAT,BDMADAT,"I"),T=$P(T,U)
S T=$$STV^BDMDD18(T,5,1)
S L=$$STV^BDMDD18(L,5,1)
DEP ;
S $P(BDMCUML(300),U,2)=$P(BDMCUML(300),U,2)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
I $E(V)="1" S $P(BDMCUML(300),U,3)=$P(BDMCUML(300),U,3)+1
I $E(V)'="1" S $P(BDMCUML(301),U,2)=$P(BDMCUML(301),U,2)+1 D
.S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,210))
.I $E(V)="1" S $P(BDMCUML(301),U,3)=$P(BDMCUML(301),U,3)+1
.I $E(V)="2" S $P(BDMCUML(301),U,4)=$P(BDMCUML(301),U,4)+1
.I $E(V)="3" S $P(BDMCUML(301),U,5)=$P(BDMCUML(301),U,5)+1
EXAMS ;
S:'$D(BDMCUML(120)) BDMCUML(120)="EXAMS - Yearly"
S $P(BDMCUML(120),U,2)=$P(BDMCUML(120),U,2)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,38))
I $E(V)="1" S $P(BDMCUML(120),U,3)=$P(BDMCUML(120),U,3)+1
I $E(V)="3" S $P(BDMCUML(120),U,6)=$P(BDMCUML(120),U,6)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,40))
I $E(V)="1" S $P(BDMCUML(120),U,4)=$P(BDMCUML(120),U,4)+1
I $E(V)="3" S $P(BDMCUML(120),U,7)=$P(BDMCUML(120),U,7)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,42))
I $E(V)="1" S $P(BDMCUML(120),U,5)=$P(BDMCUML(120),U,5)+1
I $E(V)="3" S $P(BDMCUML(120),U,8)=$P(BDMCUML(120),U,8)+1
I $P(^DPT(BDMPD,0),U,2)="F" S $P(BDMCUML(120),U,9)=$P(BDMCUML(120),U,9)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,108))
I $E(V)="1" S $P(BDMCUML(120),U,10)=$P(BDMCUML(120),U,10)+1
I $E(V)="3" S $P(BDMCUML(120),U,11)=$P(BDMCUML(120),U,11)+1
EDUC ;
S:'$D(BDMCUML(130)) BDMCUML(130)="DIABETES-RELATED EDUCATION - Yearly"
S $P(BDMCUML(130),U,2)=$P(BDMCUML(130),U,2)+1
S G=0,V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
I $E(V)="1"!($E(V)=2)!($E(V)=3) S $P(BDMCUML(130),U,3)=$P(BDMCUML(130),U,3)+1 S G=1
I $E(V)="5" S $P(BDMCUML(130),U,7)=$P(BDMCUML(130),U,7)+1
I $E(V)="1" S $P(BDMCUML(130),U,10)=$P(BDMCUML(130),U,10)+1 S G=1
I $E(V)="3" S $P(BDMCUML(130),U,10)=$P(BDMCUML(130),U,10)+1 S G=1 ;cmi/maw 1/15/08
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
I $E(V)="1" S $P(BDMCUML(130),U,4)=$P(BDMCUML(130),U,4)+1 S G=1
I $E(V)="3" S $P(BDMCUML(130),U,8)=$P(BDMCUML(130),U,8)+1
S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,48))
I $E(V)="3" S $P(BDMCUML(130),U,9)=$P(BDMCUML(130),U,9)+1
I $E(V)="1" S $P(BDMCUML(130),U,5)=$P(BDMCUML(130),U,5)+1 S G=1
I G S $P(BDMCUML(130),U,6)=$P(BDMCUML(130),U,6)+1
D ^BDMDD11
Q
SYSMEAN(P,BDATE,EDATE) ;EP
NEW X,Z,C,Y
S X=$$BPS^BDMDD13(P,BDATE,EDATE,"I")
I X="" Q ""
NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
I C<2 Q ""
S Z=C
S C=0 F Y=1:1:Z S C=$P($P(X,";",Y),"/")+C
Q C\Z
DIAMEAN(P,BDATE,EDATE) ;EP
NEW X,Z,C,Y
S X=$$BPS^BDMDD13(P,BDATE,EDATE,"I")
I X="" Q ""
NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
I C<2 Q ""
S Z=C
S C=0 F Y=1:1:Z S C=$P($P(X,";",Y),"/",2)+C
Q C\Z
BDMDD15 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 03 Feb 2014 5:38 PM ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
+2 ;
+3 ;
CUML ;EP
+1 KILL BDMCUML
+2 SET BDMCUML(10)="Gender"
+3 SET BDMCUML(20)="Age"
+4 SET BDMCUML(25)="Diabetes Type"
+5 SET BDMCUML(30)="Duration of Diabetes"
+6 SET BDMCUML(40)="BMI Category"
+7 SET BDMCUML(50)="Blood Sugar Control"
+8 SET BDMCUML(70)="Tuberculosis Status"
+9 SET BDMCUML(60)="Mean Blood Pressure (BP) - Mean of last 2, or 3 if available"
+10 SET BDMCUML(65)="Tobacco use screening during Audit period:"
+11 SET BDMCUML(80)="Tobacco use status:"
+12 SET BDMCUML(90)="Diabetes Treatment"
+13 SET BDMCUML(100)="Aspirin or Other Antiplatelet/Anticoagulant Therapy Prescribed"
+14 SET BDMCUML(110)="ACE Inhibitor or ARB Prescribed"
+15 SET BDMCUML(115)="Statin Prescribed"
+16 SET BDMCUML(300)="Depression as an Active Problem"
+17 SET BDMCUML(301)="Depression Screening?"
+18 SET BDMCUML(120)="Exams"
+19 SET BDMCUML(130)="Diabetes-Related Education"
+20 SET BDMCUML(140)="Immunizations"
+21 SET BDMCUML(145)="Laboratory Exams"
+22 SET BDMCUML(150)="Electrocardiogram (Age 30 and above)"
+23 SET BDMCUML(170)="Creatinine obtained during audit period"
+24 SET BDMCUML(175)="Estimated GFR documented during audit period"
+25 SET BDMCUML(180)="Total Cholesterol obtained in past 12 months"
+26 SET BDMCUML(190)="LDL Cholesterol obtained during audit period"
+27 SET BDMCUML(195)="HDL Cholesterol obtained during audit period"
+28 SET BDMCUML(200)="Triglycerides obtained during audit period"
+29 SET BDMCUML(400)="Comorbidities"
+30 ;
PROCESS ;
+1 SET BDMNOGO=0
+2 SET BDMPD=0
FOR
SET BDMPD=$ORDER(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD))
IF BDMPD'=+BDMPD
QUIT
DO CUML1
+3 QUIT
+4 ;
CUML1 ;
+1 ;VARIABLE FOR # OF COMORBIDITIES
SET BDMCOMOR=0
+2 ;SEVERELY OBESE
SET BDMSEVOB=0
+3 ;COMORBIDITY SECTION
SET BDMBP140=0
+4 ;CKD?
SET BDMCKD=0
+5 ;BOTH EGFR AND UACR
SET BDMEGFRU=0
+6 ;EGFR VALUE
SET BDMEGFRV=""
+7 ;UACR VALUE
SET BDMUACRV=""
GENDER ;
+1 IF $$DODX^BDMDD16(BDMPD,BDMDMRG,"I")>BDMADAT
SET BDMNOGO=BDMNOGO+1
QUIT
+2 ;gender BDMCUML(10)="Gender^total^females^males"
+3 SET $PIECE(BDMCUML(10),U,2)=$PIECE(BDMCUML(10),U,2)+1
+4 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,20))
+5 SET P=$SELECT($EXTRACT(V)="F":3,$EXTRACT(V)="M":4,1:5)
+6 SET $PIECE(BDMCUML(10),U,P)=$PIECE(BDMCUML(10),U,P)+1
AGE ;
+1 SET V=$$AGE^AUPNPAT(BDMPD,BDMADAT)
+2 ;BDMCUML(20)="Age^total^<15^15-44^45-64^>65^unknown"
+3 SET $PIECE(BDMCUML(20),U,2)=$PIECE(BDMCUML(20),U,2)+1
+4 SET P=$SELECT(V<20:3,V>19&(V<45):4,V>44&(V<65):5,V>64:6,1:7)
+5 SET $PIECE(BDMCUML(20),U,P)=$PIECE(BDMCUML(20),U,P)+1
TYPE ;
+1 ;BDMCUML(25)="Total^Type 1^Type 2"
+2 SET X=$$TYPE^BDMDD16(BDMPD,BDMDMRG,BDMADAT)
+3 SET $PIECE(BDMCUML(25),U,2)=$PIECE(BDMCUML(25),U,2)+1
+4 SET P=$SELECT(X="":4,X=1:3,X=2:4,1:4)
+5 SET $PIECE(BDMCUML(25),U,P)=$PIECE(BDMCUML(25),U,P)+1
DURDMC ;
+1 ;BDMCUML(30)="Duration of Diabetes^total^<10^10 or more^no date of dx on problem list or cms register^less than 1 year"
+2 SET $PIECE(BDMCUML(30),U,2)=$PIECE(BDMCUML(30),U,2)+1
+3 SET V=$$DURDM^BDMDD14(BDMPD,BDMDMRG,BDMADAT)
+4 SET P=$SELECT(V="":5,V<10:3,1:4)
+5 SET $PIECE(BDMCUML(30),U,P)=$PIECE(BDMCUML(30),U,P)+1
+6 IF V]""
IF V<1
SET $PIECE(BDMCUML(30),U,6)=$PIECE(BDMCUML(30),U,6)+1
BMI ;
+1 ;BDMCUML(40)="Weight Control (BMI) - does not add up to 100%^total^total^overweight^obese^height or weight missing"
+2 ;S V=$G(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,112))
+3 SET H=$$LASTHT^BDMDD13(BDMPD,BDMRED,"I")
IF H]""
SET H=$$STRIP^XLFSTR($JUSTIFY(H,5,2)," ")
+4 SET W=+$$LASTWT^BDMDD13(BDMPD,BDMBDAT,BDMRED)
SET W=$SELECT(W=0:"",1:W)
IF W]""
SET W=W\1
+5 SET V=$$BMIEPI^BDMDD19(H,W)
+6 SET $PIECE(BDMCUML(40),U,2)=$PIECE(BDMCUML(40),U,2)+1
+7 Begin DoDot:1
+8 IF V=""!(H="")!(W="")
SET $PIECE(BDMCUML(40),U,5)=$PIECE(BDMCUML(40),U,5)+1
QUIT
+9 IF V<25
SET $PIECE(BDMCUML(40),U,6)=$PIECE(BDMCUML(40),U,6)+1
QUIT
+10 IF $$OW^BDMDD14(BDMPD,V,BDMADAT)
SET $PIECE(BDMCUML(40),U,3)=$PIECE(BDMCUML(40),U,3)+1
QUIT
+11 IF $$OB^BDMDD14(BDMPD,V,BDMADAT)
SET $PIECE(BDMCUML(40),U,4)=$PIECE(BDMCUML(40),U,4)+1
+12 IF $$SOB^BDMDD14(BDMPD,V,BDMADAT)
SET $PIECE(BDMCUML(40),U,7)=$PIECE(BDMCUML(40),U,7)+1
SET BDMSEVOB=1
QUIT
End DoDot:1
HGB ;
+1 ;use last hgba1c value only
+2 ;BDMCUML(50)=
+3 SET $PIECE(BDMCUML(50),U,2)=$PIECE(BDMCUML(50),U,2)+1
+4 SET V=$PIECE($GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,78)),U,2)
+5 SET P=""
+6 IF V=""!(V="?")
SET P=9
GOTO HGBS
+7 IF V["<"
SET P=3
+8 IF V[">"
SET P=8
+9 IF P
GOTO HGBS
+10 SET V=$$STV^BDMDD18(V,5)
+11 IF V=""
SET P=9
GOTO HGBS
+12 SET V=+V
+13 SET P=$SELECT(V="":9,V<7.0:3,V>6.9&(V<8.0):4,V>7.9&(V<9.0):5,V>8.9&(V<10.0):6,V<11.0&(V>9.9):7,V>10.9:8,1:9)
HGBS ;
+1 SET $PIECE(BDMCUML(50),U,P)=$PIECE(BDMCUML(50),U,P)+1
BPC ;blood pressure control
+1 ;take last 3 bp's and get mean systolic and mean diastolic
+2 SET $PIECE(BDMCUML(60),U,2)=$PIECE(BDMCUML(60),U,2)+1
+3 SET S=$$SYSMEAN(BDMPD,BDMRBD,BDMRED)
+4 SET D=$$DIAMEAN(BDMPD,BDMRBD,BDMRED)
+5 Begin DoDot:1
+6 IF S=""!(D="")
SET $PIECE(BDMCUML(60),U,8)=$PIECE(BDMCUML(60),U,8)+1
QUIT
+7 IF S<120&(D<70)
SET $PIECE(BDMCUML(60),U,3)=$PIECE(BDMCUML(60),U,3)+1
SET BDMBP140=1
QUIT
+8 IF S<130&(D<80)
SET $PIECE(BDMCUML(60),U,4)=$PIECE(BDMCUML(60),U,4)+1
SET BDMBP140=1
QUIT
+9 IF S<140&(D<90)
SET $PIECE(BDMCUML(60),U,5)=$PIECE(BDMCUML(60),U,5)+1
SET BDMBP140=1
QUIT
+10 IF S<160&(D<95)
SET $PIECE(BDMCUML(60),U,6)=$PIECE(BDMCUML(60),U,6)+1
QUIT
+11 SET $PIECE(BDMCUML(60),U,7)=$PIECE(BDMCUML(60),U,7)+1
End DoDot:1
TBSTAT ;
+1 SET $PIECE(BDMCUML(70),U,2)=$PIECE(BDMCUML(70),U,2)+1
+2 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,70))
+3 IF $EXTRACT(V)=1!($EXTRACT(V)=2)
SET $PIECE(BDMCUML(70),U,3)=$PIECE(BDMCUML(70),U,3)+1
+4 IF $EXTRACT(V)=1
SET $PIECE(BDMCUML(70),U,4)=$PIECE(BDMCUML(70),U,4)+1
+5 IF $EXTRACT(V)=2
SET $PIECE(BDMCUML(70),U,5)=$PIECE(BDMCUML(70),U,5)+1
+6 IF $EXTRACT($PIECE(V,"||",2))=1
SET $PIECE(BDMCUML(70),U,6)=$PIECE(BDMCUML(70),U,6)+1
+7 IF $EXTRACT($PIECE(V,"||",2))=1
IF $EXTRACT($GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,72)))=1
SET $PIECE(BDMCUML(70),U,7)=$PIECE(BDMCUML(70),U,7)+1
+8 IF $EXTRACT($PIECE(V,"||",2))=2
Begin DoDot:1
+9 SET $PIECE(BDMCUML(70),U,9)=$PIECE(BDMCUML(70),U,9)+1
+10 SET X=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,114))
+11 IF $$DODX^BDMDD16(BDMPD,BDMDMRG,"I")=""
QUIT
+12 SET D=$$DODX^BDMDD16(BDMPD,BDMDMRG,"I")
SET E=X
IF D>E
QUIT
+13 SET $PIECE(BDMCUML(70),U,8)=$PIECE(BDMCUML(70),U,8)+1
End DoDot:1
TOBACCO ;
+1 SET $PIECE(BDMCUML(80),U,2)=$PIECE(BDMCUML(80),U,2)+1
+2 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
+3 SET V1=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,28))
+4 IF +V=1
SET $PIECE(BDMCUML(80),U,3)=$PIECE(BDMCUML(80),U,3)+1
SET P=$SELECT($EXTRACT(V1)="1":4,$EXTRACT(V1)="2":5,1:6)
SET $PIECE(BDMCUML(80),U,P)=$PIECE(BDMCUML(80),U,P)+1
+5 IF +V=2
SET $PIECE(BDMCUML(80),U,7)=$PIECE(BDMCUML(80),U,7)+1
+6 IF +V=3
SET $PIECE(BDMCUML(80),U,8)=$PIECE(BDMCUML(80),U,8)+1
TOBSCR ;
+1 SET $PIECE(BDMCUML(65),U,2)=$PIECE(BDMCUML(65),U,2)+1
+2 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,215))
+3 IF +V=1!(+V=2)
SET $PIECE(BDMCUML(65),U,3)=$PIECE(BDMCUML(65),U,3)+1
+4 IF +V=3
SET $PIECE(BDMCUML(65),U,4)=$PIECE(BDMCUML(65),U,4)+1
DMTX ;diabetes treatment
+1 SET BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31))
SET BDM6MBD=$$FMTE^XLFDT(BDM6MBD)
+2 SET $PIECE(BDMCUML(90),U,2)=$PIECE(BDMCUML(90),U,2)+1
+3 ;^ pieced with each item or =1 for diet alone or =14 for refused
SET V=$$THERAPY^BDMDD16(BDMPD,BDM6MBD,BDMRED)
+4 ;DIET ALONE
IF V=1
SET $PIECE(BDMCUML(90),U,3)=$PIECE(BDMCUML(90),U,3)+1
GOTO ASPIRIN
+5 FOR I=1:1
SET Q=$PIECE(V,U,I)
IF Q=""!(Q["|")
QUIT
Begin DoDot:1
+6 SET P=$SELECT(Q=2:4,Q=3:5,Q=4:6,Q=5:7,Q=6:8,Q=7:9,Q=8:10,Q=9:11,Q=10:12,Q=11:14,Q=12:15,Q=13:16,1:"")
SET $PIECE(BDMCUML(90),U,P)=$PIECE(BDMCUML(90),U,P)+1
End DoDot:1
+7 ;total number
SET I=$PIECE(V,"|||",2)
+8 IF I=1
SET $PIECE(BDMCUML(90),U,17)=$PIECE(BDMCUML(90),U,17)+1
GOTO ASPIRIN
+9 IF I=2
SET $PIECE(BDMCUML(90),U,18)=$PIECE(BDMCUML(90),U,18)+1
GOTO ASPIRIN
+10 ;
IF I=3
SET $PIECE(BDMCUML(90),U,19)=$PIECE(BDMCUML(90),U,19)+1
+11 IF I>3
SET $PIECE(BDMCUML(90),U,20)=$PIECE(BDMCUML(90),U,20)+1
+12 ;
ASPIRIN ;
+1 ;only tally if patient is 30 and older
+2 ;G ACE:$$AGE^AUPNPAT(BDMPD,BDMADAT)<41 ;changed to 41 from 30 with 2010
+3 ;I $$SEX^AUPNPAT(BDMPD)="M",$$AGE^AUPNPAT(BDMPD,BDMADAT)<51 G ACE
+4 ;I $$SEX^AUPNPAT(BDMPD)="F",$$AGE^AUPNPAT(BDMPD,BDMADAT)<61 G ACE
+5 ;not cvd
IF $EXTRACT($GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))'=1
GOTO LIPIDAG
+6 ;total with cvd
SET $PIECE(BDMCUML(100),U,2)=$PIECE(BDMCUML(100),U,2)+1
+7 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
+8 SET P=$SELECT($EXTRACT(V)=1:3,$EXTRACT(V)=3:5,$EXTRACT(V)=2:4,1:4)
+9 SET $PIECE(BDMCUML(100),U,P)=$PIECE(BDMCUML(100),U,P)+1
+10 ;
LIPIDAG ;lipid agents
+1 SET BDMLPC=0
SET BDMREF=0
+2 SET BDM6M=$$FMADD^XLFDT(BDMADAT,-(6*31))
+3 ;total # of patients
SET $PIECE(BDMCUML(115),U,2)=$PIECE(BDMCUML(115),U,2)+1
+4 ;total # with CVD ;piece 16
+5 SET V=$EXTRACT($$STATIN^BDMDD16(BDMPD,BDM6M,BDMADAT))
+6 ;
IF V=1
SET $PIECE(BDMCUML(115),U,6)=$PIECE(BDMCUML(115),U,6)+1
+7 IF V=3
SET $PIECE(BDMCUML(115),U,7)=$PIECE(BDMCUML(115),U,7)+1
+8 IF V'=3
SET $PIECE(BDMCUML(115),U,4)=$PIECE(BDMCUML(115),U,4)+1
+9 SET C=0
+10 IF $EXTRACT($GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))=1
Begin DoDot:1
+11 SET C=1
SET $PIECE(BDMCUML(115),U,16)=$PIECE(BDMCUML(115),U,16)+1
+12 IF V'=3
SET $PIECE(BDMCUML(115),U,21)=$PIECE(BDMCUML(115),U,21)+1
+13 IF V=1
SET $PIECE(BDMCUML(115),U,22)=$PIECE(BDMCUML(115),U,22)+1
+14 IF V=3
SET $PIECE(BDMCUML(115),U,17)=$PIECE(BDMCUML(115),U,17)+1
End DoDot:1
+15 SET A=$$AGE^AUPNPAT(BDMPD,BDMADAT)
+16 IF A>39&(A<76)
Begin DoDot:1
+17 SET $PIECE(BDMCUML(115),U,23)=$PIECE(BDMCUML(115),U,23)+1
+18 IF V'=3
SET $PIECE(BDMCUML(115),U,8)=$PIECE(BDMCUML(115),U,8)+1
+19 IF V=1
SET $PIECE(BDMCUML(115),U,19)=$PIECE(BDMCUML(115),U,19)+1
+20 IF V=3
SET $PIECE(BDMCUML(115),U,20)=$PIECE(BDMCUML(115),U,20)+1
End DoDot:1
+21 IF C=1!(A>39&(A<76))
Begin DoDot:1
+22 ;DENOM
SET $PIECE(BDMCUML(115),U,24)=$PIECE(BDMCUML(115),U,24)+1
+23 IF V'=3
SET $PIECE(BDMCUML(115),U,25)=$PIECE(BDMCUML(115),U,25)+1
+24 IF V=1
SET $PIECE(BDMCUML(115),U,26)=$PIECE(BDMCUML(115),U,26)+1
+25 IF V=3
SET $PIECE(BDMCUML(115),U,27)=$PIECE(BDMCUML(115),U,27)+1
End DoDot:1
+26 ;
LIPID ;115
+1 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,61))
+2 SET L=$$LDL^BDMDD18(BDMPD,BDMBDAT,BDMADAT,"I")
SET L=$PIECE(L,U)
+3 SET T=$$CHOL^BDMDD18(BDMPD,BDMBDAT,BDMADAT,"I")
SET T=$PIECE(T,U)
+4 SET T=$$STV^BDMDD18(T,5,1)
+5 SET L=$$STV^BDMDD18(L,5,1)
DEP ;
+1 SET $PIECE(BDMCUML(300),U,2)=$PIECE(BDMCUML(300),U,2)+1
+2 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(300),U,3)=$PIECE(BDMCUML(300),U,3)+1
+4 IF $EXTRACT(V)'="1"
SET $PIECE(BDMCUML(301),U,2)=$PIECE(BDMCUML(301),U,2)+1
Begin DoDot:1
+5 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,210))
+6 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(301),U,3)=$PIECE(BDMCUML(301),U,3)+1
+7 IF $EXTRACT(V)="2"
SET $PIECE(BDMCUML(301),U,4)=$PIECE(BDMCUML(301),U,4)+1
+8 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(301),U,5)=$PIECE(BDMCUML(301),U,5)+1
End DoDot:1
EXAMS ;
+1 IF '$DATA(BDMCUML(120))
SET BDMCUML(120)="EXAMS - Yearly"
+2 SET $PIECE(BDMCUML(120),U,2)=$PIECE(BDMCUML(120),U,2)+1
+3 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,38))
+4 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(120),U,3)=$PIECE(BDMCUML(120),U,3)+1
+5 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(120),U,6)=$PIECE(BDMCUML(120),U,6)+1
+6 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,40))
+7 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(120),U,4)=$PIECE(BDMCUML(120),U,4)+1
+8 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(120),U,7)=$PIECE(BDMCUML(120),U,7)+1
+9 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,42))
+10 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(120),U,5)=$PIECE(BDMCUML(120),U,5)+1
+11 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(120),U,8)=$PIECE(BDMCUML(120),U,8)+1
+12 IF $PIECE(^DPT(BDMPD,0),U,2)="F"
SET $PIECE(BDMCUML(120),U,9)=$PIECE(BDMCUML(120),U,9)+1
+13 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,108))
+14 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(120),U,10)=$PIECE(BDMCUML(120),U,10)+1
+15 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(120),U,11)=$PIECE(BDMCUML(120),U,11)+1
EDUC ;
+1 IF '$DATA(BDMCUML(130))
SET BDMCUML(130)="DIABETES-RELATED EDUCATION - Yearly"
+2 SET $PIECE(BDMCUML(130),U,2)=$PIECE(BDMCUML(130),U,2)+1
+3 SET G=0
SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
+4 IF $EXTRACT(V)="1"!($EXTRACT(V)=2)!($EXTRACT(V)=3)
SET $PIECE(BDMCUML(130),U,3)=$PIECE(BDMCUML(130),U,3)+1
SET G=1
+5 IF $EXTRACT(V)="5"
SET $PIECE(BDMCUML(130),U,7)=$PIECE(BDMCUML(130),U,7)+1
+6 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(130),U,10)=$PIECE(BDMCUML(130),U,10)+1
SET G=1
+7 ;cmi/maw 1/15/08
IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(130),U,10)=$PIECE(BDMCUML(130),U,10)+1
SET G=1
+8 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
+9 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(130),U,4)=$PIECE(BDMCUML(130),U,4)+1
SET G=1
+10 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(130),U,8)=$PIECE(BDMCUML(130),U,8)+1
+11 SET V=$GET(^XTMP("BDMDM16",BDMJOB,BDMBTH,"AUDIT",BDMPD,48))
+12 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(130),U,9)=$PIECE(BDMCUML(130),U,9)+1
+13 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(130),U,5)=$PIECE(BDMCUML(130),U,5)+1
SET G=1
+14 IF G
SET $PIECE(BDMCUML(130),U,6)=$PIECE(BDMCUML(130),U,6)+1
+15 DO ^BDMDD11
+16 QUIT
SYSMEAN(P,BDATE,EDATE) ;EP
+1 NEW X,Z,C,Y
+2 SET X=$$BPS^BDMDD13(P,BDATE,EDATE,"I")
+3 IF X=""
QUIT ""
+4 NEW Y,C
SET C=0
FOR Y=1:1:3
IF $PIECE(X,";",Y)]""
SET C=C+1
+5 IF C<2
QUIT ""
+6 SET Z=C
+7 SET C=0
FOR Y=1:1:Z
SET C=$PIECE($PIECE(X,";",Y),"/")+C
+8 QUIT C\Z
DIAMEAN(P,BDATE,EDATE) ;EP
+1 NEW X,Z,C,Y
+2 SET X=$$BPS^BDMDD13(P,BDATE,EDATE,"I")
+3 IF X=""
QUIT ""
+4 NEW Y,C
SET C=0
FOR Y=1:1:3
IF $PIECE(X,";",Y)]""
SET C=C+1
+5 IF C<2
QUIT ""
+6 SET Z=C
+7 SET C=0
FOR Y=1:1:Z
SET C=$PIECE($PIECE(X,";",Y),"/",2)+C
+8 QUIT C\Z
