- APCLP615 ; 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)="IFG"
- S APCLCUML(30)="IGT"
- S APCLCUML(31)="Metabolic Syndrome"
- S APCLCUML(32)="Other Abnormal Glucose (720.29)"
- S APCLCUML(40)="Weight Control (BMI) - does not add up to 100%"
- 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)="ANTI-PLATELET THERAPY"
- S APCLCUML(110)="ACE INHIBITOR (OR ARB) USE"
- S APCLCUML(115)="LIPID LOWERING AGENT USE"
- ;
- PROCESS ;
- S APCLPD=0 F S APCLPD=$O(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD)) Q:APCLPD'=+APCLPD D CUML1
- Q
- ;
- 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("APCLP61",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
- IFG ;
- ;APCLCUML(25)="Total^YES^NO"
- S X=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,200))
- S $P(APCLCUML(25),U,2)=$P(APCLCUML(25),U,2)+1
- S P=$S(X="Yes":3,1:4)
- S $P(APCLCUML(25),U,P)=$P(APCLCUML(25),U,P)+1
- IGT ;
- ;APCLCUML(30)="Total^YES^NO"
- S X=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,210))
- S $P(APCLCUML(30),U,2)=$P(APCLCUML(30),U,2)+1
- S P=$S(X="Yes":3,1:4)
- S $P(APCLCUML(30),U,P)=$P(APCLCUML(30),U,P)+1
- MS ;
- ;APCLCUML(31)="Total^YES^NO"
- S X=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,220))
- S $P(APCLCUML(31),U,2)=$P(APCLCUML(31),U,2)+1
- S P=$S(X="Yes":3,1:4)
- S $P(APCLCUML(31),U,P)=$P(APCLCUML(31),U,P)+1
- ABNG ;
- ;APCLCUML(32)="Total^YES^NO"
- S X=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,230))
- S $P(APCLCUML(32),U,2)=$P(APCLCUML(32),U,2)+1
- S P=$S(X="Yes":3,1:4)
- S $P(APCLCUML(32),U,P)=$P(APCLCUML(32),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("APCLP61",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^APCLP614(APCLPD,V,APCLADAT) S $P(APCLCUML(40),U,3)=$P(APCLCUML(40),U,3)+1
- .I $$OB^APCLP614(APCLPD,V,APCLADAT) S $P(APCLCUML(40),U,4)=$P(APCLCUML(40),U,4)+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)
- D
- .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<131&(D<81) 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
- TOBACCO ;
- S $P(APCLCUML(80),U,2)=$P(APCLCUML(80),U,2)+1
- S V=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,27))
- S V1=$G(^XTMP("APCLP61",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^APCLP616(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 $P(APCLCUML(100),U,2)=$P(APCLCUML(100),U,2)+1
- S V=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,62))
- S P=$S($E(V)="A":3,$E(V)="O":4,$E(V)="B":5,$E(V)="N":6,1:7)
- 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("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,94))
- S H=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,34))
- S A=$G(^XTMP("APCLP61",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("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,61))
- S L=$$LDL^APCLD518(APCLPD,APCLBDAT,APCLADAT,"I"),L=$P(L,U)
- S T=$$CHOL^APCLD518(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
- 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("APCLP61",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("APCLP61",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("APCLP61",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 ^APCLP611
- Q
- SYSMEAN(P,BDATE,EDATE) ;EP
- NEW X S X=$$BPS^APCLP613(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^APCLP613(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
- APCLP615 ; 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)="IFG"
- +5 SET APCLCUML(30)="IGT"
- +6 SET APCLCUML(31)="Metabolic Syndrome"
- +7 SET APCLCUML(32)="Other Abnormal Glucose (720.29)"
- +8 SET APCLCUML(40)="Weight Control (BMI) - does not add up to 100%"
- +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)="ANTI-PLATELET THERAPY"
- +13 SET APCLCUML(110)="ACE INHIBITOR (OR ARB) USE"
- +14 SET APCLCUML(115)="LIPID LOWERING AGENT USE"
- +15 ;
- PROCESS ;
- +1 SET APCLPD=0
- FOR
- SET APCLPD=$ORDER(^XTMP("APCLP61",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("APCLP61",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
- IFG ;
- +1 ;APCLCUML(25)="Total^YES^NO"
- +2 SET X=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,200))
- +3 SET $PIECE(APCLCUML(25),U,2)=$PIECE(APCLCUML(25),U,2)+1
- +4 SET P=$SELECT(X="Yes":3,1:4)
- +5 SET $PIECE(APCLCUML(25),U,P)=$PIECE(APCLCUML(25),U,P)+1
- IGT ;
- +1 ;APCLCUML(30)="Total^YES^NO"
- +2 SET X=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,210))
- +3 SET $PIECE(APCLCUML(30),U,2)=$PIECE(APCLCUML(30),U,2)+1
- +4 SET P=$SELECT(X="Yes":3,1:4)
- +5 SET $PIECE(APCLCUML(30),U,P)=$PIECE(APCLCUML(30),U,P)+1
- MS ;
- +1 ;APCLCUML(31)="Total^YES^NO"
- +2 SET X=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,220))
- +3 SET $PIECE(APCLCUML(31),U,2)=$PIECE(APCLCUML(31),U,2)+1
- +4 SET P=$SELECT(X="Yes":3,1:4)
- +5 SET $PIECE(APCLCUML(31),U,P)=$PIECE(APCLCUML(31),U,P)+1
- ABNG ;
- +1 ;APCLCUML(32)="Total^YES^NO"
- +2 SET X=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,230))
- +3 SET $PIECE(APCLCUML(32),U,2)=$PIECE(APCLCUML(32),U,2)+1
- +4 SET P=$SELECT(X="Yes":3,1:4)
- +5 SET $PIECE(APCLCUML(32),U,P)=$PIECE(APCLCUML(32),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("APCLP61",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^APCLP614(APCLPD,V,APCLADAT)
- SET $PIECE(APCLCUML(40),U,3)=$PIECE(APCLCUML(40),U,3)+1
- +7 IF $$OB^APCLP614(APCLPD,V,APCLADAT)
- SET $PIECE(APCLCUML(40),U,4)=$PIECE(APCLCUML(40),U,4)+1
- End DoDot: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<131&(D<81)
- 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
- TOBACCO ;
- +1 SET $PIECE(APCLCUML(80),U,2)=$PIECE(APCLCUML(80),U,2)+1
- +2 SET V=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,27))
- +3 SET V1=$GET(^XTMP("APCLP61",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^APCLP616(APCLPD,APCL6MBD,APCLRED)
- +4 IF V=1
- SET $PIECE(APCLCUML(90),U,3)=$PIECE(APCLCUML(90),U,3)+1
- +5 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
- +6 IF $LENGTH(V)>1
- IF V["2"
- SET $PIECE(APCLCUML(90),U,10)=$PIECE(APCLCUML(90),U,10)+1
- +7 IF $LENGTH(V)>1
- IF V'[2
- SET $PIECE(APCLCUML(90),U,9)=$PIECE(APCLCUML(90),U,9)+1
- ASPIRIN ;
- +1 SET $PIECE(APCLCUML(100),U,2)=$PIECE(APCLCUML(100),U,2)+1
- +2 SET V=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,62))
- +3 SET P=$SELECT($EXTRACT(V)="A":3,$EXTRACT(V)="O":4,$EXTRACT(V)="B":5,$EXTRACT(V)="N":6,1:7)
- +4 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 ;S P=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,94))
- +4 SET H=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,34))
- +5 SET A=$GET(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,60))
- +6 ;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
- +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("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,61))
- +2 SET L=$$LDL^APCLD518(APCLPD,APCLBDAT,APCLADAT,"I")
- SET L=$PIECE(L,U)
- +3 SET T=$$CHOL^APCLD518(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
- 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("APCLP61",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("APCLP61",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 ;S V=$G(^XTMP("APCLP61",APCLJOB,APCLBTH,"AUDIT",APCLPD,48))
- +10 ;I $E(V)="R" S $P(APCLCUML(130),U,9)=$P(APCLCUML(130),U,9)+1
- +11 ;I $E(V)="Y" S $P(APCLCUML(130),U,5)=$P(APCLCUML(130),U,5)+1 S G=1
- +12 IF G
- SET $PIECE(APCLCUML(130),U,6)=$PIECE(APCLCUML(130),U,6)+1
- +13 DO ^APCLP611
- +14 QUIT
- SYSMEAN(P,BDATE,EDATE) ;EP
- +1 NEW X
- SET X=$$BPS^APCLP613(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^APCLP613(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