BDMD412.m

BDMD412 ; IHS/CMI/LAB - 2012 DIABETES AUDIT ;

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

 ;

 ;cmi/anch/maw 9/12/2012 code set versioning in DEPDX

 ;

SETN ;

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

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

 Q

TBTX(P) ;EP

 I '$G(P) Q ""

 NEW BDM,E,X

 K BDM

 S X=P_"^LAST HEALTH [DM AUDIT TB HEALTH FACTORS" S E=$$START1^APCLDF(X,"BDM(")

 I E Q ""

 I $D(BDM(1)) Q $S($P(BDM(1),U,3)["TX COMPLETE":"1 Yes",$P(BDM(1),U,3)["TX INCOMPLETE"!($P(BDM(1),U,3)["TX UNTREATED"):"2 No",1:"4 Unknown")_U_$P(BDM(1),U,3)

 N T,Y S T=$O(^ATXAX("B","DM AUDIT TB HEALTH FACTORS",0))

 I 'T Q ""

 N G S G="",X=0 F  S X=$O(^AUPNHF("AA",P,X)) Q:X'=+X!(G]"")  I $D(^ATXAX(T,21,"B",X)) S G=$P(^AUTTHF(X,0),U)

 I G]"" Q $S(G["TX COMPLETE":"1 Yes",G["TX INCOMPLETE"!(G["TX UNTREATED"):"2 No",1:"4 Unknown")_U_G

 Q ""

CPT(P,BDATE,EDATE,T,F) ;EP return ien of CPT entry if patient had this CPT

 NEW X

 I '$G(P) Q ""

 I '$G(T) Q ""

 I '$G(F) S F=1

 I $G(EDATE)="" Q ""

 I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)

 ;go through visits in a date range for this patient, check cpts

 NEW D,BD,ED,X,Y,D,G,V

 S ED=9999999-EDATE,BD=9999999-BDATE,G=0

 F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D

 .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G)  D

 ..Q:'$D(^AUPNVSIT(V,0))

 ..Q:'$D(^AUPNVCPT("AD",V))

 ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G)  D

 ...I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),T,1) S G=X

 ...Q

 ..Q

 .Q

 I 'G Q ""

 I F=1 Q $S(G:1,1:"")

 I F=2 Q G

 I F=3 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")

 I F=4 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))

 Q ""

RAD(P,BDATE,EDATE,T,F) ;EP return if a v rad entry in date range

 I '$G(P) Q ""

 I '$G(T) Q ""

 I '$G(F) S F=1

 I $G(EDATE)="" Q ""

 I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)

 ;go through visits in a date range for this patient, check cpts

 NEW D,BD,ED,X,Y,D,G,V

 S ED=9999999-EDATE,BD=9999999-BDATE,G=0

 F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D

 .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G)  D

 ..Q:'$D(^AUPNVSIT(V,0))

 ..Q:'$D(^AUPNVRAD("AD",V))

 ..S X=0 F  S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X!(G)  D

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

 ...S Y=$P(^AUPNVRAD(X,0),U) Q:'Y  Q:'$D(^RAMIS(71,Y,0))

 ...S Y=$P($G(^RAMIS(71,Y,0)),U,9) Q:'Y

 ...Q:'$$ICD^ATXCHK(Y,T,1)

 ...S G=X

 ...Q

 ..Q

 .Q

 I 'G Q ""

 I F=1 Q $S(G:1,1:"")

 I F=2 Q G

 I F=3 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")

 I F=4 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))

 Q ""

