BDMD51C.m

BDMD51C ; IHS/CMI/LAB - 2005 DIABETES AUDIT ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 ;

GATHER ;

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!($D(BDM))  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I '$D(BDM(1)) Q

 S D=$P(BDM(1),U),D=9999999-D

 K BDM S BDMC=0

 S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 .S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ..Q:'$D(^AUPNVLAB(X,0))

 ..I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ..Q:'BDMOT

 ..S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ..Q:'$$LOINC(J,BDMOT)

 ..D SETV

 ..Q

 Q

LOINC(A,B) ;EP - is loinc code A in taxonomy B

 NEW %

 S %=$P($G(^LAB(95.3,A,9999999)),U,2)

 I %]"",$D(^ATXAX(B,21,"B",%)) Q 1

 S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)

 I $D(^ATXAX(B,21,"B",%)) Q 1

 Q ""

SETV ;

 S BDMC=BDMC+1

 S V=$P(^AUPNVLAB(X,0),U,3),BDMV=$P($P($G(^AUPNVSIT(V,0)),U),".") Q:'BDMV

 S BDM(BDMC)=BDMV_"^"_$S($P(^AUPNVLAB(X,0),U,4)]"":$P(^AUPNVLAB(X,0),U,4),1:"?")_"^"_$$VAL^XBDIQ1(9000010.09,X,.01)_"^"_X_";AUPNVLAB^"_V

 Q

SETN ;

 S N="" NEW A,G S (A,G)=0 F  S A=$O(BDM(A)) Q:A'=+A!(G)  S R=$P(^AUPNVLAB(+$P(BDM(A),U,4),0),U,4) I R]"",$$UP^XLFSTR(R)'="COMMENT" S G=A

 S N=$S(G:G,1:1)

 Q

SET3 ;

 NEW X,N1,N2,N3,A,T

 K A

 S X=0 F  S X=$O(BDM(X)) Q:X'=+X  S A($P(BDM(X),U),X)=""

 NEW D S D=0 F  S D=$O(A(D)) Q:D'=+D  D

 .S G=0,N=0 F  S N=$O(A(D,N)) Q:N'=+N  D

 ..I $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"",$$UP^XLFSTR($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4))'="COMMENT" S G=1 Q

 .I G S N=0 F  S N=$O(A(D,N)) Q:N'=+N  I $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)="" K BDM(N)

 .Q

 Q

CREAT ;EP

 I $G(F)="" S F="E"

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","BGP CREATININE LOINC CODES",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT CREATININE TAX",0))

 D GATHER

 I '$D(BDM(1)) Q ""

 D SETN

 I F="I" Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_"^"_$P(BDM(N),U)

 Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(N),U),5)

CHOL ;EP

 S:$G(F)="" F="E"

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","BGP TOTAL CHOLESTEROL LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0))

 D GATHER

 I '$D(BDM(1)) Q ""

 D SETN

 I F="I" Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_"^"_$P(BDM(N),U)

 Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(N),U),5)

LPROF ;

 K BDM,BDMX S BDMX=""

 S %=P_"^LAST LAB [DM AUDIT LIPID PROFILE TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")

 I '$D(BDM(1)) Q

 I F="I" S BDMX=$P(^AUPNVLAB(+$P(BDM(1),U,4),0),U,4)_"^"_$P(BDM(1),U) Q

 S BDMX=$P(^AUPNVLAB(+$P(BDM(1),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(1),U,4),0),U,4)]"":" mg/dl",1:"")_$$FMTE^XLFDT($P(BDM(1),U),5)

 Q

HDL ;EP

 I $G(F)="" S F="E"

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","BGP HDL LOINC CODES",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT HDL TAX",0))

 D GATHER

 I '$D(BDM(1)) K BDM,BDMX S BDMX="" D LPROF Q BDMX

 D SETN

 I F="I" Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_"^"_$P(BDM(N),U)

 Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(N),U),5)

