BDMDB12.m

BDMDB12 ; IHS/CMI/LAB - 2014 DIABETES AUDIT ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53

 ;

 ;cmi/anch/maw 9/12/2014 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:"3 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:"3 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^BDMUTL($P(^AUPNVCPT(X,0),U),$P(^ATXAX(T,0),U),1) S G=X  ;cmi/maw 05/15/2014 p8

 ...;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^BDMUTL(Y,$P(^ATXAX(T,0),U),1)  ;cmi/maw 05/15/2014 p8

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

 ;

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

 ;

SGLT2(P,BDATE,EDATE) ;EP

 NEW X,BDM,E

 S X=P_"^LAST MEDS [DM AUDIT SGLT-2 INHIBITOR DRUG"_";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/2014 DM2014

 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"

 ;

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

 ;

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)="D"

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

 .Q:'$$ICD^BDMUTL(I,$P(^ATXAX(T,0),U),9)  ;cmi/maw 05/15/2014 p8

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

 .S G="1  Yes - Problem List "_$P($$ICDDX^BDMUTL(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 J=$P(^AMHPROB(I,0),U,1)

 .I J=14!(J=15) S G="1  Yes - BH Problem List "_J Q

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

 .Q:I=""

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

 .S I=+$$CODEN^BDMUTL(I,80)  ;cmi/maw 05/14/2013 patch 8 icd-10

 .Q:I=""

 .Q:'$$ICD^BDMUTL(I,$P(^ATXAX(T,0),U),9)  ;cmi/maw 05/15/2014 p8

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

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

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

 .S G="1  Yes - BH Problem List "_$P($$ICDDX^BDMUTL(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^BDMUTL(J),U,1)

 ..I $$ICD^BDMUTL(J,"DM AUDIT DEPRESSIVE DISORDERS",9) S BDM=BDM+1 Q  ;cmi/maw 05/15/2014 p8

 ..;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))

 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)

 S T=+$$CODEN^BDMUTL(A,80)  ;cmi/maw 05/14/2014 patch 8 ICD-10

 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)),$P(^AUPNPROB(X,0),U,12)'="D" S Y=$P(^AUPNPROB(X,0),U) I $$ICD^BDMUTL(Y,$P(^ATXAX(T,0),U),9) S I=1  ;cmi/maw 05/15/2014 p8

 ;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)),$P(^AUPNPROB(X,0),U,12)'="D" 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)),$P(^AUPNPROB(X,0),U,12)'="D" S Y=$P(^AUPNPROB(X,0),U) I $$ICD^BDMUTL(Y,$P(^ATXAX(T,0),U),9) S I=1  ;cmi/maw 05/15/2014 p8

 ;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)),$P(^AUPNPROB(X,0),U,12)'="D" 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,"DM AUDIT DEPRESSIVE DISORDERS","A")

 D E

 S BDMLVAL=$$LASTBHDT^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"DM AUDIT DEPRESSIVE 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

 S BDMLVAL=$$LASTBHME^APCLAPIU(BDMLPDFN,$S($P(BDMLLAST,U)]"":$P(BDMLLAST,U),1:BDMLBD),BDMLED,"PHQT","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)

 ;

