- BDMD815 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
- ;
- ;
- 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 - uses last HGB A1C value"
- S BDMCUML(70)="Tuberculosis Status"
- S BDMCUML(60)="Blood Pressure Control - based on mean of last 3 bp's"
- 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?"
- ;
- PROCESS ;
- S BDMPD=0 F S BDMPD=$O(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD D CUML1
- Q
- ;
- CUML1 ;
- GENDER ;
- ;gender BDMCUML(10)="Gender^total^females^males"
- S $P(BDMCUML(10),U,2)=$P(BDMCUML(10),U,2)+1
- S V=$G(^XTMP("BDMDM81",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^BDMD816(BDMPD,BDMDMRG,BDMADAT)
- S $P(BDMCUML(25),U,2)=$P(BDMCUML(25),U,2)+1
- S P=$S(X="":5,X=1:3,X=2:4,1:5)
- S $P(BDMCUML(25),U,P)=$P(BDMCUML(25),U,P)+1
- DURDMC ;
- ;BDMCUML(30)="Duration of Diabetes^total^<10^10 or more^do date of dx on problem list or cms register"
- S $P(BDMCUML(30),U,2)=$P(BDMCUML(30),U,2)+1
- S V=$$DURDM^BDMD814(BDMPD,BDMDMRG,BDMADAT)
- S P=$S(V="":5,V<10:3,V>9:4,1:5)
- S $P(BDMCUML(30),U,P)=$P(BDMCUML(30),U,P)+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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,112))
- 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^BDMD814(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,3)=$P(BDMCUML(40),U,3)+1 Q
- .I $$OB^BDMD814(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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,78)),U)
- ;S V=$$STV^BDMD818(V,4)
- S P=$S(V="":9,V[">":8,$E(V)'=+$E(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)
- 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^BDMD816(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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
- S V1=$G(^XTMP("BDMDM81",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)="Y":4,$E(V1)="N":5,1:5) S $P(BDMCUML(80),U,P)=$P(BDMCUML(80),U,P)+1
- I +V=2 S $P(BDMCUML(80),U,6)=$P(BDMCUML(80),U,6)+1
- I +V=3 S $P(BDMCUML(80),U,7)=$P(BDMCUML(80),U,7)+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^BDMD816(BDMPD,BDM6MBD,BDMRED)
- I V=1 S $P(BDMCUML(90),U,3)=$P(BDMCUML(90),U,3)+1
- I V=9 S $P(BDMCUML(90),U,11)=$P(BDMCUML(90),U,11)+1
- ;I $L(V)=1 S P=$S(V=2:4,V=3:5,V=4:6,V=5:7,V=6:8,1:"") S $P(BDMCUML(90),U,P)=$P(BDMCUML(90),U,P)+1 ;cmi/maw 12/26/2007 orig line
- ;I $L(V)=1 S P=$S(V=2:4,V=3:5,V=4:6,V=5:7,V=6:8,V=7:12,V=8:13,1:"") S $P(BDMCUML(90),U,P)=$P(BDMCUML(90),U,P)+1 ;cmi/maw 12/26/2007 DM2008
- N I
- F I=1:1:$L(V) D
- . N Q
- . S Q=$E(V,I,I)
- . S P=$S(Q=2:4,Q=3:5,Q=4:6,Q=5:7,Q=6:8,Q=7:13,Q=8:12,1:"") S $P(BDMCUML(90),U,P)=$P(BDMCUML(90),U,P)+1 ;cmi/maw 4/2/2008 modified for incretin/dpp4 per gary
- I $L(V)>1,V["2" S $P(BDMCUML(90),U,10)=$P(BDMCUML(90),U,10)+1
- I $L(V)>1,V'[2 S $P(BDMCUML(90),U,9)=$P(BDMCUML(90),U,9)+1
- ASPIRIN ;
- ;only tally if patient is 30 and older
- G ACE:$$AGE^AUPNPAT(BDMPD,BDMADAT)<30
- S $P(BDMCUML(100),U,2)=$P(BDMCUML(100),U,2)+1
- S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
- S P=$S($E(V)="A":3,$E(V)="R":7,$E(V)="N":6,1:6)
- 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,91)) ;01/09/08
- ;S P=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,94))
- S H=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,34))
- S A=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,60))
- I $P(P,U,2)[">" S $P(P,U,2)=300 ;cmi/maw 3/26/2008 convert to 300 if it contains a > signaling overt
- I $E(P)]"",$P(P,U,2)>299.9 S $P(BDMCUML(110),U,3)=$P(BDMCUML(110),U,3)+1 I $E(A)="Y",+$P(P,U,2)>299.9 S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1 ;01/09/08
- ;I $E(P)="Y" S $P(BDMCUML(110),U,3)=$P(BDMCUML(110),U,3)+1 I $E(A)="Y" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1
- I $E(H)="Y" S $P(BDMCUML(110),U,5)=$P(BDMCUML(110),U,5)+1 I $E(A)="Y" S $P(BDMCUML(110),U,6)=$P(BDMCUML(110),U,6)+1
- LIPID ;115
- S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,61))
- S L=$$LDL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I"),L=$P(L,U)
- S T=$$CHOL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I"),T=$P(T,U)
- I T]"",T'<240 S $P(BDMCUML(115),U,3)=$P(BDMCUML(115),U,3)+1 I "SOB"[$E(V) S $P(BDMCUML(115),U,4)=$P(BDMCUML(115),U,4)+1
- I L]"",L>100 S $P(BDMCUML(115),U,5)=$P(BDMCUML(115),U,5)+1 I "SOB"[$E(V) S $P(BDMCUML(115),U,6)=$P(BDMCUML(115),U,6)+1
- ;lipid agents
- ;7 - all w/agent 8 - all with statin only 9 - all with non-statin 10 - both.fx
- I "SOB"[$E(V) S $P(BDMCUML(115),U,7)=$P(BDMCUML(115),U,7)+1
- I $E(V)="S" S $P(BDMCUML(115),U,8)=$P(BDMCUML(115),U,8)+1
- I $E(V)="O" S $P(BDMCUML(115),U,9)=$P(BDMCUML(115),U,9)+1
- I $E(V)="B" S $P(BDMCUML(115),U,10)=$P(BDMCUML(115),U,10)+1
- I $E(V)="R" S $P(BDMCUML(115),U,11)=$P(BDMCUML(115),U,11)+1
- DEP ;
- S $P(BDMCUML(300),U,2)=$P(BDMCUML(300),U,2)+1
- S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
- I $E(V)="Y" S $P(BDMCUML(300),U,3)=$P(BDMCUML(300),U,3)+1
- I $E(V)'="Y" S $P(BDMCUML(301),U,2)=$P(BDMCUML(301),U,2)+1 D
- .S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,210))
- .I $E(V)="Y" S $P(BDMCUML(301),U,3)=$P(BDMCUML(301),U,3)+1
- .I $E(V)="N" S $P(BDMCUML(301),U,4)=$P(BDMCUML(301),U,4)+1
- .I $E(V)="R" 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,38))
- I $E(V)="Y" S $P(BDMCUML(120),U,3)=$P(BDMCUML(120),U,3)+1
- I $E(V)="R" S $P(BDMCUML(120),U,6)=$P(BDMCUML(120),U,6)+1
- S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,40))
- I $E(V)="Y" S $P(BDMCUML(120),U,4)=$P(BDMCUML(120),U,4)+1
- I $E(V)="R" S $P(BDMCUML(120),U,7)=$P(BDMCUML(120),U,7)+1
- S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,42))
- I $E(V)="Y" S $P(BDMCUML(120),U,5)=$P(BDMCUML(120),U,5)+1
- I $E(V)="R" 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,108))
- I $E(V)="Y" S $P(BDMCUML(120),U,10)=$P(BDMCUML(120),U,10)+1
- I $E(V)="R" 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
- I $E(V)="Y" S $P(BDMCUML(130),U,3)=$P(BDMCUML(130),U,3)+1 S G=1
- I $E(V)="R" S $P(BDMCUML(130),U,7)=$P(BDMCUML(130),U,7)+1
- I $G(V)="Yes (RD)" S $P(BDMCUML(130),U,10)=$P(BDMCUML(130),U,10)+1 S G=1
- I $G(V)="Yes (RD & Non RD - Other)" S $P(BDMCUML(130),U,10)=$P(BDMCUML(130),U,10)+1 S G=1 ;cmi/maw 1/15/08
- S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
- I $E(V)="Y" S $P(BDMCUML(130),U,4)=$P(BDMCUML(130),U,4)+1 S G=1
- I $E(V)="R" S $P(BDMCUML(130),U,8)=$P(BDMCUML(130),U,8)+1
- S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,48))
- I $E(V)="R" S $P(BDMCUML(130),U,9)=$P(BDMCUML(130),U,9)+1
- I $E(V)="Y" 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 ^BDMD811
- Q
- SYSMEAN(P,BDATE,EDATE) ;EP
- NEW X S X=$$BPS^BDMD813(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'=3 Q ""
- S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/")+C
- Q C\3
- Q ""
- DIAMEAN(P,BDATE,EDATE) ;EP
- NEW X S X=$$BPS^BDMD813(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'=3 Q ""
- S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/",2)+C
- Q C\3
- BDMD815 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
- +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 - uses last HGB A1C value"
- +8 SET BDMCUML(70)="Tuberculosis Status"
- +9 SET BDMCUML(60)="Blood Pressure Control - based on mean of last 3 bp's"
- +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 ;
- PROCESS ;
- +1 SET BDMPD=0
- FOR
- SET BDMPD=$ORDER(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD))
- IF BDMPD'=+BDMPD
- QUIT
- DO CUML1
- +2 QUIT
- +3 ;
- CUML1 ;
- GENDER ;
- +1 ;gender BDMCUML(10)="Gender^total^females^males"
- +2 SET $PIECE(BDMCUML(10),U,2)=$PIECE(BDMCUML(10),U,2)+1
- +3 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,20))
- +4 SET P=$SELECT($EXTRACT(V)="F":3,$EXTRACT(V)="M":4,1:5)
- +5 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^BDMD816(BDMPD,BDMDMRG,BDMADAT)
- +3 SET $PIECE(BDMCUML(25),U,2)=$PIECE(BDMCUML(25),U,2)+1
- +4 SET P=$SELECT(X="":5,X=1:3,X=2:4,1:5)
- +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^do date of dx on problem list or cms register"
- +2 SET $PIECE(BDMCUML(30),U,2)=$PIECE(BDMCUML(30),U,2)+1
- +3 SET V=$$DURDM^BDMD814(BDMPD,BDMDMRG,BDMADAT)
- +4 SET P=$SELECT(V="":5,V<10:3,V>9:4,1:5)
- +5 SET $PIECE(BDMCUML(30),U,P)=$PIECE(BDMCUML(30),U,P)+1
- BMI ;
- +1 ;BDMCUML(40)="Weight Control (BMI) - does not add up to 100%^total^total^overweight^obese^height or weight missing"
- +2 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,112))
- +3 SET $PIECE(BDMCUML(40),U,2)=$PIECE(BDMCUML(40),U,2)+1
- +4 Begin DoDot:1
- +5 IF V=""
- SET $PIECE(BDMCUML(40),U,5)=$PIECE(BDMCUML(40),U,5)+1
- QUIT
- +6 IF $$OW^BDMD814(BDMPD,V,BDMADAT)
- SET $PIECE(BDMCUML(40),U,3)=$PIECE(BDMCUML(40),U,3)+1
- QUIT
- +7 IF $$OB^BDMD814(BDMPD,V,BDMADAT)
- SET $PIECE(BDMCUML(40),U,4)=$PIECE(BDMCUML(40),U,4)+1
- QUIT
- +8 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,78)),U)
- +5 ;S V=$$STV^BDMD818(V,4)
- +6 SET P=$SELECT(V="":9,V[">":8,$EXTRACT(V)'=+$EXTRACT(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)
- +7 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^BDMD816(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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
- +3 SET V1=$GET(^XTMP("BDMDM81",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)="Y":4,$EXTRACT(V1)="N":5,1:5)
- SET $PIECE(BDMCUML(80),U,P)=$PIECE(BDMCUML(80),U,P)+1
- +5 IF +V=2
- SET $PIECE(BDMCUML(80),U,6)=$PIECE(BDMCUML(80),U,6)+1
- +6 IF +V=3
- SET $PIECE(BDMCUML(80),U,7)=$PIECE(BDMCUML(80),U,7)+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 SET V=$$THERAPY^BDMD816(BDMPD,BDM6MBD,BDMRED)
- +4 IF V=1
- SET $PIECE(BDMCUML(90),U,3)=$PIECE(BDMCUML(90),U,3)+1
- +5 IF V=9
- SET $PIECE(BDMCUML(90),U,11)=$PIECE(BDMCUML(90),U,11)+1
- +6 ;I $L(V)=1 S P=$S(V=2:4,V=3:5,V=4:6,V=5:7,V=6:8,1:"") S $P(BDMCUML(90),U,P)=$P(BDMCUML(90),U,P)+1 ;cmi/maw 12/26/2007 orig line
- +7 ;I $L(V)=1 S P=$S(V=2:4,V=3:5,V=4:6,V=5:7,V=6:8,V=7:12,V=8:13,1:"") S $P(BDMCUML(90),U,P)=$P(BDMCUML(90),U,P)+1 ;cmi/maw 12/26/2007 DM2008
- +8 NEW I
- +9 FOR I=1:1:$LENGTH(V)
- Begin DoDot:1
- +10 NEW Q
- +11 SET Q=$EXTRACT(V,I,I)
- +12 ;cmi/maw 4/2/2008 modified for incretin/dpp4 per gary
- SET P=$SELECT(Q=2:4,Q=3:5,Q=4:6,Q=5:7,Q=6:8,Q=7:13,Q=8:12,1:"")
- SET $PIECE(BDMCUML(90),U,P)=$PIECE(BDMCUML(90),U,P)+1
- End DoDot:1
- +13 IF $LENGTH(V)>1
- IF V["2"
- SET $PIECE(BDMCUML(90),U,10)=$PIECE(BDMCUML(90),U,10)+1
- +14 IF $LENGTH(V)>1
- IF V'[2
- SET $PIECE(BDMCUML(90),U,9)=$PIECE(BDMCUML(90),U,9)+1
- ASPIRIN ;
- +1 ;only tally if patient is 30 and older
- +2 IF $$AGE^AUPNPAT(BDMPD,BDMADAT)<30
- GOTO ACE
- +3 SET $PIECE(BDMCUML(100),U,2)=$PIECE(BDMCUML(100),U,2)+1
- +4 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
- +5 SET P=$SELECT($EXTRACT(V)="A":3,$EXTRACT(V)="R":7,$EXTRACT(V)="N":6,1:6)
- +6 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 ;01/09/08
- SET P=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,91))
- +4 ;S P=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,94))
- +5 SET H=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,34))
- +6 SET A=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,60))
- +7 ;cmi/maw 3/26/2008 convert to 300 if it contains a > signaling overt
- IF $PIECE(P,U,2)[">"
- SET $PIECE(P,U,2)=300
- +8 ;01/09/08
- IF $EXTRACT(P)]""
- IF $PIECE(P,U,2)>299.9
- SET $PIECE(BDMCUML(110),U,3)=$PIECE(BDMCUML(110),U,3)+1
- IF $EXTRACT(A)="Y"
- IF +$PIECE(P,U,2)>299.9
- SET $PIECE(BDMCUML(110),U,4)=$PIECE(BDMCUML(110),U,4)+1
- +9 ;I $E(P)="Y" S $P(BDMCUML(110),U,3)=$P(BDMCUML(110),U,3)+1 I $E(A)="Y" S $P(BDMCUML(110),U,4)=$P(BDMCUML(110),U,4)+1
- +10 IF $EXTRACT(H)="Y"
- SET $PIECE(BDMCUML(110),U,5)=$PIECE(BDMCUML(110),U,5)+1
- IF $EXTRACT(A)="Y"
- SET $PIECE(BDMCUML(110),U,6)=$PIECE(BDMCUML(110),U,6)+1
- LIPID ;115
- +1 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,61))
- +2 SET L=$$LDL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I")
- SET L=$PIECE(L,U)
- +3 SET T=$$CHOL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I")
- SET T=$PIECE(T,U)
- +4 IF T]""
- IF T'<240
- SET $PIECE(BDMCUML(115),U,3)=$PIECE(BDMCUML(115),U,3)+1
- IF "SOB"[$EXTRACT(V)
- SET $PIECE(BDMCUML(115),U,4)=$PIECE(BDMCUML(115),U,4)+1
- +5 IF L]""
- IF L>100
- SET $PIECE(BDMCUML(115),U,5)=$PIECE(BDMCUML(115),U,5)+1
- IF "SOB"[$EXTRACT(V)
- SET $PIECE(BDMCUML(115),U,6)=$PIECE(BDMCUML(115),U,6)+1
- +6 ;lipid agents
- +7 ;7 - all w/agent 8 - all with statin only 9 - all with non-statin 10 - both.fx
- +8 IF "SOB"[$EXTRACT(V)
- SET $PIECE(BDMCUML(115),U,7)=$PIECE(BDMCUML(115),U,7)+1
- +9 IF $EXTRACT(V)="S"
- SET $PIECE(BDMCUML(115),U,8)=$PIECE(BDMCUML(115),U,8)+1
- +10 IF $EXTRACT(V)="O"
- SET $PIECE(BDMCUML(115),U,9)=$PIECE(BDMCUML(115),U,9)+1
- +11 IF $EXTRACT(V)="B"
- SET $PIECE(BDMCUML(115),U,10)=$PIECE(BDMCUML(115),U,10)+1
- +12 IF $EXTRACT(V)="R"
- SET $PIECE(BDMCUML(115),U,11)=$PIECE(BDMCUML(115),U,11)+1
- DEP ;
- +1 SET $PIECE(BDMCUML(300),U,2)=$PIECE(BDMCUML(300),U,2)+1
- +2 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
- +3 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(300),U,3)=$PIECE(BDMCUML(300),U,3)+1
- +4 IF $EXTRACT(V)'="Y"
- SET $PIECE(BDMCUML(301),U,2)=$PIECE(BDMCUML(301),U,2)+1
- Begin DoDot:1
- +5 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,210))
- +6 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(301),U,3)=$PIECE(BDMCUML(301),U,3)+1
- +7 IF $EXTRACT(V)="N"
- SET $PIECE(BDMCUML(301),U,4)=$PIECE(BDMCUML(301),U,4)+1
- +8 IF $EXTRACT(V)="R"
- 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,38))
- +4 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(120),U,3)=$PIECE(BDMCUML(120),U,3)+1
- +5 IF $EXTRACT(V)="R"
- SET $PIECE(BDMCUML(120),U,6)=$PIECE(BDMCUML(120),U,6)+1
- +6 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,40))
- +7 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(120),U,4)=$PIECE(BDMCUML(120),U,4)+1
- +8 IF $EXTRACT(V)="R"
- SET $PIECE(BDMCUML(120),U,7)=$PIECE(BDMCUML(120),U,7)+1
- +9 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,42))
- +10 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(120),U,5)=$PIECE(BDMCUML(120),U,5)+1
- +11 IF $EXTRACT(V)="R"
- 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,108))
- +14 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(120),U,10)=$PIECE(BDMCUML(120),U,10)+1
- +15 IF $EXTRACT(V)="R"
- 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("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
- +4 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(130),U,3)=$PIECE(BDMCUML(130),U,3)+1
- SET G=1
- +5 IF $EXTRACT(V)="R"
- SET $PIECE(BDMCUML(130),U,7)=$PIECE(BDMCUML(130),U,7)+1
- +6 IF $GET(V)="Yes (RD)"
- SET $PIECE(BDMCUML(130),U,10)=$PIECE(BDMCUML(130),U,10)+1
- SET G=1
- +7 ;cmi/maw 1/15/08
- IF $GET(V)="Yes (RD & Non RD - Other)"
- SET $PIECE(BDMCUML(130),U,10)=$PIECE(BDMCUML(130),U,10)+1
- SET G=1
- +8 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
- +9 IF $EXTRACT(V)="Y"
- SET $PIECE(BDMCUML(130),U,4)=$PIECE(BDMCUML(130),U,4)+1
- SET G=1
- +10 IF $EXTRACT(V)="R"
- SET $PIECE(BDMCUML(130),U,8)=$PIECE(BDMCUML(130),U,8)+1
- +11 SET V=$GET(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,48))
- +12 IF $EXTRACT(V)="R"
- SET $PIECE(BDMCUML(130),U,9)=$PIECE(BDMCUML(130),U,9)+1
- +13 IF $EXTRACT(V)="Y"
- 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 ^BDMD811
- +16 QUIT
- SYSMEAN(P,BDATE,EDATE) ;EP
- +1 NEW X
- SET X=$$BPS^BDMD813(P,BDATE,EDATE,"I")
- +2 IF X=""
- QUIT ""
- +3 NEW Y,C
- SET C=0
- FOR Y=1:1:3
- IF $PIECE(X,";",Y)]""
- SET C=C+1
- +4 IF C'=3
- QUIT ""
- +5 SET C=0
- FOR Y=1:1:3
- SET C=$PIECE($PIECE(X,";",Y),"/")+C
- +6 QUIT C\3
- +7 QUIT ""
- DIAMEAN(P,BDATE,EDATE) ;EP
- +1 NEW X
- SET X=$$BPS^BDMD813(P,BDATE,EDATE,"I")
- +2 IF X=""
- QUIT ""
- +3 NEW Y,C
- SET C=0
- FOR Y=1:1:3
- IF $PIECE(X,";",Y)]""
- SET C=C+1
- +4 IF C'=3
- QUIT ""
- +5 SET C=0
- FOR Y=1:1:3
- SET C=$PIECE($PIECE(X,";",Y),"/",2)+C
- +6 QUIT C\3