LDL ;EP

 I $G(F)="" S F="E"

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","BGP LDL LOINC CODES",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I '$D(BDM(1)) K BDM,BDMX S BDMX="" D LPROF Q BDMX

 K BDMLDL S X=0 F  S X=$O(BDM(X)) Q:X'=+X  S BDMLDL(9999999-$P(BDM(X),U),X)=BDM(X)

 S X=0,G=0 F  S X=$O(BDMLDL(X)) Q:X'=+X!G  S Y=0 F  S Y=$O(BDMLDL(X,Y)) Q:Y'=+Y!(G)  I +$P(^AUPNVLAB(+$P(BDMLDL(X,Y),U,4),0),U,4) S G=Y

 I 'G S X=$O(BDMLDL(0)),G=$O(BDMLDL(X,0))

 ;NEW N D SETN

 I F="I" Q $P(^AUPNVLAB(+$P(BDM(G),U,4),0),U,4)_"^"_$P(BDM(G),U)

 Q $P(^AUPNVLAB(+$P(BDM(G),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(G),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(G),U),5)

TRIG ;EP

 I $G(F)="" S F="E"

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","BGP TRIGLYCERIDE LOINC CODES",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT TRIGLYCERIDE TAX",0))

 D GATHER

 I '$D(BDM(1)) K BDM,BDMX S BDMX="" D LPROF Q BDMX

 D SETN

 I F="I" Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_"^"_$P(BDM(N),U)

 Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(N),U),5)

URIN ;EP

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 ;S %=P_"^LAST LAB [DM AUDIT URINALYSIS TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")

 ;gather up all labs in the date range for hemoglobin a1c

 S BDMOT=$O(^ATXAX("B","DM AUDIT URINALYSIS LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I $D(BDM(1)) Q "Yes  "_$$FMTE^XLFDT($P(BDM(1),U),5)_" Urinalysis"

 K BDM S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I $D(BDM(1)) Q "Yes  "_$$FMTE^XLFDT($P(BDM(1),U),5)_" A/C Ratio"

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT URINE PROTEIN LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I $D(BDM(1)) Q "Yes  "_$$FMTE^XLFDT($P(BDM(1),U),5)_" Urine Prot"

 NEW G S G=0

 NEW T S T=$O(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))

 S X=0 F  S X=$O(^ATXLAB(T,21,X)) Q:X'=+X!(G)  I $$REFUSAL^BDMD517(P,60,$P(^ATXLAB(T,21,X,0),U),BDATE,EDATE) S G=1

 I G Q "Refused"

 S G=0

 NEW T S T=$O(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))

 S X=0 F  S X=$O(^ATXLAB(T,21,X)) Q:X'=+X!(G)  I $$REFUSAL^BDMD517(P,60,$P(^ATXLAB(T,21,X,0),U),BDATE,EDATE) S G=1

 I G Q "Refused"

 S G=0

 NEW T S T=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))

 S X=0 F  S X=$O(^ATXLAB(T,21,X)) Q:X'=+X!(G)  I $$REFUSAL^BDMD517(P,60,$P(^ATXLAB(T,21,X,0),U),BDATE,EDATE) S G=1

 Q $S(G:"Refused",1:"No")