CVD(P,EDATE) ;EP

 I '$G(P) Q ""

 I '$D(^DPT(P)) Q ""

 NEW %,BDM,E,X,G,Z,Y,T

 ;is cvd on the problem list?

 S G=""

 S T=$O(^ATXAX("B","DM AUDIT CVD DIAGNOSES",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)="D"

 .Q:'$$ICD^BDMUTL(I,$P(^ATXAX(T,0),U),9)  ;cmi/maw 05/14/2014 p8

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

 .S G="1  Yes - Problem List "_$$VAL^XBDIQ1(9000011,X,.01)

 .Q

 I G Q G

 K BDM

 S X=P_"^LAST DX [BGP CABG DXS;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) S Y=$$FMTE^XLFDT($P(BDM(1),U,1)) Q "1  Yes - DX "_Y

 K BDM

 S X=P_"^LAST DX [BGP PCI DXS;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) S Y=$$FMTE^XLFDT($P(BDM(1),U,1)) Q "1  Yes - DX "_Y

 K BDM

 S X=P_"^LAST 2 DX [DM AUDIT CVD DIAGNOSES;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(2)) S Y=$$FMTE^XLFDT($P(BDM(1),U,1)),Z=$$FMTE^XLFDT($P(BDM(2),U,1)) Q "1  Yes - DX "_Y_" "_Z

 S X=$$LASTPRCT^BDMAPIU(P,$$DOB^AUPNPAT(P),EDATE,"BGP PCI CM PROCS","A")

 I X Q "1  Yes - "_$P(X,U,2)_" on "_$$FMTE^XLFDT($P(X,U,1))

 S X=$$LASTPRCT^BDMAPIU(P,$$DOB^AUPNPAT(P),EDATE,"BGP CABG PROCS","A")

 I X Q "1  Yes - "_$P(X,U,2)_" on "_$$FMTE^XLFDT($P(X,U,1))

 S X=$$LASTCPTT^BDMAPIU(P,$$DOB^AUPNPAT(P),EDATE,"BGP PCI CM CPTS","A")

 I X Q "1  Yes - CPT "_$P(X,U,2)_" on "_$$FMTE^XLFDT($P(X,U,1))

 S X=$$LASTCPTT^BDMAPIU(P,$$DOB^AUPNPAT(P),EDATE,"BGP CABG CPTS","A")

 I X Q "1  Yes - CPT "_$P(X,U,2)_" on "_$$FMTE^XLFDT($P(X,U,1))

 Q "2  No"

BDMDB12   ; IHS/CMI/LAB - 2014 DIABETES AUDIT ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53

 +2       ;

 +3       ;cmi/anch/maw 9/12/2014 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:"3 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:"3 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

 +9        SET ED=9999999-EDATE

           SET BD=9999999-BDATE

           SET G=0

 +10       FOR 

               SET ED=$ORDER(^AUPNVSIT("AA",P,ED))

               IF ED=""!($PIECE(ED,".")>BD)!(G)

                   QUIT 

               Begin DoDot:1

 +11               SET V=0

                   FOR 

                       SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))

                       IF V'=+V!(G)

                           QUIT 

                       Begin DoDot:2

 +12                       IF '$DATA(^AUPNVSIT(V,0))

                               QUIT 

 +13                       IF '$DATA(^AUPNVCPT("AD",V))

                               QUIT 

 +14                       SET X=0

                           FOR 

                               SET X=$ORDER(^AUPNVCPT("AD",V,X))

                               IF X'=+X!(G)

                                   QUIT 

                               Begin DoDot:3

 +15      ;cmi/maw 05/15/2014 p8

                                   IF $$ICD^BDMUTL($PIECE(^AUPNVCPT(X,0),U),$PIECE(^ATXAX(T,0),U),1)

                                       SET G=X

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

 +17                               QUIT 

                               End DoDot:3

 +18                       QUIT 

                       End DoDot:2

 +19               QUIT 

               End DoDot:1

 +20       IF 'G

               QUIT ""

 +21       IF F=1

               QUIT $SELECT(G:1,1:"")

 +22       IF F=2

               QUIT G

 +23       IF F=3

               SET V=$PIECE(^AUPNVCPT(G,0),U,3)

               IF V

                   QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")

 +24       IF F=4

               SET V=$PIECE(^AUPNVCPT(G,0),U,3)

               IF V

                   QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))

 +25       QUIT ""

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

 +1        IF '$GET(P)

               QUIT ""

 +2        IF '$GET(T)

               QUIT ""

 +3        IF '$GET(F)

               SET F=1

 +4        IF $GET(EDATE)=""

               QUIT ""

 +5        IF $GET(BDATE)=""

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

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

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

 +8        SET ED=9999999-EDATE

           SET BD=9999999-BDATE

           SET G=0

 +9        FOR 

               SET ED=$ORDER(^AUPNVSIT("AA",P,ED))