- BDMDA15 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 03 Feb 2013 5:38 PM ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**6**;JUN 14, 2007;Build 6
- ;
- ;
- 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)="Weight Control (BMI)"
- S BDMCUML(50)="Blood Sugar Control"
- S BDMCUML(70)="Tuberculosis Status"
- S BDMCUML(60)="Mean Blood Pressure (of last 2, or 3 if available)"
- S BDMCUML(80)="Tobacco use"
- S BDMCUML(90)="DIABETES TREATMENT"
- S BDMCUML(100)="ANTIPLATELET THERAPY"
- S BDMCUML(110)="ACE INHIBITOR (OR ARB) USE"
- S BDMCUML(115)="LIPID LOWERING AGENT USE"
- S BDMCUML(300)="Depression on Problem List or as POVs"
- S BDMCUML(301)="Depression Screening?"
- S BDMCUML(120)="EXAMS - Yearly"
- S BDMCUML(130)="DIABETES-RELATED EDUCATION - Yearly"
- 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"
- ;
- PROCESS ;
- S BDMNOGO=0
- S BDMPD=0 F S BDMPD=$O(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD D CUML1
- Q
- ;
- CUML1 ;
- GENDER ;
- I $$DODX^BDMDA16(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("BDMDM13",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<15:3,V>14&(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^BDMDA16(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^BDMDA14(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("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,112))
- S H=$$LASTHT^BDMDA13(BDMPD,BDMRED,"I") S:H]"" H=$J(H,5,2)
- S W=+$$LASTWT^BDMDA13(BDMPD,BDMBDAT,BDMRED),W=$S(W=0:"",1:W),W=W+.5,W=$P(W,".")
- S V=$$BMIEPI^BDMDA19(H,W)
- S $P(BDMCUML(40),U,2)=$P(BDMCUML(40),U,2)+1
- D
- .I V="" S $P(BDMCUML(40),U,5)=$P(BDMCUML(40),U,5)+1 Q
- .I $$OW^BDMDA14(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,3)=$P(BDMCUML(40),U,3)+1 Q
- .I $$OB^BDMDA14(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,4)=$P(BDMCUML(40),U,4)+1 Q
- .S $P(BDMCUML(40),U,6)=$P(BDMCUML(40),U,6)+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("BDMDM13",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^BDMDA18(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 Q
- .I S<130&(D<80) S $P(BDMCUML(60),U,4)=$P(BDMCUML(60),U,4)+1 Q
- .I S<140&(D<90) S $P(BDMCUML(60),U,5)=$P(BDMCUML(60),U,5)+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=$$TBCODE^BDMDA16(BDMPD,BDMRED,BDMDMRG)
- S $P(BDMCUML(70),U,(V+2))=$P(BDMCUML(70),U,(V+2))+1
- TOBACCO ;
- S $P(BDMCUML(80),U,2)=$P(BDMCUML(80),U,2)+1
- S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
- S V1=$G(^XTMP("BDMDM13",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
- 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^BDMDA16(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
- ;I V="R" S $P(BDMCUML(90),U,16)=$P(BDMCUML(90),U,16)+1 G ASPIRIN ;REFUSAL
- 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,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("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))'=1 G ACE ;not cvd
- S $P(BDMCUML(100),U,2)=$P(BDMCUML(100),U,2)+1 ;total with cvd
- S V=$G(^XTMP("BDMDM13",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
- ACE ;110 title^total pts^total pts with protein^# of those on ace^# with htn^# of those on ace"
- S $P(BDMCUML(110),U,2)=$P(BDMCUML(110),U,2)+1
- ;set 3rd piece with # with proteinuria
- S P=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)) ;URINE PROTEIN VALUE
- S H=$E($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,34)))
- S A=$E($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,60)))
- I A S $P(BDMCUML(110),U,3)=$P(BDMCUML(110),U,3)+1 ;TOTAL ACE
- I $E(H)=1 S $P(BDMCUML(110),U,5)=$P(BDMCUML(110),U,5)+1 I A=1 S $P(BDMCUML(110),U,7)=$P(BDMCUML(110),U,7)+1 ;TOTAL HTN
- I $P(P,U,5)=1 S V=$P(P,U,2) D ;THIS IS THE A/C RATIO, COUNT ANYTHING GREATER THAN 29.999999
- .I V["<" Q
- .I V[">" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q ;this would be the >300 value
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I V["-" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q ;this would be the 30-300 value
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I V["300" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q ;this would be the 30-300 value
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .S V=$$STV^BDMDA18(V,8)
- .I V>29.999999 S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q ;this would cover numeric values
- I $P(P,U,5)=2 S V=$P(P,U,2) D ;THIS IS THE PCR COUNT ANYTHING GREATER THAN 0.2
- .S V=$$STV^BDMDA18(V,5,1)
- .I V>0.2 S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- I $P(P,U,5)=3 S V=$P(P,U,2) D ;this is the 24 hour urine protein
- .I V["<" Q
- .S V=$$STV^BDMDA18(V,5,1)
- .I V>300 S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- I $P(P,U,5)=4 S V=$P(P,U,2) D ;this is the micro strips with a 30-300 value
- .I V["<" Q
- .I V[">" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q ;this would be the >300 value
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I V["-" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q ;this would be the 30-300 value
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I V["300" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 D Q ;this would be the 30-300 value
- ..I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .S V=$$STV^BDMDA18(V,8)
- .I V>29.999999 S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q ;this would cover numeric values
- I $P(P,U,5)=5 S V=$P(P,U,2) D ;this is the micral, use anything >=20 (not less than 20)
- .S V=$$STV^BDMDA18(V,8,2)
- .I V,V'<20 S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- I $P(P,U,5)=6 S V=$P(P,U,2) D ;this is the urine dipstick, count anything 1+ or above
- .I V["+"!(V[">")!($E(V)="p")!($E(V)="P") S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I $E($$UP^XLFSTR(V))="S" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I $E($$UP^XLFSTR(V))="M" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I $E($$UP^XLFSTR(V))="L" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- .I +V>29 S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 I A=1 S $P(BDMCUML(110),U,8)=$P(BDMCUML(110),U,8)+1 Q
- 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 C=0
- I $E($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))=1 S C=1,$P(BDMCUML(115),U,16)=$P(BDMCUML(115),U,16)+1
- S V=$$STATIN^BDMDA16(BDMPD,BDM6M,BDMADAT)
- I V]"" S BDMLPC=BDMLPC+1,$P(BDMCUML(115),U,6)=$P(BDMCUML(115),U,6)+1 S:C $P(BDMCUML(115),U,17)=$P(BDMCUML(115),U,17)+1
- S V=$$FIBRATE^BDMDA16(BDMPD,BDM6M,BDMADAT)
- I V]"" S BDMLPC=BDMLPC+1,$P(BDMCUML(115),U,7)=$P(BDMCUML(115),U,7)+1
- S V=$$NIACIN^BDMDA16(BDMPD,BDM6M,BDMADAT)
- I V]"" S BDMLPC=BDMLPC+1,$P(BDMCUML(115),U,8)=$P(BDMCUML(115),U,8)+1
- S V=$$BILE^BDMDA16(BDMPD,BDM6M,BDMADAT)
- I V]"" S BDMLPC=BDMLPC+1,$P(BDMCUML(115),U,9)=$P(BDMCUML(115),U,9)+1
- S V=$$EZET^BDMDA16(BDMPD,BDM6M,BDMADAT)
- I V]"" S BDMLPC=BDMLPC+1,$P(BDMCUML(115),U,10)=$P(BDMCUML(115),U,10)+1
- S V=$$FISHOIL^BDMDA16(BDMPD,BDM6M,BDMADAT)
- I V]"" S BDMLPC=BDMLPC+1,$P(BDMCUML(115),U,11)=$P(BDMCUML(115),U,11)+1
- S V=$$LOVAZA^BDMDA16(BDMPD,BDM6M,BDMADAT)
- I V]"" S BDMLPC=BDMLPC+1,$P(BDMCUML(115),U,12)=$P(BDMCUML(115),U,12)+1
- I BDMLPC=0 S $P(BDMCUML(115),U,5)=$P(BDMCUML(115),U,5)+1
- I BDMLPC=1 S $P(BDMCUML(115),U,3)=$P(BDMCUML(115),U,3)+1,$P(BDMCUML(115),U,13)=$P(BDMCUML(115),U,13)+1
- I BDMLPC>1 S $P(BDMCUML(115),U,4)=$P(BDMCUML(115),U,4)+1,$P(BDMCUML(115),U,13)=$P(BDMCUML(115),U,13)+1
- LIPID ;115
- S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,61))
- S L=$$LDL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I"),L=$P(L,U)
- S T=$$CHOL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I"),T=$P(T,U)
- S T=$$STV^BDMDA18(T,5,1)
- S L=$$STV^BDMDA18(L,5,1)
- DEP ;
- S $P(BDMCUML(300),U,2)=$P(BDMCUML(300),U,2)+1
- S V=$G(^XTMP("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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 ^BDMDA11
- Q
- SYSMEAN(P,BDATE,EDATE) ;EP
- NEW X,Z,C,Y
- S X=$$BPS^BDMDA13(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^BDMDA13(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
- BDMDA15 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 03 Feb 2013 5:38 PM ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**6**;JUN 14, 2007;Build 6
- +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)="Weight Control (BMI)"
- +7 SET BDMCUML(50)="Blood Sugar Control"
- +8 SET BDMCUML(70)="Tuberculosis Status"
- +9 SET BDMCUML(60)="Mean Blood Pressure (of last 2, or 3 if available)"
- +10 SET BDMCUML(80)="Tobacco use"
- +11 SET BDMCUML(90)="DIABETES TREATMENT"
- +12 SET BDMCUML(100)="ANTIPLATELET THERAPY"
- +13 SET BDMCUML(110)="ACE INHIBITOR (OR ARB) USE"
- +14 SET BDMCUML(115)="LIPID LOWERING AGENT USE"
- +15 SET BDMCUML(300)="Depression on Problem List or as POVs"
- +16 SET BDMCUML(301)="Depression Screening?"
- +17 SET BDMCUML(120)="EXAMS - Yearly"
- +18 SET BDMCUML(130)="DIABETES-RELATED EDUCATION - Yearly"
- +19 SET BDMCUML(140)="IMMUNIZATIONS"
- +20 SET BDMCUML(145)="LABORATORY EXAMS"
- +21 SET BDMCUML(150)="Electrocardiogram (Age 30 and above)"
- +22 SET BDMCUML(170)="Creatinine obtained during audit period"
- +23 SET BDMCUML(175)="Estimated GFR documented during audit period"
- +24 SET BDMCUML(180)="Total Cholesterol obtained in past 12 months"
- +25 SET BDMCUML(190)="LDL Cholesterol obtained during audit period"
- +26 SET BDMCUML(195)="HDL Cholesterol obtained during audit period"
- +27 SET BDMCUML(200)="Triglycerides obtained during audit period"
- +28 ;
- PROCESS ;
- +1 SET BDMNOGO=0
- +2 SET BDMPD=0
- FOR
- SET BDMPD=$ORDER(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD))
- IF BDMPD'=+BDMPD
- QUIT
- DO CUML1
- +3 QUIT
- +4 ;
- CUML1 ;
- GENDER ;
- +1 IF $$DODX^BDMDA16(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("BDMDM13",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<15:3,V>14&(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^BDMDA16(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^BDMDA14(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("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,112))
- +3 SET H=$$LASTHT^BDMDA13(BDMPD,BDMRED,"I")
- IF H]""
- SET H=$JUSTIFY(H,5,2)
- +4 SET W=+$$LASTWT^BDMDA13(BDMPD,BDMBDAT,BDMRED)
- SET W=$SELECT(W=0:"",1:W)
- SET W=W+.5
- SET W=$PIECE(W,".")
- +5 SET V=$$BMIEPI^BDMDA19(H,W)
- +6 SET $PIECE(BDMCUML(40),U,2)=$PIECE(BDMCUML(40),U,2)+1
- +7 Begin DoDot:1
- +8 IF V=""
- SET $PIECE(BDMCUML(40),U,5)=$PIECE(BDMCUML(40),U,5)+1
- QUIT
- +9 IF $$OW^BDMDA14(BDMPD,V,BDMADAT)
- SET $PIECE(BDMCUML(40),U,3)=$PIECE(BDMCUML(40),U,3)+1
- QUIT
- +10 IF $$OB^BDMDA14(BDMPD,V,BDMADAT)
- SET $PIECE(BDMCUML(40),U,4)=$PIECE(BDMCUML(40),U,4)+1
- QUIT
- +11 SET $PIECE(BDMCUML(40),U,6)=$PIECE(BDMCUML(40),U,6)+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("BDMDM13",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^BDMDA18(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
- QUIT
- +8 IF S<130&(D<80)
- SET $PIECE(BDMCUML(60),U,4)=$PIECE(BDMCUML(60),U,4)+1
- QUIT
- +9 IF S<140&(D<90)
- SET $PIECE(BDMCUML(60),U,5)=$PIECE(BDMCUML(60),U,5)+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=$$TBCODE^BDMDA16(BDMPD,BDMRED,BDMDMRG)
- +3 SET $PIECE(BDMCUML(70),U,(V+2))=$PIECE(BDMCUML(70),U,(V+2))+1
- TOBACCO ;
- +1 SET $PIECE(BDMCUML(80),U,2)=$PIECE(BDMCUML(80),U,2)+1
- +2 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
- +3 SET V1=$GET(^XTMP("BDMDM13",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
- 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^BDMDA16(BDMPD,BDM6MBD,BDMRED)
- +4 ;DIET ALONE
- IF V=1
- SET $PIECE(BDMCUML(90),U,3)=$PIECE(BDMCUML(90),U,3)+1
- GOTO ASPIRIN
- +5 ;I V="R" S $P(BDMCUML(90),U,16)=$P(BDMCUML(90),U,16)+1 G ASPIRIN ;REFUSAL
- +6 FOR I=1:1
- SET Q=$PIECE(V,U,I)
- IF Q=""!(Q["|")
- QUIT
- Begin DoDot:1
- +7 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,1:"")
- SET $PIECE(BDMCUML(90),U,P)=$PIECE(BDMCUML(90),U,P)+1
- End DoDot:1
- +8 ;total number
- SET I=$PIECE(V,"|||",2)
- +9 IF I=1
- SET $PIECE(BDMCUML(90),U,17)=$PIECE(BDMCUML(90),U,17)+1
- GOTO ASPIRIN
- +10 IF I=2
- SET $PIECE(BDMCUML(90),U,18)=$PIECE(BDMCUML(90),U,18)+1
- GOTO ASPIRIN
- +11 ;
- IF I=3
- SET $PIECE(BDMCUML(90),U,19)=$PIECE(BDMCUML(90),U,19)+1
- +12 IF I>3
- SET $PIECE(BDMCUML(90),U,20)=$PIECE(BDMCUML(90),U,20)+1
- +13 ;
- 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("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))'=1
- GOTO ACE
- +6 ;total with cvd
- SET $PIECE(BDMCUML(100),U,2)=$PIECE(BDMCUML(100),U,2)+1
- +7 SET V=$GET(^XTMP("BDMDM13",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
- ACE ;110 title^total pts^total pts with protein^# of those on ace^# with htn^# of those on ace"
- +1 SET $PIECE(BDMCUML(110),U,2)=$PIECE(BDMCUML(110),U,2)+1
- +2 ;set 3rd piece with # with proteinuria
- +3 ;URINE PROTEIN VALUE
- SET P=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))
- +4 SET H=$EXTRACT($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,34)))
- +5 SET A=$EXTRACT($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,60)))
- +6 ;TOTAL ACE
- IF A
- SET $PIECE(BDMCUML(110),U,3)=$PIECE(BDMCUML(110),U,3)+1
- +7 ;TOTAL HTN
- IF $EXTRACT(H)=1
- SET $PIECE(BDMCUML(110),U,5)=$PIECE(BDMCUML(110),U,5)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,7)=$PIECE(BDMCUML(110),U,7)+1
- +8 ;THIS IS THE A/C RATIO, COUNT ANYTHING GREATER THAN 29.999999
- IF $PIECE(P,U,5)=1
- SET V=$PIECE(P,U,2)
- Begin DoDot:1
- +9 IF V["<"
- QUIT
- +10 ;this would be the >300 value
- IF V[">"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +11 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- +12 ;this would be the 30-300 value
- IF V["-"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +13 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- +14 ;this would be the 30-300 value
- IF V["300"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +15 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- +16 SET V=$$STV^BDMDA18(V,8)
- +17 ;this would cover numeric values
- IF V>29.999999
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:1
- +18 ;THIS IS THE PCR COUNT ANYTHING GREATER THAN 0.2
- IF $PIECE(P,U,5)=2
- SET V=$PIECE(P,U,2)
- Begin DoDot:1
- +19 SET V=$$STV^BDMDA18(V,5,1)
- +20 IF V>0.2
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +21 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- End DoDot:1
- +22 ;this is the 24 hour urine protein
- IF $PIECE(P,U,5)=3
- SET V=$PIECE(P,U,2)
- Begin DoDot:1
- +23 IF V["<"
- QUIT
- +24 SET V=$$STV^BDMDA18(V,5,1)
- +25 IF V>300
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +26 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- End DoDot:1
- +27 ;this is the micro strips with a 30-300 value
- IF $PIECE(P,U,5)=4
- SET V=$PIECE(P,U,2)
- Begin DoDot:1
- +28 IF V["<"
- QUIT
- +29 ;this would be the >300 value
- IF V[">"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +30 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- +31 ;this would be the 30-300 value
- IF V["-"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +32 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- +33 ;this would be the 30-300 value
- IF V["300"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- Begin DoDot:2
- +34 IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:2
- QUIT
- +35 SET V=$$STV^BDMDA18(V,8)
- +36 ;this would cover numeric values
- IF V>29.999999
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:1
- +37 ;this is the micral, use anything >=20 (not less than 20)
- IF $PIECE(P,U,5)=5
- SET V=$PIECE(P,U,2)
- Begin DoDot:1
- +38 SET V=$$STV^BDMDA18(V,8,2)
- +39 IF V
- IF V'<20
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:1
- +40 ;this is the urine dipstick, count anything 1+ or above
- IF $PIECE(P,U,5)=6
- SET V=$PIECE(P,U,2)
- Begin DoDot:1
- +41 IF V["+"!(V[">")!($EXTRACT(V)="p")!($EXTRACT(V)="P")
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- +42 IF $EXTRACT($$UP^XLFSTR(V))="S"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- +43 IF $EXTRACT($$UP^XLFSTR(V))="M"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- +44 IF $EXTRACT($$UP^XLFSTR(V))="L"
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- +45 IF +V>29
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- IF A=1
- SET $PIECE(BDMCUML(110),U,8)=$PIECE(BDMCUML(110),U,8)+1
- QUIT
- End DoDot:1
- 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 C=0
- +6 IF $EXTRACT($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))=1
- SET C=1
- SET $PIECE(BDMCUML(115),U,16)=$PIECE(BDMCUML(115),U,16)+1
- +7 SET V=$$STATIN^BDMDA16(BDMPD,BDM6M,BDMADAT)
- +8 IF V]""
- SET BDMLPC=BDMLPC+1
- SET $PIECE(BDMCUML(115),U,6)=$PIECE(BDMCUML(115),U,6)+1
- IF C
- SET $PIECE(BDMCUML(115),U,17)=$PIECE(BDMCUML(115),U,17)+1
- +9 SET V=$$FIBRATE^BDMDA16(BDMPD,BDM6M,BDMADAT)
- +10 IF V]""
- SET BDMLPC=BDMLPC+1
- SET $PIECE(BDMCUML(115),U,7)=$PIECE(BDMCUML(115),U,7)+1
- +11 SET V=$$NIACIN^BDMDA16(BDMPD,BDM6M,BDMADAT)
- +12 IF V]""
- SET BDMLPC=BDMLPC+1
- SET $PIECE(BDMCUML(115),U,8)=$PIECE(BDMCUML(115),U,8)+1
- +13 SET V=$$BILE^BDMDA16(BDMPD,BDM6M,BDMADAT)
- +14 IF V]""
- SET BDMLPC=BDMLPC+1
- SET $PIECE(BDMCUML(115),U,9)=$PIECE(BDMCUML(115),U,9)+1
- +15 SET V=$$EZET^BDMDA16(BDMPD,BDM6M,BDMADAT)
- +16 IF V]""
- SET BDMLPC=BDMLPC+1
- SET $PIECE(BDMCUML(115),U,10)=$PIECE(BDMCUML(115),U,10)+1
- +17 SET V=$$FISHOIL^BDMDA16(BDMPD,BDM6M,BDMADAT)
- +18 IF V]""
- SET BDMLPC=BDMLPC+1
- SET $PIECE(BDMCUML(115),U,11)=$PIECE(BDMCUML(115),U,11)+1
- +19 SET V=$$LOVAZA^BDMDA16(BDMPD,BDM6M,BDMADAT)
- +20 IF V]""
- SET BDMLPC=BDMLPC+1
- SET $PIECE(BDMCUML(115),U,12)=$PIECE(BDMCUML(115),U,12)+1
- +21 IF BDMLPC=0
- SET $PIECE(BDMCUML(115),U,5)=$PIECE(BDMCUML(115),U,5)+1
- +22 IF BDMLPC=1
- SET $PIECE(BDMCUML(115),U,3)=$PIECE(BDMCUML(115),U,3)+1
- SET $PIECE(BDMCUML(115),U,13)=$PIECE(BDMCUML(115),U,13)+1
- +23 IF BDMLPC>1
- SET $PIECE(BDMCUML(115),U,4)=$PIECE(BDMCUML(115),U,4)+1
- SET $PIECE(BDMCUML(115),U,13)=$PIECE(BDMCUML(115),U,13)+1
- LIPID ;115
- +1 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,61))
- +2 SET L=$$LDL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
- SET L=$PIECE(L,U)
- +3 SET T=$$CHOL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
- SET T=$PIECE(T,U)
- +4 SET T=$$STV^BDMDA18(T,5,1)
- +5 SET L=$$STV^BDMDA18(L,5,1)
- DEP ;
- +1 SET $PIECE(BDMCUML(300),U,2)=$PIECE(BDMCUML(300),U,2)+1
- +2 SET V=$GET(^XTMP("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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("BDMDM13",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 ^BDMDA11
- +16 QUIT
- SYSMEAN(P,BDATE,EDATE) ;EP
- +1 NEW X,Z,C,Y
- +2 SET X=$$BPS^BDMDA13(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^BDMDA13(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