Routine: APCLD615

APCLD615 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

CUML ;EP

 K APCLCUML

 S APCLCUML(10)="Gender"

 S APCLCUML(20)="Age"

 S APCLCUML(25)="Diabetes Type"

 S APCLCUML(30)="Duration of Diabetes"

 S APCLCUML(40)="Weight Control (BMI)"

 S APCLCUML(50)="Blood Sugar Control - uses last HGB A1C value"

 S APCLCUML(70)="Tuberculosis Status"

 S APCLCUML(60)="Blood Pressure Control - based on mean of last 3 bp's"

 S APCLCUML(80)="Tobacco use"

 S APCLCUML(90)="DIABETES TREATMENT"

 S APCLCUML(100)="ANTIPLATELET THERAPY"

 S APCLCUML(110)="ACE INHIBITOR (OR ARB) USE"

 S APCLCUML(115)="LIPID LOWERING AGENT USE"

 S APCLCUML(300)="Depression on Problem List or as POVs"

 S APCLCUML(301)="Depression Screening?"

PROCESS ;

 S APCLPD=0 F  S APCLPD=$O(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD)) Q:APCLPD'=+APCLPD  D CUML1

CUML1 ;

GENDER ;

 ;gender APCLCUML(10)="Gender^total^females^males"

 S $P(APCLCUML(10),U,2)=$P(APCLCUML(10),U,2)+1

 S V=$G(^XTMP("APCLDM61",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"

 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

TYPE ;

 ;APCLCUML(25)="Total^Type 1^Type 2"

 S X=$$TYPE^APCLD616(APCLPD,APCLDMRG,APCLADAT)

 S $P(APCLCUML(25),U,2)=$P(APCLCUML(25),U,2)+1

 S P=$S(X="":5,X=1:3,X=2:4,1:5)

 S $P(APCLCUML(25),U,P)=$P(APCLCUML(25),U,P)+1

DURDMC ;

 ;APCLCUML(30)="Duration of Diabetes^total^<10^10 or more^do date of dx on problem list or cms register"

 S $P(APCLCUML(30),U,2)=$P(APCLCUML(30),U,2)+1

 S V=$$DURDM^APCLD614(APCLPD,APCLDMRG,APCLADAT)

 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 V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,112))

 S $P(APCLCUML(40),U,2)=$P(APCLCUML(40),U,2)+1

 .I V="" S $P(APCLCUML(40),U,5)=$P(APCLCUML(40),U,5)+1 Q

 .I $$OW^APCLD614(APCLPD,V,APCLADAT) S $P(APCLCUML(40),U,3)=$P(APCLCUML(40),U,3)+1 Q

 .I $$OB^APCLD614(APCLPD,V,APCLADAT) S $P(APCLCUML(40),U,4)=$P(APCLCUML(40),U,4)+1 Q

 .S $P(APCLCUML(40),U,6)=$P(APCLCUML(40),U,6)+1 Q

