BDMD417 ; IHS/CMI/LAB - 2012 DIABETES AUDIT ; 13 Mar 2012 1:52 PM
;;2.0;DIABETES MANAGEMENT SYSTEM;**5**;JUN 14, 2007
DIETEDUC(P,BDATE,EDATE) ;EP
NEW D,BD,ED,X,Y,%DT,D,G,BDMVRD,V,BDM,RD,NRD,BDMV
S (RD,NRD,BDMV)=""
S X=BDATE,%DT="P" D ^%DT S BD=Y
S X=EDATE,%DT="P" D ^%DT S ED=Y
S D=9999999-ED,(RD,NRD)=""
F S D=$O(^AUPNVSIT("AA",P,D)) Q:D=""!(D>(9999999-BD)) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,D,V)) Q:V'=+V D
..Q:'$D(^AUPNVSIT(V,0))
..Q:$P(^AUPNVSIT(V,0),U,11)
..Q:'$P(^AUPNVSIT(V,0),U,9)
..Q:$$DNKA(V)
..Q:$P(^AUPNVSIT(V,0),U,7)="C"
..Q:$$CLINIC^APCLV(V,"C")=52
..I $$PRIMPROV^APCLV(V,"D")=29 S BDMVRD(V)="",BDMV=BDMV_" RD: "_$P(^DIC(7,$O(^DIC(7,"D",29,0)),0),U)_" Visit: "_$$VD^APCLV(V,"E")_" " Q
..I $$PRIMPROV^APCLV(V,"D")="07" S BDMVRD(V)="",BDMV=BDMV_" RD: "_$P(^DIC(7,$O(^DIC(7,"D","07",0)),0),U)_" Visit: "_$$VD^APCLV(V,"E")_" " Q
..I $$PRIMPROV^APCLV(V,"D")="34" S BDMVRD(V)="",BDMV=BDMV_" RD: "_$P(^DIC(7,$O(^DIC(7,"D",34,0)),0),U)_" Visit: "_$$VD^APCLV(V,"E")_" " Q
..;now check povs for V65.3 and label as non-rd
..S X=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X I $$VAL^XBDIQ1(9000010.07,X,.01)="V65.3" S NRD=1,BDMV=BDMV_"NRD: V65.3 Dx: "_$$VD^APCLV(V,"E")_" "
..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X S Z=$$VAL^XBDIQ1(9000010.18,X,.01) I Z=97802!(Z=97803)!(Z=97804) S RD=1,BDMV=BDMV_"RD: CPT "_Z_" "_$$VD^APCLV(V,"E")_" "
..;now check for education topics
..S T=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
..S X=0 F S X=$O(^AUPNVPED("AD",V,X)) Q:X'=+X S Y=$P($G(^AUPNVPED(X,0)),U) D
...Q:'Y
...Q:'$D(^AUTTEDT(Y,0))
...I T,$D(^ATXAX(T,21,"B",Y)) S Z=$$PC(X) D Q
....I Z="07"!(Z=29)!(Z=34) S RD=1,BDMV=BDMV_"RD: "_$P(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" " Q
....S NRD=1,BDMV=BDMV_"NRD: "_$P(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" "
...S J=$P(^AUTTEDT(Y,0),U,2) I $P(J,"-",2)="N"!($P(J,"-",2)="DT")!($P(J,"-")="MNT")!($P(J,"-",2)="MNT") S Z=$$PC(X) D Q
....I Z="07"!(Z=29)!(Z=34) S RD=1,BDMV=BDMV_"RD: "_$P(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" " Q
....S NRD=1,BDMV=BDMV_"NRD: "_$P(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" "
..Q
.Q
I $D(BDMVRD) S RD=1 ;a RD visit so a hit
S G=0
I RD!(NRD) Q $S(RD+NRD=2:"3 Yes (RD & Non RD - Other) "_U_BDMV,RD:"1 Yes (RD) "_BDMV,1:"2 Yes (Non RD) "_BDMV)
NEW T S T=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
NEW G,X,Y,%DT S X=BDATE,%DT="P" D ^%DT S B=Y
S X=EDATE,%DT="P" D ^%DT S E=Y
S G=0
S I=0 F S I=$O(^AUPNPREF("AA",BDMPD,9999999.09,I)) Q:I'=+I!(G) D
.S A=0 I $D(^ATXAX(T,21,"B",I)) S A=1
.S Z=$P($G(^AUTTEDT(I,0)),U,2) I $P(Z,"-",2)="N"!($P(Z,"-",2)="DT")!($P(Z,"-")="MNT")!($P(Z,"-",2)="MNT") S A=1
.Q:'A
.S X=0 F S X=$O(^AUPNPREF("AA",BDMPD,9999999.09,I,X)) Q:X'=+X!(G) D
..S Y=0 F S Y=$O(^AUPNPREF("AA",BDMPD,9999999.09,I,X,Y)) Q:Y'=+Y S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S G=1_"^"_$P(^AUPNPREF(Y,0),U,7)_U_Y
I G,$P(G,U,2)'="N" S Y=$P(G,U,3) Q "5 Refused "_$$VAL^XBDIQ1(9000022,Y,.04)_" "_$$VAL^XBDIQ1(9000022,Y,.03)_" "_$$VAL^XBDIQ1(9000022,Y,.07)
Q "4 None"_$S(G:" - Not Medically Indicated",1:"")
PC(V) ;return provider discipline of educ provider
I 'V Q ""
NEW X S X=$P(^AUPNVPED(V,0),U,5)
I 'X Q ""
;IHS/CMI/LAB patch 11 01/11/2002
I $P(^DD(9000010.16,.05,0),U,2)[200 Q $$PROVCLSC^XBFUNC1(X)
NEW A S A=$P(^DIC(6,X,0),U,4)
I 'A Q ""
Q $P($G(^DIC(7,A,9999999)),U)
EXEDUC(P,BDATE,EDATE) ;EP
NEW BDM,X,E,%,G
S X=P_"^LAST EDUC [DM AUDIT EXERCISE EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
I $D(BDM(1)) Q "1 Yes "_$P(BDM(1),U,3)_" "_$$DATE^BDMS9B1($P(BDM(1),U,1))
K BDM
S X=P_"^ALL EDUC;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
S X=0,G=0 F S X=$O(BDM(X)) Q:X'=+X!(G) S I=+$P(BDM(X),U,4),E=$P($G(^AUPNVPED(I,0)),U),T=$P($G(^AUTTEDT(E,0)),U,2) I $P(T,"-",2)="EX" S G=1
I G Q "1 Yes "_T_" "_$$VD^APCLV($P(^AUPNVPED(I,0),U,3),"E")
K BDM
S X=P_"^LAST DX V65.41;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
I $D(BDM(1)) Q "1 Yes POV: "_$P(BDM(1),U,3)_" "_$$DATE^BDMS9B1($P(BDM(1),U))
S G=0
NEW T S T=$O(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",0))
NEW G,X,Y,%DT S X=BDATE,%DT="P" D ^%DT S B=Y
S X=EDATE,%DT="P" D ^%DT S E=Y
S G=0
S I=0 F S I=$O(^AUPNPREF("AA",BDMPD,9999999.09,I)) Q:I'=+I!(G) D
.S A=0 I $D(^ATXAX(T,21,"B",I)) S A=1
.S Z=$P($G(^AUTTEDT(I,0)),U,2) I $P(Z,"-",2)="EX" S A=1
.Q:'A
.S X=0 F S X=$O(^AUPNPREF("AA",BDMPD,9999999.09,I,X)) Q:X'=+X!(G) D
..S Y=0 F S Y=$O(^AUPNPREF("AA",BDMPD,9999999.09,I,X,Y)) Q:Y'=+Y S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S G=1_"^"_$P(^AUPNPREF(Y,0),U,7)_U_Y
I G,$P(G,U,2)'="N" S Y=$P(G,U,3) Q "3 Refused "_$$VAL^XBDIQ1(9000022,Y,.04)_" "_$$VAL^XBDIQ1(9000022,Y,.03)_" "_$$VAL^XBDIQ1(9000022,Y,.07)
Q "2 No"_$S(G:" - Not Medically Indicated",1:"")
OTHEDUC(P,BDATE,EDATE) ;EP
NEW BDM,X,E,%,T,TX
S TX=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
K BDM
S X=P_"^ALL EDUC;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
S X=0,G=0 F S X=$O(BDM(X)) Q:X'=+X!(G) D
.S I=+$P(BDM(X),U,4)
.S J=$P($G(^AUPNVPED(I,0)),U)
.Q:'J
.S T=$P($G(^AUTTEDT(J,0)),U,2)
.I $P(T,"-",2)="EX" Q
.I $P(T,"-",2)="N" Q
.I $P(T,"-",2)="MNT" Q
.I $P(T,"-",2)="DT" Q
.I TX,$D(^ATXAX(TX,21,"AA",I)) S G="1 Yes "_T_" "_$$VD^APCLV($P(^AUPNVPED(I,0),U,3),"E")
.I $E($P(T,"-",1),1,3)="250"!($P(T,"-",1)="DM")!($P(T,"-",1)="DMC") S G="1 Yes "_T_" "_$$VD^APCLV($P(^AUPNVPED(I,0),U,3),"E")
I G Q G
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,9999999.09,I)) Q:I'=+I!(G) D
.S A=0
.S Z=$P($G(^AUTTEDT(I,0)),U,2)
.I $P(Z,"-",2)="EX" Q
.I $P(Z,"-",2)="N" Q
.I $P(Z,"-",2)="MNT" Q
.I $P(Z,"-",2)="DT" Q
.I $P(Z,"-",1)="MNT" Q
.I $D(^ATXAX(TX,21,"B",I)) S A=1
.I $E($P(Z,"-",1),1,3)="250"!($P(Z,"-",1)="DM")!($P(Z,"-",1)="DMC") S A=1
.Q:'A
.S X=0 F S X=$O(^AUPNPREF("AA",BDMPD,9999999.09,I,X)) Q:X'=+X!(G) D
..S Y=0 F S Y=$O(^AUPNPREF("AA",BDMPD,9999999.09,I,X,Y)) Q:Y'=+Y S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S G=1_"^"_$P(^AUPNPREF(Y,0),U,7)_U_Y
I G,$P(G,U,2)'="N" S Y=$P(G,U,3) Q "3 Refused "_$$VAL^XBDIQ1(9000022,Y,.04)_" "_$$VAL^XBDIQ1(9000022,Y,.03)_" "_$$VAL^XBDIQ1(9000022,Y,.07)
Q "2 No"_$S(G:" - Not Medically Indicated",1:"")
;
DFE(P,BDATE,EDATE,F,R) ;EP - FOOT EXAM
I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
I $G(EDATE)="" S EDATE=DT
I $G(F)="" S F="E"
NEW BDMY,BDMV,%,LASTI,A,D,V,G,PROV,E,T,PROVI
S LASTI=""
S BDMY(1)=$$LASTDFE^APCLAPI2(P,BDATE,EDATE,"D")
I BDMY(1) S LASTI=$P(BDMY(1),U)_U_"1 Yes - Diabetic Foot Exam - "_$$DATE^BDMS9B1($P(BDMY(1),U)) I F="H" Q LASTI
I F="E",LASTI]"" Q $P(LASTI,U,2) ; if in audit and has exam display it
;now check any clinic 65 or prov 33/25
;
K T
S T="T"
D ALLV^BDMAPIU(P,BDATE,EDATE,.T)
;reorder by date of visit/reverse order
S %=0 F S %=$O(T(%)) Q:%'=+% S BDMY((9999999-$P(T(%),U)),$P(T(%),U,5))=T(%)
N PROV,D,V,G
S (D,V)=0,G=""
F S D=$O(BDMY(D)) Q:D'=+D!(G) S V=0 F S V=$O(BDMY(D,V)) Q:V'=+V!(G) D
.Q:$$DNKA(V)
.Q:$P(^AUPNVSIT(V,0),U,7)="C"
.Q:$$CLINIC^APCLV(V,"C")=52
.S PROV=$$PRIMPROV^APCLV(V,"D"),PROVI=$$PRIMPROV^APCLV(V,"F") I (PROV=33!(PROV=25)!(PROV=84)) S G=9999999-D
I G]"" D
.Q:$P(LASTI,U)>G
.S LASTI=G_U_"1 "_$S(F="H":"Maybe",1:"Yes")_" - "_$P(^DIC(7,PROVI,0),U,1)_" - "_$$DATE^BDMS9B1($P(G,U))
S (D,V)=0,G=""
F S D=$O(BDMY(D)) Q:D'=+D!(G) S V=0 F S V=$O(BDMY(D,V)) Q:V'=+V!(G) D
.Q:$$DNKA(V)
.Q:$P(^AUPNVSIT(V,0),U,7)="C"
.Q:$$CLINIC^APCLV(V,"C")=52
.S PROV=$$CLINIC^APCLV(V,"C"),PROVI=$$CLINIC^APCLV(V,"I") I PROV=65!(PROV="B7") S G=9999999-D
I G]"" D
.Q:$P(LASTI,U)>G
.S LASTI=G_U_"1 "_$S(F="H":"Maybe",1:"Yes")_" - "_$P(^DIC(40.7,PROVI,0),U,1)_" - "_$$DATE^BDMS9B1($P(G,U))
;
I $G(R) Q $S(F="D":$P(LASTI,U),1:$P(LASTI,U,2)) ;no refusals
;
I LASTI]"" Q $S(F="D":$P(LASTI,U),1:$P(LASTI,U,2))
;
NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0)),BDATE,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused - "_$P(G,U,3)
Q "2 No"_$S(G:" - Not Medically Indicated",1:"")
;
ADA(V) ;any ada other than 9991
I '$G(V) Q ""
NEW X,Y,Z,G
S G="",X=0 F S X=$O(^AUPNVDEN("AD",V,X)) Q:X'=+X!(G) S Y=$P($G(^AUPNVDEN(X,0)),U) I Y,$D(^AUTTADA(Y,0)),$P(^AUTTADA(Y,0),U)'=9991 S G=1
Q G
DNKA(V) ;EP - is this a DNKA visit?
I '$G(V) Q ""
NEW D,N S D=$$PRIMPOV^APCLV(V,"C")
I D=".0860" Q 1
S N=$$PRIMPOV^APCLV(V,"N")
I $E(D)="V",N["DNKA" Q 1
I $E(D)="V",N["DID NOT KEEP APPOINTMENT" Q 1
I $E(D)="V",N["DID NOT KEEP APPT" Q 1
Q 0
REFR(V) ;
I '$G(V) Q ""
NEW D,N S D=$$PRIMPOV^APCLV(V,"C")
I D="367.89"!(D="367.9")!($E(D,1,5)=372.0)!($E(D,1,5)=372.1) Q 1
Q 0
;
REFUSAL(P,F,I,B,E) ;EP
I '$G(P) Q ""
I '$G(F) Q ""
I '$G(I) Q ""
I $G(B)="" Q ""
I $G(E)="" Q ""
NEW G,X,Y,%DT,R S X=B,%DT="P" D ^%DT S B=Y
S X=E,%DT="P" D ^%DT S E=Y
S (X,G)=0 F S X=$O(^AUPNPREF("AA",P,F,I,X)) Q:X'=+X!(G) S Y=0 F S Y=$O(^AUPNPREF("AA",P,F,I,X,Y)) Q:Y'=+Y S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) D
.S G=1_"^"_$P(^AUPNPREF(Y,0),U,7)_U_$$DATE^BDMS9B1($P(^AUPNPREF(Y,0),U,3))_U_$$VAL^XBDIQ1(9000022,Y,.04)_U_$$VAL^XBDIQ1(9000022,Y,.07)_U_$$VAL^XBDIQ1(9000022,Y,.01)_U_$P(^AUPNPREF(Y,0),U,3)
Q G
;
EYE(P,BDATE,EDATE,F,R) ;EP
I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
I $G(EDATE)="" S EDATE=DT
I $G(F)="" S F="E"
NEW BDMY,BDMV,%,LASTI,BD,ED,T,D,%,Y,X,G,V,PROV,T,PROVI
S LASTI=$$LASTDEYE^APCLAPI2(P,BDATE,EDATE,"D")
I LASTI]"" S $P(LASTI,U,2)="1 Yes - Diabetic Eye Exam - "_$$DATE^BDMS9B1($P(LASTI,U)) I F="H" Q LASTI
I F="E",LASTI]"" Q $P(LASTI,U,2) ; if in audit and has exam display it
;
S X=$$LASTCPTT^BDMAPIU(P,BDATE,EDATE,$O(^ATXAX("B","DM AUDIT EYE EXAM CPTS",0)),"E")
I $P(X,U)>$P(LASTI,U) S LASTI=$P(X,U)_U_"1 Yes - "_$P(X,U,2)_" - "_$$DATE^BDMS9B1($P(X,U)) I F="H" Q LASTI
K BDMV,BDMY
I LASTI]"" Q LASTI
;
K T
S T="T"
D ALLV^BDMAPIU(P,BDATE,EDATE,.T)
;reorder by date of visit/reverse order
S %=0 F S %=$O(T(%)) Q:%'=+% S BDMY((9999999-$P(T(%),U)),$P(T(%),U,5))=T(%)
N PROV,D,V,G
S (D,V)=0,G=""
F S D=$O(BDMY(D)) Q:D'=+D!(G) S V=0 F S V=$O(BDMY(D,V)) Q:V'=+V!(G) D
.Q:$$DNKA(V)
.Q:$P(^AUPNVSIT(V,0),U,7)="C"
.Q:$$CLINIC^APCLV(V,"C")=52
.S PROV=$$PRIMPROV^APCLV(V,"D"),PROVI=$$PRIMPROV^APCLV(V,"F") I (PROV=24!(PROV=79)!(PROV="08")),'$$REFR(V) S G=9999999-D
I G]"" D
.Q:$P(LASTI,U)>G
.S LASTI=G_U_"1 "_$S(F="H":"Maybe",1:"Yes")_" - "_$P(^DIC(7,PROVI,0),U,1)_" ("_PROV_") Visit - "_$$DATE^BDMS9B1($P(G,U))
S (D,V)=0,G=""
F S D=$O(BDMY(D)) Q:D'=+D!(G) S V=0 F S V=$O(BDMY(D,V)) Q:V'=+V!(G) D
.Q:$$DNKA(V)
.Q:$P(^AUPNVSIT(V,0),U,7)="C"
.Q:$$CLINIC^APCLV(V,"C")=52
.S PROV=$$CLINIC^APCLV(V,"C"),PROVI=$$CLINIC^APCLV(V,"I") I PROV=17!(PROV=18)!(PROV=64)!(PROV="A2"),'$$REFR(V) S G=9999999-D
I G]"" D
.Q:$P(LASTI,U)>G
.S LASTI=G_U_"1 "_$S(F="H":"Maybe",1:"Yes")_" - "_$P(^DIC(40.7,PROVI,0),U,1)_" ("_PROV_") Visit - "_$$DATE^BDMS9B1($P(G,U))
;
I $G(R) Q $S(F="D":$P(LASTI,U),1:$P(LASTI,U,2)) ;no refusals
;
I LASTI]"" Q $S(F="D":$P(LASTI,U),1:$P(LASTI,U,2))
;
NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DIABETIC EYE EXAM",0)),BDATE,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused - "_$P(G,U,3)
Q "2 No"_$S(G:" - Not Medically Indicated",1:"")
;
DENTAL(P,BDATE,EDATE,F,R) ;EP
NEW BDMY,BDMV,%,LASTI,BD,ED,T,D,%,Y,X,G,V,PROV
I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
I $G(EDATE)="" S EDATE=DT
I $G(F)="" S F="E"
S LASTI=$$LASTDENT^APCLAPI2(P,BDATE,EDATE,"D")
I LASTI]"" S $P(LASTI,U,2)="1 Yes - Dental Exam - "_$$DATE^BDMS9B1($P(LASTI,U)) I F="H" Q LASTI
I F="E",LASTI]"" Q $P(LASTI,U,2) ; if in audit and has exam display it
;
K BDMV,BDMY
;
K T
S T="T"
D ALLV^BDMAPIU(P,BDATE,EDATE,.T)
;reorder by date of visit/reverse order
S %=0 F S %=$O(T(%)) Q:%'=+% S BDMY((9999999-$P(T(%),U)),$P(T(%),U,5))=T(%)
N PROV,D,V,G
S (D,V)=0,G=""
F S D=$O(BDMY(D)) Q:D'=+D!(G) S V=0 F S V=$O(BDMY(D,V)) Q:V'=+V!(G) D
.Q:$$DNKA(V)
.Q:$P(^AUPNVSIT(V,0),U,7)="C"
.Q:$$CLINIC^APCLV(V,"C")=52
.S PROV=$$PRIMPROV^APCLV(V,"D") I PROV=52,$$ADA(V) S G=9999999-D
I G]"" D
.Q:$P(LASTI,U)>G
.S LASTI=G_U_"1 "_$S(F="H":"Maybe",1:"Yes")_" - Dentist Visit - "_$$DATE^BDMS9B1($P(G,U))
S (D,V)=0,G=""
F S D=$O(BDMY(D)) Q:D'=+D!(G) S V=0 F S V=$O(BDMY(D,V)) Q:V'=+V!(G) S PROV=$$CLINIC^APCLV(V,"C") I PROV=56,$$ADA(V),$O(^AUPNVDEN("AD",V,0)),'$$DNKA(V) S G=9999999-D
I G]"" D
.Q:$P(LASTI,U)>G
.S LASTI=G_U_"1 "_$S(F="H":"Maybe",1:"Yes")_" - Dental Clinic visit - "_$$DATE^BDMS9B1($P(G,U))
;
I $G(R) Q $S(F="D":$P(LASTI,U),1:$P(LASTI,U,2)) ;no refusals
;
I LASTI]"" Q $S(F="D":$P(LASTI,U),1:$P(LASTI,U,2))
;
NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DENTAL EXAM",0)),BDATE,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused - "_$P(G,U,3)
Q "2 No"_$S(G:" - Not Medically Indicated",1:"")
BDMD417 ; IHS/CMI/LAB - 2012 DIABETES AUDIT ; 13 Mar 2012 1:52 PM
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**5**;JUN 14, 2007
DIETEDUC(P,BDATE,EDATE) ;EP
+1 NEW D,BD,ED,X,Y,%DT,D,G,BDMVRD,V,BDM,RD,NRD,BDMV
+2 SET (RD,NRD,BDMV)=""
+3 SET X=BDATE
SET %DT="P"
DO ^%DT
SET BD=Y
+4 SET X=EDATE
SET %DT="P"
DO ^%DT
SET ED=Y
+5 SET D=9999999-ED
SET (RD,NRD)=""
+6 FOR
SET D=$ORDER(^AUPNVSIT("AA",P,D))
IF D=""!(D>(9999999-BD))
QUIT
Begin DoDot:1
+7 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,D,V))
IF V'=+V
QUIT
Begin DoDot:2
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+10 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+11 IF $$DNKA(V)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+13 IF $$CLINIC^APCLV(V,"C")=52
QUIT
+14 IF $$PRIMPROV^APCLV(V,"D")=29
SET BDMVRD(V)=""
SET BDMV=BDMV_" RD: "_$PIECE(^DIC(7,$ORDER(^DIC(7,"D",29,0)),0),U)_" Visit: "_$$VD^APCLV(V,"E")_" "
QUIT
+15 IF $$PRIMPROV^APCLV(V,"D")="07"
SET BDMVRD(V)=""
SET BDMV=BDMV_" RD: "_$PIECE(^DIC(7,$ORDER(^DIC(7,"D","07",0)),0),U)_" Visit: "_$$VD^APCLV(V,"E")_" "
QUIT
+16 IF $$PRIMPROV^APCLV(V,"D")="34"
SET BDMVRD(V)=""
SET BDMV=BDMV_" RD: "_$PIECE(^DIC(7,$ORDER(^DIC(7,"D",34,0)),0),U)_" Visit: "_$$VD^APCLV(V,"E")_" "
QUIT
+17 ;now check povs for V65.3 and label as non-rd
+18 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",V,X))
IF X'=+X
QUIT
IF $$VAL^XBDIQ1(9000010.07,X,.01)="V65.3"
SET NRD=1
SET BDMV=BDMV_"NRD: V65.3 Dx: "_$$VD^APCLV(V,"E")_" "
+19 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X
QUIT
SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
IF Z=97802!(Z=97803)!(Z=97804)
SET RD=1
SET BDMV=BDMV_"RD: CPT "_Z_" "_$$VD^APCLV(V,"E")_" "
+20 ;now check for education topics
+21 SET T=$ORDER(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
+22 SET X=0
FOR
SET X=$ORDER(^AUPNVPED("AD",V,X))
IF X'=+X
QUIT
SET Y=$PIECE($GET(^AUPNVPED(X,0)),U)
Begin DoDot:3
+23 IF 'Y
QUIT
+24 IF '$DATA(^AUTTEDT(Y,0))
QUIT
+25 IF T
IF $DATA(^ATXAX(T,21,"B",Y))
SET Z=$$PC(X)
Begin DoDot:4
+26 IF Z="07"!(Z=29)!(Z=34)
SET RD=1
SET BDMV=BDMV_"RD: "_$PIECE(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" "
QUIT
+27 SET NRD=1
SET BDMV=BDMV_"NRD: "_$PIECE(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" "
End DoDot:4
QUIT
+28 SET J=$PIECE(^AUTTEDT(Y,0),U,2)
IF $PIECE(J,"-",2)="N"!($PIECE(J,"-",2)="DT")!($PIECE(J,"-")="MNT")!($PIECE(J,"-",2)="MNT")
SET Z=$$PC(X)
Begin DoDot:4
+29 IF Z="07"!(Z=29)!(Z=34)
SET RD=1
SET BDMV=BDMV_"RD: "_$PIECE(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" "
QUIT
+30 SET NRD=1
SET BDMV=BDMV_"NRD: "_$PIECE(^AUTTEDT(Y,0),U,2)_" "_$$VD^APCLV(V,"E")_" "
End DoDot:4
QUIT
End DoDot:3
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 ;a RD visit so a hit
IF $DATA(BDMVRD)
SET RD=1
+34 SET G=0
+35 IF RD!(NRD)
QUIT $SELECT(RD+NRD=2:"3 Yes (RD & Non RD - Other) "_U_BDMV,RD:"1 Yes (RD) "_BDMV,1:"2 Yes (Non RD) "_BDMV)
+36 NEW T
SET T=$ORDER(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
+37 NEW G,X,Y,%DT
SET X=BDATE
SET %DT="P"
DO ^%DT
SET B=Y
+38 SET X=EDATE
SET %DT="P"
DO ^%DT
SET E=Y
+39 SET G=0
+40 SET I=0
FOR
SET I=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I))
IF I'=+I!(G)
QUIT
Begin DoDot:1
+41 SET A=0
IF $DATA(^ATXAX(T,21,"B",I))
SET A=1
+42 SET Z=$PIECE($GET(^AUTTEDT(I,0)),U,2)
IF $PIECE(Z,"-",2)="N"!($PIECE(Z,"-",2)="DT")!($PIECE(Z,"-")="MNT")!($PIECE(Z,"-",2)="MNT")
SET A=1
+43 IF 'A
QUIT
+44 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+45 SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I,X,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AUPNPREF(Y,0),U,3)
IF D'<B&(D'>E)
SET G=1_"^"_$PIECE(^AUPNPREF(Y,0),U,7)_U_Y
End DoDot:2
End DoDot:1
+46 IF G
IF $PIECE(G,U,2)'="N"
SET Y=$PIECE(G,U,3)
QUIT "5 Refused "_$$VAL^XBDIQ1(9000022,Y,.04)_" "_$$VAL^XBDIQ1(9000022,Y,.03)_" "_$$VAL^XBDIQ1(9000022,Y,.07)
+47 QUIT "4 None"_$SELECT(G:" - Not Medically Indicated",1:"")
PC(V) ;return provider discipline of educ provider
+1 IF 'V
QUIT ""
+2 NEW X
SET X=$PIECE(^AUPNVPED(V,0),U,5)
+3 IF 'X
QUIT ""
+4 ;IHS/CMI/LAB patch 11 01/11/2002
+5 IF $PIECE(^DD(9000010.16,.05,0),U,2)[200
QUIT $$PROVCLSC^XBFUNC1(X)
+6 NEW A
SET A=$PIECE(^DIC(6,X,0),U,4)
+7 IF 'A
QUIT ""
+8 QUIT $PIECE($GET(^DIC(7,A,9999999)),U)
EXEDUC(P,BDATE,EDATE) ;EP
+1 NEW BDM,X,E,%,G
+2 SET X=P_"^LAST EDUC [DM AUDIT EXERCISE EDUC TOPICS;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"BDM(")
+3 IF $DATA(BDM(1))
QUIT "1 Yes "_$PIECE(BDM(1),U,3)_" "_$$DATE^BDMS9B1($PIECE(BDM(1),U,1))
+4 KILL BDM
+5 SET X=P_"^ALL EDUC;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"BDM(")
+6 SET X=0
SET G=0
FOR
SET X=$ORDER(BDM(X))
IF X'=+X!(G)
QUIT
SET I=+$PIECE(BDM(X),U,4)
SET E=$PIECE($GET(^AUPNVPED(I,0)),U)
SET T=$PIECE($GET(^AUTTEDT(E,0)),U,2)
IF $PIECE(T,"-",2)="EX"
SET G=1
+7 IF G
QUIT "1 Yes "_T_" "_$$VD^APCLV($PIECE(^AUPNVPED(I,0),U,3),"E")
+8 KILL BDM
+9 SET X=P_"^LAST DX V65.41;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"BDM(")
+10 IF $DATA(BDM(1))
QUIT "1 Yes POV: "_$PIECE(BDM(1),U,3)_" "_$$DATE^BDMS9B1($PIECE(BDM(1),U))
+11 SET G=0
+12 NEW T
SET T=$ORDER(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",0))
+13 NEW G,X,Y,%DT
SET X=BDATE
SET %DT="P"
DO ^%DT
SET B=Y
+14 SET X=EDATE
SET %DT="P"
DO ^%DT
SET E=Y
+15 SET G=0
+16 SET I=0
FOR
SET I=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I))
IF I'=+I!(G)
QUIT
Begin DoDot:1
+17 SET A=0
IF $DATA(^ATXAX(T,21,"B",I))
SET A=1
+18 SET Z=$PIECE($GET(^AUTTEDT(I,0)),U,2)
IF $PIECE(Z,"-",2)="EX"
SET A=1
+19 IF 'A
QUIT
+20 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+21 SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I,X,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AUPNPREF(Y,0),U,3)
IF D'<B&(D'>E)
SET G=1_"^"_$PIECE(^AUPNPREF(Y,0),U,7)_U_Y
End DoDot:2
End DoDot:1
+22 IF G
IF $PIECE(G,U,2)'="N"
SET Y=$PIECE(G,U,3)
QUIT "3 Refused "_$$VAL^XBDIQ1(9000022,Y,.04)_" "_$$VAL^XBDIQ1(9000022,Y,.03)_" "_$$VAL^XBDIQ1(9000022,Y,.07)
+23 QUIT "2 No"_$SELECT(G:" - Not Medically Indicated",1:"")
OTHEDUC(P,BDATE,EDATE) ;EP
+1 NEW BDM,X,E,%,T,TX
+2 SET TX=$ORDER(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
+3 KILL BDM
+4 SET X=P_"^ALL EDUC;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"BDM(")
+5 SET X=0
SET G=0
FOR
SET X=$ORDER(BDM(X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+6 SET I=+$PIECE(BDM(X),U,4)
+7 SET J=$PIECE($GET(^AUPNVPED(I,0)),U)
+8 IF 'J
QUIT
+9 SET T=$PIECE($GET(^AUTTEDT(J,0)),U,2)
+10 IF $PIECE(T,"-",2)="EX"
QUIT
+11 IF $PIECE(T,"-",2)="N"
QUIT
+12 IF $PIECE(T,"-",2)="MNT"
QUIT
+13 IF $PIECE(T,"-",2)="DT"
QUIT
+14 IF TX
IF $DATA(^ATXAX(TX,21,"AA",I))
SET G="1 Yes "_T_" "_$$VD^APCLV($PIECE(^AUPNVPED(I,0),U,3),"E")
+15 IF $EXTRACT($PIECE(T,"-",1),1,3)="250"!($PIECE(T,"-",1)="DM")!($PIECE(T,"-",1)="DMC")
SET G="1 Yes "_T_" "_$$VD^APCLV($PIECE(^AUPNVPED(I,0),U,3),"E")
End DoDot:1
+16 IF G
QUIT G
+17 SET X=BDATE
SET %DT="P"
DO ^%DT
SET B=Y
+18 SET X=EDATE
SET %DT="P"
DO ^%DT
SET E=Y
+19 SET G=""
+20 SET I=0
FOR
SET I=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I))
IF I'=+I!(G)
QUIT
Begin DoDot:1
+21 SET A=0
+22 SET Z=$PIECE($GET(^AUTTEDT(I,0)),U,2)
+23 IF $PIECE(Z,"-",2)="EX"
QUIT
+24 IF $PIECE(Z,"-",2)="N"
QUIT
+25 IF $PIECE(Z,"-",2)="MNT"
QUIT
+26 IF $PIECE(Z,"-",2)="DT"
QUIT
+27 IF $PIECE(Z,"-",1)="MNT"
QUIT
+28 IF $DATA(^ATXAX(TX,21,"B",I))
SET A=1
+29 IF $EXTRACT($PIECE(Z,"-",1),1,3)="250"!($PIECE(Z,"-",1)="DM")!($PIECE(Z,"-",1)="DMC")
SET A=1
+30 IF 'A
QUIT
+31 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+32 SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",BDMPD,9999999.09,I,X,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AUPNPREF(Y,0),U,3)
IF D'<B&(D'>E)
SET G=1_"^"_$PIECE(^AUPNPREF(Y,0),U,7)_U_Y
End DoDot:2
End DoDot:1
+33 IF G
IF $PIECE(G,U,2)'="N"
SET Y=$PIECE(G,U,3)
QUIT "3 Refused "_$$VAL^XBDIQ1(9000022,Y,.04)_" "_$$VAL^XBDIQ1(9000022,Y,.03)_" "_$$VAL^XBDIQ1(9000022,Y,.07)
+34 QUIT "2 No"_$SELECT(G:" - Not Medically Indicated",1:"")
+35 ;
DFE(P,BDATE,EDATE,F,R) ;EP - FOOT EXAM
+1 IF $GET(BDATE)=""
SET BDATE=$$DOB^AUPNPAT(P)
+2 IF $GET(EDATE)=""
SET EDATE=DT
+3 IF $GET(F)=""
SET F="E"
+4 NEW BDMY,BDMV,%,LASTI,A,D,V,G,PROV,E,T,PROVI
+5 SET LASTI=""
+6 SET BDMY(1)=$$LASTDFE^APCLAPI2(P,BDATE,EDATE,"D")
+7 IF BDMY(1)
SET LASTI=$PIECE(BDMY(1),U)_U_"1 Yes - Diabetic Foot Exam - "_$$DATE^BDMS9B1($PIECE(BDMY(1),U))
IF F="H"
QUIT LASTI
+8 ; if in audit and has exam display it
IF F="E"
IF LASTI]""
QUIT $PIECE(LASTI,U,2)
+9 ;now check any clinic 65 or prov 33/25
+10 ;
+11 KILL T
+12 SET T="T"
+13 DO ALLV^BDMAPIU(P,BDATE,EDATE,.T)
+14 ;reorder by date of visit/reverse order
+15 SET %=0
FOR
SET %=$ORDER(T(%))
IF %'=+%
QUIT
SET BDMY((9999999-$PIECE(T(%),U)),$PIECE(T(%),U,5))=T(%)
+16 NEW PROV,D,V,G
+17 SET (D,V)=0
SET G=""
+18 FOR
SET D=$ORDER(BDMY(D))
IF D'=+D!(G)
QUIT
SET V=0
FOR
SET V=$ORDER(BDMY(D,V))
IF V'=+V!(G)
QUIT
Begin DoDot:1
+19 IF $$DNKA(V)
QUIT
+20 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+21 IF $$CLINIC^APCLV(V,"C")=52
QUIT
+22 SET PROV=$$PRIMPROV^APCLV(V,"D")
SET PROVI=$$PRIMPROV^APCLV(V,"F")
IF (PROV=33!(PROV=25)!(PROV=84))
SET G=9999999-D
End DoDot:1
+23 IF G]""
Begin DoDot:1
+24 IF $PIECE(LASTI,U)>G
QUIT
+25 SET LASTI=G_U_"1 "_$SELECT(F="H":"Maybe",1:"Yes")_" - "_$PIECE(^DIC(7,PROVI,0),U,1)_" - "_$$DATE^BDMS9B1($PIECE(G,U))
End DoDot:1
+26 SET (D,V)=0
SET G=""
+27 FOR
SET D=$ORDER(BDMY(D))
IF D'=+D!(G)
QUIT
SET V=0
FOR
SET V=$ORDER(BDMY(D,V))
IF V'=+V!(G)
QUIT
Begin DoDot:1
+28 IF $$DNKA(V)
QUIT
+29 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+30 IF $$CLINIC^APCLV(V,"C")=52
QUIT
+31 SET PROV=$$CLINIC^APCLV(V,"C")
SET PROVI=$$CLINIC^APCLV(V,"I")
IF PROV=65!(PROV="B7")
SET G=9999999-D
End DoDot:1
+32 IF G]""
Begin DoDot:1
+33 IF $PIECE(LASTI,U)>G
QUIT
+34 SET LASTI=G_U_"1 "_$SELECT(F="H":"Maybe",1:"Yes")_" - "_$PIECE(^DIC(40.7,PROVI,0),U,1)_" - "_$$DATE^BDMS9B1($PIECE(G,U))
End DoDot:1
+35 ;
+36 ;no refusals
IF $GET(R)
QUIT $SELECT(F="D":$PIECE(LASTI,U),1:$PIECE(LASTI,U,2))
+37 ;
+38 IF LASTI]""
QUIT $SELECT(F="D":$PIECE(LASTI,U),1:$PIECE(LASTI,U,2))
+39 ;
+40 NEW G
SET G=$$REFUSAL(P,9999999.15,$ORDER(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0)),BDATE,EDATE)
+41 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused - "_$PIECE(G,U,3)
+42 QUIT "2 No"_$SELECT(G:" - Not Medically Indicated",1:"")
+43 ;
ADA(V) ;any ada other than 9991
+1 IF '$GET(V)
QUIT ""
+2 NEW X,Y,Z,G
+3 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVDEN("AD",V,X))
IF X'=+X!(G)
QUIT
SET Y=$PIECE($GET(^AUPNVDEN(X,0)),U)
IF Y
IF $DATA(^AUTTADA(Y,0))
IF $PIECE(^AUTTADA(Y,0),U)'=9991
SET G=1
+4 QUIT G
DNKA(V) ;EP - is this a DNKA visit?
+1 IF '$GET(V)
QUIT ""
+2 NEW D,N
SET D=$$PRIMPOV^APCLV(V,"C")
+3 IF D=".0860"
QUIT 1
+4 SET N=$$PRIMPOV^APCLV(V,"N")
+5 IF $EXTRACT(D)="V"
IF N["DNKA"
QUIT 1
+6 IF $EXTRACT(D)="V"
IF N["DID NOT KEEP APPOINTMENT"
QUIT 1
+7 IF $EXTRACT(D)="V"
IF N["DID NOT KEEP APPT"
QUIT 1
+8 QUIT 0
REFR(V) ;
+1 IF '$GET(V)
QUIT ""
+2 NEW D,N
SET D=$$PRIMPOV^APCLV(V,"C")
+3 IF D="367.89"!(D="367.9")!($EXTRACT(D,1,5)=372.0)!($EXTRACT(D,1,5)=372.1)
QUIT 1
+4 QUIT 0
+5 ;
REFUSAL(P,F,I,B,E) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(F)
QUIT ""
+3 IF '$GET(I)
QUIT ""
+4 IF $GET(B)=""
QUIT ""
+5 IF $GET(E)=""
QUIT ""
+6 NEW G,X,Y,%DT,R
SET X=B
SET %DT="P"
DO ^%DT
SET B=Y
+7 SET X=E
SET %DT="P"
DO ^%DT
SET E=Y
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,F,I,X))
IF X'=+X!(G)
QUIT
SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",P,F,I,X,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AUPNPREF(Y,0),U,3)
IF D'<B&(D'>E)
Begin DoDot:1
+9 SET G=1_"^"_$PIECE(^AUPNPREF(Y,0),U,7)_U_$$DATE^BDMS9B1($PIECE(^AUPNPREF(Y,0),U,3))_U_$$VAL^XBDIQ1(9000022,Y,.04)_U_$$VAL^XBDIQ1(9000022,Y,.07)_U_$$VAL^XBDIQ1(9000022,Y,.01)_U_$PIECE(^AUPNPREF(Y,0),U,3)
End DoDot:1
+10 QUIT G
+11 ;
EYE(P,BDATE,EDATE,F,R) ;EP
+1 IF $GET(BDATE)=""
SET BDATE=$$DOB^AUPNPAT(P)
+2 IF $GET(EDATE)=""
SET EDATE=DT
+3 IF $GET(F)=""
SET F="E"
+4 NEW BDMY,BDMV,%,LASTI,BD,ED,T,D,%,Y,X,G,V,PROV,T,PROVI
+5 SET LASTI=$$LASTDEYE^APCLAPI2(P,BDATE,EDATE,"D")
+6 IF LASTI]""
SET $PIECE(LASTI,U,2)="1 Yes - Diabetic Eye Exam - "_$$DATE^BDMS9B1($PIECE(LASTI,U))
IF F="H"
QUIT LASTI
+7 ; if in audit and has exam display it
IF F="E"
IF LASTI]""
QUIT $PIECE(LASTI,U,2)
+8 ;
+9 SET X=$$LASTCPTT^BDMAPIU(P,BDATE,EDATE,$ORDER(^ATXAX("B","DM AUDIT EYE EXAM CPTS",0)),"E")
+10 IF $PIECE(X,U)>$PIECE(LASTI,U)
SET LASTI=$PIECE(X,U)_U_"1 Yes - "_$PIECE(X,U,2)_" - "_$$DATE^BDMS9B1($PIECE(X,U))
IF F="H"
QUIT LASTI
+11 KILL BDMV,BDMY
+12 IF LASTI]""
QUIT LASTI
+13 ;
+14 KILL T
+15 SET T="T"
+16 DO ALLV^BDMAPIU(P,BDATE,EDATE,.T)
+17 ;reorder by date of visit/reverse order
+18 SET %=0
FOR
SET %=$ORDER(T(%))
IF %'=+%
QUIT
SET BDMY((9999999-$PIECE(T(%),U)),$PIECE(T(%),U,5))=T(%)
+19 NEW PROV,D,V,G
+20 SET (D,V)=0
SET G=""
+21 FOR
SET D=$ORDER(BDMY(D))
IF D'=+D!(G)
QUIT
SET V=0
FOR
SET V=$ORDER(BDMY(D,V))
IF V'=+V!(G)
QUIT
Begin DoDot:1
+22 IF $$DNKA(V)
QUIT
+23 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+24 IF $$CLINIC^APCLV(V,"C")=52
QUIT
+25 SET PROV=$$PRIMPROV^APCLV(V,"D")
SET PROVI=$$PRIMPROV^APCLV(V,"F")
IF (PROV=24!(PROV=79)!(PROV="08"))
IF '$$REFR(V)
SET G=9999999-D
End DoDot:1
+26 IF G]""
Begin DoDot:1
+27 IF $PIECE(LASTI,U)>G
QUIT
+28 SET LASTI=G_U_"1 "_$SELECT(F="H":"Maybe",1:"Yes")_" - "_$PIECE(^DIC(7,PROVI,0),U,1)_" ("_PROV_") Visit - "_$$DATE^BDMS9B1($PIECE(G,U))
End DoDot:1
+29 SET (D,V)=0
SET G=""
+30 FOR
SET D=$ORDER(BDMY(D))
IF D'=+D!(G)
QUIT
SET V=0
FOR
SET V=$ORDER(BDMY(D,V))
IF V'=+V!(G)
QUIT
Begin DoDot:1
+31 IF $$DNKA(V)
QUIT
+32 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+33 IF $$CLINIC^APCLV(V,"C")=52
QUIT
+34 SET PROV=$$CLINIC^APCLV(V,"C")
SET PROVI=$$CLINIC^APCLV(V,"I")
IF PROV=17!(PROV=18)!(PROV=64)!(PROV="A2")
IF '$$REFR(V)
SET G=9999999-D
End DoDot:1
+35 IF G]""
Begin DoDot:1
+36 IF $PIECE(LASTI,U)>G
QUIT
+37 SET LASTI=G_U_"1 "_$SELECT(F="H":"Maybe",1:"Yes")_" - "_$PIECE(^DIC(40.7,PROVI,0),U,1)_" ("_PROV_") Visit - "_$$DATE^BDMS9B1($PIECE(G,U))
End DoDot:1
+38 ;
+39 ;no refusals
IF $GET(R)
QUIT $SELECT(F="D":$PIECE(LASTI,U),1:$PIECE(LASTI,U,2))
+40 ;
+41 IF LASTI]""
QUIT $SELECT(F="D":$PIECE(LASTI,U),1:$PIECE(LASTI,U,2))
+42 ;
+43 NEW G
SET G=$$REFUSAL(P,9999999.15,$ORDER(^AUTTEXAM("B","DIABETIC EYE EXAM",0)),BDATE,EDATE)
+44 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused - "_$PIECE(G,U,3)
+45 QUIT "2 No"_$SELECT(G:" - Not Medically Indicated",1:"")
+46 ;
DENTAL(P,BDATE,EDATE,F,R) ;EP
+1 NEW BDMY,BDMV,%,LASTI,BD,ED,T,D,%,Y,X,G,V,PROV
+2 IF $GET(BDATE)=""
SET BDATE=$$DOB^AUPNPAT(P)
+3 IF $GET(EDATE)=""
SET EDATE=DT
+4 IF $GET(F)=""
SET F="E"
+5 SET LASTI=$$LASTDENT^APCLAPI2(P,BDATE,EDATE,"D")
+6 IF LASTI]""
SET $PIECE(LASTI,U,2)="1 Yes - Dental Exam - "_$$DATE^BDMS9B1($PIECE(LASTI,U))
IF F="H"
QUIT LASTI
+7 ; if in audit and has exam display it
IF F="E"
IF LASTI]""
QUIT $PIECE(LASTI,U,2)
+8 ;
+9 KILL BDMV,BDMY
+10 ;
+11 KILL T
+12 SET T="T"
+13 DO ALLV^BDMAPIU(P,BDATE,EDATE,.T)
+14 ;reorder by date of visit/reverse order
+15 SET %=0
FOR
SET %=$ORDER(T(%))
IF %'=+%
QUIT
SET BDMY((9999999-$PIECE(T(%),U)),$PIECE(T(%),U,5))=T(%)
+16 NEW PROV,D,V,G
+17 SET (D,V)=0
SET G=""
+18 FOR
SET D=$ORDER(BDMY(D))
IF D'=+D!(G)
QUIT
SET V=0
FOR
SET V=$ORDER(BDMY(D,V))
IF V'=+V!(G)
QUIT
Begin DoDot:1
+19 IF $$DNKA(V)
QUIT
+20 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+21 IF $$CLINIC^APCLV(V,"C")=52
QUIT
+22 SET PROV=$$PRIMPROV^APCLV(V,"D")
IF PROV=52
IF $$ADA(V)
SET G=9999999-D
End DoDot:1
+23 IF G]""
Begin DoDot:1
+24 IF $PIECE(LASTI,U)>G
QUIT
+25 SET LASTI=G_U_"1 "_$SELECT(F="H":"Maybe",1:"Yes")_" - Dentist Visit - "_$$DATE^BDMS9B1($PIECE(G,U))
End DoDot:1
+26 SET (D,V)=0
SET G=""
+27 FOR
SET D=$ORDER(BDMY(D))
IF D'=+D!(G)
QUIT
SET V=0
FOR
SET V=$ORDER(BDMY(D,V))
IF V'=+V!(G)
QUIT
SET PROV=$$CLINIC^APCLV(V,"C")
IF PROV=56
IF $$ADA(V)
IF $ORDER(^AUPNVDEN("AD",V,0))
IF '$$DNKA(V)
SET G=9999999-D
+28 IF G]""
Begin DoDot:1
+29 IF $PIECE(LASTI,U)>G
QUIT
+30 SET LASTI=G_U_"1 "_$SELECT(F="H":"Maybe",1:"Yes")_" - Dental Clinic visit - "_$$DATE^BDMS9B1($PIECE(G,U))
End DoDot:1
+31 ;
+32 ;no refusals
IF $GET(R)
QUIT $SELECT(F="D":$PIECE(LASTI,U),1:$PIECE(LASTI,U,2))
+33 ;
+34 IF LASTI]""
QUIT $SELECT(F="D":$PIECE(LASTI,U),1:$PIECE(LASTI,U,2))
+35 ;
+36 NEW G
SET G=$$REFUSAL(P,9999999.15,$ORDER(^AUTTEXAM("B","DENTAL EXAM",0)),BDATE,EDATE)
+37 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused - "_$PIECE(G,U,3)
+38 QUIT "2 No"_$SELECT(G:" - Not Medically Indicated",1:"")
