- APCLD51C ; IHS/CMI/LAB - 2005 DIABETES AUDIT ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- 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(APCL)) 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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I '$D(APCL(1)) Q
- S D=$P(APCL(1),U),D=9999999-D
- K APCL S APCLC=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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ..Q:'APCLOT
- ..S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ..Q:'$$LOINC(J,APCLOT)
- ..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 APCLC=APCLC+1
- S V=$P(^AUPNVLAB(X,0),U,3),APCLV=$P($P($G(^AUPNVSIT(V,0)),U),".") Q:'APCLV
- S APCL(APCLC)=APCLV_"^"_$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(APCL(A)) Q:A'=+A!(G) S R=$P(^AUPNVLAB(+$P(APCL(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(APCL(X)) Q:X'=+X S A($P(APCL(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(APCL(N),U,4),0),U,4)]"",$$UP^XLFSTR($P(^AUPNVLAB(+$P(APCL(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(APCL(N),U,4),0),U,4)="" K APCL(N)
- .Q
- Q
- CREAT ;EP
- I $G(F)="" S F="E"
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","BGP CREATININE LOINC CODES",0))
- S APCLLT=$O(^ATXLAB("B","DM AUDIT CREATININE TAX",0))
- D GATHER
- I '$D(APCL(1)) Q ""
- D SETN
- I F="I" Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_"^"_$P(APCL(N),U)
- Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(N),U),5)
- CHOL ;EP
- S:$G(F)="" F="E"
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","BGP TOTAL CHOLESTEROL LOINC",0))
- S APCLLT=$O(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0))
- D GATHER
- I '$D(APCL(1)) Q ""
- D SETN
- I F="I" Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_"^"_$P(APCL(N),U)
- Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(N),U),5)
- LPROF ;
- K APCL,APCLX S APCLX=""
- S %=P_"^LAST LAB [DM AUDIT LIPID PROFILE TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
- I '$D(APCL(1)) Q
- I F="I" S APCLX=$P(^AUPNVLAB(+$P(APCL(1),U,4),0),U,4)_"^"_$P(APCL(1),U) Q
- S APCLX=$P(^AUPNVLAB(+$P(APCL(1),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(1),U,4),0),U,4)]"":" mg/dl",1:"")_$$FMTE^XLFDT($P(APCL(1),U),5)
- Q
- HDL ;EP
- I $G(F)="" S F="E"
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","BGP HDL LOINC CODES",0))
- S APCLLT=$O(^ATXLAB("B","DM AUDIT HDL TAX",0))
- D GATHER
- I '$D(APCL(1)) K APCL,APCLX S APCLX="" D LPROF Q APCLX
- D SETN
- I F="I" Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_"^"_$P(APCL(N),U)
- Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(N),U),5)
- LDL ;EP
- I $G(F)="" S F="E"
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","BGP LDL LOINC CODES",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I '$D(APCL(1)) K APCL,APCLX S APCLX="" D LPROF Q APCLX
- K APCLLDL S X=0 F S X=$O(APCL(X)) Q:X'=+X S APCLLDL(9999999-$P(APCL(X),U),X)=APCL(X)
- S X=0,G=0 F S X=$O(APCLLDL(X)) Q:X'=+X!G S Y=0 F S Y=$O(APCLLDL(X,Y)) Q:Y'=+Y!(G) I +$P(^AUPNVLAB(+$P(APCLLDL(X,Y),U,4),0),U,4) S G=Y
- I 'G S X=$O(APCLLDL(0)),G=$O(APCLLDL(X,0))
- ;NEW N D SETN
- I F="I" Q $P(^AUPNVLAB(+$P(APCL(G),U,4),0),U,4)_"^"_$P(APCL(G),U)
- Q $P(^AUPNVLAB(+$P(APCL(G),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(G),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(G),U),5)
- TRIG ;EP
- I $G(F)="" S F="E"
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","BGP TRIGLYCERIDE LOINC CODES",0))
- S APCLLT=$O(^ATXLAB("B","DM AUDIT TRIGLYCERIDE TAX",0))
- D GATHER
- I '$D(APCL(1)) K APCL,APCLX S APCLX="" D LPROF Q APCLX
- D SETN
- I F="I" Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_"^"_$P(APCL(N),U)
- Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(N),U),5)
- URIN ;EP
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- ;S %=P_"^LAST LAB [DM AUDIT URINALYSIS TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
- ;gather up all labs in the date range for hemoglobin a1c
- S APCLOT=$O(^ATXAX("B","DM AUDIT URINALYSIS LOINC",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I $D(APCL(1)) Q "Yes "_$$FMTE^XLFDT($P(APCL(1),U),5)_" Urinalysis"
- K APCL S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I $D(APCL(1)) Q "Yes "_$$FMTE^XLFDT($P(APCL(1),U),5)_" A/C Ratio"
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT URINE PROTEIN LOINC",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I $D(APCL(1)) Q "Yes "_$$FMTE^XLFDT($P(APCL(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^APCLD517(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^APCLD517(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^APCLD517(P,60,$P(^ATXLAB(T,21,X,0),U),BDATE,EDATE) S G=1
- Q $S(G:"Refused",1:"No")
- PROTEIN ;EP
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT URINE PROTEIN LOINC",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I '$D(APCL(1)) S %1="" D ACRATIO Q %1
- D SETN
- NEW %,%1 S %=$P(^AUPNVLAB(+$P(APCL(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(APCL(N),U),"5")_" "_$P(APCL(N),U,3)
- ACRATIO ;
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I '$D(APCL) S %1="" Q
- D SETN
- NEW % S %=$P(^AUPNVLAB(+$P(APCL(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(APCL(N),U),"5")_" "_$P(APCL(N),U,3)
- Q
- ACRATIOM ;
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I '$D(APCL) S %1="" Q
- D SETN
- NEW % S %=$P(^AUPNVLAB(+$P(APCL(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(APCL(N),U),"5")_" "_$P(APCL(N),U,3)
- Q
- MICRO ;EP
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT MICROALBUMIN LOINC",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- I '$D(APCL(1)) S %1="" D ACRATIOM Q %1
- D SETN
- NEW % S %=$P(^AUPNVLAB(+$P(APCL(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(APCL(N),U),"5")_" "_$P(APCL(N),U,3)
- HGBA1C ;EP
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","BGP HGBA1C LOINC CODES",0))
- S APCLLT=$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 APCLLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCLLT,21,"B",$P(^AUPNVLAB(X,0),U))) D SETV Q
- ...Q:'APCLOT
- ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
- ...Q:'$$LOINC(J,APCLOT)
- ...D SETV
- ...Q
- D SET3
- K X S (%,C,R)="" F S %=$O(APCL(%)) Q:%'=+%!(C>1) S X(9999999-$P(APCL(%),U),1)=$P(^AUPNVLAB(+$P(APCL(%),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 APCL,X,%,E,R,V,C
- K APCL
- S %=P_"^LAST 200 LAB [DM AUDIT GLUCOSE TESTS TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
- I '$D(APCL(1)) Q ""
- D SET3
- S (%,C,R)="" F S %=$O(APCL(%)) Q:%=""!(C>2) S R=R_$P(^AUPNVLAB(+$P(APCL(%),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(%),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(%),U))_"^",C=C+1
- Q R
- ;
- FGLUCOSE ;EP
- I $G(F)="" S F="E"
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT FASTING GLUC LOINC",0))
- S APCLLT=$O(^ATXLAB("B","DM AUDIT FASTING GLUCOSE TESTS",0))
- D GATHER
- I '$D(APCL(1)) Q ""
- D SETN
- I F="I" Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_"^"_$P(APCL(N),U)
- Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(N),U),5)
- G75 ;EP
- I $G(F)="" S F="E"
- NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- K APCL
- S APCLC=0
- S APCLOT=$O(^ATXAX("B","DM AUDIT 75GM 2HR LOINC",0))
- S APCLLT=$O(^ATXLAB("B","DM AUDIT 75GM 2HR GLUCOSE",0))
- D GATHER
- I '$D(APCL(1)) Q ""
- D SETN
- I F="I" Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_"^"_$P(APCL(N),U)
- Q $P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)_$S($P(^AUPNVLAB(+$P(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($P(APCL(N),U),5)
- APCLD51C ; IHS/CMI/LAB - 2005 DIABETES AUDIT ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +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(APCL))
- 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 APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +6 IF 'APCLOT
- QUIT
- +7 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +8 IF '$$LOINC(J,APCLOT)
- QUIT
- +9 DO SETV
- +10 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 IF '$DATA(APCL(1))
- QUIT
- +12 SET D=$PIECE(APCL(1),U)
- SET D=9999999-D
- +13 KILL APCL
- SET APCLC=0
- +14 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:1
- +15 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +16 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +17 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +18 IF 'APCLOT
- QUIT
- +19 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +20 IF '$$LOINC(J,APCLOT)
- QUIT
- +21 DO SETV
- +22 QUIT
- End DoDot:2
- End DoDot:1
- +23 QUIT
- LOINC(A,B) ;EP - is loinc code A in taxonomy B
- +1 NEW %
- +2 SET %=$PIECE($GET(^LAB(95.3,A,9999999)),U,2)
- +3 IF %]""
- IF $DATA(^ATXAX(B,21,"B",%))
- QUIT 1
- +4 SET %=$PIECE($GET(^LAB(95.3,A,0)),U)_"-"_$PIECE($GET(^LAB(95.3,A,0)),U,15)
- +5 IF $DATA(^ATXAX(B,21,"B",%))
- QUIT 1
- +6 QUIT ""
- SETV ;
- +1 SET APCLC=APCLC+1
- +2 SET V=$PIECE(^AUPNVLAB(X,0),U,3)
- SET APCLV=$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
- IF 'APCLV
- QUIT
- +3 SET APCL(APCLC)=APCLV_"^"_$SELECT($PIECE(^AUPNVLAB(X,0),U,4)]"":$PIECE(^AUPNVLAB(X,0),U,4),1:"?")_"^"_$$VAL^XBDIQ1(9000010.09,X,.01)_"^"_X_";AUPNVLAB^"_V
- +4 QUIT
- SETN ;
- +1 SET N=""
- NEW A,G
- SET (A,G)=0
- FOR
- SET A=$ORDER(APCL(A))
- IF A'=+A!(G)
- QUIT
- SET R=$PIECE(^AUPNVLAB(+$PIECE(APCL(A),U,4),0),U,4)
- IF R]""
- IF $$UP^XLFSTR(R)'="COMMENT"
- SET G=A
- +2 SET N=$SELECT(G:G,1:1)
- +3 QUIT
- SET3 ;
- +1 NEW X,N1,N2,N3,A,T
- +2 KILL A
- +3 SET X=0
- FOR
- SET X=$ORDER(APCL(X))
- IF X'=+X
- QUIT
- SET A($PIECE(APCL(X),U),X)=""
- +4 NEW D
- SET D=0
- FOR
- SET D=$ORDER(A(D))
- IF D'=+D
- QUIT
- Begin DoDot:1
- +5 SET G=0
- SET N=0
- FOR
- SET N=$ORDER(A(D,N))
- IF N'=+N
- QUIT
- Begin DoDot:2
- +6 IF $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)]""
- IF $$UP^XLFSTR($PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4))'="COMMENT"
- SET G=1
- QUIT
- End DoDot:2
- +7 IF G
- SET N=0
- FOR
- SET N=$ORDER(A(D,N))
- IF N'=+N
- QUIT
- IF $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)=""
- KILL APCL(N)
- +8 QUIT
- End DoDot:1
- +9 QUIT
- CREAT ;EP
- +1 IF $GET(F)=""
- SET F="E"
- +2 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +3 KILL APCL
- +4 SET APCLC=0
- +5 SET APCLOT=$ORDER(^ATXAX("B","BGP CREATININE LOINC CODES",0))
- +6 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT CREATININE TAX",0))
- +7 DO GATHER
- +8 IF '$DATA(APCL(1))
- QUIT ""
- +9 DO SETN
- +10 IF F="I"
- QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_"^"_$PIECE(APCL(N),U)
- +11 QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(N),U),5)
- CHOL ;EP
- +1 IF $GET(F)=""
- SET F="E"
- +2 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +3 KILL APCL
- +4 SET APCLC=0
- +5 SET APCLOT=$ORDER(^ATXAX("B","BGP TOTAL CHOLESTEROL LOINC",0))
- +6 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0))
- +7 DO GATHER
- +8 IF '$DATA(APCL(1))
- QUIT ""
- +9 DO SETN
- +10 IF F="I"
- QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_"^"_$PIECE(APCL(N),U)
- +11 QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(N),U),5)
- LPROF ;
- +1 KILL APCL,APCLX
- SET APCLX=""
- +2 SET %=P_"^LAST LAB [DM AUDIT LIPID PROFILE TAX;DURING "_BDATE_"-"_EDATE
- SET E=$$START1^APCLDF(%,"APCL(")
- +3 IF '$DATA(APCL(1))
- QUIT
- +4 IF F="I"
- SET APCLX=$PIECE(^AUPNVLAB(+$PIECE(APCL(1),U,4),0),U,4)_"^"_$PIECE(APCL(1),U)
- QUIT
- +5 SET APCLX=$PIECE(^AUPNVLAB(+$PIECE(APCL(1),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(1),U,4),0),U,4)]"":" mg/dl",1:"")_$$FMTE^XLFDT($PIECE(APCL(1),U),5)
- +6 QUIT
- HDL ;EP
- +1 IF $GET(F)=""
- SET F="E"
- +2 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +3 KILL APCL
- +4 SET APCLC=0
- +5 SET APCLOT=$ORDER(^ATXAX("B","BGP HDL LOINC CODES",0))
- +6 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT HDL TAX",0))
- +7 DO GATHER
- +8 IF '$DATA(APCL(1))
- KILL APCL,APCLX
- SET APCLX=""
- DO LPROF
- QUIT APCLX
- +9 DO SETN
- +10 IF F="I"
- QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_"^"_$PIECE(APCL(N),U)
- +11 QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(N),U),5)
- LDL ;EP
- +1 IF $GET(F)=""
- SET F="E"
- +2 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +3 KILL APCL
- +4 SET APCLC=0
- +5 SET APCLOT=$ORDER(^ATXAX("B","BGP LDL LOINC CODES",0))
- +6 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
- +7 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)
- QUIT
- Begin DoDot:1
- +8 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:2
- +9 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +10 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +11 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +12 IF 'APCLOT
- QUIT
- +13 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +14 IF '$$LOINC(J,APCLOT)
- QUIT
- +15 DO SETV
- +16 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 IF '$DATA(APCL(1))
- KILL APCL,APCLX
- SET APCLX=""
- DO LPROF
- QUIT APCLX
- +18 KILL APCLLDL
- SET X=0
- FOR
- SET X=$ORDER(APCL(X))
- IF X'=+X
- QUIT
- SET APCLLDL(9999999-$PIECE(APCL(X),U),X)=APCL(X)
- +19 SET X=0
- SET G=0
- FOR
- SET X=$ORDER(APCLLDL(X))
- IF X'=+X!G
- QUIT
- SET Y=0
- FOR
- SET Y=$ORDER(APCLLDL(X,Y))
- IF Y'=+Y!(G)
- QUIT
- IF +$PIECE(^AUPNVLAB(+$PIECE(APCLLDL(X,Y),U,4),0),U,4)
- SET G=Y
- +20 IF 'G
- SET X=$ORDER(APCLLDL(0))
- SET G=$ORDER(APCLLDL(X,0))
- +21 ;NEW N D SETN
- +22 IF F="I"
- QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(G),U,4),0),U,4)_"^"_$PIECE(APCL(G),U)
- +23 QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(G),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(G),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(G),U),5)
- TRIG ;EP
- +1 IF $GET(F)=""
- SET F="E"
- +2 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +3 KILL APCL
- +4 SET APCLC=0
- +5 SET APCLOT=$ORDER(^ATXAX("B","BGP TRIGLYCERIDE LOINC CODES",0))
- +6 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT TRIGLYCERIDE TAX",0))
- +7 DO GATHER
- +8 IF '$DATA(APCL(1))
- KILL APCL,APCLX
- SET APCLX=""
- DO LPROF
- QUIT APCLX
- +9 DO SETN
- +10 IF F="I"
- QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_"^"_$PIECE(APCL(N),U)
- +11 QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(N),U),5)
- URIN ;EP
- +1 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +2 KILL APCL
- +3 SET APCLC=0
- +4 ;S %=P_"^LAST LAB [DM AUDIT URINALYSIS TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
- +5 ;gather up all labs in the date range for hemoglobin a1c
- +6 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT URINALYSIS LOINC",0))
- +7 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))
- +8 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)
- QUIT
- Begin DoDot:1
- +9 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:2
- +10 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +11 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +12 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +13 IF 'APCLOT
- QUIT
- +14 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +15 IF '$$LOINC(J,APCLOT)
- QUIT
- +16 DO SETV
- +17 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 IF $DATA(APCL(1))
- QUIT "Yes "_$$FMTE^XLFDT($PIECE(APCL(1),U),5)_" Urinalysis"
- +19 KILL APCL
- SET APCLC=0
- +20 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
- +21 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
- +22 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)
- QUIT
- Begin DoDot:1
- +23 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:2
- +24 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +25 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +26 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +27 IF 'APCLOT
- QUIT
- +28 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +29 IF '$$LOINC(J,APCLOT)
- QUIT
- +30 DO SETV
- +31 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 IF $DATA(APCL(1))
- QUIT "Yes "_$$FMTE^XLFDT($PIECE(APCL(1),U),5)_" A/C Ratio"
- +33 KILL APCL
- +34 SET APCLC=0
- +35 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT URINE PROTEIN LOINC",0))
- +36 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
- +37 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)
- QUIT
- Begin DoDot:1
- +38 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:2
- +39 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +40 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +41 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +42 IF 'APCLOT
- QUIT
- +43 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +44 IF '$$LOINC(J,APCLOT)
- QUIT
- +45 DO SETV
- +46 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +47 IF $DATA(APCL(1))
- QUIT "Yes "_$$FMTE^XLFDT($PIECE(APCL(1),U),5)_" Urine Prot"
- +48 NEW G
- SET G=0
- +49 NEW T
- SET T=$ORDER(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))
- +50 SET X=0
- FOR
- SET X=$ORDER(^ATXLAB(T,21,X))
- IF X'=+X!(G)
- QUIT
- IF $$REFUSAL^APCLD517(P,60,$PIECE(^ATXLAB(T,21,X,0),U),BDATE,EDATE)
- SET G=1
- +51 IF G
- QUIT "Refused"
- +52 SET G=0
- +53 NEW T
- SET T=$ORDER(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
- +54 SET X=0
- FOR
- SET X=$ORDER(^ATXLAB(T,21,X))
- IF X'=+X!(G)
- QUIT
- IF $$REFUSAL^APCLD517(P,60,$PIECE(^ATXLAB(T,21,X,0),U),BDATE,EDATE)
- SET G=1
- +55 IF G
- QUIT "Refused"
- +56 SET G=0
- +57 NEW T
- SET T=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
- +58 SET X=0
- FOR
- SET X=$ORDER(^ATXLAB(T,21,X))
- IF X'=+X!(G)
- QUIT
- IF $$REFUSAL^APCLD517(P,60,$PIECE(^ATXLAB(T,21,X,0),U),BDATE,EDATE)
- SET G=1
- +59 QUIT $SELECT(G:"Refused",1:"No")
- PROTEIN ;EP
- +1 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +2 KILL APCL
- +3 SET APCLC=0
- +4 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT URINE PROTEIN LOINC",0))
- +5 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
- +6 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)
- QUIT
- Begin DoDot:1
- +7 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:2
- +8 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +9 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +10 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +11 IF 'APCLOT
- QUIT
- +12 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +13 IF '$$LOINC(J,APCLOT)
- QUIT
- +14 DO SETV
- +15 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 IF '$DATA(APCL(1))
- SET %1=""
- DO ACRATIO
- QUIT %1
- +17 DO SETN
- +18 NEW %,%1
- SET %=$PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)
- +19 SET %1=$SELECT(%="":"No result",%["+":"Yes ",%[">":"Yes ",$EXTRACT(%)="P":"Yes ",...
- ... $EXTRACT(%)="p":"Yes ",$$UP^XLFSTR($EXTRACT(%))="S":"Yes ",$$UP^XLFSTR($EXTRACT(%))="M":"Yes ",$$UP^XLFSTR($EXTRACT(%))="L":"Yes ",$EXTRACT(%)="c":"No result ",$EXTRACT(%)="C":"No result ",+%>29:"Yes ",1:"No ")
- +20 QUIT %1_%_" "_$$FMTE^XLFDT($PIECE(APCL(N),U),"5")_" "_$PIECE(APCL(N),U,3)
- ACRATIO ;
- +1 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +2 KILL APCL
- SET APCLC=0
- +3 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
- +4 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
- +5 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)
- QUIT
- Begin DoDot:1
- +6 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:2
- +7 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +8 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +9 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +10 IF 'APCLOT
- QUIT
- +11 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +12 IF '$$LOINC(J,APCLOT)
- QUIT
- +13 DO SETV
- +14 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 IF '$DATA(APCL)
- SET %1=""
- QUIT
- +16 DO SETN
- +17 NEW %
- SET %=$PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)
- +18 SET %1=$SELECT(%="":"No result",%[">":"Yes ",$EXTRACT(%)="c":"No result ",$EXTRACT(%)="C":"No result ",+%>299:"Yes ",1:"No ")
- +19 SET %1=%1_" "_%_" "_$$FMTE^XLFDT($PIECE(APCL(N),U),"5")_" "_$PIECE(APCL(N),U,3)
- +20 QUIT
- ACRATIOM ;
- +1 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +2 KILL APCL
- SET APCLC=0
- +3 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT A/C RATIO LOINC",0))
- +4 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
- +5 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)
- QUIT
- Begin DoDot:1
- +6 SET L=0
- FOR
- SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
- IF L'=+L
- QUIT
- Begin DoDot:2
- +7 SET X=0
- FOR
- SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +8 IF '$DATA(^AUPNVLAB(X,0))
- QUIT
- +9 IF APCLLT
- IF $PIECE(^AUPNVLAB(X,0),U)
- IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
- DO SETV
- QUIT
- +10 IF 'APCLOT
- QUIT
- +11 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
- IF J=""
- QUIT
- +12 IF '$$LOINC(J,APCLOT)
- QUIT
- +13 DO SETV
- +14 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 IF '$DATA(APCL)
- SET %1=""
- QUIT
- +16 DO SETN
- +17 NEW %
- SET %=$PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)
- +18 SET %1=$SELECT(%="":"No result",%="30-300":"Pos ",$EXTRACT(%)="c":"No result ",$EXTRACT(%)="C":"No result ",+%>29&(+%<300):"Pos ",1:"No ")
- +19 SET %1=%1_" "_%_" "_$$FMTE^XLFDT($PIECE(APCL(N),U),"5")_" "_$PIECE(APCL(N),U,3)
- +20 QUIT
- MICRO ;EP
- +1 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
- +2 KILL APCL
- SET APCLC=0
- +3 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT MICROALBUMIN LOINC",0))
- +4 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT MICROALBUMINURIA TAX",0))
+5 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)
QUIT
Begin DoDot:1
+6 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L
QUIT
Begin DoDot:2
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X
QUIT
Begin DoDot:3
+8 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+9 IF APCLLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
DO SETV
QUIT
+10 IF 'APCLOT
QUIT
+11 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+12 IF '$$LOINC(J,APCLOT)
QUIT
+13 DO SETV
+14 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF '$DATA(APCL(1))
SET %1=""
DO ACRATIOM
QUIT %1
+16 DO SETN
+17 NEW %
SET %=$PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)
+18 SET %1=$SELECT(%="":"No result",%["+":"Pos ",%[">":"Pos ",$EXTRACT(%)="P":"Pos ",$EXTRACT(%)="p":"Pos ",$EXTRACT(%)="c":"No result ",$EXTRACT(%)="C":"No result ",+%>29:"Pos ",1:"Neg ")
+19 QUIT %1_%_" "_$$FMTE^XLFDT($PIECE(APCL(N),U),"5")_" "_$PIECE(APCL(N),U,3)
HGBA1C ;EP
+1 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
+2 KILL APCL
+3 SET APCLC=0
+4 SET APCLOT=$ORDER(^ATXAX("B","BGP HGBA1C LOINC CODES",0))
+5 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))
+6 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)
QUIT
Begin DoDot:1
+7 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L
QUIT
Begin DoDot:2
+8 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X
QUIT
Begin DoDot:3
+9 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+10 IF APCLLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(APCLLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
DO SETV
QUIT
+11 IF 'APCLOT
QUIT
+12 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+13 IF '$$LOINC(J,APCLOT)
QUIT
+14 DO SETV
+15 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+16 DO SET3
+17 KILL X
SET (%,C,R)=""
FOR
SET %=$ORDER(APCL(%))
IF %'=+%!(C>1)
QUIT
SET X(9999999-$PIECE(APCL(%),U),1)=$PIECE(^AUPNVLAB(+$PIECE(APCL(%),U,4),0),U,4)
+18 SET %=0
SET R=""
FOR
SET %=$ORDER(X(%))
IF %=""
QUIT
SET V=0
FOR
SET V=$ORDER(X(%,V))
IF V=""
QUIT
SET R=R_X(%,V)_"^"_$$FMTE^XLFDT(9999999-%)_"^"_(9999999-%)_"^"
+19 QUIT R
BS ;EP
+1 NEW APCL,X,%,E,R,V,C
+2 KILL APCL
+3 SET %=P_"^LAST 200 LAB [DM AUDIT GLUCOSE TESTS TAX;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"APCL(")
+4 IF '$DATA(APCL(1))
QUIT ""
+5 DO SET3
+6 SET (%,C,R)=""
FOR
SET %=$ORDER(APCL(%))
IF %=""!(C>2)
QUIT
SET R=R_$PIECE(^AUPNVLAB(+$PIECE(APCL(%),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(%),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(%),U))_"^"
SET C=C+1
+7 QUIT R
+8 ;
FGLUCOSE ;EP
+1 IF $GET(F)=""
SET F="E"
+2 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
+3 KILL APCL
+4 SET APCLC=0
+5 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT FASTING GLUC LOINC",0))
+6 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT FASTING GLUCOSE TESTS",0))
+7 DO GATHER
+8 IF '$DATA(APCL(1))
QUIT ""
+9 DO SETN
+10 IF F="I"
QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_"^"_$PIECE(APCL(N),U)
+11 QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(N),U),5)
G75 ;EP
+1 IF $GET(F)=""
SET F="E"
+2 NEW APCL,X,%,E,R,V,APCLLT,APCLOT,B,D,L,J,APCLC,APCLV,V
+3 KILL APCL
+4 SET APCLC=0
+5 SET APCLOT=$ORDER(^ATXAX("B","DM AUDIT 75GM 2HR LOINC",0))
+6 SET APCLLT=$ORDER(^ATXLAB("B","DM AUDIT 75GM 2HR GLUCOSE",0))
+7 DO GATHER
+8 IF '$DATA(APCL(1))
QUIT ""
+9 DO SETN
+10 IF F="I"
QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_"^"_$PIECE(APCL(N),U)
+11 QUIT $PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)_$SELECT($PIECE(^AUPNVLAB(+$PIECE(APCL(N),U,4),0),U,4)]"":" mg/dl ",1:"")_$$FMTE^XLFDT($PIECE(APCL(N),U),5)