HGB ;

 ;use last hgba1c value only

 ;APCLCUML(50)=

 S $P(APCLCUML(50),U,2)=$P(APCLCUML(50),U,2)+1

 S V=$P($G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,78)),U)

 ;S V=$$STV^APCLD618(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(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 $P(APCLCUML(60),U,2)=$P(APCLCUML(60),U,2)+1

 S S=$$SYSMEAN(APCLPD,APCLRBD,APCLRED)

 S D=$$DIAMEAN(APCLPD,APCLRBD,APCLRED)

 .I S=""!(D="") S $P(APCLCUML(60),U,8)=$P(APCLCUML(60),U,8)+1 Q

 .I S<120&(D<70) S $P(APCLCUML(60),U,3)=$P(APCLCUML(60),U,3)+1 Q

 .I S<130&(D<80) S $P(APCLCUML(60),U,4)=$P(APCLCUML(60),U,4)+1 Q

 .I S<140&(D<90) S $P(APCLCUML(60),U,5)=$P(APCLCUML(60),U,5)+1 Q

 .I S<160&(D<95) 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 $P(APCLCUML(70),U,2)=$P(APCLCUML(70),U,2)+1

 S V=$$TBCODE^APCLD616(APCLPD,APCLRED,APCLDMRG)

 S $P(APCLCUML(70),U,(V+2))=$P(APCLCUML(70),U,(V+2))+1

TOBACCO ;

 S $P(APCLCUML(80),U,2)=$P(APCLCUML(80),U,2)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,27))

 S V1=$G(^XTMP("APCLDM61",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

DMTX ;diabetes treatment

 S APCL6MBD=$$FMADD^XLFDT(APCLADAT,-(6*31)),APCL6MBD=$$FMTE^XLFDT(APCL6MBD)

 S $P(APCLCUML(90),U,2)=$P(APCLCUML(90),U,2)+1

 S V=$$THERAPY^APCLD616(APCLPD,APCL6MBD,APCLRED)

 I V=1 S $P(APCLCUML(90),U,3)=$P(APCLCUML(90),U,3)+1

 I V=9 S $P(APCLCUML(90),U,11)=$P(APCLCUML(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(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 ;

 ;only tally if patient is 30 and older

 G ACE:$$AGE^AUPNPAT(APCLPD,APCLADAT)<30

 S $P(APCLCUML(100),U,2)=$P(APCLCUML(100),U,2)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,62))

 S P=$S($E(V)="A":3,$E(V)="R":7,$E(V)="N":6,1:6)

 S $P(APCLCUML(100),U,P)=$P(APCLCUML(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(APCLCUML(110),U,2)=$P(APCLCUML(110),U,2)+1

 ;set 3rd piece with # with proteinuria

 S P=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,94))

 S H=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,34))

 S A=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,60))

 I $E(P)="Y" S $P(APCLCUML(110),U,3)=$P(APCLCUML(110),U,3)+1 I $E(A)="Y" S $P(APCLCUML(110),U,4)=$P(APCLCUML(110),U,4)+1

 I $E(H)="Y" S $P(APCLCUML(110),U,5)=$P(APCLCUML(110),U,5)+1 I $E(A)="Y" S $P(APCLCUML(110),U,6)=$P(APCLCUML(110),U,6)+1