PROTEIN ;EP

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT URINE PROTEIN LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I '$D(BDM(1)) S %1="" D ACRATIO Q %1

 D SETN

 NEW %,%1 S %=$P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)

 S %1=$S(%="":"No result",%["+":"Yes ",%[">":"Yes ",$E(%)="P":"Yes ",$E(%)="p":"Yes ",$$UP^XLFSTR($E(%))="S":"Yes ",$$UP^XLFSTR($E(%))="M":"Yes ",$$UP^XLFSTR($E(%))="L":"Yes ",$E(%)="c":"No result ",$E(%)="C":"No result ",+%>29:"Yes ",1:"No ")

 Q %1_%_" "_$$FMTE^XLFDT($P(BDM(N),U),"5")_" "_$P(BDM(N),U,3)

ACRATIO ;

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I '$D(BDM) S %1="" Q

 D SETN

 NEW % S %=$P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)

 S %1=$S(%="":"No result",%[">":"Yes ",$E(%)="c":"No result ",$E(%)="C":"No result ",+%>299:"Yes ",1:"No ")

 S %1=%1_" "_%_" "_$$FMTE^XLFDT($P(BDM(N),U),"5")_" "_$P(BDM(N),U,3)

 Q

ACRATIOM ;

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I '$D(BDM) S %1="" Q

 D SETN

 NEW % S %=$P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)

 S %1=$S(%="":"No result",%="30-300":"Pos ",$E(%)="c":"No result ",$E(%)="C":"No result ",+%>29&(+%<300):"Pos ",1:"No ")

 S %1=%1_" "_%_" "_$$FMTE^XLFDT($P(BDM(N),U),"5")_" "_$P(BDM(N),U,3)

 Q

MICRO ;EP

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT MICROALBUMIN LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT MICROALBUMINURIA TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 I '$D(BDM(1)) S %1="" D ACRATIOM Q %1

 D SETN

 NEW % S %=$P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)

 S %1=$S(%="":"No result",%["+":"Pos ",%[">":"Pos ",$E(%)="P":"Pos ",$E(%)="p":"Pos ",$E(%)="c":"No result ",$E(%)="C":"No result ",+%>29:"Pos ",1:"Neg ")

 Q %1_%_" "_$$FMTE^XLFDT($P(BDM(N),U),"5")_" "_$P(BDM(N),U,3)

HGBA1C ;EP

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","BGP HGBA1C LOINC CODES",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q

 ...Q:'BDMOT

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,BDMOT)

 ...D SETV

 ...Q

 D SET3

 K X S (%,C,R)="" F  S %=$O(BDM(%)) Q:%'=+%!(C>1)  S X(9999999-$P(BDM(%),U),1)=$P(^AUPNVLAB(+$P(BDM(%),U,4),0),U,4)

 S %=0,R="" F  S %=$O(X(%)) Q:%=""  S V=0 F  S V=$O(X(%,V)) Q:V=""  S R=R_X(%,V)_"^"_$$FMTE^XLFDT(9999999-%)_"^"_(9999999-%)_"^"

 Q R

BS ;EP

 NEW BDM,X,%,E,R,V,C

 K BDM

 S %=P_"^LAST 200 LAB [DM AUDIT GLUCOSE TESTS TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")

 I '$D(BDM(1)) Q ""

 D SET3

 S (%,C,R)="" F  S %=$O(BDM(%)) Q:%=""!(C>2)  S R=R_$P(^AUPNVLAB(+$P(BDM(%),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(%),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(%),U))_"^",C=C+1

 Q R

 ;

FGLUCOSE ;EP

 I $G(F)="" S F="E"

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT FASTING GLUC LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT FASTING GLUCOSE TESTS",0))

 D GATHER

 I '$D(BDM(1)) Q ""

 D SETN

 I F="I" Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_"^"_$P(BDM(N),U)

 Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(N),U),5)

G75 ;EP

 I $G(F)="" S F="E"

 NEW BDM,X,%,E,R,V,BDMLT,BDMOT,B,D,L,J,BDMC,BDMV,V

 K BDM

 S BDMC=0

 S BDMOT=$O(^ATXAX("B","DM AUDIT 75GM 2HR LOINC",0))

 S BDMLT=$O(^ATXLAB("B","DM AUDIT 75GM 2HR GLUCOSE",0))

 D GATHER

 I '$D(BDM(1)) Q ""

 D SETN

 I F="I" Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_"^"_$P(BDM(N),U)

 Q $P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(BDM(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(BDM(N),U),5)

BDMD51C   ; IHS/CMI/LAB - 2005 DIABETES AUDIT ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 +2       ;

GATHER    ;

 +1        SET B=9999999-BDATE

           SET E=9999999-EDATE

           SET D=E-1

           FOR 

               SET D=$ORDER(^AUPNVLAB("AE",P,D))

               IF D'=+D!(D>B)!($DATA(BDM))

                   QUIT 

               Begin DoDot:1

 +2                SET L=0

                   FOR 

                       SET L=$ORDER(^AUPNVLAB("AE",P,D,L))

                       IF L'=+L

                           QUIT 

                       Begin DoDot:2

 +3                        SET X=0

                           FOR 

                               SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))

                               IF X'=+X

                                   QUIT 

                               Begin DoDot:3

 +4                                IF '$DATA(^AUPNVLAB(X,0))

                                       QUIT 

 +5                                IF BDMLT

                                       IF $PIECE(^AUPNVLAB(X,0),U)

                                           IF $DATA(^ATXLAB(BDMLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))

                                               DO SETV

                                               QUIT