BGP8DHE2 ; IHS/CMI/LAB - measure HEDIS ;
;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
;
MEDNEPH(P,BDATE,EDATE) ;EP
K BGPC,BGPX,BGP1
S BGPC=""
S %="",E=+$$CODEN^ICPTCOD(82043),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-CPT^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(82044),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-CPT^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(82042),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-CPT^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(84156),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-CPT^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("3060F"),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-CPT^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("3061F"),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-CPT^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("3062F"),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^URINE PROTEIN-CPT^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("4009F"),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^ACEI MED-CPT^^"_$P(%,U,2)
;TRAN
S %="",E=+$$CODEN^ICPTCOD(82043),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-TRAN^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(82044),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-TRAN^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(82042),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-TRAN^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(84156),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-TRAN^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("3060F"),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-TRAN^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("3061F"),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^MICROALB-TRAN^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("3062F"),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^URINE PROTEIN-TRAN^^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD("4009F"),%=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
I %]"" S BGPX(9999999-$P(%,U,2))="1^ACEI MED-TRAN^^"_$P(%,U,2)
;now get all loinc/taxonomy tests
S T=$O(^ATXAX("B","BGP HEDIS NEPHROPTHY SCR LOINC",0))
S BGPLT=$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)!(BGPC]"") D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"") D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"") D
...Q:'$D(^AUPNVLAB(X,0))
...Q:$P(^AUPNVLAB(X,0),U,4)=""
...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) S (BGPC,BGPX(D))="1^MICROALB^^"_(9999999-D) Q
...Q:'T
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,T)
...S (BGPC,BGPX(D))="1^MICROALB^^"_(9999999-D) Q
...Q
I $D(BGPX) S X=$O(BGPX(0)) Q BGPX(X) ;quit on the latest one found, if one found
;
S T=$O(^ATXAX("B","BGP HEDIS NEPHROPTHY SCR LOINC",0))
S BGPLT=$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)!(BGPC]"") D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"") D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"") D
...Q:'$D(^AUPNVLAB(X,0))
...Q:$P(^AUPNVLAB(X,0),U,4)="" ;MUST HAVE A RESULT
...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) S (BGPC,BGPX(D))="1^A/C RATIO^^"_(9999999-D) Q
...Q:'T
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,T)
...S (BGPC,BGPX(D))="1^A/C RATIO^^"_(9999999-D) Q
...Q
I $D(BGPX) S X=$O(BGPX(0)) Q BGPX(X) ;quit on the latest one found, if one found
;
K BGPG S %=P_"^LAST LAB [DM AUDIT URINE PROTEIN TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
S (%,R)="" I $D(BGPG(1)) D Q R_"^"_"U"_"^"_%_"^"_$P(BGPG(1),U)
.S %=$P(^AUPNVLAB(+$P(BGPG(1),U,4),0),U,4)
.S R=$S(%="":"",%["+":1,%[">":1,$E(%)="P":1,$E(%)="p":1,$E(%)="L":1,$E(%)="l":1,$E(%)="M":1,$E(%)="m":1,$E(%)="S":1,$E(%)="s":1,$E(%)="c":"",$E(%)="C":"",+%>29:1,1:"")
S T=$O(^ATXAX("B","BGP URINE PROTEIN LOINC CODES",0))
S BGPC="",B=9999999-BDATE,E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BGPC]"") D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"") D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"") D
...Q:'T
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,T)
...S %=$P(^AUPNVLAB(X,0),U,4)
...;S R=$S(%="":"",%["+":1,%[">":1,$E(%)="P":1,$E(%)="p":1,$E(%)="c":"",$E(%)="C":"",+%>29:1,1:"")
...S R=$S(%="":"",%["+":1,%[">":1,$E(%)="P":1,$E(%)="p":1,$E(%)="L":1,$E(%)="l":1,$E(%)="M":1,$E(%)="m":1,$E(%)="S":1,$E(%)="s":1,$E(%)="c":"",$E(%)="C":"",+%>29:1,1:"")
...S BGPC=R_"^U^"_%_"^"_(9999999-D)
I BGPC]"" Q BGPC
;NEPHEVID
K BGPG
S Y="BGPG("
S X=P_"^LAST DX [BGP NEPHROPATHY DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1_U_$P(BGPG(1),U,2)_"^^"_$P(BGPG(1),U,1) ;has a dx
K BGPG
S T=$O(^ATXAX("B","BGP NEPHROPATHY PROCEDURES",0))
S (F,S)=0 F S F=$O(^AUPNVPRC("AC",P,F)) Q:F'=+F!(S) S C=$P(^AUPNVPRC(F,0),U) D
.S G=0 S:$$ICD^ATXCHK(C,T,0) G=1
.Q:G=0
.S D=$P(^AUPNVPRC(F,0),U,6) I D="" S D=$P($P(^AUPNVSIT($P(^AUPNVPRC(F,0),U,3),0),U),".")
.I D>EDATE Q
.I D<BDATE Q
.S S=1
I S=1 Q 1_U_$P($$ICDOP^ICDCODE(C),U,2)_"^^"_D ;has a PROCEDURE
S T=$O(^ATXAX("B","BGP NEPHROPATHY CPTS",0))
S X=$$CPT^BGP8DU(P,BDATE,EDATE,T,5)
I X]"" Q 1_U_$P(X,U,2)_"^^"_$P(X,U)
S T=$O(^ATXAX("B","BGP NEPHROPATHY CPTS",0))
S X=$$TRAN^BGP8DU(P,BDATE,EDATE,T,5)
I X]"" Q 1_U_$P(X,U,2)_"^^"_$P(X,U)
;
K ^TMP($J,"A")
S A="^TMP($J,""A"","
S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,A)
S X=0,Y=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y) S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R=49,'$$DNKA^BGP8D21($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
I Y Q 2_"^Cl: "_R_"^^"_D
S (X,Y)=0,D="" F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y) S R=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D") I R=69,'$$DNKA^BGP8D21($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
I Y Q "2^Prv: "_R_"^^"_D
;
;ACE INHIBITOR
NEW T,T1,T2,T3
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T=$O(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
S T1=$O(^ATXAX("B","BGP HEDIS ACEI NDC",0))
S T2=$O(^ATXAX("B","BGP HEDIS ARB MEDS",0))
S T3=$O(^ATXAX("B","BGP HEDIS ARB NDC",0))
S X=0,G="" F S X=$O(BGPMEDS1(X)) Q:X'=+X!(G) S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:'$P(^AUPNVMED(Y,0),U,7) ;NO DAYS SUPPLY
.I $P(^AUPNVMED(Y,0),U,8)]"",$P(^AUPNVMED(Y,0),U,8)=$P(BGPMEDS1(X),U) Q
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1_U_$P(BGPMEDS1(X),U)_U_"acei/arb prescription" Q
.I T2,$D(^ATXAX(T2,21,"B",D)) S G=1_U_$P(BGPMEDS1(X),U)_U_"acei/arb prescription" Q
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1_U_$P(BGPMEDS1(X),U)_U_"acei/arb prescription" Q
.I N]"",T3,$D(^ATXAX(T3,21,"B",N)) S G=1_U_$P(BGPMEDS1(X),U)_U_"acei/arb prescription" Q
I G Q 1_U_$P(G,U,3)_"^^"_$P(G,U,2)
Q ""
;;;
LOINC(A,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 ""
BGP8DHE2 ; IHS/CMI/LAB - measure HEDIS ;
+1 ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
+2 ;
MEDNEPH(P,BDATE,EDATE) ;EP
+1 KILL BGPC,BGPX,BGP1
+2 SET BGPC=""
+3 SET %=""
SET E=+$$CODEN^ICPTCOD(82043)
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+4 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-CPT^^"_$PIECE(%,U,2)
+5 SET %=""
SET E=+$$CODEN^ICPTCOD(82044)
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+6 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-CPT^^"_$PIECE(%,U,2)
+7 SET %=""
SET E=+$$CODEN^ICPTCOD(82042)
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+8 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-CPT^^"_$PIECE(%,U,2)
+9 SET %=""
SET E=+$$CODEN^ICPTCOD(84156)
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+10 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-CPT^^"_$PIECE(%,U,2)
+11 SET %=""
SET E=+$$CODEN^ICPTCOD("3060F")
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+12 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-CPT^^"_$PIECE(%,U,2)
+13 SET %=""
SET E=+$$CODEN^ICPTCOD("3061F")
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+14 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-CPT^^"_$PIECE(%,U,2)
+15 SET %=""
SET E=+$$CODEN^ICPTCOD("3062F")
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+16 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^URINE PROTEIN-CPT^^"_$PIECE(%,U,2)
+17 SET %=""
SET E=+$$CODEN^ICPTCOD("4009F")
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+18 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^ACEI MED-CPT^^"_$PIECE(%,U,2)
+19 ;TRAN
+20 SET %=""
SET E=+$$CODEN^ICPTCOD(82043)
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+21 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-TRAN^^"_$PIECE(%,U,2)
+22 SET %=""
SET E=+$$CODEN^ICPTCOD(82044)
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+23 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-TRAN^^"_$PIECE(%,U,2)
+24 SET %=""
SET E=+$$CODEN^ICPTCOD(82042)
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+25 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-TRAN^^"_$PIECE(%,U,2)
+26 SET %=""
SET E=+$$CODEN^ICPTCOD(84156)
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+27 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-TRAN^^"_$PIECE(%,U,2)
+28 SET %=""
SET E=+$$CODEN^ICPTCOD("3060F")
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+29 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-TRAN^^"_$PIECE(%,U,2)
+30 SET %=""
SET E=+$$CODEN^ICPTCOD("3061F")
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+31 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^MICROALB-TRAN^^"_$PIECE(%,U,2)
+32 SET %=""
SET E=+$$CODEN^ICPTCOD("3062F")
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+33 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^URINE PROTEIN-TRAN^^"_$PIECE(%,U,2)
+34 SET %=""
SET E=+$$CODEN^ICPTCOD("4009F")
SET %=$$TRANI^BGP8DU(P,BDATE,EDATE,E)
+35 IF %]""
SET BGPX(9999999-$PIECE(%,U,2))="1^ACEI MED-TRAN^^"_$PIECE(%,U,2)
+36 ;now get all loinc/taxonomy tests
+37 SET T=$ORDER(^ATXAX("B","BGP HEDIS NEPHROPTHY SCR LOINC",0))
+38 SET BGPLT=$ORDER(^ATXLAB("B","DM AUDIT MICROALBUMINURIA TAX",0))
+39 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)!(BGPC]"")
QUIT
Begin DoDot:1
+40 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L!(BGPC]"")
QUIT
Begin DoDot:2
+41 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X!(BGPC]"")
QUIT
Begin DoDot:3
+42 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+43 IF $PIECE(^AUPNVLAB(X,0),U,4)=""
QUIT
+44 IF BGPLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BGPLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
SET (BGPC,BGPX(D))="1^MICROALB^^"_(9999999-D)
QUIT
+45 IF 'T
QUIT
+46 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+47 IF '$$LOINC(J,T)
QUIT
+48 SET (BGPC,BGPX(D))="1^MICROALB^^"_(9999999-D)
QUIT
+49 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+50 ;quit on the latest one found, if one found
IF $DATA(BGPX)
SET X=$ORDER(BGPX(0))
QUIT BGPX(X)
+51 ;
+52 SET T=$ORDER(^ATXAX("B","BGP HEDIS NEPHROPTHY SCR LOINC",0))
+53 SET BGPLT=$ORDER(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
+54 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)!(BGPC]"")
QUIT
Begin DoDot:1
+55 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L!(BGPC]"")
QUIT
Begin DoDot:2
+56 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X!(BGPC]"")
QUIT
Begin DoDot:3
+57 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+58 ;MUST HAVE A RESULT
IF $PIECE(^AUPNVLAB(X,0),U,4)=""
QUIT
+59 IF BGPLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BGPLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
SET (BGPC,BGPX(D))="1^A/C RATIO^^"_(9999999-D)
QUIT
+60 IF 'T
QUIT
+61 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+62 IF '$$LOINC(J,T)
QUIT
+63 SET (BGPC,BGPX(D))="1^A/C RATIO^^"_(9999999-D)
QUIT
+64 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+65 ;quit on the latest one found, if one found
IF $DATA(BGPX)
SET X=$ORDER(BGPX(0))
QUIT BGPX(X)
+66 ;
+67 KILL BGPG
SET %=P_"^LAST LAB [DM AUDIT URINE PROTEIN TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGPG(")
+68 SET (%,R)=""
IF $DATA(BGPG(1))
Begin DoDot:1
+69 SET %=$PIECE(^AUPNVLAB(+$PIECE(BGPG(1),U,4),0),U,4)
+70 SET R=$SELECT(%="":"",%["+":1,%[">":1,$EXTRACT(%)="P":1,$EXTRACT(%)="p":1,$EXTRACT(%)="L":1,$EXTRACT(%)="l":1,$EXTRACT(%)="M":1,$EXTRACT(%)="m":1,$EXTRACT(%)="S":1,$EXTRACT(%)="s":1,$EXTRACT(%)="c":"",$EXTRACT(%)="C":"",+%>29:1,1:"")
End DoDot:1
QUIT R_"^"_"U"_"^"_%_"^"_$PIECE(BGPG(1),U)
+71 SET T=$ORDER(^ATXAX("B","BGP URINE PROTEIN LOINC CODES",0))
+72 SET BGPC=""
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)!(BGPC]"")
QUIT
Begin DoDot:1
+73 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L!(BGPC]"")
QUIT
Begin DoDot:2
+74 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X!(BGPC]"")
QUIT
Begin DoDot:3
+75 IF 'T
QUIT
+76 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+77 IF '$$LOINC(J,T)
QUIT
+78 SET %=$PIECE(^AUPNVLAB(X,0),U,4)
+79 ;S R=$S(%="":"",%["+":1,%[">":1,$E(%)="P":1,$E(%)="p":1,$E(%)="c":"",$E(%)="C":"",+%>29:1,1:"")
+80 SET R=$SELECT(%="":"",%["+":1,%[">":1,$EXTRACT(%)="P":1,$EXTRACT(%)="p":1,$EXTRACT(%)="L":1,$EXTRACT(%)="l":1,$EXTRACT(%)="M":1,$EXTRACT(%)="m":1,$EXTRACT(%)="S":1,$EXTRACT(%)="s":1,$EXTRACT(%)="c":"",$EXTRACT(%)="C":"",
+%>29:1,1:"")
+81 SET BGPC=R_"^U^"_%_"^"_(9999999-D)
End DoDot:3
End DoDot:2
End DoDot:1
+82 IF BGPC]""
QUIT BGPC
+83 ;NEPHEVID
+84 KILL BGPG
+85 SET Y="BGPG("
+86 SET X=P_"^LAST DX [BGP NEPHROPATHY DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+87 ;has a dx
IF $DATA(BGPG(1))
QUIT 1_U_$PIECE(BGPG(1),U,2)_"^^"_$PIECE(BGPG(1),U,1)
+88 KILL BGPG
+89 SET T=$ORDER(^ATXAX("B","BGP NEPHROPATHY PROCEDURES",0))
+90 SET (F,S)=0
FOR
SET F=$ORDER(^AUPNVPRC("AC",P,F))
IF F'=+F!(S)
QUIT
SET C=$PIECE(^AUPNVPRC(F,0),U)
Begin DoDot:1
+91 SET G=0
IF $$ICD^ATXCHK(C,T,0)
SET G=1
+92 IF G=0
QUIT
+93 SET D=$PIECE(^AUPNVPRC(F,0),U,6)
IF D=""
SET D=$PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVPRC(F,0),U,3),0),U),".")
+94 IF D>EDATE
QUIT
+95 IF D<BDATE
QUIT
+96 SET S=1
End DoDot:1
+97 ;has a PROCEDURE
IF S=1
QUIT 1_U_$PIECE($$ICDOP^ICDCODE(C),U,2)_"^^"_D
+98 SET T=$ORDER(^ATXAX("B","BGP NEPHROPATHY CPTS",0))
+99 SET X=$$CPT^BGP8DU(P,BDATE,EDATE,T,5)
+100 IF X]""
QUIT 1_U_$PIECE(X,U,2)_"^^"_$PIECE(X,U)
+101 SET T=$ORDER(^ATXAX("B","BGP NEPHROPATHY CPTS",0))
+102 SET X=$$TRAN^BGP8DU(P,BDATE,EDATE,T,5)
+103 IF X]""
QUIT 1_U_$PIECE(X,U,2)_"^^"_$PIECE(X,U)
+104 ;
+105 KILL ^TMP($JOB,"A")
+106 SET A="^TMP($J,""A"","
+107 SET %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,A)
+108 SET X=0
SET Y=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(Y)
QUIT
SET R=$$CLINIC^APCLV($PIECE(^TMP($JOB,"A",X),U,5),"C")
IF R=49
IF '$$DNKA^BGP8D21($PIECE(^TMP($JOB,"A",X),U,5))
SET Y=1
SET D=$PIECE(^TMP($JOB,"A",X),U)
+109 IF Y
QUIT 2_"^Cl: "_R_"^^"_D
+110 SET (X,Y)=0
SET D=""
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(Y)
QUIT
SET R=$$PRIMPROV^APCLV($PIECE(^TMP($JOB,"A",X),U,5),"D")
IF R=69
IF '$$DNKA^BGP8D21($PIECE(^TMP($JOB,"A",X),U,5))
SET Y=1
SET D=$PIECE(^TMP($JOB,"A",X),U)
+111 IF Y
QUIT "2^Prv: "_R_"^^"_D
+112 ;
+113 ;ACE INHIBITOR
+114 NEW T,T1,T2,T3
+115 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+116 IF '$DATA(BGPMEDS1)
QUIT ""
+117 SET T=$ORDER(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
+118 SET T1=$ORDER(^ATXAX("B","BGP HEDIS ACEI NDC",0))
+119 SET T2=$ORDER(^ATXAX("B","BGP HEDIS ARB MEDS",0))
+120 SET T3=$ORDER(^ATXAX("B","BGP HEDIS ARB NDC",0))
+121 SET X=0
SET G=""
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(G)
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+122 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+123 ;NO DAYS SUPPLY
IF '$PIECE(^AUPNVMED(Y,0),U,7)
QUIT
+124 IF $PIECE(^AUPNVMED(Y,0),U,8)]""
IF $PIECE(^AUPNVMED(Y,0),U,8)=$PIECE(BGPMEDS1(X),U)
QUIT
+125 SET D=$PIECE(^AUPNVMED(Y,0),U)
+126 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1_U_$PIECE(BGPMEDS1(X),U)_U_"acei/arb prescription"
QUIT
+127 IF T2
IF $DATA(^ATXAX(T2,21,"B",D))
SET G=1_U_$PIECE(BGPMEDS1(X),U)_U_"acei/arb prescription"
QUIT
+128 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+129 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1_U_$PIECE(BGPMEDS1(X),U)_U_"acei/arb prescription"
QUIT
+130 IF N]""
IF T3
IF $DATA(^ATXAX(T3,21,"B",N))
SET G=1_U_$PIECE(BGPMEDS1(X),U)_U_"acei/arb prescription"
QUIT
End DoDot:1
+131 IF G
QUIT 1_U_$PIECE(G,U,3)_"^^"_$PIECE(G,U,2)
+132 QUIT ""
+133 ;;;
LOINC(A,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 ""