LIPID ;115

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,61))

 S L=$$LDL^APCLD618(APCLPD,APCLBDAT,APCLADAT,"I"),L=$P(L,U)

 S T=$$CHOL^APCLD618(APCLPD,APCLBDAT,APCLADAT,"I"),T=$P(T,U)

 I T]"",T'<240 S $P(APCLCUML(115),U,3)=$P(APCLCUML(115),U,3)+1 I "SOB"[$E(V) S $P(APCLCUML(115),U,4)=$P(APCLCUML(115),U,4)+1

 I L]"",L>100 S $P(APCLCUML(115),U,5)=$P(APCLCUML(115),U,5)+1 I "SOB"[$E(V) S $P(APCLCUML(115),U,6)=$P(APCLCUML(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(APCLCUML(115),U,7)=$P(APCLCUML(115),U,7)+1

 I $E(V)="S" S $P(APCLCUML(115),U,8)=$P(APCLCUML(115),U,8)+1

 I $E(V)="O" S $P(APCLCUML(115),U,9)=$P(APCLCUML(115),U,9)+1

 I $E(V)="B" S $P(APCLCUML(115),U,10)=$P(APCLCUML(115),U,10)+1

 I $E(V)="R" S $P(APCLCUML(115),U,11)=$P(APCLCUML(115),U,11)+1

DEP ;

 S $P(APCLCUML(300),U,2)=$P(APCLCUML(300),U,2)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,200))

 I $E(V)="Y" S $P(APCLCUML(300),U,3)=$P(APCLCUML(300),U,3)+1

 I $E(V)'="Y" S $P(APCLCUML(301),U,2)=$P(APCLCUML(301),U,2)+1 D

 .S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,210))

 .I $E(V)="Y" S $P(APCLCUML(301),U,3)=$P(APCLCUML(301),U,3)+1

 .I $E(V)="N" S $P(APCLCUML(301),U,4)=$P(APCLCUML(301),U,4)+1

 .I $E(V)="R" S $P(APCLCUML(301),U,5)=$P(APCLCUML(301),U,5)+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("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,38))

 I $E(V)="Y" S $P(APCLCUML(120),U,3)=$P(APCLCUML(120),U,3)+1

 I $E(V)="R" S $P(APCLCUML(120),U,6)=$P(APCLCUML(120),U,6)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,40))

 I $E(V)="Y" S $P(APCLCUML(120),U,4)=$P(APCLCUML(120),U,4)+1

 I $E(V)="R" S $P(APCLCUML(120),U,7)=$P(APCLCUML(120),U,7)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,42))

 I $E(V)="Y" S $P(APCLCUML(120),U,5)=$P(APCLCUML(120),U,5)+1

 I $E(V)="R" S $P(APCLCUML(120),U,8)=$P(APCLCUML(120),U,8)+1

 I $P(^DPT(APCLPD,0),U,2)="F" S $P(APCLCUML(120),U,9)=$P(APCLCUML(120),U,9)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,108))

 I $E(V)="Y" S $P(APCLCUML(120),U,10)=$P(APCLCUML(120),U,10)+1

 I $E(V)="R" S $P(APCLCUML(120),U,11)=$P(APCLCUML(120),U,11)+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 G=0,V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,44))

 I $E(V)="Y" S $P(APCLCUML(130),U,3)=$P(APCLCUML(130),U,3)+1 S G=1

 I $E(V)="R" S $P(APCLCUML(130),U,7)=$P(APCLCUML(130),U,7)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,46))

 I $E(V)="Y" S $P(APCLCUML(130),U,4)=$P(APCLCUML(130),U,4)+1 S G=1

 I $E(V)="R" S $P(APCLCUML(130),U,8)=$P(APCLCUML(130),U,8)+1

 S V=$G(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,48))

 I $E(V)="R" S $P(APCLCUML(130),U,9)=$P(APCLCUML(130),U,9)+1

 I $E(V)="Y" S $P(APCLCUML(130),U,5)=$P(APCLCUML(130),U,5)+1 S G=1

 I G S $P(APCLCUML(130),U,6)=$P(APCLCUML(130),U,6)+1

 D ^APCLD611

