BDMD912.m

BDMD912 ; IHS/CMI/LAB - 2009 DIABETES AUDIT ;

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

 ;

 ;cmi/anch/maw 9/12/2009 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)

 ;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^BDMD912(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^BDMD912(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)

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

 ;

REFMED(P,BDATE,EDATE) ;EP

 NEW T,T1,T2,T3,T4,T5,T6,T7,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))  ;cmi/maw 12/18/2007 DM2009

 S T6=$O(^ATXAX("B","DM AUDIT DPP4 INHIBITOR DRUGS",0))  ;cmi/maw 12/18/2007 DM2009

 S T7=$O(^ATXAX("B","DM AUDIT AMYLIN ANALOGUES",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 $D(^ATXAX(T,21,"B",I)) S A=1

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

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

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

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

 .I $D(^ATXAX(T5,21,"B",I)) S A=1  ;cmi/maw 12/18/2009 DM2009

 .I $D(^ATXAX(T6,21,"B",I)) S A=1  ;cmi/maw 12/18/2009 DM2009

 .I $D(^ATXAX(T7,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 ""

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 DM2009

 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/2009 DM2009

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

 ;

TXNAME(V) ;EP

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

 S V=$$TXNAMES(V)

 Q $E(V,1,16)

TXNAMES(Y) ;

 I Y=10 Q "REFUSED"

 I Y=1 Q "DIET"

 I Y=2 Q "INSULIN"

 I Y=3 Q "SULFONYLUREA"

 I Y=4 Q "METFORMIN (GLUCOPHAGE)"

 I Y=5 Q "ACARBOSE OR MIGLITOL"

 I Y=6 Q "GLITAZONE"

 I Y=7 Q "INCRETIN MIMETIC"

 I Y=8 Q "DPP4"

 I Y=9 Q "AMYLIN ANALOGUES"

 I Y=23 Q "INSULIN+S'UREA"

 I Y=24 Q "INSULIN+MET"

 I Y=25 Q "INSULIN+ACAR"

 I Y=26 Q "INSULIN+GLITAZONE"

 I Y=27 Q "INSULIN+INCR"

 I Y=28 Q "INSULIN+DPP4"

 I Y=34 Q "S'UREA+MET"

 I Y=35 Q "S'UREA+ACAR"

 I Y=36 Q "S'UREA+GLITAZONE"

 I Y=37 Q "S'UREA+INCR"

 I Y=38 Q "S'UREA+DPP4"

 I Y=45 Q "MET+ACAR"

 I Y=46 Q "MET+GLITAZONE"

 I Y=47 Q "MET+INCR"

 I Y=48 Q "MET+DPP4"

 I Y=56 Q "ACAR+GLITAZONE"

 I Y=57 Q "ACAR+INCR"

 I Y=58 Q "ACAR+DPP4"

 I Y=67 Q "GLITAZONE+INCR"

 I Y=68 Q "GLITAZONE+DPP4"

 I Y=78 Q "INCR+DPP4"

 I Y=234 Q "INS+S'UREA+MET"

 I Y=235 Q "INS+S'UREA+ACAR"

 I Y=236 Q "INS+S'UREA+GLIT"

 I Y=237 Q "INS+S'UREA+INCR"

 I Y=238 Q "INS+S'UREA+DPP4"

 I Y=245 Q "INS+MET+ACAR"

 I Y=246 Q "INS+MET+GLITAZONE"

 I Y=247 Q "INS+MET+INCR"

 I Y=248 Q "INS+MET+DPP4"

 I Y=256 Q "INS+ACAR+GLITAZONE"

 I Y=257 Q "INS+ACAR+INCR"

 I Y=258 Q "INS+ACAR+DPP4"

 I Y=267 Q "INS+GLIT+INCR"

 I Y=268 Q "INS+GLIT+DPP4"

 I Y=278 Q "INS+INCR+DPP4"

 I Y=345 Q "S'UREA+MET+ACAR"

 I Y=346 Q "S'UREA+MET+GLIT"

 I Y=347 Q "S'UREA+MET+INCR"

 I Y=348 Q "S'UREA+MET+DPP4"

 I Y=356 Q "S'UREA+ACAR+GLIT"

 I Y=357 Q "S'UREA+ACAR+INCR"

 I Y=358 Q "S'UREA+ACAR+DPP4"

 I Y=456 Q "MET+ACAR+GLIT"

 I Y=457 Q "MET+ACAR+INCR"

 I Y=458 Q "MET+ACAR+DPP4"

 I Y=567 Q "ACAR+GLIT+INCR"

 I Y=568 Q "ACAR+GLIT+DPP4"

 I Y=578 Q "GLIT+INCR+DPP4"

 Q ""

 ;

DEPDX(P,BDATE,EDATE) ;EP

 NEW BDM,X

 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:'$$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)

 .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 I $D(BDM(1)) S BDM=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))

 .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 BDMP=$P($G(^AMHPROB(BDMP,0)),U)

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

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

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

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

 ..I $E(BDMP,1,3)=296 S BDM=BDM+1 Q

 ..I $E(BDMP,1,3)=300 S BDM=BDM+1 Q

 ..I $E(BDMP,1,3)=309 S BDM=BDM+1 Q

 ..I BDMP="301.13" S BDM=BDM+1 Q

 ..I BDMP=308.3 S BDM=BDM+1 Q

 ..I BDMP="311." 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^APCLAPI(P,BDATE,EDATE,"A")

 I $G(R) Q $S(F="A":$P(BDMC,U),1:"1  Yes - "_$P(BDMC,U,2)_"  "_$$FMTE^XLFDT($P(BDMC,U)))

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

 ;refusal

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

 I G 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^BDMD910(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

BDMD912   ; IHS/CMI/LAB - 2009 DIABETES AUDIT ;

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

 +2       ;

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

 +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                               IF $$ICD^ATXCHK($PIECE(^AUPNVCPT(X,0),U),T,1)

                                       SET G=X

 +16                               QUIT 

                               End DoDot:3

 +17                       QUIT 

                       End DoDot:2

 +18               QUIT 

               End DoDot:1

 +19       IF 'G

               QUIT ""

 +20       IF F=1

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

 +21       IF F=2

               QUIT G

 +22       IF F=3

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

               IF V

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

 +23       IF F=4

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

               IF V

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

 +24       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))

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

                   QUIT 

               Begin DoDot:1

 +10               SET V=0

                   FOR 

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

                       IF V'=+V!(G)

                           QUIT 

                       Begin DoDot:2

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

                               QUIT 

 +12                       IF '$DATA(^AUPNVRAD("AD",V))

                               QUIT 

 +13                       SET X=0

                           FOR 

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

                               IF X'=+X!(G)

                                   QUIT 

                               Begin DoDot:3

 +14                               IF '$DATA(^AUPNVRAD(X,0))

                                       QUIT 

 +15                               SET Y=$PIECE(^AUPNVRAD(X,0),U)

                                   IF 'Y

                                       QUIT 

                                   IF '$DATA(^RAMIS(71,Y,0))

                                       QUIT 

 +16                               SET Y=$PIECE($GET(^RAMIS(71,Y,0)),U,9)

                                   IF 'Y

                                       QUIT 

 +17                               IF '$$ICD^ATXCHK(Y,T,1)

                                       QUIT 

 +18                               SET G=X

 +19                               QUIT 

                               End DoDot:3

 +20                       QUIT 

                       End DoDot:2

 +21               QUIT 

               End DoDot:1

 +22       IF 'G

               QUIT ""

 +23       IF F=1

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

 +24       IF F=2

               QUIT G

 +25       IF F=3

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

               IF V

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

 +26       IF F=4

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