Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDMPF17

BDMPF17.m

Go to the documentation of this file. 
  1. BDMPF17 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
  1. DIETEDUC(P,BDATE,EDATE)  ;EP
  1.  NEW D,BD,ED,X,Y,%DT,D,G,BDMVRD,V,BDM,RD,NRD
  1.  S (RD,NRD)=""
  1.  S X=BDATE,%DT="P" D ^%DT S BD=Y
  1.  S X=EDATE,%DT="P" D ^%DT S ED=Y
  1.  S D=9999999-ED,(RD,NRD)="" ;is this right???
  1.  F  S D=$O(^AUPNVSIT("AA",P,D)) Q:D=""!(D>(9999999-BD))  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,D,V)) Q:V'=+V  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:$P(^AUPNVSIT(V,0),U,11)
  1.  ..Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  ..;Q:'$D(^AUPNVPOV("AD",V))
  1.  ..;Q:'$D(^AUPNVPRV("AD",V))
  1.  ..Q:$$DNKA(V)
  1.  ..Q:$P(^AUPNVSIT(V,0),U,7)="C"
  1.  ..Q:$$CLINIC^APCLV(V,"C")=52
  1.  ..I $$PRIMPROV^APCLV(V,"D")=29 S BDMVRD(V)="" Q
  1.  ..I $$PRIMPROV^APCLV(V,"D")="07" S BDMVRD(V)="" Q
  1.  ..I $$PRIMPROV^APCLV(V,"D")="34" S BDMVRD(V)="" Q
  1.  ..;now check povs for V65.3 and label as non-rd
  1.  ..N TAX
  1.  ..S TAX=$O(^ATXAX("B","BGP DIETARY SURVEILLANCE DXS",0))
  1.  ..;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
  1.  ..S X=0 F  S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X  I $$ICD^BDMUTL($$VALI^XBDIQ1(9000010.07,X,.01),$P(^ATXAX(TAX,0),U),9) S NRD=1  ;,BDMV=BDMV_"NRD: "_$$VAL^XBDIQ1(9000010.07,X,.01)_" Dx: "_$$VD^APCLV(V,"E")_" "  ;p8 ICD-10
  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
  1.  ..;now check for education topics
  1.  ..S T=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
  1.  ..S X=0 F  S X=$O(^AUPNVPED("AD",V,X)) Q:X'=+X  S Y=$P($G(^AUPNVPED(X,0)),U) D
  1.  ...I T,$D(^ATXAX(T,21,"B",Y)) S Z=$$PC(X) D  Q
  1.  ....I Z="07"!(Z=29)!(Z=34) S RD=1 Q
  1.  ....S NRD=1
  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
  1.  ....I Z="07"!(Z=29)!(Z=34) S RD=1 Q
  1.  ....S NRD=1
  1.  ..Q
  1.  .Q
  1.  I $D(BDMVRD) S RD=1 ;a RD visit so a hit
  1.  S G=0
  1.  I RD!(NRD) Q $S(RD+NRD=2:"Yes (RD & Non RD - Other)",RD:"Yes (RD)",1:"Yes (Non RD)")
  1.  NEW T S T=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
  1.  NEW G,X,Y,%DT S X=BDATE,%DT="P" D ^%DT S B=Y
  1.  S X=EDATE,%DT="P" D ^%DT S E=Y
  1.  S G=0
  1.  S I=0 F  S I=$O(^AUPNPREF("AA",BDMPF,9999999.09,I)) Q:I'=+I!(G)  D
  1.  .S A=0 I $D(^ATXAX(T,21,"B",I)) S A=1
  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
  1.  .Q:'A
  1.  .S X=0 F  S X=$O(^AUPNPREF("AA",BDMPF,9999999.09,I,X)) Q:X'=+X!(G)  D
  1.  ..S Y=0 F  S Y=$O(^AUPNPREF("AA",BDMPF,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)
  1.  I G,$P(G,U,2)'="N" Q "Refused"
  1.  Q "None"_$S(G:" - Not Medically Indicated",1:"")
  1. PC(V) ;return provider discipline of educ provider
  1.  I 'V Q ""
  1.  NEW X S X=$P(^AUPNVPED(V,0),U,5)
  1.  I 'X Q ""
  1.  ;IHS/CMI/LAB patch 11 01/11/2002
  1.  I $P(^DD(9000010.16,.05,0),U,2)[200 Q $$PROVCLSC^XBFUNC1(X)
  1.  NEW A S A=$P(^DIC(6,X,0),U,4)
  1.  I 'A Q ""
  1.  Q $P($G(^DIC(7,A,9999999)),U)
  1. EXEDUC(P,BDATE,EDATE) ;EP
  1.  NEW BDM,X,E,%,G
  1.  S X=P_"^LAST EDUC [DM AUDIT EXERCISE EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) Q "Yes  "_$P(BDM(1),U,3)_"  "_$$DATE^BDMS9B1($P(BDM(1),U,1))
  1.  K BDM
  1.  S X=P_"^ALL EDUC;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  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
  1.  I G Q "Yes "_T_"  "_$$VD^APCLV($P(^AUPNVPED(I,0),U,3),"E")
  1.  K BDM
  1.  S X=P_"^LAST DX V65.41;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) Q "Yes  POV: "_$P(BDM(1),U,3)_"  "_$$DATE^BDMS9B1($P(BDM(1),U))
  1.  Q "No" ;_$S(G:" - Not Medically Indicated",1:"")
  1. OTHEDUC(P,BDATE,EDATE) ;EP
  1.  NEW BDM,X,E,%,T,TX
  1.  S TX=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
  1.  K BDM
  1.  S X=P_"^ALL EDUC;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  S X=0,G=0 F  S X=$O(BDM(X)) Q:X'=+X!(G)  D
  1.  .S I=+$P(BDM(X),U,4)
  1.  .S J=$P($G(^AUPNVPED(I,0)),U)
  1.  .Q:'J
  1.  .S T=$P($G(^AUTTEDT(J,0)),U,2)
  1.  .I $P(T,"-",2)="EX" Q
  1.  .I $P(T,"-",2)="N" Q
  1.  .I $P(T,"-",2)="MNT" Q
  1.  .I $P(T,"-",2)="DT" Q
  1.  .I TX,$D(^ATXAX(TX,21,"AA",I)) S G="1  Yes "_T_"  "_$$VD^APCLV($P(^AUPNVPED(I,0),U,3),"E")
  1.  .I $E($P(T,"-",1),1,3)="250"!($P(T,"-",1)="DM")!($P(T,"-",1)="DMC") S G="Yes "_T_"  "_$$VD^APCLV($P(^AUPNVPED(I,0),U,3),"E")
  1.  I G Q G
  1.  Q "No"  ;_$S(G:" - Not Medically Indicated",1:"")
  1. DFE(P,BDATE,EDATE) ;EP
  1.  NEW BDM,%,E,C K BDM S %=P_"^LAST EXAM DIABETIC FOOT EXAM;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
  1.  I $D(BDM(1)) Q "Yes-Diabetic Foot Exam-"_$$FMTE^XLFDT($P(BDM(1),U))
  1.  ;now check any clinic 65
  1.  K BDM
  1.  S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
  1.  NEW X,Y,R S (X,Y)=0 F  S X=$O(BDM(X)) Q:X'=+X!(Y)  S R=$$PRIMPROV^APCLV($P(BDM(X),U,5),"D") I (R=33!(R=25)!(R=84)),'$$DNKA($P(BDM(X),U,5)) S Y=1
  1.  I Y Q "Yes - Podiatrist Visit"
  1.  S X=0,Y=0 F  S X=$O(BDM(X)) Q:X'=+X!(Y)  S C=$$CLINIC^APCLV($P(BDM(X),U,5),"C") I C=65!(C="B7"),'$$DNKA($P(BDM(X),U,5)) S Y=1
  1.  I Y Q "Yes - Podiatry Clinic visit"
  1.  NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DIABETIC FOOT EXAM, COMPLETE",0)),BDATE,EDATE)
  1.  I G,$P(G,U,2)'="N" Q "Refused"
  1.  Q "No"_$S(G:" - Not Medically Indicated",1:"")
  1. ADA(V) ;any ada other than 9991
  1.  I '$G(V) Q ""
  1.  NEW X,Y,Z,G
  1.  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
  1.  Q G
  1. DNKA(V) ;is this a DNKA visit?
  1.  I '$G(V) Q ""
  1.  NEW D,N S D=$$PRIMPOV^APCLV(V,"C")
  1.  I D=".0860" Q 1
  1.  S N=$$PRIMPOV^APCLV(V,"N")
  1.  I $E(D)="V",N["DNKA" Q 1
  1.  I $E(D)="V",N["DID NOT KEEP APPOINTMENT" Q 1
  1.  I $E(D)="V",N["DID NOT KEEP APPT" Q 1
  1.  Q 0
  1. REFR(V) ;
  1.  I '$G(V) Q ""
  1.  NEW D,N S D=$$PRIMPOV^APCLV(V,"C")
  1.  I D="367.89"!(D="367.9")!($E(D,1,5)=372.0)!($E(D,1,5)=372.1) Q 1
  1.  Q 0
  1. REFUSAL(P,F,I,B,E) ;EP
  1.  I '$G(P) Q ""
  1.  I '$G(F) Q ""
  1.  I '$G(I) Q ""
  1.  I $G(B)="" Q ""
  1.  I $G(E)="" Q ""
  1.  NEW G,X,Y,%DT S X=B,%DT="P" D ^%DT S B=Y
  1.  S X=E,%DT="P" D ^%DT S E=Y
  1.  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)
  1.  Q G
  1. EYE(P,BDATE,EDATE) ;EP
  1.  NEW BDM,%,E K BDM S %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
  1.  I $D(BDM(1)) Q "Yes-Diabetic Eye Exam-"_$$FMTE^XLFDT($P(BDM(1),U))
  1.  K BDM NEW BD,ED,T
  1.  S X=BDATE,%DT="P" D ^%DT S BD=Y
  1.  S X=EDATE,%DT="P" D ^%DT S ED=Y
  1.  S T=$O(^ICPT("B",92250,0)),T1=$O(^ICPT("B",92014,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))
  1.  I T,$D(^AUPNVCPT("AA",P,T)) S %="" D  I %]"" Q %
  1.  .S E=0 F  S E=$O(^AUPNVCPT("AA",P,T,E)) Q:E'=+E!(%]"")  D
  1.  ..S D=9999999-E ;date done
  1.  ..I D>ED Q
  1.  ..I D<BD Q
  1.  ..S %="Yes-Fundus Photography-"_$$FMTE^XLFDT(D)
  1.  ..Q
  1.  .Q
  1. T1 ;
  1.  I T1,$D(^AUPNVCPT("AA",P,T1)) S %="" D  I %]"" Q %
  1.  .S E=0 F  S E=$O(^AUPNVCPT("AA",P,T1,E)) Q:E'=+E!(%]"")  D
  1.  ..S D=9999999-E ;date done
  1.  ..I D>ED Q
  1.  ..I D<BD Q
  1.  ..S %="Yes-Eye Exam/Est Pat-"_$$FMTE^XLFDT(D)
  1.  ..Q
  1.  .Q
  1. T2 ;
  1.  I T2,$D(^AUPNVCPT("AA",P,T2)) S %="" D  I %]"" Q %
  1.  .S E=0 F  S E=$O(^AUPNVCPT("AA",P,T2,E)) Q:E'=+E!(%]"")  D
  1.  ..S D=9999999-E ;date done
  1.  ..I D>ED Q
  1.  ..I D<BD Q
  1.  ..S %="Yes-CPT 92014-"_$$FMTE^XLFDT(D)
  1.  ..Q
  1.  .Q
  1. T3 ;
  1.  I T3,$D(^AUPNVCPT("AA",P,T3)) S %="" D  I %]"" Q %
  1.  .S E=0 F  S E=$O(^AUPNVCPT("AA",P,T3,E)) Q:E'=+E!(%]"")  D
  1.  ..S D=9999999-E ;date done
  1.  ..I D>ED Q
  1.  ..I D<BD Q
  1.  ..S %="Yes-CPT 92015-"_$$FMTE^XLFDT(D)
  1.  ..Q
  1.  .Q
  1. T4 ;
  1.  I T4,$D(^AUPNVCPT("AA",P,T4)) S %="" D  I %]"" Q %
  1.  .S E=0 F  S E=$O(^AUPNVCPT("AA",P,T4,E)) Q:E'=+E!(%]"")  D
  1.  ..S D=9999999-E ;date done
  1.  ..I D>ED Q
  1.  ..I D<BD Q
  1.  ..S %="Yes-CPT 92004-"_$$FMTE^XLFDT(D)
  1.  ..Q
  1.  .Q
  1. T5 ;
  1.  I T5,$D(^AUPNVCPT("AA",P,T5)) S %="" D  I %]"" Q %
  1.  .S E=0 F  S E=$O(^AUPNVCPT("AA",P,T5,E)) Q:E'=+E!(%]"")  D
  1.  ..S D=9999999-E ;date done
  1.  ..I D>ED Q
  1.  ..I D<BD Q
  1.  ..S %="Yes-CPT 92002-"_$$FMTE^XLFDT(D)
  1.  ..Q
  1.  .Q
  1.  S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
  1.  NEW X,Y,R S (X,Y)=0 F  S X=$O(BDM(X)) Q:X'=+X!(Y)  S R=$$PRIMPROV^APCLV($P(BDM(X),U,5),"D") I (R=24!(R=79)!(R="08")),'$$DNKA($P(BDM(X),U,5)),'$$REFR($P(BDM(X),U,5)) S Y=1
  1.  I Y Q "Yes - Optometrist/Opthamalogist Visit"
  1.  S X=0,Y=0 F  S X=$O(BDM(X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(BDM(X),U,5),"C") I (R=17!(R=18)!(R=64)!(R="A2")),'$$DNKA($P(BDM(X),U,5)),'$$REFR($P(BDM(X),U,5)) S Y=1
  1.  I Y Q "Yes - Optometry/Opthamology Clinic visit"
  1.  NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DIABETIC EYE EXAM",0)),BDATE,EDATE)
  1.  I G,$P(G,U,2)'="N" Q "Refused"
  1.  Q "No"_$S(G:" - Not Medically Indicated",1:"")
  1. DENTAL(P,BDATE,EDATE) ;EP
  1.  I '$G(P) Q ""
  1.  NEW BDM,%,E
  1.  K BDM
  1.  S %=P_"^LAST EXAM DENTAL;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
  1.  S %=$P($G(BDM(1)),U)
  1.  I %]"" Q "Yes-Dental Exam-"_$$FMTE^XLFDT(%)
  1.  K BDM
  1.  S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")
  1.  NEW X,Y S X=0,Y="" F  S X=$O(BDM(X)) Q:X'=+X!(Y]"")  I $$CLINIC^APCLV($P(BDM(X),U,5),"C")=56!($$CLINIC^APCLV($P(BDM(X),U,5),"C")="99"),$$ADA($P(BDM(X),U,5)),'$$DNKA($P(BDM(X),U,5)) S Y=$$FMTE^XLFDT($P(BDM(X),U))
  1.  I Y]"" Q "Yes-Dental Clinic visit-"_Y
  1.  S X=0,Y="" F  S X=$O(BDM(X)) Q:X'=+X!(Y]"")  I $$PRIMPROV^APCLV($P(BDM(X),U,5),"D")=52,$$ADA($P(BDM(X),U,5)),'$$DNKA($P(BDM(X),U,5)) S Y=$$FMTE^XLFDT($P(BDM(X),U))
  1.  I Y]"" Q "Yes-Dentist Visit-"_$$FMTE^XLFDT(Y)
  1.  S X=0,Y="" F  S X=$O(BDM(X)) Q:X'=+X!(Y]"")  I $$CLINIC^APCLV($P(BDM(X),U,5),"C")=56!($$CLINIC^APCLV($P(BDM(X),U,5),"C")="99"),'$$ADA($P(BDM(X),U,5)),$O(^AUPNVDEN("AD",$P(BDM(X),U,5),0)) S Y=1
  1.  I Y Q "Refused"
  1.  NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DENTAL EXAM",0)),BDATE,EDATE)
  1.  I G,$P(G,U,2)'="N" Q "Refused"
  1.  Q "No"_$S(G:" - Not Medically Indicated",1:"")