SYSMEAN(P,BDATE,EDATE) ;EP

 NEW X S X=$$BPS^APCLD613(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^APCLD613(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

APCLD615  ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

CUML      ;EP

 +1        KILL APCLCUML

 +2        SET APCLCUML(10)="Gender"

 +3        SET APCLCUML(20)="Age"

 +4        SET APCLCUML(25)="Diabetes Type"

 +5        SET APCLCUML(30)="Duration of Diabetes"

 +6        SET APCLCUML(40)="Weight Control (BMI)"

 +7        SET APCLCUML(50)="Blood Sugar Control - uses last HGB A1C value"

 +8        SET APCLCUML(70)="Tuberculosis Status"

 +9        SET APCLCUML(60)="Blood Pressure Control - based on mean of last 3 bp's"

 +10       SET APCLCUML(80)="Tobacco use"

 +11       SET APCLCUML(90)="DIABETES TREATMENT"

 +12       SET APCLCUML(100)="ANTIPLATELET THERAPY"

 +13       SET APCLCUML(110)="ACE INHIBITOR (OR ARB) USE"

 +14       SET APCLCUML(115)="LIPID LOWERING AGENT USE"

 +15       SET APCLCUML(300)="Depression on Problem List or as POVs"

 +16       SET APCLCUML(301)="Depression Screening?"

 +17      ;

PROCESS   ;

 +1        SET APCLPD=0

FOR

               SET APCLPD=$ORDER(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD))

               IF APCLPD'=+APCLPD

                   QUIT

               DO CUML1

 +2        QUIT

 +3       ;

CUML1     ;

GENDER    ;

 +1       ;gender APCLCUML(10)="Gender^total^females^males"

 +2        SET $PIECE(APCLCUML(10),U,2)=$PIECE(APCLCUML(10),U,2)+1

 +3        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,20))

 +4        SET P=$SELECT($EXTRACT(V)="F":3,$EXTRACT(V)="M":4,1:5)

 +5        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        SET $PIECE(APCLCUML(20),U,2)=$PIECE(APCLCUML(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(APCLCUML(20),U,P)=$PIECE(APCLCUML(20),U,P)+1

TYPE      ;

 +1       ;APCLCUML(25)="Total^Type 1^Type 2"

 +2        SET X=$$TYPE^APCLD616(APCLPD,APCLDMRG,APCLADAT)

 +3        SET $PIECE(APCLCUML(25),U,2)=$PIECE(APCLCUML(25),U,2)+1

 +4        SET P=$SELECT(X="":5,X=1:3,X=2:4,1:5)

 +5        SET $PIECE(APCLCUML(25),U,P)=$PIECE(APCLCUML(25),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        SET $PIECE(APCLCUML(30),U,2)=$PIECE(APCLCUML(30),U,2)+1

 +3        SET V=$$DURDM^APCLD614(APCLPD,APCLDMRG,APCLADAT)

 +4        SET P=$SELECT(V="":5,V<10:3,V>9:4,1:5)

 +5        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        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,112))

 +3        SET $PIECE(APCLCUML(40),U,2)=$PIECE(APCLCUML(40),U,2)+1

 +4        Begin DoDot:1

 +5            IF V=""

                   SET $PIECE(APCLCUML(40),U,5)=$PIECE(APCLCUML(40),U,5)+1

                   QUIT

 +6            IF $$OW^APCLD614(APCLPD,V,APCLADAT)

                   SET $PIECE(APCLCUML(40),U,3)=$PIECE(APCLCUML(40),U,3)+1

                   QUIT

 +7            IF $$OB^APCLD614(APCLPD,V,APCLADAT)

                   SET $PIECE(APCLCUML(40),U,4)=$PIECE(APCLCUML(40),U,4)+1

                   QUIT

 +8            SET $PIECE(APCLCUML(40),U,6)=$PIECE(APCLCUML(40),U,6)+1

               QUIT

           End DoDot:1

HGB       ;

 +1       ;use last hgba1c value only

 +2       ;APCLCUML(50)=

 +3        SET $PIECE(APCLCUML(50),U,2)=$PIECE(APCLCUML(50),U,2)+1

 +4        SET V=$PIECE($GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,78)),U)

 +5       ;S V=$$STV^APCLD618(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(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        SET $PIECE(APCLCUML(60),U,2)=$PIECE(APCLCUML(60),U,2)+1

 +3        SET S=$$SYSMEAN(APCLPD,APCLRBD,APCLRED)

 +4        SET D=$$DIAMEAN(APCLPD,APCLRBD,APCLRED)

 +5        Begin DoDot:1

 +6            IF S=""!(D="")

                   SET $PIECE(APCLCUML(60),U,8)=$PIECE(APCLCUML(60),U,8)+1

                   QUIT

 +7            IF S<120&(D<70)

                   SET $PIECE(APCLCUML(60),U,3)=$PIECE(APCLCUML(60),U,3)+1

                   QUIT

 +8            IF S<130&(D<80)

                   SET $PIECE(APCLCUML(60),U,4)=$PIECE(APCLCUML(60),U,4)+1

                   QUIT

 +9            IF S<140&(D<90)

                   SET $PIECE(APCLCUML(60),U,5)=$PIECE(APCLCUML(60),U,5)+1

                   QUIT

 +10           IF S<160&(D<95)

                   SET $PIECE(APCLCUML(60),U,6)=$PIECE(APCLCUML(60),U,6)+1

                   QUIT

 +11           SET $PIECE(APCLCUML(60),U,7)=$PIECE(APCLCUML(60),U,7)+1

           End DoDot:1

TBSTAT    ;

 +1        SET $PIECE(APCLCUML(70),U,2)=$PIECE(APCLCUML(70),U,2)+1

 +2        SET V=$$TBCODE^APCLD616(APCLPD,APCLRED,APCLDMRG)

 +3        SET $PIECE(APCLCUML(70),U,(V+2))=$PIECE(APCLCUML(70),U,(V+2))+1

TOBACCO   ;

 +1        SET $PIECE(APCLCUML(80),U,2)=$PIECE(APCLCUML(80),U,2)+1

 +2        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,27))

 +3        SET V1=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,28))

 +4        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

 +5        IF +V=2

               SET $PIECE(APCLCUML(80),U,6)=$PIECE(APCLCUML(80),U,6)+1

 +6        IF +V=3

               SET $PIECE(APCLCUML(80),U,7)=$PIECE(APCLCUML(80),U,7)+1

