Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDMD815

BDMD815.m

Go to the documentation of this file.
  1. BDMD815 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
  1. ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
  1. ;
  1. ;
  1. CUML ;EP
  1. K BDMCUML
  1. S BDMCUML(10)="Gender"
  1. S BDMCUML(20)="Age"
  1. S BDMCUML(25)="Diabetes Type"
  1. S BDMCUML(30)="Duration of Diabetes"
  1. S BDMCUML(40)="Weight Control (BMI)"
  1. S BDMCUML(50)="Blood Sugar Control - uses last HGB A1C value"
  1. S BDMCUML(70)="Tuberculosis Status"
  1. S BDMCUML(60)="Blood Pressure Control - based on mean of last 3 bp's"
  1. S BDMCUML(80)="Tobacco use"
  1. S BDMCUML(90)="DIABETES TREATMENT"
  1. S BDMCUML(100)="ANTIPLATELET THERAPY"
  1. S BDMCUML(110)="ACE INHIBITOR (OR ARB) USE"
  1. S BDMCUML(115)="LIPID LOWERING AGENT USE"
  1. S BDMCUML(300)="Depression on Problem List or as POVs"
  1. S BDMCUML(301)="Depression Screening?"
  1. ;
  1. PROCESS ;
  1. S BDMPD=0 F S BDMPD=$O(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD D CUML1
  1. Q
  1. ;
  1. CUML1 ;
  1. GENDER ;
  1. ;gender BDMCUML(10)="Gender^total^females^males"
  1. S $P(BDMCUML(10),U,2)=$P(BDMCUML(10),U,2)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,20))
  1. S P=$S($E(V)="F":3,$E(V)="M":4,1:5)
  1. S $P(BDMCUML(10),U,P)=$P(BDMCUML(10),U,P)+1
  1. AGE ;
  1. S V=$$AGE^AUPNPAT(BDMPD,BDMADAT)
  1. ;BDMCUML(20)="Age^total^<15^15-44^45-64^>65^unknown"
  1. S $P(BDMCUML(20),U,2)=$P(BDMCUML(20),U,2)+1
  1. S P=$S(V<15:3,V>14&(V<45):4,V>44&(V<65):5,V>64:6,1:7)
  1. S $P(BDMCUML(20),U,P)=$P(BDMCUML(20),U,P)+1
  1. TYPE ;
  1. ;BDMCUML(25)="Total^Type 1^Type 2"
  1. S X=$$TYPE^BDMD816(BDMPD,BDMDMRG,BDMADAT)
  1. S $P(BDMCUML(25),U,2)=$P(BDMCUML(25),U,2)+1
  1. S P=$S(X="":5,X=1:3,X=2:4,1:5)
  1. S $P(BDMCUML(25),U,P)=$P(BDMCUML(25),U,P)+1
  1. DURDMC ;
  1. ;BDMCUML(30)="Duration of Diabetes^total^<10^10 or more^do date of dx on problem list or cms register"
  1. S $P(BDMCUML(30),U,2)=$P(BDMCUML(30),U,2)+1
  1. S V=$$DURDM^BDMD814(BDMPD,BDMDMRG,BDMADAT)
  1. S P=$S(V="":5,V<10:3,V>9:4,1:5)
  1. S $P(BDMCUML(30),U,P)=$P(BDMCUML(30),U,P)+1
  1. BMI ;
  1. ;BDMCUML(40)="Weight Control (BMI) - does not add up to 100%^total^total^overweight^obese^height or weight missing"
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,112))
  1. S $P(BDMCUML(40),U,2)=$P(BDMCUML(40),U,2)+1
  1. D
  1. .I V="" S $P(BDMCUML(40),U,5)=$P(BDMCUML(40),U,5)+1 Q
  1. .I $$OW^BDMD814(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,3)=$P(BDMCUML(40),U,3)+1 Q
  1. .I $$OB^BDMD814(BDMPD,V,BDMADAT) S $P(BDMCUML(40),U,4)=$P(BDMCUML(40),U,4)+1 Q
  1. .S $P(BDMCUML(40),U,6)=$P(BDMCUML(40),U,6)+1 Q
  1. HGB ;
  1. ;use last hgba1c value only
  1. ;BDMCUML(50)=
  1. S $P(BDMCUML(50),U,2)=$P(BDMCUML(50),U,2)+1
  1. S V=$P($G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,78)),U)
  1. ;S V=$$STV^BDMD818(V,4)
  1. 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)
  1. S $P(BDMCUML(50),U,P)=$P(BDMCUML(50),U,P)+1
  1. BPC ;blood pressure control
  1. ;take last 3 bp's and get mean systolic and mean diastolic
  1. S $P(BDMCUML(60),U,2)=$P(BDMCUML(60),U,2)+1
  1. S S=$$SYSMEAN(BDMPD,BDMRBD,BDMRED)
  1. S D=$$DIAMEAN(BDMPD,BDMRBD,BDMRED)
  1. D
  1. .I S=""!(D="") S $P(BDMCUML(60),U,8)=$P(BDMCUML(60),U,8)+1 Q
  1. .I S<120&(D<70) S $P(BDMCUML(60),U,3)=$P(BDMCUML(60),U,3)+1 Q
  1. .I S<130&(D<80) S $P(BDMCUML(60),U,4)=$P(BDMCUML(60),U,4)+1 Q
  1. .I S<140&(D<90) S $P(BDMCUML(60),U,5)=$P(BDMCUML(60),U,5)+1 Q
  1. .I S<160&(D<95) S $P(BDMCUML(60),U,6)=$P(BDMCUML(60),U,6)+1 Q
  1. .S $P(BDMCUML(60),U,7)=$P(BDMCUML(60),U,7)+1
  1. TBSTAT ;
  1. S $P(BDMCUML(70),U,2)=$P(BDMCUML(70),U,2)+1
  1. S V=$$TBCODE^BDMD816(BDMPD,BDMRED,BDMDMRG)
  1. S $P(BDMCUML(70),U,(V+2))=$P(BDMCUML(70),U,(V+2))+1
  1. TOBACCO ;
  1. S $P(BDMCUML(80),U,2)=$P(BDMCUML(80),U,2)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
  1. S V1=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,28))
  1. 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
  1. I +V=2 S $P(BDMCUML(80),U,6)=$P(BDMCUML(80),U,6)+1
  1. I +V=3 S $P(BDMCUML(80),U,7)=$P(BDMCUML(80),U,7)+1
  1. DMTX ;diabetes treatment
  1. S BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31)),BDM6MBD=$$FMTE^XLFDT(BDM6MBD)
  1. S $P(BDMCUML(90),U,2)=$P(BDMCUML(90),U,2)+1
  1. S V=$$THERAPY^BDMD816(BDMPD,BDM6MBD,BDMRED)
  1. I V=1 S $P(BDMCUML(90),U,3)=$P(BDMCUML(90),U,3)+1
  1. I V=9 S $P(BDMCUML(90),U,11)=$P(BDMCUML(90),U,11)+1
  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
  1. ;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
  1. N I
  1. F I=1:1:$L(V) D
  1. . N Q
  1. . S Q=$E(V,I,I)
  1. . 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
  1. I $L(V)>1,V["2" S $P(BDMCUML(90),U,10)=$P(BDMCUML(90),U,10)+1
  1. I $L(V)>1,V'[2 S $P(BDMCUML(90),U,9)=$P(BDMCUML(90),U,9)+1
  1. ASPIRIN ;
  1. ;only tally if patient is 30 and older
  1. G ACE:$$AGE^AUPNPAT(BDMPD,BDMADAT)<30
  1. S $P(BDMCUML(100),U,2)=$P(BDMCUML(100),U,2)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
  1. S P=$S($E(V)="A":3,$E(V)="R":7,$E(V)="N":6,1:6)
  1. S $P(BDMCUML(100),U,P)=$P(BDMCUML(100),U,P)+1
  1. ACE ;110 title^total pts^total pts with protein^# of those on ace^# with htn^# of those on ace"
  1. S $P(BDMCUML(110),U,2)=$P(BDMCUML(110),U,2)+1
  1. ;set 3rd piece with # with proteinuria
  1. S P=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,91)) ;01/09/08
  1. ;S P=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,94))
  1. S H=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,34))
  1. S A=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,60))
  1. 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
  1. 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
  1. ;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
  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
  1. LIPID ;115
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,61))
  1. S L=$$LDL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I"),L=$P(L,U)
  1. S T=$$CHOL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I"),T=$P(T,U)
  1. 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
  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
  1. ;lipid agents
  1. ;7 - all w/agent 8 - all with statin only 9 - all with non-statin 10 - both.fx
  1. I "SOB"[$E(V) S $P(BDMCUML(115),U,7)=$P(BDMCUML(115),U,7)+1
  1. I $E(V)="S" S $P(BDMCUML(115),U,8)=$P(BDMCUML(115),U,8)+1
  1. I $E(V)="O" S $P(BDMCUML(115),U,9)=$P(BDMCUML(115),U,9)+1
  1. I $E(V)="B" S $P(BDMCUML(115),U,10)=$P(BDMCUML(115),U,10)+1
  1. I $E(V)="R" S $P(BDMCUML(115),U,11)=$P(BDMCUML(115),U,11)+1
  1. DEP ;
  1. S $P(BDMCUML(300),U,2)=$P(BDMCUML(300),U,2)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
  1. I $E(V)="Y" S $P(BDMCUML(300),U,3)=$P(BDMCUML(300),U,3)+1
  1. I $E(V)'="Y" S $P(BDMCUML(301),U,2)=$P(BDMCUML(301),U,2)+1 D
  1. .S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,210))
  1. .I $E(V)="Y" S $P(BDMCUML(301),U,3)=$P(BDMCUML(301),U,3)+1
  1. .I $E(V)="N" S $P(BDMCUML(301),U,4)=$P(BDMCUML(301),U,4)+1
  1. .I $E(V)="R" S $P(BDMCUML(301),U,5)=$P(BDMCUML(301),U,5)+1
  1. EXAMS ;
  1. S:'$D(BDMCUML(120)) BDMCUML(120)="EXAMS - Yearly"
  1. S $P(BDMCUML(120),U,2)=$P(BDMCUML(120),U,2)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,38))
  1. I $E(V)="Y" S $P(BDMCUML(120),U,3)=$P(BDMCUML(120),U,3)+1
  1. I $E(V)="R" S $P(BDMCUML(120),U,6)=$P(BDMCUML(120),U,6)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,40))
  1. I $E(V)="Y" S $P(BDMCUML(120),U,4)=$P(BDMCUML(120),U,4)+1
  1. I $E(V)="R" S $P(BDMCUML(120),U,7)=$P(BDMCUML(120),U,7)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,42))
  1. I $E(V)="Y" S $P(BDMCUML(120),U,5)=$P(BDMCUML(120),U,5)+1
  1. I $E(V)="R" S $P(BDMCUML(120),U,8)=$P(BDMCUML(120),U,8)+1
  1. I $P(^DPT(BDMPD,0),U,2)="F" S $P(BDMCUML(120),U,9)=$P(BDMCUML(120),U,9)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,108))
  1. I $E(V)="Y" S $P(BDMCUML(120),U,10)=$P(BDMCUML(120),U,10)+1
  1. I $E(V)="R" S $P(BDMCUML(120),U,11)=$P(BDMCUML(120),U,11)+1
  1. EDUC ;
  1. S:'$D(BDMCUML(130)) BDMCUML(130)="DIABETES-RELATED EDUCATION - Yearly"
  1. S $P(BDMCUML(130),U,2)=$P(BDMCUML(130),U,2)+1
  1. S G=0,V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
  1. I $E(V)="Y" S $P(BDMCUML(130),U,3)=$P(BDMCUML(130),U,3)+1 S G=1
  1. I $E(V)="R" S $P(BDMCUML(130),U,7)=$P(BDMCUML(130),U,7)+1
  1. I $G(V)="Yes (RD)" S $P(BDMCUML(130),U,10)=$P(BDMCUML(130),U,10)+1 S G=1
  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
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
  1. I $E(V)="Y" S $P(BDMCUML(130),U,4)=$P(BDMCUML(130),U,4)+1 S G=1
  1. I $E(V)="R" S $P(BDMCUML(130),U,8)=$P(BDMCUML(130),U,8)+1
  1. S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,48))
  1. I $E(V)="R" S $P(BDMCUML(130),U,9)=$P(BDMCUML(130),U,9)+1
  1. I $E(V)="Y" S $P(BDMCUML(130),U,5)=$P(BDMCUML(130),U,5)+1 S G=1
  1. I G S $P(BDMCUML(130),U,6)=$P(BDMCUML(130),U,6)+1
  1. D ^BDMD811
  1. Q
  1. SYSMEAN(P,BDATE,EDATE) ;EP
  1. NEW X S X=$$BPS^BDMD813(P,BDATE,EDATE,"I")
  1. I X="" Q ""
  1. NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1. I C'=3 Q ""
  1. S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/")+C
  1. Q C\3
  1. Q ""
  1. DIAMEAN(P,BDATE,EDATE) ;EP
  1. NEW X S X=$$BPS^BDMD813(P,BDATE,EDATE,"I")
  1. I X="" Q ""
  1. NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1. I C'=3 Q ""
  1. S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/",2)+C
  1. Q C\3