APCLD995 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
CUML ;EP
K APCLCUML
S APCLPD=0 F S APCLPD=$O(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD)) Q:APCLPD'=+APCLPD D CUML1
Q
;
CUML1 ;
GENDER ;
;gender APCLCUML(10)="Gender^total^females^males"
S:'$D(APCLCUML(10)) APCLCUML(10)="Gender"
S $P(APCLCUML(10),U,2)=$P(APCLCUML(10),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,20))
S P=$S($E(V)="F":3,$E(V)="M":4,1:5)
S $P(APCLCUML(10),U,P)=$P(APCLCUML(10),U,P)+1
AGE ;
S V=$$AGE^AUPNPAT(APCLPD,APCLADAT)
;APCLCUML(20)="Age^total^<15^15-44^45-64^>65^unknown"
I '$D(APCLCUML(20)) S APCLCUML(20)="Age"
S $P(APCLCUML(20),U,2)=$P(APCLCUML(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(APCLCUML(20),U,P)=$P(APCLCUML(20),U,P)+1
DURDMC ;
;APCLCUML(30)="Duration of Diabetes^total^<10^10 or more^do date of dx on problem list or cms register"
I '$D(APCLCUML(30)) S APCLCUML(30)="Duration of Diabetes"
S $P(APCLCUML(30),U,2)=$P(APCLCUML(30),U,2)+1
S V=$$DURDM^APCLD994(APCLPD,APCLDMRG,APCLADAT,"I")
S P=$S(V="":5,V<10:3,V>9:4,1:5)
S $P(APCLCUML(30),U,P)=$P(APCLCUML(30),U,P)+1
BMI ;
;APCLCUML(40)="Weight Control (BMI) - does not add up to 100%^total^total^overweight^obese^height or weight missing"
S:'$D(APCLCUML(40)) APCLCUML(40)="Weight Control (BMI) - does not add up to 100%"
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,112))
S $P(APCLCUML(40),U,2)=$P(APCLCUML(40),U,2)+1
D
.I V="" S $P(APCLCUML(40),U,5)=$P(APCLCUML(40),U,5)+1 Q
.I $$OW^APCLD994(APCLPD,V,APCLADAT) S $P(APCLCUML(40),U,3)=$P(APCLCUML(40),U,3)+1
.I $$OB^APCLD994(APCLPD,V,APCLADAT) S $P(APCLCUML(40),U,4)=$P(APCLCUML(40),U,4)+1
HGB ;
;use last hgba1c value only
;APCLCUML(50)=
S:'$D(APCLCUML(50)) APCLCUML(50)="Blood Sugar Control - uses last HGB A1C value"
S $P(APCLCUML(50),U,2)=$P(APCLCUML(50),U,2)+1
S V=$P($G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,78)),U)
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)
S $P(APCLCUML(50),U,P)=$P(APCLCUML(50),U,P)+1
BPC ;blood pressure control
;take last 3 bp's and get mean systolic and mean diastolic
S:'$D(APCLCUML(60)) APCLCUML(60)="Blood Pressure Control - based on mean of last 3 bp's"
S $P(APCLCUML(60),U,2)=$P(APCLCUML(60),U,2)+1
S S=$$SYSMEAN(APCLPD,APCLRBD,APCLRED)
S D=$$DIAMEAN(APCLPD,APCLRBD,APCLRED)
D
.I S=""!(D="") S $P(APCLCUML(60),U,8)=$P(APCLCUML(60),U,8)+1 Q
.I S<120&(D<80) S $P(APCLCUML(60),U,3)=$P(APCLCUML(60),U,3)+1 Q
.I S<131&(D<86) S $P(APCLCUML(60),U,4)=$P(APCLCUML(60),U,4)+1 Q
.I S<141&(D<91) S $P(APCLCUML(60),U,5)=$P(APCLCUML(60),U,5)+1 Q
.I S<161&(D<96) S $P(APCLCUML(60),U,6)=$P(APCLCUML(60),U,6)+1 Q
.S $P(APCLCUML(60),U,7)=$P(APCLCUML(60),U,7)+1
TBSTAT ;
S:'$D(APCLCUML(70)) APCLCUML(70)="Tuberculosis Status"
S $P(APCLCUML(70),U,2)=$P(APCLCUML(70),U,2)+1
S V=$$TBCODE^APCLD996(APCLPD,APCLRED,APCLDMRG)
S $P(APCLCUML(70),U,(V+2))=$P(APCLCUML(70),U,(V+2))+1
TOBACCO ;
S:'$D(APCLCUML(80)) APCLCUML(80)="Tobacco use"
S $P(APCLCUML(80),U,2)=$P(APCLCUML(80),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,27))
S V1=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,28))
I +V=1 S $P(APCLCUML(80),U,3)=$P(APCLCUML(80),U,3)+1 S P=$S($E(V1)="Y":4,$E(V1)="N":5,1:5) S $P(APCLCUML(80),U,P)=$P(APCLCUML(80),U,P)+1
I +V=2 S $P(APCLCUML(80),U,6)=$P(APCLCUML(80),U,6)+1
I +V=3 S $P(APCLCUML(80),U,7)=$P(APCLCUML(80),U,7)+1
I +V=4 S $P(APCLCUML(80),U,8)=$P(APCLCUML(80),U,8)+1
DMTX ;diabetes treatment
S APCL6MBD=$$FMADD^XLFDT(APCLADAT,-(6*31)),APCL6MBD=$$FMTE^XLFDT(APCL6MBD)
S:'$D(APCLCUML(90)) APCLCUML(90)="DIABETES TREATMENT"
S $P(APCLCUML(90),U,2)=$P(APCLCUML(90),U,2)+1
S V=$$THERAPY^APCLD996(APCLPD,APCL6MBD,APCLRED)
I V=1 S $P(APCLCUML(90),U,3)=$P(APCLCUML(90),U,3)+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(APCLCUML(90),U,P)=$P(APCLCUML(90),U,P)+1
I $L(V)>1,V["2" S $P(APCLCUML(90),U,10)=$P(APCLCUML(90),U,10)+1
I $L(V)>1,V'[2 S $P(APCLCUML(90),U,9)=$P(APCLCUML(90),U,9)+1
ASPIRIN ;
S:'$D(APCLCUML(100)) APCLCUML(100)="DAILY LOW-DOSE ASPIRIN THERAPY"
S $P(APCLCUML(100),U,2)=$P(APCLCUML(100),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,62))
S P=$S($E(V)="Y":3,1:4)
S $P(APCLCUML(100),U,P)=$P(APCLCUML(100),U,P)+1
EXAMS ;
S:'$D(APCLCUML(120)) APCLCUML(120)="EXAMS - Yearly"
S $P(APCLCUML(120),U,2)=$P(APCLCUML(120),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,38))
I $E(V)="Y" S $P(APCLCUML(120),U,3)=$P(APCLCUML(120),U,3)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,40))
I $E(V)="Y" S $P(APCLCUML(120),U,4)=$P(APCLCUML(120),U,4)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,42))
I $E(V)="Y" S $P(APCLCUML(120),U,5)=$P(APCLCUML(120),U,5)+1
EDUC ;
S:'$D(APCLCUML(130)) APCLCUML(130)="DIABETES-RELATED EDUCATION - Yearly"
S $P(APCLCUML(130),U,2)=$P(APCLCUML(130),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,44))
I $E(V)'="N" S $P(APCLCUML(130),U,3)=$P(APCLCUML(130),U,3)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,46))
I $E(V)="Y" S $P(APCLCUML(130),U,4)=$P(APCLCUML(130),U,4)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,48))
I $E(V)="Y" S $P(APCLCUML(130),U,5)=$P(APCLCUML(130),U,5)+1
IMM ;
S:'$D(APCLCUML(140)) APCLCUML(140)="IMMUNIZATIONS"
S $P(APCLCUML(140),U,2)=$P(APCLCUML(140),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,64))
I $E(V)="Y" S $P(APCLCUML(140),U,3)=$P(APCLCUML(140),U,3)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,66))
I $E(V)="Y" S $P(APCLCUML(140),U,4)=$P(APCLCUML(140),U,4)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,68))
I $E(V)="Y" S $P(APCLCUML(140),U,5)=$P(APCLCUML(140),U,5)+1
EKG ;need date of last ekg
S:'$D(APCLCUML(150)) APCLCUML(150)="EKG"
S $P(APCLCUML(150),U,2)=$P(APCLCUML(150),U,2)+1
S V=$$EKG^APCLD998(APCLPD,APCLRED,"I")
I V]"" D
.S E=$$FMDIFF^XLFDT(APCLADAT,V)
.I E<(365.25*3) S $P(APCLCUML(150),U,3)=$P(APCLCUML(150),U,3)+1 Q
.I E<(365.25*5) S $P(APCLCUML(150),U,4)=$P(APCLCUML(150),U,4)+1 Q
.S $P(APCLCUML(150),U,5)=$P(APCLCUML(150),U,5)+1
CREAT ;
S:'$D(APCLCUML(170)) APCLCUML(170)="Creatinine obtained in the past 12 months"
S $P(APCLCUML(170),U,2)=$P(APCLCUML(170),U,2)+1
S V=$$CREAT^APCLD998(APCLPD,APCLRBD,APCLRED,"I"),V=$P(V,U)
I V="" S $P(APCLCUML(170),U,5)=$P(APCLCUML(170),U,5)+1 G TCHOL
I V'=+V S $P(APCLCUML(170),U,6)=$P(APCLCUML(170),U,6)+1 G TCHOL ;unable to determine result
I V>1.9 S $P(APCLCUML(170),U,3)=$P(APCLCUML(170),U,3)+1
I V<2.0 S $P(APCLCUML(170),U,4)=$P(APCLCUML(170),U,4)+1
TCHOL ;
S:'$D(APCLCUML(180)) APCLCUML(180)="Total Cholesterol obtained in past 12 months"
S $P(APCLCUML(180),U,2)=$P(APCLCUML(180),U,2)+1
S V=$$CHOL^APCLD998(APCLPD,APCLRBD,APCLRED,"I"),V=$P(V,U)
I V="" S $P(APCLCUML(180),U,6)=$P(APCLCUML(180),U,6)+1 G LDL
I V'=+V S $P(APCLCUML(180),U,7)=$P(APCLCUML(180),U,7)+1 G LDL ;unable to determine result
I V<200 S $P(APCLCUML(180),U,3)=$P(APCLCUML(180),U,3)+1
I V<240&(V>199) S $P(APCLCUML(180),U,4)=$P(APCLCUML(180),U,4)+1
I V>239 S $P(APCLCUML(180),U,5)=$P(APCLCUML(180),U,5)+1
LDL ;
S:'$D(APCLCUML(190)) APCLCUML(190)="LDL Cholesterol obtained in the past 12 months"
S $P(APCLCUML(190),U,2)=$P(APCLCUML(190),U,2)+1
S V=$$LDL^APCLD998(APCLPD,APCLRBD,APCLRED,"I"),V=$P(V,U)
I V="" S $P(APCLCUML(190),U,7)=$P(APCLCUML(190),U,7)+1 G TRIG
I V'=+V S $P(APCLCUML(190),U,8)=$P(APCLCUML(190),U,8)+1 G TRIG ;unable to determine result
I V<100 S $P(APCLCUML(190),U,3)=$P(APCLCUML(190),U,3)+1
I V<130&(V>99) S $P(APCLCUML(190),U,4)=$P(APCLCUML(190),U,4)+1
I V>129&(V<161) S $P(APCLCUML(190),U,5)=$P(APCLCUML(190),U,5)+1
I V>160 S $P(APCLCUML(190),U,6)=$P(APCLCUML(190),U,6)+1
TRIG ;
S:'$D(APCLCUML(200)) APCLCUML(200)="Triglycerides obtained in past 12 months"
S $P(APCLCUML(200),U,2)=$P(APCLCUML(200),U,2)+1
S V=$$TRIG^APCLD998(APCLPD,APCLRBD,APCLRED,"I"),V=$P(V,U)
I V="" S $P(APCLCUML(200),U,7)=$P(APCLCUML(200),U,7)+1 G SELF
I V'=+V S $P(APCLCUML(200),U,8)=$P(APCLCUML(200),U,8)+1 G SELF ;unable to determine result
I V<150 S $P(APCLCUML(200),U,3)=$P(APCLCUML(200),U,3)+1
I V<200&(V>149) S $P(APCLCUML(200),U,4)=$P(APCLCUML(200),U,4)+1
I V>199&(V<401) S $P(APCLCUML(200),U,5)=$P(APCLCUML(200),U,5)+1
I V>400 S $P(APCLCUML(200),U,6)=$P(APCLCUML(200),U,6)+1
SELF ;
S:'$D(APCLCUML(210)) APCLCUML(210)="Self monitoring of blood glucose documented"
S $P(APCLCUML(210),U,2)=$P(APCLCUML(210),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,98))
S P=$S($E(V)="Y":3,1:4)
S $P(APCLCUML(210),U,P)=$P(APCLCUML(210),U,P)+1
SDM ;
S:'$D(APCLCUML(220)) APCLCUML(220)="Participating in SDM"
S $P(APCLCUML(220),U,2)=$P(APCLCUML(220),U,2)+1
S V=$G(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,100))
S P=$S($E(V)="Y":3,1:4)
S $P(APCLCUML(220),U,P)=$P(APCLCUML(220),U,P)+1
Q
SYSMEAN(P,BDATE,EDATE) ;EP
NEW X S X=$$BPS^APCLD997(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^APCLD997(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
APCLD995 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
CUML ;EP
+1 KILL APCLCUML
+2 SET APCLPD=0
FOR
SET APCLPD=$ORDER(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD))
IF APCLPD'=+APCLPD
QUIT
DO CUML1
+3 QUIT
+4 ;
CUML1 ;
GENDER ;
+1 ;gender APCLCUML(10)="Gender^total^females^males"
+2 IF '$DATA(APCLCUML(10))
SET APCLCUML(10)="Gender"
+3 SET $PIECE(APCLCUML(10),U,2)=$PIECE(APCLCUML(10),U,2)+1
+4 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,20))
+5 SET P=$SELECT($EXTRACT(V)="F":3,$EXTRACT(V)="M":4,1:5)
+6 SET $PIECE(APCLCUML(10),U,P)=$PIECE(APCLCUML(10),U,P)+1
AGE ;
+1 SET V=$$AGE^AUPNPAT(APCLPD,APCLADAT)
+2 ;APCLCUML(20)="Age^total^<15^15-44^45-64^>65^unknown"
+3 IF '$DATA(APCLCUML(20))
SET APCLCUML(20)="Age"
+4 SET $PIECE(APCLCUML(20),U,2)=$PIECE(APCLCUML(20),U,2)+1
+5 SET P=$SELECT(V<15:3,V>14&(V<45):4,V>44&(V<65):5,V>64:6,1:7)
+6 SET $PIECE(APCLCUML(20),U,P)=$PIECE(APCLCUML(20),U,P)+1
DURDMC ;
+1 ;APCLCUML(30)="Duration of Diabetes^total^<10^10 or more^do date of dx on problem list or cms register"
+2 IF '$DATA(APCLCUML(30))
SET APCLCUML(30)="Duration of Diabetes"
+3 SET $PIECE(APCLCUML(30),U,2)=$PIECE(APCLCUML(30),U,2)+1
+4 SET V=$$DURDM^APCLD994(APCLPD,APCLDMRG,APCLADAT,"I")
+5 SET P=$SELECT(V="":5,V<10:3,V>9:4,1:5)
+6 SET $PIECE(APCLCUML(30),U,P)=$PIECE(APCLCUML(30),U,P)+1
BMI ;
+1 ;APCLCUML(40)="Weight Control (BMI) - does not add up to 100%^total^total^overweight^obese^height or weight missing"
+2 IF '$DATA(APCLCUML(40))
SET APCLCUML(40)="Weight Control (BMI) - does not add up to 100%"
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,112))
+4 SET $PIECE(APCLCUML(40),U,2)=$PIECE(APCLCUML(40),U,2)+1
+5 Begin DoDot:1
+6 IF V=""
SET $PIECE(APCLCUML(40),U,5)=$PIECE(APCLCUML(40),U,5)+1
QUIT
+7 IF $$OW^APCLD994(APCLPD,V,APCLADAT)
SET $PIECE(APCLCUML(40),U,3)=$PIECE(APCLCUML(40),U,3)+1
+8 IF $$OB^APCLD994(APCLPD,V,APCLADAT)
SET $PIECE(APCLCUML(40),U,4)=$PIECE(APCLCUML(40),U,4)+1
End DoDot:1
HGB ;
+1 ;use last hgba1c value only
+2 ;APCLCUML(50)=
+3 IF '$DATA(APCLCUML(50))
SET APCLCUML(50)="Blood Sugar Control - uses last HGB A1C value"
+4 SET $PIECE(APCLCUML(50),U,2)=$PIECE(APCLCUML(50),U,2)+1
+5 SET V=$PIECE($GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,78)),U)
+6 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)
+7 SET $PIECE(APCLCUML(50),U,P)=$PIECE(APCLCUML(50),U,P)+1
BPC ;blood pressure control
+1 ;take last 3 bp's and get mean systolic and mean diastolic
+2 IF '$DATA(APCLCUML(60))
SET APCLCUML(60)="Blood Pressure Control - based on mean of last 3 bp's"
+3 SET $PIECE(APCLCUML(60),U,2)=$PIECE(APCLCUML(60),U,2)+1
+4 SET S=$$SYSMEAN(APCLPD,APCLRBD,APCLRED)
+5 SET D=$$DIAMEAN(APCLPD,APCLRBD,APCLRED)
+6 Begin DoDot:1
+7 IF S=""!(D="")
SET $PIECE(APCLCUML(60),U,8)=$PIECE(APCLCUML(60),U,8)+1
QUIT
+8 IF S<120&(D<80)
SET $PIECE(APCLCUML(60),U,3)=$PIECE(APCLCUML(60),U,3)+1
QUIT
+9 IF S<131&(D<86)
SET $PIECE(APCLCUML(60),U,4)=$PIECE(APCLCUML(60),U,4)+1
QUIT
+10 IF S<141&(D<91)
SET $PIECE(APCLCUML(60),U,5)=$PIECE(APCLCUML(60),U,5)+1
QUIT
+11 IF S<161&(D<96)
SET $PIECE(APCLCUML(60),U,6)=$PIECE(APCLCUML(60),U,6)+1
QUIT
+12 SET $PIECE(APCLCUML(60),U,7)=$PIECE(APCLCUML(60),U,7)+1
End DoDot:1
TBSTAT ;
+1 IF '$DATA(APCLCUML(70))
SET APCLCUML(70)="Tuberculosis Status"
+2 SET $PIECE(APCLCUML(70),U,2)=$PIECE(APCLCUML(70),U,2)+1
+3 SET V=$$TBCODE^APCLD996(APCLPD,APCLRED,APCLDMRG)
+4 SET $PIECE(APCLCUML(70),U,(V+2))=$PIECE(APCLCUML(70),U,(V+2))+1
TOBACCO ;
+1 IF '$DATA(APCLCUML(80))
SET APCLCUML(80)="Tobacco use"
+2 SET $PIECE(APCLCUML(80),U,2)=$PIECE(APCLCUML(80),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,27))
+4 SET V1=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,28))
+5 IF +V=1
SET $PIECE(APCLCUML(80),U,3)=$PIECE(APCLCUML(80),U,3)+1
SET P=$SELECT($EXTRACT(V1)="Y":4,$EXTRACT(V1)="N":5,1:5)
SET $PIECE(APCLCUML(80),U,P)=$PIECE(APCLCUML(80),U,P)+1
+6 IF +V=2
SET $PIECE(APCLCUML(80),U,6)=$PIECE(APCLCUML(80),U,6)+1
+7 IF +V=3
SET $PIECE(APCLCUML(80),U,7)=$PIECE(APCLCUML(80),U,7)+1
+8 IF +V=4
SET $PIECE(APCLCUML(80),U,8)=$PIECE(APCLCUML(80),U,8)+1
DMTX ;diabetes treatment
+1 SET APCL6MBD=$$FMADD^XLFDT(APCLADAT,-(6*31))
SET APCL6MBD=$$FMTE^XLFDT(APCL6MBD)
+2 IF '$DATA(APCLCUML(90))
SET APCLCUML(90)="DIABETES TREATMENT"
+3 SET $PIECE(APCLCUML(90),U,2)=$PIECE(APCLCUML(90),U,2)+1
+4 SET V=$$THERAPY^APCLD996(APCLPD,APCL6MBD,APCLRED)
+5 IF V=1
SET $PIECE(APCLCUML(90),U,3)=$PIECE(APCLCUML(90),U,3)+1
+6 IF $LENGTH(V)=1
SET P=$SELECT(V=2:4,V=3:5,V=4:6,V=5:7,V=6:8,1:"")
SET $PIECE(APCLCUML(90),U,P)=$PIECE(APCLCUML(90),U,P)+1
+7 IF $LENGTH(V)>1
IF V["2"
SET $PIECE(APCLCUML(90),U,10)=$PIECE(APCLCUML(90),U,10)+1
+8 IF $LENGTH(V)>1
IF V'[2
SET $PIECE(APCLCUML(90),U,9)=$PIECE(APCLCUML(90),U,9)+1
ASPIRIN ;
+1 IF '$DATA(APCLCUML(100))
SET APCLCUML(100)="DAILY LOW-DOSE ASPIRIN THERAPY"
+2 SET $PIECE(APCLCUML(100),U,2)=$PIECE(APCLCUML(100),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,62))
+4 SET P=$SELECT($EXTRACT(V)="Y":3,1:4)
+5 SET $PIECE(APCLCUML(100),U,P)=$PIECE(APCLCUML(100),U,P)+1
EXAMS ;
+1 IF '$DATA(APCLCUML(120))
SET APCLCUML(120)="EXAMS - Yearly"
+2 SET $PIECE(APCLCUML(120),U,2)=$PIECE(APCLCUML(120),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,38))
+4 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(120),U,3)=$PIECE(APCLCUML(120),U,3)+1
+5 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,40))
+6 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(120),U,4)=$PIECE(APCLCUML(120),U,4)+1
+7 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,42))
+8 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(120),U,5)=$PIECE(APCLCUML(120),U,5)+1
EDUC ;
+1 IF '$DATA(APCLCUML(130))
SET APCLCUML(130)="DIABETES-RELATED EDUCATION - Yearly"
+2 SET $PIECE(APCLCUML(130),U,2)=$PIECE(APCLCUML(130),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,44))
+4 IF $EXTRACT(V)'="N"
SET $PIECE(APCLCUML(130),U,3)=$PIECE(APCLCUML(130),U,3)+1
+5 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,46))
+6 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(130),U,4)=$PIECE(APCLCUML(130),U,4)+1
+7 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,48))
+8 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(130),U,5)=$PIECE(APCLCUML(130),U,5)+1
IMM ;
+1 IF '$DATA(APCLCUML(140))
SET APCLCUML(140)="IMMUNIZATIONS"
+2 SET $PIECE(APCLCUML(140),U,2)=$PIECE(APCLCUML(140),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,64))
+4 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(140),U,3)=$PIECE(APCLCUML(140),U,3)+1
+5 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,66))
+6 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(140),U,4)=$PIECE(APCLCUML(140),U,4)+1
+7 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,68))
+8 IF $EXTRACT(V)="Y"
SET $PIECE(APCLCUML(140),U,5)=$PIECE(APCLCUML(140),U,5)+1
EKG ;need date of last ekg
+1 IF '$DATA(APCLCUML(150))
SET APCLCUML(150)="EKG"
+2 SET $PIECE(APCLCUML(150),U,2)=$PIECE(APCLCUML(150),U,2)+1
+3 SET V=$$EKG^APCLD998(APCLPD,APCLRED,"I")
+4 IF V]""
Begin DoDot:1
+5 SET E=$$FMDIFF^XLFDT(APCLADAT,V)
+6 IF E<(365.25*3)
SET $PIECE(APCLCUML(150),U,3)=$PIECE(APCLCUML(150),U,3)+1
QUIT
+7 IF E<(365.25*5)
SET $PIECE(APCLCUML(150),U,4)=$PIECE(APCLCUML(150),U,4)+1
QUIT
+8 SET $PIECE(APCLCUML(150),U,5)=$PIECE(APCLCUML(150),U,5)+1
End DoDot:1
CREAT ;
+1 IF '$DATA(APCLCUML(170))
SET APCLCUML(170)="Creatinine obtained in the past 12 months"
+2 SET $PIECE(APCLCUML(170),U,2)=$PIECE(APCLCUML(170),U,2)+1
+3 SET V=$$CREAT^APCLD998(APCLPD,APCLRBD,APCLRED,"I")
SET V=$PIECE(V,U)
+4 IF V=""
SET $PIECE(APCLCUML(170),U,5)=$PIECE(APCLCUML(170),U,5)+1
GOTO TCHOL
+5 ;unable to determine result
IF V'=+V
SET $PIECE(APCLCUML(170),U,6)=$PIECE(APCLCUML(170),U,6)+1
GOTO TCHOL
+6 IF V>1.9
SET $PIECE(APCLCUML(170),U,3)=$PIECE(APCLCUML(170),U,3)+1
+7 IF V<2.0
SET $PIECE(APCLCUML(170),U,4)=$PIECE(APCLCUML(170),U,4)+1
TCHOL ;
+1 IF '$DATA(APCLCUML(180))
SET APCLCUML(180)="Total Cholesterol obtained in past 12 months"
+2 SET $PIECE(APCLCUML(180),U,2)=$PIECE(APCLCUML(180),U,2)+1
+3 SET V=$$CHOL^APCLD998(APCLPD,APCLRBD,APCLRED,"I")
SET V=$PIECE(V,U)
+4 IF V=""
SET $PIECE(APCLCUML(180),U,6)=$PIECE(APCLCUML(180),U,6)+1
GOTO LDL
+5 ;unable to determine result
IF V'=+V
SET $PIECE(APCLCUML(180),U,7)=$PIECE(APCLCUML(180),U,7)+1
GOTO LDL
+6 IF V<200
SET $PIECE(APCLCUML(180),U,3)=$PIECE(APCLCUML(180),U,3)+1
+7 IF V<240&(V>199)
SET $PIECE(APCLCUML(180),U,4)=$PIECE(APCLCUML(180),U,4)+1
+8 IF V>239
SET $PIECE(APCLCUML(180),U,5)=$PIECE(APCLCUML(180),U,5)+1
LDL ;
+1 IF '$DATA(APCLCUML(190))
SET APCLCUML(190)="LDL Cholesterol obtained in the past 12 months"
+2 SET $PIECE(APCLCUML(190),U,2)=$PIECE(APCLCUML(190),U,2)+1
+3 SET V=$$LDL^APCLD998(APCLPD,APCLRBD,APCLRED,"I")
SET V=$PIECE(V,U)
+4 IF V=""
SET $PIECE(APCLCUML(190),U,7)=$PIECE(APCLCUML(190),U,7)+1
GOTO TRIG
+5 ;unable to determine result
IF V'=+V
SET $PIECE(APCLCUML(190),U,8)=$PIECE(APCLCUML(190),U,8)+1
GOTO TRIG
+6 IF V<100
SET $PIECE(APCLCUML(190),U,3)=$PIECE(APCLCUML(190),U,3)+1
+7 IF V<130&(V>99)
SET $PIECE(APCLCUML(190),U,4)=$PIECE(APCLCUML(190),U,4)+1
+8 IF V>129&(V<161)
SET $PIECE(APCLCUML(190),U,5)=$PIECE(APCLCUML(190),U,5)+1
+9 IF V>160
SET $PIECE(APCLCUML(190),U,6)=$PIECE(APCLCUML(190),U,6)+1
TRIG ;
+1 IF '$DATA(APCLCUML(200))
SET APCLCUML(200)="Triglycerides obtained in past 12 months"
+2 SET $PIECE(APCLCUML(200),U,2)=$PIECE(APCLCUML(200),U,2)+1
+3 SET V=$$TRIG^APCLD998(APCLPD,APCLRBD,APCLRED,"I")
SET V=$PIECE(V,U)
+4 IF V=""
SET $PIECE(APCLCUML(200),U,7)=$PIECE(APCLCUML(200),U,7)+1
GOTO SELF
+5 ;unable to determine result
IF V'=+V
SET $PIECE(APCLCUML(200),U,8)=$PIECE(APCLCUML(200),U,8)+1
GOTO SELF
+6 IF V<150
SET $PIECE(APCLCUML(200),U,3)=$PIECE(APCLCUML(200),U,3)+1
+7 IF V<200&(V>149)
SET $PIECE(APCLCUML(200),U,4)=$PIECE(APCLCUML(200),U,4)+1
+8 IF V>199&(V<401)
SET $PIECE(APCLCUML(200),U,5)=$PIECE(APCLCUML(200),U,5)+1
+9 IF V>400
SET $PIECE(APCLCUML(200),U,6)=$PIECE(APCLCUML(200),U,6)+1
SELF ;
+1 IF '$DATA(APCLCUML(210))
SET APCLCUML(210)="Self monitoring of blood glucose documented"
+2 SET $PIECE(APCLCUML(210),U,2)=$PIECE(APCLCUML(210),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,98))
+4 SET P=$SELECT($EXTRACT(V)="Y":3,1:4)
+5 SET $PIECE(APCLCUML(210),U,P)=$PIECE(APCLCUML(210),U,P)+1
SDM ;
+1 IF '$DATA(APCLCUML(220))
SET APCLCUML(220)="Participating in SDM"
+2 SET $PIECE(APCLCUML(220),U,2)=$PIECE(APCLCUML(220),U,2)+1
+3 SET V=$GET(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,100))
+4 SET P=$SELECT($EXTRACT(V)="Y":3,1:4)
+5 SET $PIECE(APCLCUML(220),U,P)=$PIECE(APCLCUML(220),U,P)+1
+6 QUIT
SYSMEAN(P,BDATE,EDATE) ;EP
+1 NEW X
SET X=$$BPS^APCLD997(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^APCLD997(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