DMTX      ;diabetes treatment

 +1        SET APCL6MBD=$$FMADD^XLFDT(APCLADAT,-(6*31))

           SET APCL6MBD=$$FMTE^XLFDT(APCL6MBD)

 +2        SET $PIECE(APCLCUML(90),U,2)=$PIECE(APCLCUML(90),U,2)+1

 +3        SET V=$$THERAPY^APCLD616(APCLPD,APCL6MBD,APCLRED)

 +4        IF V=1

               SET $PIECE(APCLCUML(90),U,3)=$PIECE(APCLCUML(90),U,3)+1

 +5        IF V=9

               SET $PIECE(APCLCUML(90),U,11)=$PIECE(APCLCUML(90),U,11)+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       ;only tally if patient is 30 and older

 +2        IF $$AGE^AUPNPAT(APCLPD,APCLADAT)<30

               GOTO ACE

 +3        SET $PIECE(APCLCUML(100),U,2)=$PIECE(APCLCUML(100),U,2)+1

 +4        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,62))

 +5        SET P=$SELECT($EXTRACT(V)="A":3,$EXTRACT(V)="R":7,$EXTRACT(V)="N":6,1:6)

 +6        SET $PIECE(APCLCUML(100),U,P)=$PIECE(APCLCUML(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(APCLCUML(110),U,2)=$PIECE(APCLCUML(110),U,2)+1

 +2       ;set 3rd piece with # with proteinuria

 +3        SET P=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,94))

 +4        SET H=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,34))

 +5        SET A=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,60))

 +6        IF $EXTRACT(P)="Y"

               SET $PIECE(APCLCUML(110),U,3)=$PIECE(APCLCUML(110),U,3)+1

               IF $EXTRACT(A)="Y"

                   SET $PIECE(APCLCUML(110),U,4)=$PIECE(APCLCUML(110),U,4)+1

 +7        IF $EXTRACT(H)="Y"

               SET $PIECE(APCLCUML(110),U,5)=$PIECE(APCLCUML(110),U,5)+1

               IF $EXTRACT(A)="Y"

                   SET $PIECE(APCLCUML(110),U,6)=$PIECE(APCLCUML(110),U,6)+1