EKG(P,EDATE,F) ;EP

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

 S %DT="P",X=EDATE D ^%DT S ED=Y

 NEW BDM,X,%,E,LEKG S LEKG="",%=P_"^LAST DIAGNOSTIC ECG SUMMARY;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")

 I $D(BDM) S LEKG=$P(BDM(1),U)

 K BDM S %=P_"^LAST PROCEDURE 89.51;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE,E=$$START1^APCLDF(%,"BDM("),E=$$START1^APCLDF(%,"BDM(")

 I $D(BDM(1)) D

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 K BDM S %=P_"^LAST PROCEDURE 89.52;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE,E=$$START1^APCLDF(%,"BDM("),E=$$START1^APCLDF(%,"BDM(")

 I $D(BDM(1)) D

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 K BDM S %=P_"^LAST PROCEDURE 89.53;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE,E=$$START1^APCLDF(%,"BDM("),E=$$START1^APCLDF(%,"BDM(")

 I $D(BDM(1)) D

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 K BDM S %=P_"^LAST PROCEDURE 89.50;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE,E=$$START1^APCLDF(%,"BDM("),E=$$START1^APCLDF(%,"BDM(")

 I $D(BDM(1)) D

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 K BDM S %=P_"^LAST DX 794.31;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE,E=$$START1^APCLDF(%,"BDM("),E=$$START1^APCLDF(%,"BDM(")

 I $D(BDM(1)) D

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 ;check CPT codes in year prior to date range

 S T=$O(^ATXAX("B","DM AUDIT EKG CPTS",0))

 K BDM I T S BDM(1)=$$CPT^BDMD412(P,$$DOB^AUPNPAT(P),ED,T,3) D

 .I BDM(1)="" K BDM Q

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 K BDM I T S BDM(1)=$$RAD^BDMD412(P,$$DOB^AUPNPAT(P),ED,T,3) D

 .I BDM(1)="" K BDM Q

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 K BDM I T S BDM(1)=$$TRAN^BDMD4DU(P,$$DOB^AUPNPAT(P),ED,T,3) D

 .I BDM(1)="" Q

 .Q:LEKG>$P(BDM(1),U)

 .S LEKG=$P(BDM(1),U)

 Q $S(F="E":$$FMTE^XLFDT(LEKG),1:LEKG)

 ;

REFMED(P,BDATE,EDATE) ;EP

 NEW T,T1,T2,T3,T4,T5,T6,T7,T8,A,G,B,Y,X,I,Z,E

 S T=$O(^ATXAX("B","DM AUDIT INSULIN DRUGS",0))

 S T1=$O(^ATXAX("B","DM AUDIT SULFONYLUREA DRUGS",0))

 S T2=$O(^ATXAX("B","DM AUDIT METFORMIN DRUGS",0))

 S T3=$O(^ATXAX("B","DM AUDIT ACARBOSE DRUGS",0))

 S T4=$O(^ATXAX("B","DM AUDIT GLITAZONE DRUGS",0))

 S T5=$O(^ATXAX("B","DM AUDIT INCRETIN MIMETIC",0))

 S T6=$O(^ATXAX("B","DM AUDIT DPP4 INHIBITOR DRUGS",0))

 S T7=$O(^ATXAX("B","DM AUDIT AMYLIN ANALOGUES",0))

 S T8=$O(^ATXAX("B","DM AUDIT SULFONYLUREA-LIKE",0))

 S G=0

 NEW %DT S X=BDATE,%DT="P" D ^%DT S B=Y

 S X=EDATE,%DT="P" D ^%DT S E=Y

 S G=""

 S I=0 F  S I=$O(^AUPNPREF("AA",BDMPD,50,I)) Q:I'=+I!(G)  D

 .S A=0

 .I T,$D(^ATXAX(T,21,"B",I)) S A=1

 .I T1,$D(^ATXAX(T1,21,"B",I)) S A=1

 .I T2,$D(^ATXAX(T2,21,"B",I)) S A=1

 .I T3,$D(^ATXAX(T3,21,"B",I)) S A=1

 .I T4,$D(^ATXAX(T4,21,"B",I)) S A=1

 .I T5,$D(^ATXAX(T5,21,"B",I)) S A=1

 .I T6,$D(^ATXAX(T6,21,"B",I)) S A=1

 .I T7,$D(^ATXAX(T7,21,"B",I)) S A=1

 .I T8,$D(^ATXAX(T8,21,"B",I)) S A=1

 .Q:'A

 .S X=0 F  S X=$O(^AUPNPREF("AA",BDMPD,50,I,X)) Q:X'=+X!(G)  D

 ..S Y=0 F  S Y=$O(^AUPNPREF("AA",BDMPD,50,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) I $P(^AUPNPREF(Y,0),U,7)="R" S G=1

 Q G

INSULIN(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT INSULIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

 ;

SULF(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT SULFONYLUREA DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

 ;

SULFLIKE(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT SULFONYLUREA-LIKE"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

MET(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT METFORMIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

 ;

ACAR(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT ACARBOSE DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

 ;

TROG(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT GLITAZONE DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

INCR(P,BDATE,EDATE) ;EP  cmi/maw 12/18/2007 DM2012

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT INCRETIN MIMETIC"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

 ;

DPP4(P,BDATE,EDATE) ;EP  cmi/maw 12/18/2012 DM2012

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT DPP4 INHIBITOR DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

AMYLIN(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT AMYLIN ANALOGUES"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

GLP1(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT GLP-1 ANALOG DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

BROM(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT BROMOCRIPTINE DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

 ;

COLE(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT COLESEVELAM DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

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

 Q ""

DEPDX(P,BDATE,EDATE) ;EP

 NEW BDM,X,BDMP,BDMP4,T,I,G,J,D,BDMD

 K BDM

 S (G,X,I)=""

 ;is depression on the problem list?

 S T=$O(^ATXAX("B","DM AUDIT DEPRESSIVE DISORDERS",0))

 S X=0 F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G]"")  D

 .S I=$P($G(^AUPNPROB(X,0)),U)

 .Q:$P(^AUPNPROB(X,0),U,12)'="A"

 .Q:'$$ICD^ATXCHK(I,T,9)

 .S G="1  Yes - Problem List "_$P($$ICDDX^ICDCODE(I),U,2)  ;cmi/anch/maw 9/12/2007 csv

 .Q

 I G]"" Q G

 S (G,X,I)=""

 ;is depression on the BH problem list?

 S T=$O(^ATXAX("B","DM AUDIT DEPRESSIVE DISORDERS",0))

 S X=0 F  S X=$O(^AMHPPROB("AC",P,X)) Q:X'=+X!(G]"")  D

 .S I=$P($G(^AMHPPROB(X,0)),U)

 .S I=$P($G(^AMHPROB(I,0)),U,5)

 .Q:I=""

 .S I=+$$CODEN^ICDCODE(I,80)

 .Q:I=""

 .Q:'$$ICD^ATXCHK(I,T,9)

 .Q:$P(^AMHPPROB(X,0),U,12)'="A"

 .S G="1  Yes - BH Problem List "_$P($$ICDDX^ICDCODE(I),U,2)  ;cmi/anch/maw 9/12/2007 csv

 .Q

 I G]"" Q G

 ;now check for 2 dxs in past year

 S Y="BDM(",BDMV=""

 S X=P_"^LAST 2 DX [DM AUDIT DEPRESSIVE DISORDERS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,Y)

 I $D(BDM(2)) Q "1  Yes 2 dxs in PCC"

 S BDM=0,BDMD=""

 I $D(BDM(1)) S BDM=1,BDMD=$P(BDM(1),U,1)

 ;go through BH record file and find up to 2 visits in date range

 S E=9999999-BDATE,D=9999999-EDATE-1_".99" F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!($P(D,".")>E)!(BDM>1)  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(BDM>1)  D

 .Q:'$D(^AMHREC(V,0))

 .Q:BDMD=$P($P(^AMHREC(V,0),U,1),".")

 .I $P(^AMHREC(V,0),U,16)]"",BDMV]"",$P(^AMHREC(V,0),U,16)=BDMV Q

 .S X=0 F  S X=$O(^AMHRPRO("AD",V,X)) Q:X'=+X!(BDM>1)  S BDMP=$P($G(^AMHRPRO(X,0)),U) D

 ..Q:'BDMP

 ..S BDMP4=$P($G(^AMHPROB(BDMP,0)),U)

 ..I BDMP4=14 S BDM=BDM+1 Q

 ..I BDMP4=15 S BDM=BDM+1 Q

 ..I BDMP4=18 S BDM=BDM+1 Q

 ..I BDMP4=24 S BDM=BDM+1 Q

 ..S J=$P(^AMHPROB(BDMP,0),U,5)

 ..S J=$P($$ICDDX^ICDCODE(J),U,1)

 ..I $$ICD^ATXCHK(J,$O(^ATXAX("B","DM AUDIT DEPRESSIVE DISORDERS",0)),9) S BDM=BDM+1 Q

 ..Q

 I BDM>1 Q "1  Yes 2 dx PCC/BH"

 Q "2  No"

 ;

DEPSCR(P,BDATE,EDATE,F,R) ;EP

 NEW X,BDMC

 I $G(P)="" Q ""

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

 S BDMC=$$LASTDEPS(P,BDATE,EDATE,"A")

 I $G(R) Q $S(F="D":$P(BDMC,U),1:"1  Yes - "_$P(BDMC,U,2)_" "_$$DATE^BDMS9B1($P(BDMC,U)))

 I BDMC]"" Q "1  Yes - "_$E($P(BDMC,U,2),1,20)_" "_$$DATE^BDMS9B1($P(BDMC,U))

 ;refusal

 NEW G S G=$$REFUSAL^BDMD417(P,9999999.15,$O(^AUTTEXAM("B","DEPRESSION SCREENING",0)),BDATE,EDATE)

 I G,'$G(R) Q "3  Refused "_$P(G,U,3)

 S D=0,BDMC="",E=9999999-BDATE,D=9999999-EDATE-1_".99" F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!($P(D,".")>E)!(BDMC]"")  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(BDMC]"")  D

 .I $P($G(^AMHREC(V,14)),U,5)]"",($P(^AMHREC(V,14),U,5)="UAS"!($P(^AMHREC(V,14),U,5)'="REF")) S BDMC="3  Refused BH Exam 36 "_$$DATE^BDMD410(9999999-D) Q

 I BDMC]"" Q BDMC

 Q "2  No"

 ;

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 ""

PLCODE(P,A) ;EP

 I $G(P)="" Q ""

 I $G(A)="" Q ""

 N T S T=+$$CODEN^ICDCODE(A,80)

 I 'T Q ""

 N X,Y,I S (X,Y,I)=0 F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(I)  I $D(^AUPNPROB(X,0)) S Y=$P(^AUPNPROB(X,0),U) I $$ICD^ATXCHK(Y,T,9) S I=1

 Q I

PLTAX(P,A) ;EP - is DX on problem list 1 or 0

 I $G(P)="" Q ""

 I $G(A)="" Q ""

 N T S T=$O(^ATXAX("B",A,0))

 I 'T Q ""

 N X,Y,I S (X,Y,I)=0 F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(I)  I $D(^AUPNPROB(X,0)) S Y=$P(^AUPNPROB(X,0),U) I $$ICD^ATXCHK(Y,T,9) S I=1

 Q I

 ;

E ;

 I $P(BDMLVAL,U,1)>$P(BDMLLAST,U,1) S BDMLLAST=BDMLVAL

 Q

 ;

LASTDEPS(BDMLPDFN,BDMLBD,BDMLED,BDMLFORM) ;PEP - return last depression screen

 ;         

 I $G(BDMLBD)="" S BDMLBD=$$DOB^AUPNPAT(BDMLPDFN)

 I $G(BDMLED)="" S BDMLED=DT

 I $G(BDMLFORM)="" S BDMLFORM="D"

 NEW BDMLLAST,BDMLVAL,BDMLX

 S BDMLLAST=""

 S BDMLVAL=$$LASTDEP(BDMLPDFN,BDMLBD,BDMLED,"A")

 D E

 S BDMLVAL=$$LASTITEM^APCLAPIU(BDMLPDFN,"V79.0","DX",$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"A")

 D E

 S BDMLVAL=$$LASTITEM^APCLAPIU(BDMLPDFN,"PHQ2","MEASUREMENT",$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"A")

 D E

 S BDMLVAL=$$LASTITEM^APCLAPIU(BDMLPDFN,"PHQ9","MEASUREMENT",$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"A")

 D E

 S BDMLVAL=$$LASTITEM^APCLAPIU(BDMLPDFN,"PHQT","MEASUREMENT",$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"A")

 D E

 S BDMLX=0 F  S BDMLX=$O(^AUTTEDT("C","DEP-SCR",BDMLX)) Q:BDMLX'=+BDMLX  D

 .S BDMLVAL=$$LASTITEM^APCLAPIU(BDMLPDFN,"`"_BDMLX,"EDUCATION",$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"A")

 .D E

 S BDMLVAL=$$LASTBHDX^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"14.1","A")

 D E

 S BDMLVAL=$$LASTBHED^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"DEP-SCR","A")

 D E

 ;now check for mood disorders

 S BDMLVAL=$$LASTDXT^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"BGP MOOD DISORDERS","A")

 D E

 S BDMLVAL=$$LASTBHDT^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"BGP MOOD DISORDERS","A")

 D E

 S BDMLVAL=$$LASTBHDX^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"14","A")

 D E

 S BDMLVAL=$$LASTBHDX^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"15","A")

 D E

 S BDMLVAL=$$LASTBHME^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"PHQ2","A")

 D E

 S BDMLVAL=$$LASTBHME^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"PHQ9","A")

 D E

 I BDMLFORM="D" Q $P(BDMLLAST,U)

 Q BDMLLAST

 ;

LASTDEP(P,BD,ED,F) ;

 NEW %,E,D,V,X,G

 NEW BDMLG,BDMLX,BDMLC,BDMLV

 S %=P_"^LAST EXAM 36;DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"BDMLG(")

 I $D(BDMLG(1)) S BDMLX(9999999-$P(BDMLG(1),U))=$$VE(BDMLG(1))

 ;now look at AMHREC

 S BDMLC=0,BDMLV=""

 S E=(9999999-BD),D=9999999-ED-1_".99" F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!(BDMLC)!($P(D,".")>E)  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(BDMLC)  D

 .S X=$P($G(^AMHREC(V,14)),U,5)

 .I X="" Q  ;no test

 .I $E(X)="U" Q  ;don't count refusal here

 .I X="REF" Q

 .S G=9999999-$P(D,".")

 .Q:$D(BDMLX($P(D,".")))

 .S BDMLX($P(D,"."))=G_"^BH: DEPRESSION SCREENING^"_$$VAL^XBDIQ1(9002011,V,1405)_"^^9002011^"_V

 I $O(BDMLX(0)) S G=$O(BDMLX(0)) Q $S(F="D":$P(BDMLX(G),U,1),1:BDMLX(G))

 Q ""

 ;

 ;

VE(Y,F,T) ;EP

 Q $P(Y,U,1)_"^Exam: "_$P(Y,U,3)_"^"_$$VAL^XBDIQ1(9000010.13,+$P(Y,U,4),.04)_"^"_$P(Y,U,5)_"^9000010.13^"_+$P(Y,U,4)

 ;

BDMD412   ; IHS/CMI/LAB - 2012 DIABETES AUDIT ;

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

 +2       ;

 +3       ;cmi/anch/maw 9/12/2012 code set versioning in DEPDX

 +4       ;

SETN      ;

 +1        SET N=""

           NEW A,G

           SET (A,G)=0

           FOR 

               SET A=$ORDER(BDM(A))

               IF A'=+A!(G)

                   QUIT 

               IF $PIECE(^AUPNVLAB(+$PIECE(BDM(A),U,4),0),U,4)]""

                   SET G=A

 +2        SET N=$SELECT(G:G,1:1)

 +3        QUIT 

TBTX(P)   ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2        NEW BDM,E,X

 +3        KILL BDM

 +4        SET X=P_"^LAST HEALTH [DM AUDIT TB HEALTH FACTORS"

           SET E=$$START1^APCLDF(X,"BDM(")

 +5        IF E

               QUIT ""

 +6        IF $DATA(BDM(1))

               QUIT $SELECT($PIECE(BDM(1),U,3)["TX COMPLETE":"1 Yes",$PIECE(BDM(1),U,3)["TX INCOMPLETE"!($PIECE(BDM(1),U,3)["TX UNTREATED"):"2 No",1:"4 Unknown")_U_$PIECE(BDM(1),U,3)

 +7        NEW T,Y

           SET T=$ORDER(^ATXAX("B","DM AUDIT TB HEALTH FACTORS",0))

 +8        IF 'T

               QUIT ""

 +9        NEW G

           SET G=""

           SET X=0

           FOR 

               SET X=$ORDER(^AUPNHF("AA",P,X))

               IF X'=+X!(G]"")

                   QUIT 

               IF $DATA(^ATXAX(T,21,"B",X))

                   SET G=$PIECE(^AUTTHF(X,0),U)

 +10       IF G]""

               QUIT $SELECT(G["TX COMPLETE":"1 Yes",G["TX INCOMPLETE"!(G["TX UNTREATED"):"2 No",1:"4 Unknown")_U_G

 +11       QUIT ""

CPT(P,BDATE,EDATE,T,F) ;EP return ien of CPT entry if patient had this CPT

 +1        NEW X

 +2        IF '$GET(P)

               QUIT ""

 +3        IF '$GET(T)

               QUIT ""

 +4        IF '$GET(F)

               SET F=1

 +5        IF $GET(EDATE)=""

               QUIT ""

 +6        IF $GET(BDATE)=""

               SET BDATE=$$FMADD^XLFDT(EDATE,-365)

 +7       ;go through visits in a date range for this patient, check cpts

 +8        NEW D,BD,ED,X,Y,D,G,V