BDMDA11 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**5,6,7**;JUN 14, 2007;Build 24
;
;
IMM ;
S:'$D(BDMCUML(140)) BDMCUML(140)="IMMUNIZATIONS"
S $P(BDMCUML(140),U,2)=$P(BDMCUML(140),U,2)+1
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))
I $E(V)="1" S $P(BDMCUML(140),U,3)=$P(BDMCUML(140),U,3)+1
I $E(V)="3" S $P(BDMCUML(140),U,6)=$P(BDMCUML(140),U,6)+1
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))
I $E(V)="1" S $P(BDMCUML(140),U,4)=$P(BDMCUML(140),U,4)+1
I $E(V)="3" S $P(BDMCUML(140),U,7)=$P(BDMCUML(140),U,7)+1
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))
I $E(V)="1" S $P(BDMCUML(140),U,5)=$P(BDMCUML(140),U,5)+1
I $E(V)="3" S $P(BDMCUML(140),U,8)=$P(BDMCUML(140),U,8)+1
;HEP B
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,115))
I $E(V)="1" S $P(BDMCUML(140),U,9)=$P(BDMCUML(140),U,9)+1
I $E(V)="3" S $P(BDMCUML(140),U,10)=$P(BDMCUML(140),U,10)+1
;
QUAN ;
;145
;title^total pts^total YES^NO^REF^UACR^UPCR^24HR^MICRO STRIP^MICRO ONLY^DIPSTICK
K BDMOFLG
S BDMOFLG=0
S:'$D(BDMCUML(145)) BDMCUML(145)="LABORATORY EXAMS"
S $P(BDMCUML(145),U,2)=$P(BDMCUML(145),U,2)+1 ;TOTAL # of patients
S Q=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))
S V=$E($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))) ;test done?
S T=$P($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5) ;type of test
S R=$S($P(Q,U,6)]"":$P(Q,U,6),1:$P(Q,U,2)) ;value/result
I V=1 D
.S $P(BDMCUML(145),U,3)=$P(BDMCUML(145),U,3)+1
.S P=$S(T=1:6,T=2:7,T=3:8,T=4:9,T=5:10,T=6:11,1:"")
.S $P(BDMCUML(145),U,P)=$P(BDMCUML(145),U,P)+1
;.I T=1!(T=2)!(T=5) D
;..I T=5 D
;...S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1
;..I T=1 D
;...I R[">" S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
;...;I $$UP^XLFSTR(R)["COMMENT" S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q
;...S R=$$STV^BDMDA18(R,8)
;...I R="" S $P(BDMCUML(145),U,15)=$P(BDMCUML(145),U,15)+1 Q
;...S R=+R
;...I R<30 S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q
;...I R<300.9999 S $P(BDMCUML(145),U,13)=$P(BDMCUML(145),U,13)+1 Q
;...S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1
;..I T=2 D
;...I R["-" S $P(BDMCUML(145),U,13)=$P(BDMCUML(145),U,13)+1 Q
;...I R["300" S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
;...I R[">" S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
;...S R=$$STV^BDMDA18(R,5,1) I R>300 S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
;...S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1
I V=2 S $P(BDMCUML(145),U,4)=$P(BDMCUML(145),U,4)+1 ;no urine testing
S G=$P($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),U,2) ;egfr value
S H=0
D
.S G=$$AS^BDMDA18(G)
.S G=$$STV^BDMDA18(G,5,1)
.I G="" Q
.I +G>29 S $P(BDMCUML(145),U,20)=$P(BDMCUML(145),U,20)+1,H=1 Q
I H,T=1 S $P(BDMCUML(145),U,21)=$P(BDMCUML(145),U,21)+1
EKG ;need date of last ekg
;
CREAT ;
;
GFR ;
G:$$AGE^AUPNPAT(BDMPD,BDMADAT)<18 TCHOL
S:'$D(BDMCUML(175)) BDMCUML(175)="e-GFR to assess kidney function obtained during audit period"
S $P(BDMCUML(175),U,2)=$P(BDMCUML(175),U,2)+1 ;total pts over 18
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,79))
I $E(V)=1 S $P(BDMCUML(175),U,5)=$P(BDMCUML(175),U,5)+1
S V=$P(V,U,2)
I $E(V)=">" S $P(BDMCUML(175),U,6)=$P(BDMCUML(175),U,6)+1 G TCHOL ;>60
S V=$$STV^BDMDA18(V,5,1)
I V="" S $P(BDMCUML(175),U,10)=$P(BDMCUML(175),U,10)+1 G TCHOL
I +V>59 S $P(BDMCUML(175),U,6)=$P(BDMCUML(175),U,6)+1 G TCHOL
I +V<15 S $P(BDMCUML(175),U,9)=$P(BDMCUML(175),U,9)+1 G TCHOL
I +V>29,+V<60 S $P(BDMCUML(175),U,7)=$P(BDMCUML(175),U,7)+1 G TCHOL
I +V>14,+V<30 S $P(BDMCUML(175),U,8)=$P(BDMCUML(175),U,8)+1 G TCHOL
;
TCHOL ;
S:'$D(BDMCUML(180)) BDMCUML(180)="Total Cholesterol obtained in past 12 months"
S $P(BDMCUML(180),U,2)=$P(BDMCUML(180),U,2)+1
S V=$$CHOL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
I V="" S $P(BDMCUML(180),U,6)=$P(BDMCUML(180),U,6)+1 G NONHDL
S V=$P(V,U)
S V=$$STV^BDMDA18(V,5,1)
I V="" S $P(BDMCUML(180),U,7)=$P(BDMCUML(180),U,7)+1 G NONHDL
I $E(V)'=+$E(V)!(+V=0) S $P(BDMCUML(180),U,7)=$P(BDMCUML(180),U,7)+1 G NONHDL
I V<200 S $P(BDMCUML(180),U,3)=$P(BDMCUML(180),U,3)+1 G NONHDL
I V<240 S $P(BDMCUML(180),U,4)=$P(BDMCUML(180),U,4)+1 G NONHDL
S $P(BDMCUML(180),U,5)=$P(BDMCUML(180),U,5)+1
NONHDL ;
S:'$D(BDMCUML(185)) BDMCUML(185)="Non-HDL cholesterol obtained during audit perio"
S $P(BDMCUML(185),U,2)=$P(BDMCUML(185),U,2)+1 ;TOTAL PTS
S V=$P($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,117)),U,1)
I V="" S $P(BDMCUML(185),U,7)=$P(BDMCUML(185),U,7)+1 G LDL
I $E(V)'=+$E(V)!(+V=0) S $P(BDMCUML(185),U,7)=$P(BDMCUML(185),U,7)+1 G LDL
I V<130 S $P(BDMCUML(185),U,3)=$P(BDMCUML(185),U,3)+1 G LDL
I V>129,V<160 S $P(BDMCUML(185),U,4)=$P(BDMCUML(185),U,4)+1 G LDL
I V>159,V<191 S $P(BDMCUML(185),U,5)=$P(BDMCUML(185),U,5)+1 G LDL
S $P(BDMCUML(185),U,6)=$P(BDMCUML(185),U,6)+1
LDL ;
S:'$D(BDMCUML(190)) BDMCUML(190)="LDL Cholesterol obtained during audit period"
S $P(BDMCUML(190),U,2)=$P(BDMCUML(190),U,2)+1
S V=$$LDL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
I V="" S $P(BDMCUML(190),U,7)=$P(BDMCUML(190),U,7)+1 G HDL
S V=$P(V,U)
;S V=$$STV^BDMDA18(V,4)
S V=$$STV^BDMDA18(V,5,1) I $E(V)'=+$E(V)!(+V=0) S $P(BDMCUML(190),U,8)=$P(BDMCUML(190),U,8)+1 G HDL
I V<100 S $P(BDMCUML(190),U,3)=$P(BDMCUML(190),U,3)+1 G HDL
I V<130 S $P(BDMCUML(190),U,4)=$P(BDMCUML(190),U,4)+1 G HDL
I V<160.1 S $P(BDMCUML(190),U,5)=$P(BDMCUML(190),U,5)+1 G HDL
S $P(BDMCUML(190),U,6)=$P(BDMCUML(190),U,6)+1
HDL ;
S:'$D(BDMCUML(195)) BDMCUML(195)="HDL Cholesterol obtained during audit period"
S V=$$HDL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
S S=$P(^DPT(BDMPD,0),U,2) ;GENDER
I S="F" D
.S $P(BDMCUML(195),U,2)=$P(BDMCUML(195),U,2)+1
.I V="" S $P(BDMCUML(195),U,5)=$P(BDMCUML(195),U,5)+1 Q
.S V=$P(V,U)
.S V=$$STV^BDMDA18(V,5,1) I $E(V)'=+$E(V)!(+V=0) S $P(BDMCUML(195),U,5)=$P(BDMCUML(195),U,5)+1 Q
.S V=$P(V,"."),V=$$STV^BDMDA18(V,5,1)
.I $E(V)'=+$E(V)!(+V=0)!(V="") S $P(BDMCUML(195),U,5)=$P(BDMCUML(195),U,5)+1 Q
.I V'>50 S $P(BDMCUML(195),U,3)=$P(BDMCUML(195),U,3)+1 Q
.S $P(BDMCUML(195),U,4)=$P(BDMCUML(195),U,4)+1 Q
I S="M" D
.S $P(BDMCUML(195),U,6)=$P(BDMCUML(195),U,6)+1
.I V="" S $P(BDMCUML(195),U,9)=$P(BDMCUML(195),U,9)+1 Q
.S V=$P(V,U)
.S V=$$STV^BDMDA18(V,5,1) I $E(V)'=+$E(V)!(+V=0) S $P(BDMCUML(195),U,9)=$P(BDMCUML(195),U,9)+1 Q ;unable to determine result, not a number
.S V=$P(V,"."),V=$$STV^BDMDA18(V,5,1)
.I $E(V)'=+$E(V)!(+V=0)!(V="") S $P(BDMCUML(195),U,9)=$P(BDMCUML(195),U,9)+1 Q ;unable to determine result, not a number
.I V'>40 S $P(BDMCUML(195),U,7)=$P(BDMCUML(195),U,7)+1 Q
.S $P(BDMCUML(195),U,8)=$P(BDMCUML(195),U,8)+1 Q
TRIG ;
S:'$D(BDMCUML(200)) BDMCUML(200)="Triglycerides obtained in past 12 months"
S $P(BDMCUML(200),U,2)=$P(BDMCUML(200),U,2)+1
S V=$$TRIG^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
I V="" S $P(BDMCUML(200),U,7)=$P(BDMCUML(200),U,7)+1 G SELF
S V=$P(V,U)
S V=$$STV^BDMDA18(V,5,1) I $E(V)'=+$E(V) S $P(BDMCUML(200),U,5)=$P(BDMCUML(200),U,5)+1 G SELF ;unable to determine result, not a number
I V'>400 S $P(BDMCUML(200),U,3)=$P(BDMCUML(200),U,3)+1 G SELF
S $P(BDMCUML(200),U,4)=$P(BDMCUML(200),U,4)+1
SELF ;
CVD ;USE 250
S:'$D(BDMCUML(250)) BDMCUML(250)="CARDIOVASCULAR DISEASE"
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))
I $E(V)=1 S $P(BDMCUML(250),U,3)=$P(BDMCUML(250),U,3)+1
S $P(BDMCUML(250),U,2)=$P(BDMCUML(250),U,2)+1
EGFRQUP ;
S:'$D(BDMCUML(270)) BDMCUML(270)="eGFR and QUANTITATIVE URINARY PROTEIN ASSESSMENT"
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),V=$$STV^BDMDA18($P(V,U,2),5)
S T=$P($G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5) ;type of test
S $P(BDMCUML(270),U,2)=$P(BDMCUML(270),U,2)+1
I V]"",(T=1!(T=2)!(T=3)) S $P(BDMCUML(270),U,3)=$P(BDMCUML(270),U,3)+1 ;had both
COMBINED ;USE 260
S:'$D(BDMCUML(260)) BDMCUML(260)="PILOT ELEMENTS: COMBINED OUTCOMES MEASURE"
S V=$G(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,118))
I $E(V)=1 S $P(BDMCUML(260),U,3)=$P(BDMCUML(260),U,3)+1
S $P(BDMCUML(260),U,2)=$P(BDMCUML(260),U,2)+1
Q
CESS(P,BDATE,EDATE) ;EP - find any cessation hf in 12 months before E
I '$G(P) Q ""
I $P($$TOBACCO^BDMDA1T(P,$$DOB^AUPNPAT(P),EDATE),U,1)'=1 Q ""
NEW BDM,E,X,G,T,O,D,H,C
K BDM
S T=$O(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
S (H,D)=0 S O=""
S H=0 F S H=$O(^AUPNVHF("AA",P,H)) Q:H'=+H!(O]"") D
.S G=0
.I $D(^ATXAX(T,21,"AA",H)) S G=1
.I $P(^AUTTHF(H,0),U,1)["CESSATION",$$VAL^XBDIQ1(9999999.64,H,.03)["TOBACCO" S G=1
.Q:'G
.S D="" F S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D!(O]"") D
..Q:(9999999-D)>EDATE ;after time frame
..Q:(9999999-D)<BDATE ;before time frame
..S O="1 Yes- "_$$FMTE^XLFDT(9999999-D)_" HF: "_$P(^AUTTHF(H,0),U)
.Q
I O Q O ;found a cessation hf so quit
S O=$$CESSOTH(P,BDATE,EDATE)
I O Q O
Q "2 No"
;
CESSOTH(P,BDATE,EDATE) ;EP
NEW BDMALLED,X,Y,%,T,G,A,B,E,Z,BDMLPED,BDMMEDS1
K BDMALLED
S BDMLPED=""
S Y="BDMALLED("
S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S %="" I $D(BDMALLED(1)) S %="" D I %]"" S BDMLPED=%
.S (X,D)=0,T="" F S X=$O(BDMALLED(X)) Q:X'=+X D
..S T=$P(^AUPNVPED(+$P(BDMALLED(X),U,4),0),U)
..Q:'T
..Q:'$D(^AUTTEDT(T,0))
..S T=$P(^AUTTEDT(T,0),U,2)
..I $P(T,"-")="TO",$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
..I $P(T,"-",2)="TO",$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
..I $P(T,"-",2)="SHS",$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
..I $P(T,"-",1)["305.1"!($P(T,"-")="649.00")!($P(T,"-")="649.01")!($P(T,"-")="649.02")!($P(T,"-")="649.03")!($P(T,"-")="649.04")!($P(T,"-")="V15.82"),$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
..I $P(T,"-",1)="D1320"!($P(T,"-")="99406")!($P(T,"-")="99407")!($P(T,"-")="G0375")!($P(T,"-")="G0376")!($P(T,"-")="4000F")!($P(T,"-")="G8402")!($P(T,"-")="G8453"),$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
I %]"" Q "1 Yes "_$$FMTE^XLFDT($P(%,U,1))_" Pt Ed "_$P(%,U,2)
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
S X=0,G="" F S X=$O(^TMP($J,"A",X)) Q:X'=+X S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.S B=$$CLINIC^APCLV(V,"C")
.I B=94,$P(BDMLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BDMLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"Clinic 94" Q
.S Z=0 F S Z=$O(^AUPNVDEN("AD",V,Z)) Q:Z'=+Z!(G) S B=$P($G(^AUPNVDEN(Z,0)),U) I B S B=$P($G(^AUTTADA(B,0)),U) I B=1320,$P(BDMLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BDMLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"ADA 1320" Q
.Q
I BDMLPED]"" Q "1 Yes "_$$FMTE^XLFDT($P(BDMLPED,U,1))_" "_$P(BDMLPED,U,2)
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT D1320"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN D1320"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406)) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT 99406"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406)) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN 99406"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407)) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT 99407"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407)) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN 99407"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT G0375"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT G0376"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT 4000F"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN G0375"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN G0376"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN 4000F"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4001F")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CESSATION MED - CPT 4001F"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4001F")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN 4001F"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT G8402"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN G8402"
S G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"CPT G8453"
S G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453")) I G,$P(BDMLPED,U)<$P(G,U,2) S BDMLPED=$P(G,U,2)_U_"TRAN G8453"
I BDMLPED]"" Q "1 Yes "_$$FMTE^XLFDT($P(BDMLPED,U,1))_" "_$P(BDMLPED,U,2)
;now check meds
K BDMMEDS1
D GETMEDS^BDMDADU(P,BDATE,EDATE,,,,,.BDMMEDS1)
S T=$O(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))
S T1=$O(^ATXAX("B","BGP CMS SMOKING CESSATION NDC",0))
S (X,G,M,E)=0,D="" F S X=$O(BDMMEDS1(X)) Q:X'=+X S V=$P(BDMMEDS1(X),U,5),Y=+$P(BDMMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK" ;new in v11.0
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:'Z
.S N=$P($G(^PSDRUG(Z,0)),U)
.I $D(^ATXAX(T,21,"B",Z))!(N["NICOTINE TRANS")!(N["NICOTINE PATCH")!(N["NICOTINE POLACRILEX")!(N["NICOTINE INHALER")!(N["NICOTINE NASAL SPRAY") D
..I $P(BDMLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BDMLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N
.S C=$P($G(^PSDRUG(Z,2)),U,4)
.I C]"",$D(^ATXAX(T1,21,"B",C)) I $P(BDMLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BDMLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N
I BDMLPED]"" Q "1 Yes "_$$FMTE^XLFDT($P(BDMLPED,U,1))_" "_$P(BDMLPED,U,2)
PEDREF ; REFUSALS REMOVED 2013 AUDIT
Q ""
REFTOED(P,BDATE,EDATE) ;EP - now check all Refusals of these education topics
S G="",X=0 F S X=$O(^AUPNPREF("AA",P,9999999.09,X)) Q:X=""!(G]"") D
.S D=0 F S D=$O(^AUPNPREF("AA",P,9999999.09,X,D)) Q:D=""!(G]"") D
..S I=0 F S I=$O(^AUPNPREF("AA",P,9999999.09,X,D,I)) Q:I'=+I!(G]"") D
...S Z=$P($G(^AUPNPREF(I,0)),U,3)
...Q:Z=""
...I Z<BDATE Q
...I Z>EDATE Q
...S Y=$P($G(^AUTTEDT(X,0)),U,2)
...I $P(Y,"-")="TO"!($P(Y,"-",2)="TO")!($P(Y,"-",2)="SHS") S G=Z_U_"Refused "_Y
...I $P(Y,"-",1)["305.1"!($P(Y,"-")="649.00")!($P(Y,"-")="649.01")!($P(Y,"-")="649.02")!($P(Y,"-")="649.03")!($P(Y,"-")="649.04")!($P(Y,"-")="V15.82") S G=Z_U_"Ref "_Y
Q G
BDMDA11 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**5,6,7**;JUN 14, 2007;Build 24
+2 ;
+3 ;
IMM ;
+1 IF '$DATA(BDMCUML(140))
SET BDMCUML(140)="IMMUNIZATIONS"
+2 SET $PIECE(BDMCUML(140),U,2)=$PIECE(BDMCUML(140),U,2)+1
+3 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))
+4 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(140),U,3)=$PIECE(BDMCUML(140),U,3)+1
+5 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(140),U,6)=$PIECE(BDMCUML(140),U,6)+1
+6 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))
+7 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(140),U,4)=$PIECE(BDMCUML(140),U,4)+1
+8 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(140),U,7)=$PIECE(BDMCUML(140),U,7)+1
+9 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))
+10 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(140),U,5)=$PIECE(BDMCUML(140),U,5)+1
+11 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(140),U,8)=$PIECE(BDMCUML(140),U,8)+1
+12 ;HEP B
+13 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,115))
+14 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(140),U,9)=$PIECE(BDMCUML(140),U,9)+1
+15 IF $EXTRACT(V)="3"
SET $PIECE(BDMCUML(140),U,10)=$PIECE(BDMCUML(140),U,10)+1
+16 ;
QUAN ;
+1 ;145
+2 ;title^total pts^total YES^NO^REF^UACR^UPCR^24HR^MICRO STRIP^MICRO ONLY^DIPSTICK
+3 KILL BDMOFLG
+4 SET BDMOFLG=0
+5 IF '$DATA(BDMCUML(145))
SET BDMCUML(145)="LABORATORY EXAMS"
+6 ;TOTAL # of patients
SET $PIECE(BDMCUML(145),U,2)=$PIECE(BDMCUML(145),U,2)+1
+7 SET Q=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))
+8 ;test done?
SET V=$EXTRACT($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)))
+9 ;type of test
SET T=$PIECE($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5)
+10 ;value/result
SET R=$SELECT($PIECE(Q,U,6)]"":$PIECE(Q,U,6),1:$PIECE(Q,U,2))
+11 IF V=1
Begin DoDot:1
+12 SET $PIECE(BDMCUML(145),U,3)=$PIECE(BDMCUML(145),U,3)+1
+13 SET P=$SELECT(T=1:6,T=2:7,T=3:8,T=4:9,T=5:10,T=6:11,1:"")
+14 SET $PIECE(BDMCUML(145),U,P)=$PIECE(BDMCUML(145),U,P)+1
End DoDot:1
+15 ;.I T=1!(T=2)!(T=5) D
+16 ;..I T=5 D
+17 ;...S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1
+18 ;..I T=1 D
+19 ;...I R[">" S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
+20 ;...;I $$UP^XLFSTR(R)["COMMENT" S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q
+21 ;...S R=$$STV^BDMDA18(R,8)
+22 ;...I R="" S $P(BDMCUML(145),U,15)=$P(BDMCUML(145),U,15)+1 Q
+23 ;...S R=+R
+24 ;...I R<30 S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q
+25 ;...I R<300.9999 S $P(BDMCUML(145),U,13)=$P(BDMCUML(145),U,13)+1 Q
+26 ;...S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1
+27 ;..I T=2 D
+28 ;...I R["-" S $P(BDMCUML(145),U,13)=$P(BDMCUML(145),U,13)+1 Q
+29 ;...I R["300" S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
+30 ;...I R[">" S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
+31 ;...S R=$$STV^BDMDA18(R,5,1) I R>300 S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
+32 ;...S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1
+33 ;no urine testing
IF V=2
SET $PIECE(BDMCUML(145),U,4)=$PIECE(BDMCUML(145),U,4)+1
+34 ;egfr value
SET G=$PIECE($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),U,2)
+35 SET H=0
+36 Begin DoDot:1
+37 SET G=$$AS^BDMDA18(G)
+38 SET G=$$STV^BDMDA18(G,5,1)
+39 IF G=""
QUIT
+40 IF +G>29
SET $PIECE(BDMCUML(145),U,20)=$PIECE(BDMCUML(145),U,20)+1
SET H=1
QUIT
End DoDot:1
+41 IF H
IF T=1
SET $PIECE(BDMCUML(145),U,21)=$PIECE(BDMCUML(145),U,21)+1
EKG ;need date of last ekg
+1 ;
CREAT ;
+1 ;
GFR ;
+1 IF $$AGE^AUPNPAT(BDMPD,BDMADAT)<18
GOTO TCHOL
+2 IF '$DATA(BDMCUML(175))
SET BDMCUML(175)="e-GFR to assess kidney function obtained during audit period"
+3 ;total pts over 18
SET $PIECE(BDMCUML(175),U,2)=$PIECE(BDMCUML(175),U,2)+1
+4 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,79))
+5 IF $EXTRACT(V)=1
SET $PIECE(BDMCUML(175),U,5)=$PIECE(BDMCUML(175),U,5)+1
+6 SET V=$PIECE(V,U,2)
+7 ;>60
IF $EXTRACT(V)=">"
SET $PIECE(BDMCUML(175),U,6)=$PIECE(BDMCUML(175),U,6)+1
GOTO TCHOL
+8 SET V=$$STV^BDMDA18(V,5,1)
+9 IF V=""
SET $PIECE(BDMCUML(175),U,10)=$PIECE(BDMCUML(175),U,10)+1
GOTO TCHOL
+10 IF +V>59
SET $PIECE(BDMCUML(175),U,6)=$PIECE(BDMCUML(175),U,6)+1
GOTO TCHOL
+11 IF +V<15
SET $PIECE(BDMCUML(175),U,9)=$PIECE(BDMCUML(175),U,9)+1
GOTO TCHOL
+12 IF +V>29
IF +V<60
SET $PIECE(BDMCUML(175),U,7)=$PIECE(BDMCUML(175),U,7)+1
GOTO TCHOL
+13 IF +V>14
IF +V<30
SET $PIECE(BDMCUML(175),U,8)=$PIECE(BDMCUML(175),U,8)+1
GOTO TCHOL
+14 ;
TCHOL ;
+1 IF '$DATA(BDMCUML(180))
SET BDMCUML(180)="Total Cholesterol obtained in past 12 months"
+2 SET $PIECE(BDMCUML(180),U,2)=$PIECE(BDMCUML(180),U,2)+1
+3 SET V=$$CHOL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
+4 IF V=""
SET $PIECE(BDMCUML(180),U,6)=$PIECE(BDMCUML(180),U,6)+1
GOTO NONHDL
+5 SET V=$PIECE(V,U)
+6 SET V=$$STV^BDMDA18(V,5,1)
+7 IF V=""
SET $PIECE(BDMCUML(180),U,7)=$PIECE(BDMCUML(180),U,7)+1
GOTO NONHDL
+8 IF $EXTRACT(V)'=+$EXTRACT(V)!(+V=0)
SET $PIECE(BDMCUML(180),U,7)=$PIECE(BDMCUML(180),U,7)+1
GOTO NONHDL
+9 IF V<200
SET $PIECE(BDMCUML(180),U,3)=$PIECE(BDMCUML(180),U,3)+1
GOTO NONHDL
+10 IF V<240
SET $PIECE(BDMCUML(180),U,4)=$PIECE(BDMCUML(180),U,4)+1
GOTO NONHDL
+11 SET $PIECE(BDMCUML(180),U,5)=$PIECE(BDMCUML(180),U,5)+1
NONHDL ;
+1 IF '$DATA(BDMCUML(185))
SET BDMCUML(185)="Non-HDL cholesterol obtained during audit perio"
+2 ;TOTAL PTS
SET $PIECE(BDMCUML(185),U,2)=$PIECE(BDMCUML(185),U,2)+1
+3 SET V=$PIECE($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,117)),U,1)
+4 IF V=""
SET $PIECE(BDMCUML(185),U,7)=$PIECE(BDMCUML(185),U,7)+1
GOTO LDL
+5 IF $EXTRACT(V)'=+$EXTRACT(V)!(+V=0)
SET $PIECE(BDMCUML(185),U,7)=$PIECE(BDMCUML(185),U,7)+1
GOTO LDL
+6 IF V<130
SET $PIECE(BDMCUML(185),U,3)=$PIECE(BDMCUML(185),U,3)+1
GOTO LDL
+7 IF V>129
IF V<160
SET $PIECE(BDMCUML(185),U,4)=$PIECE(BDMCUML(185),U,4)+1
GOTO LDL
+8 IF V>159
IF V<191
SET $PIECE(BDMCUML(185),U,5)=$PIECE(BDMCUML(185),U,5)+1
GOTO LDL
+9 SET $PIECE(BDMCUML(185),U,6)=$PIECE(BDMCUML(185),U,6)+1
LDL ;
+1 IF '$DATA(BDMCUML(190))
SET BDMCUML(190)="LDL Cholesterol obtained during audit period"
+2 SET $PIECE(BDMCUML(190),U,2)=$PIECE(BDMCUML(190),U,2)+1
+3 SET V=$$LDL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
+4 IF V=""
SET $PIECE(BDMCUML(190),U,7)=$PIECE(BDMCUML(190),U,7)+1
GOTO HDL
+5 SET V=$PIECE(V,U)
+6 ;S V=$$STV^BDMDA18(V,4)
+7 SET V=$$STV^BDMDA18(V,5,1)
IF $EXTRACT(V)'=+$EXTRACT(V)!(+V=0)
SET $PIECE(BDMCUML(190),U,8)=$PIECE(BDMCUML(190),U,8)+1
GOTO HDL
+8 IF V<100
SET $PIECE(BDMCUML(190),U,3)=$PIECE(BDMCUML(190),U,3)+1
GOTO HDL
+9 IF V<130
SET $PIECE(BDMCUML(190),U,4)=$PIECE(BDMCUML(190),U,4)+1
GOTO HDL
+10 IF V<160.1
SET $PIECE(BDMCUML(190),U,5)=$PIECE(BDMCUML(190),U,5)+1
GOTO HDL
+11 SET $PIECE(BDMCUML(190),U,6)=$PIECE(BDMCUML(190),U,6)+1
HDL ;
+1 IF '$DATA(BDMCUML(195))
SET BDMCUML(195)="HDL Cholesterol obtained during audit period"
+2 SET V=$$HDL^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
+3 ;GENDER
SET S=$PIECE(^DPT(BDMPD,0),U,2)
+4 IF S="F"
Begin DoDot:1
+5 SET $PIECE(BDMCUML(195),U,2)=$PIECE(BDMCUML(195),U,2)+1
+6 IF V=""
SET $PIECE(BDMCUML(195),U,5)=$PIECE(BDMCUML(195),U,5)+1
QUIT
+7 SET V=$PIECE(V,U)
+8 SET V=$$STV^BDMDA18(V,5,1)
IF $EXTRACT(V)'=+$EXTRACT(V)!(+V=0)
SET $PIECE(BDMCUML(195),U,5)=$PIECE(BDMCUML(195),U,5)+1
QUIT
+9 SET V=$PIECE(V,".")
SET V=$$STV^BDMDA18(V,5,1)
+10 IF $EXTRACT(V)'=+$EXTRACT(V)!(+V=0)!(V="")
SET $PIECE(BDMCUML(195),U,5)=$PIECE(BDMCUML(195),U,5)+1
QUIT
+11 IF V'>50
SET $PIECE(BDMCUML(195),U,3)=$PIECE(BDMCUML(195),U,3)+1
QUIT
+12 SET $PIECE(BDMCUML(195),U,4)=$PIECE(BDMCUML(195),U,4)+1
QUIT
End DoDot:1
+13 IF S="M"
Begin DoDot:1
+14 SET $PIECE(BDMCUML(195),U,6)=$PIECE(BDMCUML(195),U,6)+1
+15 IF V=""
SET $PIECE(BDMCUML(195),U,9)=$PIECE(BDMCUML(195),U,9)+1
QUIT
+16 SET V=$PIECE(V,U)
+17 ;unable to determine result, not a number
SET V=$$STV^BDMDA18(V,5,1)
IF $EXTRACT(V)'=+$EXTRACT(V)!(+V=0)
SET $PIECE(BDMCUML(195),U,9)=$PIECE(BDMCUML(195),U,9)+1
QUIT
+18 SET V=$PIECE(V,".")
SET V=$$STV^BDMDA18(V,5,1)
+19 ;unable to determine result, not a number
IF $EXTRACT(V)'=+$EXTRACT(V)!(+V=0)!(V="")
SET $PIECE(BDMCUML(195),U,9)=$PIECE(BDMCUML(195),U,9)+1
QUIT
+20 IF V'>40
SET $PIECE(BDMCUML(195),U,7)=$PIECE(BDMCUML(195),U,7)+1
QUIT
+21 SET $PIECE(BDMCUML(195),U,8)=$PIECE(BDMCUML(195),U,8)+1
QUIT
End DoDot:1
TRIG ;
+1 IF '$DATA(BDMCUML(200))
SET BDMCUML(200)="Triglycerides obtained in past 12 months"
+2 SET $PIECE(BDMCUML(200),U,2)=$PIECE(BDMCUML(200),U,2)+1
+3 SET V=$$TRIG^BDMDA18(BDMPD,BDMBDAT,BDMADAT,"I")
+4 IF V=""
SET $PIECE(BDMCUML(200),U,7)=$PIECE(BDMCUML(200),U,7)+1
GOTO SELF
+5 SET V=$PIECE(V,U)
+6 ;unable to determine result, not a number
SET V=$$STV^BDMDA18(V,5,1)
IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(BDMCUML(200),U,5)=$PIECE(BDMCUML(200),U,5)+1
GOTO SELF
+7 IF V'>400
SET $PIECE(BDMCUML(200),U,3)=$PIECE(BDMCUML(200),U,3)+1
GOTO SELF
+8 SET $PIECE(BDMCUML(200),U,4)=$PIECE(BDMCUML(200),U,4)+1
SELF ;
CVD ;USE 250
+1 IF '$DATA(BDMCUML(250))
SET BDMCUML(250)="CARDIOVASCULAR DISEASE"
+2 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))
+3 IF $EXTRACT(V)=1
SET $PIECE(BDMCUML(250),U,3)=$PIECE(BDMCUML(250),U,3)+1
+4 SET $PIECE(BDMCUML(250),U,2)=$PIECE(BDMCUML(250),U,2)+1
EGFRQUP ;
+1 IF '$DATA(BDMCUML(270))
SET BDMCUML(270)="eGFR and QUANTITATIVE URINARY PROTEIN ASSESSMENT"
+2 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,79))
SET V=$$STV^BDMDA18($PIECE(V,U,2),5)
+3 ;type of test
SET T=$PIECE($GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5)
+4 SET $PIECE(BDMCUML(270),U,2)=$PIECE(BDMCUML(270),U,2)+1
+5 ;had both
IF V]""
IF (T=1!(T=2)!(T=3))
SET $PIECE(BDMCUML(270),U,3)=$PIECE(BDMCUML(270),U,3)+1
COMBINED ;USE 260
+1 IF '$DATA(BDMCUML(260))
SET BDMCUML(260)="PILOT ELEMENTS: COMBINED OUTCOMES MEASURE"
+2 SET V=$GET(^XTMP("BDMDM13",BDMJOB,BDMBTH,"AUDIT",BDMPD,118))
+3 IF $EXTRACT(V)=1
SET $PIECE(BDMCUML(260),U,3)=$PIECE(BDMCUML(260),U,3)+1
+4 SET $PIECE(BDMCUML(260),U,2)=$PIECE(BDMCUML(260),U,2)+1
+5 QUIT
CESS(P,BDATE,EDATE) ;EP - find any cessation hf in 12 months before E
+1 IF '$GET(P)
QUIT ""
+2 IF $PIECE($$TOBACCO^BDMDA1T(P,$$DOB^AUPNPAT(P),EDATE),U,1)'=1
QUIT ""
+3 NEW BDM,E,X,G,T,O,D,H,C
+4 KILL BDM
+5 SET T=$ORDER(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
+6 SET (H,D)=0
SET O=""
+7 SET H=0
FOR
SET H=$ORDER(^AUPNVHF("AA",P,H))
IF H'=+H!(O]"")
QUIT
Begin DoDot:1
+8 SET G=0
+9 IF $DATA(^ATXAX(T,21,"AA",H))
SET G=1
+10 IF $PIECE(^AUTTHF(H,0),U,1)["CESSATION"
IF $$VAL^XBDIQ1(9999999.64,H,.03)["TOBACCO"
SET G=1
+11 IF 'G
QUIT
+12 SET D=""
FOR
SET D=$ORDER(^AUPNVHF("AA",P,H,D))
IF D'=+D!(O]"")
QUIT
Begin DoDot:2
+13 ;after time frame
IF (9999999-D)>EDATE
QUIT
+14 ;before time frame
IF (9999999-D)<BDATE
QUIT
+15 SET O="1 Yes- "_$$FMTE^XLFDT(9999999-D)_" HF: "_$PIECE(^AUTTHF(H,0),U)
End DoDot:2
+16 QUIT
End DoDot:1
+17 ;found a cessation hf so quit
IF O
QUIT O
+18 SET O=$$CESSOTH(P,BDATE,EDATE)
+19 IF O
QUIT O
+20 QUIT "2 No"
+21 ;
CESSOTH(P,BDATE,EDATE) ;EP
+1 NEW BDMALLED,X,Y,%,T,G,A,B,E,Z,BDMLPED,BDMMEDS1
+2 KILL BDMALLED
+3 SET BDMLPED=""
+4 SET Y="BDMALLED("
+5 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+6 SET %=""
IF $DATA(BDMALLED(1))
SET %=""
Begin DoDot:1
+7 SET (X,D)=0
SET T=""
FOR
SET X=$ORDER(BDMALLED(X))
IF X'=+X
QUIT
Begin DoDot:2
+8 SET T=$PIECE(^AUPNVPED(+$PIECE(BDMALLED(X),U,4),0),U)
+9 IF 'T
QUIT
+10 IF '$DATA(^AUTTEDT(T,0))
QUIT
+11 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+12 IF $PIECE(T,"-")="TO"
IF $PIECE(BDMLPED,U)<$PIECE(BDMALLED(X),U)
SET %=$PIECE(BDMALLED(X),U)_U_T
QUIT
+13 IF $PIECE(T,"-",2)="TO"
IF $PIECE(BDMLPED,U)<$PIECE(BDMALLED(X),U)
SET %=$PIECE(BDMALLED(X),U)_U_T
QUIT
+14 IF $PIECE(T,"-",2)="SHS"
IF $PIECE(BDMLPED,U)<$PIECE(BDMALLED(X),U)
SET %=$PIECE(BDMALLED(X),U)_U_T
QUIT
+15 IF $PIECE(T,"-",1)["305.1"!($PIECE(T,"-")="649.00")!($PIECE(T,"-")="649.01")!($PIECE(T,"-")="649.02")!($PIECE(T,"-")="649.03")!($PIECE(T,"-")="649.04")!($PIECE(T,"-")="V15.82")
IF $PIECE(BDMLPED,U)<$PIECE(BDMALLED(X),U)
SET %=$PIECE(BDMALLED(X),U)_U_T
QUIT
+16 IF $PIECE(T,"-",1)="D1320"!($PIECE(T,"-")="99406")!($PIECE(T,"-")="99407")!($PIECE(T,"-")="G0375")!($PIECE(T,"-")="G0376")!($PIECE(T,"-")="4000F")!($PIECE(T,"-")="G8402")!($PIECE(T,"-")="G8453")
IF $PIECE(BDMLPED,U)<$PIECE(BDMALLED(X),U)
SET %=$PIECE(BDMALLED(X),U)_U_T
QUIT
End DoDot:2
End DoDot:1
IF %]""
SET BDMLPED=%
+17 IF %]""
QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(%,U,1))_" Pt Ed "_$PIECE(%,U,2)
+18 KILL ^TMP($JOB,"A")
+19 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+20 SET X=0
SET G=""
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+21 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+22 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+23 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+24 SET B=$$CLINIC^APCLV(V,"C")
+25 IF B=94
IF $PIECE(BDMLPED,U)<$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
SET BDMLPED=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_"Clinic 94"
QUIT
+26 SET Z=0
FOR
SET Z=$ORDER(^AUPNVDEN("AD",V,Z))
IF Z'=+Z!(G)
QUIT
SET B=$PIECE($GET(^AUPNVDEN(Z,0)),U)
IF B
SET B=$PIECE($GET(^AUTTADA(B,0)),U)
IF B=1320
IF $PIECE(BDMLPED,U)<$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
SET BDMLPED=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_"ADA 1320"
QUIT
+27 QUIT
End DoDot:1
+28 IF BDMLPED]""
QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(BDMLPED,U,1))_" "_$PIECE(BDMLPED,U,2)
+29 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT D1320"
+30 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN D1320"
+31 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT 99406"
+32 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN 99406"
+33 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT 99407"
+34 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN 99407"
+35 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT G0375"
+36 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT G0376"
+37 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT 4000F"
+38 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN G0375"
+39 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN G0376"
+40 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN 4000F"
+41 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4001F"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CESSATION MED - CPT 4001F"
+42 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4001F"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN 4001F"
+43 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT G8402"
+44 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN G8402"
+45 SET G=$$CPTI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"CPT G8453"
+46 SET G=$$TRANI^BDMDADU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453"))
IF G
IF $PIECE(BDMLPED,U)<$PIECE(G,U,2)
SET BDMLPED=$PIECE(G,U,2)_U_"TRAN G8453"
+47 IF BDMLPED]""
QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(BDMLPED,U,1))_" "_$PIECE(BDMLPED,U,2)
+48 ;now check meds
+49 KILL BDMMEDS1
+50 DO GETMEDS^BDMDADU(P,BDATE,EDATE,,,,,.BDMMEDS1)
+51 SET T=$ORDER(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))
+52 SET T1=$ORDER(^ATXAX("B","BGP CMS SMOKING CESSATION NDC",0))
+53 SET (X,G,M,E)=0
SET D=""
FOR
SET X=$ORDER(BDMMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BDMMEDS1(X),U,5)
SET Y=+$PIECE(BDMMEDS1(X),U,4)
Begin DoDot:1
+54 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+55 ;new in v11.0
IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+56 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+57 IF 'Z
QUIT
+58 SET N=$PIECE($GET(^PSDRUG(Z,0)),U)
+59 IF $DATA(^ATXAX(T,21,"B",Z))!(N["NICOTINE TRANS")!(N["NICOTINE PATCH")!(N["NICOTINE POLACRILEX")!(N["NICOTINE INHALER")!(N["NICOTINE NASAL SPRAY")
Begin DoDot:2
+60 IF $PIECE(BDMLPED,U)<$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
SET BDMLPED=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N
End DoDot:2
+61 SET C=$PIECE($GET(^PSDRUG(Z,2)),U,4)
+62 IF C]""
IF $DATA(^ATXAX(T1,21,"B",C))
IF $PIECE(BDMLPED,U)<$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
SET BDMLPED=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N
End DoDot:1
+63 IF BDMLPED]""
QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(BDMLPED,U,1))_" "_$PIECE(BDMLPED,U,2)
PEDREF ; REFUSALS REMOVED 2013 AUDIT
+1 QUIT ""
REFTOED(P,BDATE,EDATE) ;EP - now check all Refusals of these education topics
+1 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,9999999.09,X))
IF X=""!(G]"")
QUIT
Begin DoDot:1
+2 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,9999999.09,X,D))
IF D=""!(G]"")
QUIT
Begin DoDot:2
+3 SET I=0
FOR
SET I=$ORDER(^AUPNPREF("AA",P,9999999.09,X,D,I))
IF I'=+I!(G]"")
QUIT
Begin DoDot:3
+4 SET Z=$PIECE($GET(^AUPNPREF(I,0)),U,3)
+5 IF Z=""
QUIT
+6 IF Z<BDATE
QUIT
+7 IF Z>EDATE
QUIT
+8 SET Y=$PIECE($GET(^AUTTEDT(X,0)),U,2)
+9 IF $PIECE(Y,"-")="TO"!($PIECE(Y,"-",2)="TO")!($PIECE(Y,"-",2)="SHS")
SET G=Z_U_"Refused "_Y
+10 IF $PIECE(Y,"-",1)["305.1"!($PIECE(Y,"-")="649.00")!($PIECE(Y,"-")="649.01")!($PIECE(Y,"-")="649.02")!($PIECE(Y,"-")="649.03")!($PIECE(Y,"-")="649.04")!($PIECE(Y,"-")="V15.82")
SET G=Z_U_"Ref "_Y
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT G