LIPID     ;115

 +1        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,61))

 +2        SET L=$$LDL^APCLD618(APCLPD,APCLBDAT,APCLADAT,"I")

           SET L=$PIECE(L,U)

 +3        SET T=$$CHOL^APCLD618(APCLPD,APCLBDAT,APCLADAT,"I")

           SET T=$PIECE(T,U)

 +4        IF T]""

               IF T'<240

                   SET $PIECE(APCLCUML(115),U,3)=$PIECE(APCLCUML(115),U,3)+1

                   IF "SOB"[$EXTRACT(V)

                       SET $PIECE(APCLCUML(115),U,4)=$PIECE(APCLCUML(115),U,4)+1

 +5        IF L]""

               IF L>100

                   SET $PIECE(APCLCUML(115),U,5)=$PIECE(APCLCUML(115),U,5)+1

                   IF "SOB"[$EXTRACT(V)

                       SET $PIECE(APCLCUML(115),U,6)=$PIECE(APCLCUML(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(APCLCUML(115),U,7)=$PIECE(APCLCUML(115),U,7)+1

 +9        IF $EXTRACT(V)="S"

               SET $PIECE(APCLCUML(115),U,8)=$PIECE(APCLCUML(115),U,8)+1

 +10       IF $EXTRACT(V)="O"

               SET $PIECE(APCLCUML(115),U,9)=$PIECE(APCLCUML(115),U,9)+1

 +11       IF $EXTRACT(V)="B"

               SET $PIECE(APCLCUML(115),U,10)=$PIECE(APCLCUML(115),U,10)+1

 +12       IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(115),U,11)=$PIECE(APCLCUML(115),U,11)+1

DEP       ;

 +1        SET $PIECE(APCLCUML(300),U,2)=$PIECE(APCLCUML(300),U,2)+1

 +2        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,200))

 +3        IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(300),U,3)=$PIECE(APCLCUML(300),U,3)+1

 +4        IF $EXTRACT(V)'="Y"

               SET $PIECE(APCLCUML(301),U,2)=$PIECE(APCLCUML(301),U,2)+1

               Begin DoDot:1

 +5                SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,210))

 +6                IF $EXTRACT(V)="Y"

                       SET $PIECE(APCLCUML(301),U,3)=$PIECE(APCLCUML(301),U,3)+1

 +7                IF $EXTRACT(V)="N"

                       SET $PIECE(APCLCUML(301),U,4)=$PIECE(APCLCUML(301),U,4)+1

 +8                IF $EXTRACT(V)="R"

                       SET $PIECE(APCLCUML(301),U,5)=$PIECE(APCLCUML(301),U,5)+1

               End DoDot: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("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,38))

 +4        IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(120),U,3)=$PIECE(APCLCUML(120),U,3)+1

 +5        IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(120),U,6)=$PIECE(APCLCUML(120),U,6)+1

 +6        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,40))

 +7        IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(120),U,4)=$PIECE(APCLCUML(120),U,4)+1

 +8        IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(120),U,7)=$PIECE(APCLCUML(120),U,7)+1

 +9        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,42))

 +10       IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(120),U,5)=$PIECE(APCLCUML(120),U,5)+1

 +11       IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(120),U,8)=$PIECE(APCLCUML(120),U,8)+1

 +12       IF $PIECE(^DPT(APCLPD,0),U,2)="F"

               SET $PIECE(APCLCUML(120),U,9)=$PIECE(APCLCUML(120),U,9)+1

 +13       SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,108))

 +14       IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(120),U,10)=$PIECE(APCLCUML(120),U,10)+1

 +15       IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(120),U,11)=$PIECE(APCLCUML(120),U,11)+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 G=0

           SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,44))

 +4        IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(130),U,3)=$PIECE(APCLCUML(130),U,3)+1

               SET G=1

 +5        IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(130),U,7)=$PIECE(APCLCUML(130),U,7)+1

 +6        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,46))

 +7        IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(130),U,4)=$PIECE(APCLCUML(130),U,4)+1

               SET G=1

 +8        IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(130),U,8)=$PIECE(APCLCUML(130),U,8)+1

 +9        SET V=$GET(^XTMP("APCLDM61",APCLJOB,APCLBTH,"AUDIT",APCLPD,48))

 +10       IF $EXTRACT(V)="R"

               SET $PIECE(APCLCUML(130),U,9)=$PIECE(APCLCUML(130),U,9)+1

 +11       IF $EXTRACT(V)="Y"

               SET $PIECE(APCLCUML(130),U,5)=$PIECE(APCLCUML(130),U,5)+1

               SET G=1

 +12       IF G

               SET $PIECE(APCLCUML(130),U,6)=$PIECE(APCLCUML(130),U,6)+1

 +13       DO ^APCLD611

 +14       QUIT

SYSMEAN(P,BDATE,EDATE) ;EP

 +1        NEW X

           SET X=$$BPS^APCLD613(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^APCLD613(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

APCLD615.m