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

APCLD217.m

Go to the documentation of this file.
  1. APCLD217 ; IHS/CMI/LAB - 2001 DIABETES AUDIT ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;
  1. ;cmi/anch/maw 9/10/2007 code set versioning in PLDMDXS
  1. ;
  1. DIETEDUC(P,BDATE,EDATE) ;EP
  1. NEW D,BD,ED,X,Y,%DT,D,G,APCLVRD,V,APCL,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. ..I $$PRIMPROV^APCLV(V,"D")=29 S APCLVRD(V)="" Q
  1. ..I $$PRIMPROV^APCLV(V,"D")="07" S APCLVRD(V)="" Q
  1. ..I $$PRIMPROV^APCLV(V,"D")="34" S APCLVRD(V)="" Q
  1. ..Q
  1. .Q
  1. I $D(APCLVRD) S RD=1 ;a RD visit so a hit
  1. K APCL
  1. S X=P_"^EDUC [DM AUDIT DIET EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCL(")
  1. NEW APCLDED S X=0 F S X=$O(APCL(X)) Q:X'=+X S APCLDED($P(APCL(X),U,5))=$$PC(+$P(APCL(X),U,4))
  1. S X=0 F S X=$O(APCLDED(X)) Q:X'=+X D
  1. .I APCLDED(X)="07"!(APCLDED(X)=29)!(APCLDED(X)=34) S RD=1 Q
  1. .I '$D(APCLVRD(X)) S NRD=1 ;a topic with this is not an provider documented, no RD visit
  1. S G=0
  1. I RD!(NRD) Q $S(RD+NRD=2:"Yes (RD & Non RD)",RD:"Yes (RD)",1:"Yes (Non RD)")
  1. NEW T S T=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
  1. I 'T Q "None"
  1. S X=0 F S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G) I $$REFUSAL(P,9999999.09,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE) S G=1
  1. I G Q "Refused"
  1. Q "None"
  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 APCL,X,E,%,G
  1. S X=P_"^EDUC [DM AUDIT EXERCISE EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCL(")
  1. I $D(APCL(1)) Q "Yes"
  1. S G=0
  1. NEW T S T=$O(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",0))
  1. I 'T Q "No"
  1. S X=0 F S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G) I $$REFUSAL(P,9999999.09,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE) S G=1
  1. Q $S(G:"Refused",1:"No")
  1. OTHEDUC(P,BDATE,EDATE) ;EP
  1. NEW APCL,X,E,%
  1. S X=P_"^EDUC [DM AUDIT OTHER EDUC TOPICS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCL(")
  1. I $D(APCL(1)) Q "Yes"
  1. S G=0
  1. NEW T S T=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
  1. I 'T Q "No"
  1. S X=0 F S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G) I $$REFUSAL(P,9999999.09,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE) S G=1
  1. Q $S(G:"Refused",1:"No")
  1. DFE(P,BDATE,EDATE) ;EP
  1. NEW APCL,%,E K APCL S %=P_"^LAST EXAM DIABETIC FOOT EXAM;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
  1. I $D(APCL(1)) Q "Yes-Diabetic Foot Exam-"_$$FMTE^XLFDT($P(APCL(1),U))
  1. ;now check any clinic 65
  1. K APCL
  1. S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
  1. 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
  1. I Y Q "Yes - Podiatrist Visit"
  1. S X=0,Y=0 F S X=$O(APCL(X)) Q:X'=+X!(Y) I $$CLINIC^APCLV($P(APCL(X),U,5),"C")=65,'$$DNKA($P(APCL(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 Q "Refused"
  1. Q "No"
  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
  1. Q G
  1. EYE(P,BDATE,EDATE) ;EP
  1. NEW APCL,%,E K APCL S %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
  1. I $D(APCL(1)) Q "Yes-Diabetic Eye Exam-"_$$FMTE^XLFDT($P(APCL(1),U))
  1. K APCL 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",92012,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. 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. S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
  1. 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
  1. I Y Q "Yes - Optometrist/Opthamalogist Visit"
  1. 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
  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 Q "Refused"
  1. Q "No"
  1. DENTAL(P,BDATE,EDATE) ;EP
  1. I '$G(P) Q ""
  1. NEW APCL,%,E
  1. K APCL
  1. S %=P_"^LAST EXAM DENTAL;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
  1. S %=$P($G(APCL(1)),U)
  1. I %]"" Q "Yes-Dental Exam-"_$$FMTE^XLFDT(%)
  1. K APCL
  1. S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"APCL(")
  1. 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"),'$$DNKA($P(APCL(X),U,5)) S Y=$$FMTE^XLFDT($P(APCL(X),U))
  1. I Y]"" Q "Yes-Dental Clinic visit-"_Y
  1. NEW X,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,'$$DNKA($P(APCL(X),U,5)) S Y=$$FMTE^XLFDT($P(APCL(X),U))
  1. I Y]"" Q "Yes-Dentist Visit-"_$$FMTE^XLFDT(Y)
  1. NEW G S G=$$REFUSAL(P,9999999.15,$O(^AUTTEXAM("B","DENTAL EXAM",0)),BDATE,EDATE)
  1. I G Q "Refused"
  1. Q "No"
  1. BPS(P,BDATE,EDATE,F) ;EP ;
  1. I $G(F)="" S F="E"
  1. NEW X,APCL,E,APCLL,APCLLL,APCLV
  1. S APCLLL=0,APCLV=""
  1. K APCL
  1. S X=P_"^LAST 50 MEAS BP;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCL(")
  1. S APCLL=0 F S APCLL=$O(APCL(APCLL)) Q:APCLL'=+APCLL!(APCLLL=3) S APCLBP=$P($G(APCL(APCLL)),U,2) D
  1. .Q:$$CLINIC^APCLV($P(APCL(APCLL),U,5),"C")=30
  1. .S APCLLL=APCLLL+1
  1. .I F="E" S $P(APCLV,";",APCLLL)=APCLBP_" "_$$FMTE^XLFDT($P(APCL(APCLL),U))
  1. .I F="I" S $P(APCLV,";",APCLLL)=$P(APCLBP," ")
  1. Q APCLV
  1. HTNDX(P,EDATE) ;EP - is HTN on problem list
  1. I '$G(P) Q ""
  1. I '$D(^DPT(P)) Q ""
  1. NEW %,APCL,E
  1. K APCL
  1. S %=P_"^PROBLEM [DM AUDIT PROBLEM HTN DIAGNOSES" S E=$$START1^APCLDF(%,"APCL(")
  1. I $D(APCL(1)) Q "Yes"
  1. K APCL
  1. S X=P_"^LAST 3 DX [SURVEILLANCE HYPERTENSION;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_EDATE S E=$$START1^APCLDF(X,"APCL(") I $D(APCL(3)) Q "Yes"
  1. Q "No"
  1. LASTHT(P,EDATE,F) ;EP - return last ht and date
  1. I 'P Q ""
  1. I $G(F)="" S F="E"
  1. I '$D(^AUPNVSIT("AC",P)) Q ""
  1. NEW %,APCLARRY,H,E
  1. S %=P_"^LAST MEAS HT;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_EDATE NEW X S E=$$START1^APCLDF(%,"APCLARRY(") S H=$P($G(APCLARRY(1)),U,2)
  1. I H="" Q H
  1. S H=$J(H,4,1)
  1. I F="I" Q H
  1. Q H_" inches "_$$FMTE^XLFDT($P(APCLARRY(1),U))
  1. LASTWT(P,EDATE,F) ;EP - return last wt
  1. I 'P Q ""
  1. I $G(F)="" S F="E"
  1. NEW %,APCLARRY,E,APCLW,X,APCLN,APCL,APCLD,APCLZ,APCLX
  1. NEW APCLV221 S APCLV221=$O(^ICD9("BA","V22.1 ",""))
  1. K APCL S APCLW="" S APCLX=P_"^LAST 24 MEAS WT;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_EDATE S E=$$START1^APCLDF(APCLX,"APCL(")
  1. S APCLN=0 F S APCLN=$O(APCL(APCLN)) Q:APCLN'=+APCLN!(APCLW]"") D
  1. . S APCLZ=$P(APCL(APCLN),U,5)
  1. . I '$D(^AUPNVPOV("AD",APCLZ)) S APCLW=$P(APCL(APCLN),U,2)_" lbs "_$$FMTE^XLFDT($P(APCL(APCLN),U)) Q
  1. . S APCLD=0 F S APCLD=$O(^AUPNVPOV("AD",APCLZ,APCLD)) Q:'APCLD!(APCLW]"") D
  1. .. I $P(^AUPNVPOV(APCLD,0),U)'=APCLV221 S APCLW=$P(APCL(APCLN),U,2)_" lbs "_$$FMTE^XLFDT($P(APCL(APCLN),U))
  1. ..Q
  1. Q $S(F="E":APCLW,1:+APCLW)
  1. CMSFDX(P,R,T) ;EP - return date/dx of dm in register
  1. I '$G(P) Q ""
  1. I '$G(R) Q ""
  1. I $G(T)="" Q ""
  1. NEW D1,Y,X,D,G S (G,X)=0,(D,Y)="" F S X=$O(^ACM(44,"C",P,X)) Q:X'=+X!(G) I $P(^ACM(44,X,0),U,4)=R D
  1. .S D=$P($G(^ACM(44,X,"SV")),U,2),D1=D,D=$$FMTE^XLFDT(D)
  1. .S Y=$$VAL^XBDIQ1(9002244,X,.01)
  1. Q $S(T="D":$G(D),T="DX":$G(Y),T="ID":$G(D1),1:"")
  1. ;
  1. PLDMDOO(P,F) ;EP
  1. I '$G(P) Q ""
  1. I $G(F)="" S F="E"
  1. NEW T S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1. I 'T Q ""
  1. NEW D,X,I S D="",X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
  1. .S I=$P(^AUPNPROB(X,0),U)
  1. .I $$ICD^ATXCHK(I,T,9) D
  1. ..I $P(^AUPNPROB(X,0),U,13)]"" S D($P(^AUPNPROB(X,0),U,13))=""
  1. ..Q
  1. .Q
  1. S D=$O(D(0)) Q $S(F="E":$$FMTE^XLFDT(D),1:$O(D(0)))
  1. PLDMDXS(P) ;EP - get all DM dxs from problem list
  1. I '$G(P) Q ""
  1. NEW T S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1. I 'T Q "<diabetes taxonomy missing>"
  1. NEW D,X,I S D="",X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
  1. .S I=$P(^AUPNPROB(X,0),U)
  1. .;I $$ICD^ATXCHK(I,T,9) S:D]"" D=D_";" S D=D_$P(^ICD9(I,0),U) ;cmi/anch/maw 9/10/2007 orig line
  1. .I $$ICD^ATXCHK(I,T,9) S:D]"" D=D_";" S D=D_$P($$ICDDX^ICDCODE(I),U,2) ;cmi/anch/maw 9/10/2007 csv
  1. .Q
  1. Q D
  1. ;
  1. FRSTDMDX(P,F) ;EP return date of first dm dx
  1. I '$G(P) Q ""
  1. I $G(F)="" S F="E"
  1. NEW X,E,APCL,Y
  1. S Y="APCL("
  1. S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y) S Y=$P($G(APCL(1)),U)
  1. Q $S(F="E":$$FMTE^XLFDT(Y),1:Y)
  1. LASTDMDX(P,D) ;EP - last pcc dm dx
  1. I '$G(P) Q ""
  1. NEW X,E,APCL,Y
  1. S Y="APCL("
  1. S X=P_"^LAST DX [DM AUDIT TYPE II DXS;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_D S E=$$START1^APCLDF(X,Y)
  1. I $D(APCL(1)) Q "Type 2"
  1. K APCL S X=P_"^LAST DX [DM AUDIT TYPE I DXS;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_D S E=$$START1^APCLDF(X,Y)
  1. I $D(APCL(1)) Q "Type 1"
  1. Q ""
  1. ;