APCLP517 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
DIETEDUC(P,BDATE,EDATE) ;EP
NEW D,BD,ED,X,Y,%DT,D,G,APCLVRD,V,APCL,RD,NRD
S (RD,NRD)=""
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)="" ;is this right???
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:'$D(^AUPNVPOV("AD",V))
..;Q:'$D(^AUPNVPRV("AD",V))
..Q:$$DNKA(V)
..Q:$P(^AUPNVSIT(V,0),U,7)="C"
..Q:$$CLINIC^APCLV(V,"C")=52
..I $$PRIMPROV^APCLV(V,"D")=29 S APCLVRD(V)="" Q
..I $$PRIMPROV^APCLV(V,"D")="07" S APCLVRD(V)="" Q
..I $$PRIMPROV^APCLV(V,"D")="34" S APCLVRD(V)="" 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
..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
..;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
...I T,$D(^ATXAX(T,21,"B",Y)) S Z=$$PC(X) D Q
....I Z="07"!(Z=29)!(Z=34) S RD=1 Q
....S NRD=1
...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 Q
....S NRD=1
..Q
.Q
I $D(APCLVRD) S RD=1 ;a RD visit so a hit
S G=0
I RD!(NRD) Q $S(RD+NRD=2:"Yes (RD & Non RD - Other)",RD:"Yes (RD)",1:"Yes (Non RD)")
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",APCLPD,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",APCLPD,9999999.09,I,X)) Q:X'=+X!(G) D
..S Y=0 F S Y=$O(^AUPNPREF("AA",APCLPD,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)
I G,$P(G,U,2)'="N" Q "Refused"
Q "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 APCL,X,E,%,G
S X=P_"^EDUC [DM AUDIT EXERCISE EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL(1)) Q "Yes"
S G=0
NEW T S T=$O(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",0))
I 'T Q "No"
S X=0 F S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G) S G=$$REFUSAL(P,9999999.09,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)
I G,$P(G,U,2)'="N" Q "Refused"
Q "No"_$S(G:" - Not Medically Indicated",1:"")
OTHEDUC(P,BDATE,EDATE) ;EP
NEW APCL,X,E,%
S X=P_"^EDUC [DM AUDIT OTHER EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL(1)) Q "Yes"
S G=0
NEW T S T=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
I 'T Q "No"
S X=0 F S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G) S G=$$REFUSAL(P,9999999.09,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)
I G,$P(G,U,2)'="N" Q "Refused"
Q "No"_$S(G:" - Not Medically Indicated",1:"")
DFE(P,BDATE,EDATE) ;EP
NEW APCL,%,E,C K APCL S %=P_"^LAST EXAM DIABETIC FOOT EXAM;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
I $D(APCL(1)) Q "Yes-Diabetic Foot Exam-"_$$FMTE^XLFDT($P(APCL(1),U))
;now check any clinic 65
K APCL
S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
NEW X,Y,R S (X,Y)=0 F S X=$O(APCL(X)) Q:X'=+X!(Y) S R=$$PRIMPROV^APCLV($P(APCL(X),U,5),"D") I (R=33!(R=25)!(R=84)),'$$DNKA($P(APCL(X),U,5)) S Y=1
I Y Q "Yes - Podiatrist Visit"
S X=0,Y=0 F S X=$O(APCL(X)) Q:X'=+X!(Y) S C=$$CLINIC^APCLV($P(APCL(X),U,5),"C") I C=65!(C="B7"),'$$DNKA($P(APCL(X),U,5)) S Y=1
I Y Q "Yes - Podiatry Clinic visit"
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 "Refused"
Q "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) ;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 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) S G=1_"^"_$P(^AUPNPREF(Y,0),U,7)
Q G
EYE(P,BDATE,EDATE) ;EP
NEW APCL,%,E K APCL S %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
I $D(APCL(1)) Q "Yes-Diabetic Eye Exam-"_$$FMTE^XLFDT($P(APCL(1),U))
K APCL NEW BD,ED,T
S X=BDATE,%DT="P" D ^%DT S BD=Y
S X=EDATE,%DT="P" D ^%DT S ED=Y
S T=$O(^ICPT("B",92250,0)),T1=$O(^ICPT("B",92012,0)),T2=$O(^ICPT("B",92014,0)),T3=$O(^ICPT("B",92015,0)),T4=$O(^ICPT("B",92004,0)),T5=$O(^ICPT("B",92002,0))
I T,$D(^AUPNVCPT("AA",P,T)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-Fundus Photography-"_$$FMTE^XLFDT(D)
..Q
.Q
T1 ;
I T1,$D(^AUPNVCPT("AA",P,T1)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T1,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-Eye Exam/Est Pat-"_$$FMTE^XLFDT(D)
..Q
.Q
T2 ;
I T2,$D(^AUPNVCPT("AA",P,T2)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T2,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-CPT 92014-"_$$FMTE^XLFDT(D)
..Q
.Q
T3 ;
I T3,$D(^AUPNVCPT("AA",P,T3)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T3,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-CPT 92015-"_$$FMTE^XLFDT(D)
..Q
.Q
T4 ;
I T4,$D(^AUPNVCPT("AA",P,T4)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T4,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-CPT 92004-"_$$FMTE^XLFDT(D)
..Q
.Q
T5 ;
I T5,$D(^AUPNVCPT("AA",P,T5)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T5,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-CPT 92002-"_$$FMTE^XLFDT(D)
..Q
.Q
S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
NEW X,Y,R S (X,Y)=0 F S X=$O(APCL(X)) Q:X'=+X!(Y) S R=$$PRIMPROV^APCLV($P(APCL(X),U,5),"D") I (R=24!(R=79)!(R="08")),'$$DNKA($P(APCL(X),U,5)),'$$REFR($P(APCL(X),U,5)) S Y=1
I Y Q "Yes - Optometrist/Opthamalogist Visit"
S X=0,Y=0 F S X=$O(APCL(X)) Q:X'=+X!(Y) S R=$$CLINIC^APCLV($P(APCL(X),U,5),"C") I (R=17!(R=18)!(R=64)!(R="A2")),'$$DNKA($P(APCL(X),U,5)),'$$REFR($P(APCL(X),U,5)) S Y=1
I Y Q "Yes - Optometry/Opthamology Clinic visit"
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 "Refused"
Q "No"_$S(G:" - Not Medically Indicated",1:"")
DENTAL(P,BDATE,EDATE) ;EP
I '$G(P) Q ""
NEW APCL,%,E
K APCL
S %=P_"^LAST EXAM DENTAL;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
S %=$P($G(APCL(1)),U)
I %]"" Q "Yes-Dental Exam-"_$$FMTE^XLFDT(%)
K APCL
S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
NEW X,Y S X=0,Y="" F S X=$O(APCL(X)) Q:X'=+X!(Y]"") I $$CLINIC^APCLV($P(APCL(X),U,5),"C")=56!($$CLINIC^APCLV($P(APCL(X),U,5),"C")="99"),$$ADA($P(APCL(X),U,5)),'$$DNKA($P(APCL(X),U,5)) S Y=$$FMTE^XLFDT($P(APCL(X),U))
I Y]"" Q "Yes-Dental Clinic visit-"_Y
S X=0,Y="" F S X=$O(APCL(X)) Q:X'=+X!(Y]"") I $$PRIMPROV^APCLV($P(APCL(X),U,5),"D")=52,$$ADA($P(APCL(X),U,5)),'$$DNKA($P(APCL(X),U,5)) S Y=$$FMTE^XLFDT($P(APCL(X),U))
I Y]"" Q "Yes-Dentist Visit-"_$$FMTE^XLFDT(Y)
S X=0,Y="" F S X=$O(APCL(X)) Q:X'=+X!(Y]"") I $$CLINIC^APCLV($P(APCL(X),U,5),"C")=56!($$CLINIC^APCLV($P(APCL(X),U,5),"C")="99"),'$$ADA($P(APCL(X),U,5)),$O(^AUPNVDEN("AD",$P(APCL(X),U,5),0)) S Y=1
I Y Q "Refused"
NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DENTAL EXAM",0)),BDATE,EDATE)
I G,$P(G,U,2)'="N" Q "Refused"
Q "No"_$S(G:" - Not Medically Indicated",1:"")
APCLP517 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
DIETEDUC(P,BDATE,EDATE) ;EP
+1 NEW D,BD,ED,X,Y,%DT,D,G,APCLVRD,V,APCL,RD,NRD
+2 SET (RD,NRD)=""
+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 ;is this right???
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 ;Q:'$D(^AUPNVPOV("AD",V))
+12 ;Q:'$D(^AUPNVPRV("AD",V))
+13 IF $$DNKA(V)
QUIT
+14 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+15 IF $$CLINIC^APCLV(V,"C")=52
QUIT
+16 IF $$PRIMPROV^APCLV(V,"D")=29
SET APCLVRD(V)=""
QUIT
+17 IF $$PRIMPROV^APCLV(V,"D")="07"
SET APCLVRD(V)=""
QUIT
+18 IF $$PRIMPROV^APCLV(V,"D")="34"
SET APCLVRD(V)=""
QUIT
+19 ;now check povs for V65.3 and label as non-rd
+20 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
+21 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
+22 ;now check for education topics
+23 SET T=$ORDER(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
+24 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
+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
QUIT
+27 SET NRD=1
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
QUIT
+30 SET NRD=1
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(APCLVRD)
SET RD=1
+34 SET G=0
+35 IF RD!(NRD)
QUIT $SELECT(RD+NRD=2:"Yes (RD & Non RD - Other)",RD:"Yes (RD)",1:"Yes (Non RD)")
+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",APCLPD,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",APCLPD,9999999.09,I,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+45 SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",APCLPD,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)
End DoDot:2
End DoDot:1
+46 IF G
IF $PIECE(G,U,2)'="N"
QUIT "Refused"
+47 QUIT "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 APCL,X,E,%,G
+2 SET X=P_"^EDUC [DM AUDIT EXERCISE EDUC TOPICS;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCL(")
+3 IF $DATA(APCL(1))
QUIT "Yes"
+4 SET G=0
+5 NEW T
SET T=$ORDER(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",0))
+6 IF 'T
QUIT "No"
+7 SET X=0
FOR
SET X=$ORDER(^ATXAX(T,21,X))
IF X'=+X!(G)
QUIT
SET G=$$REFUSAL(P,9999999.09,$PIECE(^ATXAX(T,21,X,0),U),BDATE,EDATE)
+8 IF G
IF $PIECE(G,U,2)'="N"
QUIT "Refused"
+9 QUIT "No"_$SELECT(G:" - Not Medically Indicated",1:"")
OTHEDUC(P,BDATE,EDATE) ;EP
+1 NEW APCL,X,E,%
+2 SET X=P_"^EDUC [DM AUDIT OTHER EDUC TOPICS;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCL(")
+3 IF $DATA(APCL(1))
QUIT "Yes"
+4 SET G=0
+5 NEW T
SET T=$ORDER(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
+6 IF 'T
QUIT "No"
+7 SET X=0
FOR
SET X=$ORDER(^ATXAX(T,21,X))
IF X'=+X!(G)
QUIT
SET G=$$REFUSAL(P,9999999.09,$PIECE(^ATXAX(T,21,X,0),U),BDATE,EDATE)
+8 IF G
IF $PIECE(G,U,2)'="N"
QUIT "Refused"
+9 QUIT "No"_$SELECT(G:" - Not Medically Indicated",1:"")
DFE(P,BDATE,EDATE) ;EP
+1 NEW APCL,%,E,C
KILL APCL
SET %=P_"^LAST EXAM DIABETIC FOOT EXAM;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"APCL(")
+2 IF $DATA(APCL(1))
QUIT "Yes-Diabetic Foot Exam-"_$$FMTE^XLFDT($PIECE(APCL(1),U))
+3 ;now check any clinic 65
+4 KILL APCL
+5 SET %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"APCL(")
+6 NEW X,Y,R
SET (X,Y)=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(Y)
QUIT
SET R=$$PRIMPROV^APCLV($PIECE(APCL(X),U,5),"D")
IF (R=33!(R=25)!(R=84))
IF '$$DNKA($PIECE(APCL(X),U,5))
SET Y=1
+7 IF Y
QUIT "Yes - Podiatrist Visit"
+8 SET X=0
SET Y=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(Y)
QUIT
SET C=$$CLINIC^APCLV($PIECE(APCL(X),U,5),"C")
IF C=65!(C="B7")
IF '$$DNKA($PIECE(APCL(X),U,5))
SET Y=1
+9 IF Y
QUIT "Yes - Podiatry Clinic visit"
+10 NEW G
SET G=$$REFUSAL(P,9999999.15,$ORDER(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0)),BDATE,EDATE)
+11 IF G
IF $PIECE(G,U,2)'="N"
QUIT "Refused"
+12 QUIT "No"_$SELECT(G:" - Not Medically Indicated",1:"")
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) ;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
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
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)
SET G=1_"^"_$PIECE(^AUPNPREF(Y,0),U,7)
+9 QUIT G
EYE(P,BDATE,EDATE) ;EP
+1 NEW APCL,%,E
KILL APCL
SET %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"APCL(")
+2 IF $DATA(APCL(1))
QUIT "Yes-Diabetic Eye Exam-"_$$FMTE^XLFDT($PIECE(APCL(1),U))
+3 KILL APCL
NEW BD,ED,T
+4 SET X=BDATE
SET %DT="P"
DO ^%DT
SET BD=Y
+5 SET X=EDATE
SET %DT="P"
DO ^%DT
SET ED=Y
+6 SET T=$ORDER(^ICPT("B",92250,0))
SET T1=$ORDER(^ICPT("B",92012,0))
SET T2=$ORDER(^ICPT("B",92014,0))
SET T3=$ORDER(^ICPT("B",92015,0))
SET T4=$ORDER(^ICPT("B",92004,0))
SET T5=$ORDER(^ICPT("B",92002,0))
+7 IF T
IF $DATA(^AUPNVCPT("AA",P,T))
SET %=""
Begin DoDot:1
+8 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+9 ;date done
SET D=9999999-E
+10 IF D>ED
QUIT
+11 IF D<BD
QUIT
+12 SET %="Yes-Fundus Photography-"_$$FMTE^XLFDT(D)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
IF %]""
QUIT %
T1 ;
+1 IF T1
IF $DATA(^AUPNVCPT("AA",P,T1))
SET %=""
Begin DoDot:1
+2 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T1,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+3 ;date done
SET D=9999999-E
+4 IF D>ED
QUIT
+5 IF D<BD
QUIT
+6 SET %="Yes-Eye Exam/Est Pat-"_$$FMTE^XLFDT(D)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
IF %]""
QUIT %
T2 ;
+1 IF T2
IF $DATA(^AUPNVCPT("AA",P,T2))
SET %=""
Begin DoDot:1
+2 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T2,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+3 ;date done
SET D=9999999-E
+4 IF D>ED
QUIT
+5 IF D<BD
QUIT
+6 SET %="Yes-CPT 92014-"_$$FMTE^XLFDT(D)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
IF %]""
QUIT %
T3 ;
+1 IF T3
IF $DATA(^AUPNVCPT("AA",P,T3))
SET %=""
Begin DoDot:1
+2 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T3,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+3 ;date done
SET D=9999999-E
+4 IF D>ED
QUIT
+5 IF D<BD
QUIT
+6 SET %="Yes-CPT 92015-"_$$FMTE^XLFDT(D)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
IF %]""
QUIT %
T4 ;
+1 IF T4
IF $DATA(^AUPNVCPT("AA",P,T4))
SET %=""
Begin DoDot:1
+2 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T4,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+3 ;date done
SET D=9999999-E
+4 IF D>ED
QUIT
+5 IF D<BD
QUIT
+6 SET %="Yes-CPT 92004-"_$$FMTE^XLFDT(D)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
IF %]""
QUIT %
T5 ;
+1 IF T5
IF $DATA(^AUPNVCPT("AA",P,T5))
SET %=""
Begin DoDot:1
+2 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T5,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+3 ;date done
SET D=9999999-E
+4 IF D>ED
QUIT
+5 IF D<BD
QUIT
+6 SET %="Yes-CPT 92002-"_$$FMTE^XLFDT(D)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
IF %]""
QUIT %
+9 SET %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"APCL(")
+10 NEW X,Y,R
SET (X,Y)=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(Y)
QUIT
SET R=$$PRIMPROV^APCLV($PIECE(APCL(X),U,5),"D")
IF (R=24!(R=79)!(R="08"))
IF '$$DNKA($PIECE(APCL(X),U,5))
IF '$$REFR($PIECE(APCL(X),U,5))
SET Y=1
+11 IF Y
QUIT "Yes - Optometrist/Opthamalogist Visit"
+12 SET X=0
SET Y=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(Y)
QUIT
SET R=$$CLINIC^APCLV($PIECE(APCL(X),U,5),"C")
IF (R=17!(R=18)!(R=64)!(R="A2"))
IF '$$DNKA($PIECE(APCL(X),U,5))
IF '$$REFR($PIECE(APCL(X),U,5))
SET Y=1
+13 IF Y
QUIT "Yes - Optometry/Opthamology Clinic visit"
+14 NEW G
SET G=$$REFUSAL(P,9999999.15,$ORDER(^AUTTEXAM("B","DIABETIC EYE EXAM",0)),BDATE,EDATE)
+15 IF G
IF $PIECE(G,U,2)'="N"
QUIT "Refused"
+16 QUIT "No"_$SELECT(G:" - Not Medically Indicated",1:"")
DENTAL(P,BDATE,EDATE) ;EP
+1 IF '$GET(P)
QUIT ""
+2 NEW APCL,%,E
+3 KILL APCL
+4 SET %=P_"^LAST EXAM DENTAL;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"APCL(")
+5 SET %=$PIECE($GET(APCL(1)),U)
+6 IF %]""
QUIT "Yes-Dental Exam-"_$$FMTE^XLFDT(%)
+7 KILL APCL
+8 SET %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"APCL(")
+9 NEW X,Y
SET X=0
SET Y=""
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(Y]"")
QUIT
IF $$CLINIC^APCLV($PIECE(APCL(X),U,5),"C")=56!($$CLINIC^APCLV($PIECE(APCL(X),U,5),"C")="99")
IF $$ADA($PIECE(APCL(X),U,5))
IF '$$DNKA($PIECE(APCL(X),U,5))
SET Y=$$FMTE^XLFDT($PIECE(APCL(X),U))
+10 IF Y]""
QUIT "Yes-Dental Clinic visit-"_Y
+11 SET X=0
SET Y=""
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(Y]"")
QUIT
IF $$PRIMPROV^APCLV($PIECE(APCL(X),U,5),"D")=52
IF $$ADA($PIECE(APCL(X),U,5))
IF '$$DNKA($PIECE(APCL(X),U,5))
SET Y=$$FMTE^XLFDT($PIECE(APCL(X),U))
+12 IF Y]""
QUIT "Yes-Dentist Visit-"_$$FMTE^XLFDT(Y)
+13 SET X=0
SET Y=""
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(Y]"")
QUIT
IF $$CLINIC^APCLV($PIECE(APCL(X),U,5),"C")=56!($$CLINIC^APCLV($PIECE(APCL(X),U,5),"C")="99")
IF '$$ADA($PIECE(APCL(X),U,5))
IF $ORDER(^AUPNVDEN("AD",$PIECE(APCL(X),U,5),0))
SET Y=1
+14 IF Y
QUIT "Refused"
+15 NEW G
SET G=$$REFUSAL(P,9999999.15,$ORDER(^AUTTEXAM("B","DENTAL EXAM",0)),BDATE,EDATE)
+16 IF G
IF $PIECE(G,U,2)'="N"
QUIT "Refused"
+17 QUIT "No"_$SELECT(G:" - Not Medically Indicated",1:"")
