- BDMDB11 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
- ;
- IMM ;
- S:'$D(BDMCUML(140)) BDMCUML(140)="IMMUNIZATIONS"
- S $P(BDMCUML(140),U,2)=$P(BDMCUML(140),U,2)+1
- S V=$G(^XTMP("BDMDM14",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("BDMDM14",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("BDMDM14",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("BDMDM14",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("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))
- S V=$E($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))) ;test done?
- ;S T=$P($G(^XTMP("BDMDM14",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 S $P(BDMCUML(145),U,4)=$P(BDMCUML(145),U,4)+1 ;no UACR
- I V=1 D
- .S $P(BDMCUML(145),U,3)=$P(BDMCUML(145),U,3)+1 ;TOTAL WITH UACR
- .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^BDMDB18(R,8)
- .I R="" S $P(BDMCUML(145),U,15)=$P(BDMCUML(145),U,15)+1 Q ;NO RESULT
- .S R=+R
- .I R<30 S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q ;NORMAL UACR
- .I R<300.9999 S $P(BDMCUML(145),U,13)=$P(BDMCUML(145),U,13)+1 Q ;INREACSED 30-300
- .S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 ;INCREASED >300
- S G=$P($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),U,2) ;egfr value
- S H=0
- I $$AGE^AUPNPAT(BDMPD,BDMADAT)>17 D
- .S G=$$AS^BDMDB18(G)
- .S G=$$STV^BDMDB18(G,5,1)
- .I G="" Q
- .I +G>29 S $P(BDMCUML(145),U,20)=$P(BDMCUML(145),U,20)+1 I V=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("BDMDM14",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^BDMDB18(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^BDMDB18(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^BDMDB18(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"
- S $P(BDMCUML(185),U,2)=$P(BDMCUML(185),U,2)+1 ;TOTAL PTS
- S V=$P($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,117)),U,1) ;non hdl
- 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^BDMDB18(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^BDMDB18(V,4)
- S V=$$STV^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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("BDMDM14",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"
- G:$$AGE^AUPNPAT(BDMPD,BDMADAT)<18 COMBINED
- S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),V=$$STV^BDMDB18($P(V,U,2),5)
- S T=$P($G(^XTMP("BDMDM14",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 S $P(BDMCUML(270),U,3)=$P(BDMCUML(270),U,3)+1 ;had both
- COMBINED ;USE 260
- S:'$D(BDMCUML(260)) BDMCUML(260)="Combined Outcome Measures"
- S V=$G(^XTMP("BDMDM14",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^BDMDB1T(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
- ..;make the call here to the BGP SMOKING DXS taxonomy
- ..;p8 ICD-10
- ..N CODE
- ..S CODE=$P($$CODEN^BDMUTL($P(T,"-",1),80),"~")
- ..I CODE>0 D
- ...N TAX
- ...S TAX=$O(^ATXAX("B","BGP SMOKER ONLY DXS",0))
- ...I $$ICD^BDMUTL(CODE,"BGP SMOKER ONLY DXS",9),$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
- ...;I $$ICD^ATXCHK($P(T,"-",1),TAX,9),$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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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^BDMDBDU(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 2014 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
- BDMDB11 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
- +2 ;
- 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("BDMDM14",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("BDMDM14",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("BDMDM14",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("BDMDM14",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("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))
- +8 ;test done?
- SET V=$EXTRACT($GET(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)))
- +9 ;S T=$P($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5) ;type of test
- +10 ;value/result
- SET R=$SELECT($PIECE(Q,U,6)]"":$PIECE(Q,U,6),1:$PIECE(Q,U,2))
- +11 ;no UACR
- IF V'=1
- SET $PIECE(BDMCUML(145),U,4)=$PIECE(BDMCUML(145),U,4)+1
- +12 IF V=1
- Begin DoDot:1
- +13 ;TOTAL WITH UACR
- SET $PIECE(BDMCUML(145),U,3)=$PIECE(BDMCUML(145),U,3)+1
- +14 IF R[">"
- SET $PIECE(BDMCUML(145),U,14)=$PIECE(BDMCUML(145),U,14)+1
- QUIT
- +15 ;I $$UP^XLFSTR(R)["COMMENT" S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q
- +16 SET R=$$STV^BDMDB18(R,8)
- +17 ;NO RESULT
- IF R=""
- SET $PIECE(BDMCUML(145),U,15)=$PIECE(BDMCUML(145),U,15)+1
- QUIT
- +18 SET R=+R
- +19 ;NORMAL UACR
- IF R<30
- SET $PIECE(BDMCUML(145),U,12)=$PIECE(BDMCUML(145),U,12)+1
- QUIT
- +20 ;INREACSED 30-300
- IF R<300.9999
- SET $PIECE(BDMCUML(145),U,13)=$PIECE(BDMCUML(145),U,13)+1
- QUIT
- +21 ;INCREASED >300
- SET $PIECE(BDMCUML(145),U,14)=$PIECE(BDMCUML(145),U,14)+1
- End DoDot:1
- +22 ;egfr value
- SET G=$PIECE($GET(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),U,2)
- +23 SET H=0
- +24 IF $$AGE^AUPNPAT(BDMPD,BDMADAT)>17
- Begin DoDot:1
- +25 SET G=$$AS^BDMDB18(G)
- +26 SET G=$$STV^BDMDB18(G,5,1)
- +27 IF G=""
- QUIT
- +28 IF +G>29
- SET $PIECE(BDMCUML(145),U,20)=$PIECE(BDMCUML(145),U,20)+1
- IF V=1
- SET $PIECE(BDMCUML(145),U,21)=$PIECE(BDMCUML(145),U,21)+1
- End DoDot: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("BDMDM14",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^BDMDB18(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^BDMDB18(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^BDMDB18(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"
- +2 ;TOTAL PTS
- SET $PIECE(BDMCUML(185),U,2)=$PIECE(BDMCUML(185),U,2)+1
- +3 ;non hdl
- SET V=$PIECE($GET(^XTMP("BDMDM14",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^BDMDB18(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^BDMDB18(V,4)
- +7 SET V=$$STV^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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^BDMDB18(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("BDMDM14",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 IF $$AGE^AUPNPAT(BDMPD,BDMADAT)<18
- GOTO COMBINED
- +3 SET V=$GET(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,79))
- SET V=$$STV^BDMDB18($PIECE(V,U,2),5)
- +4 ;type of test
- SET T=$PIECE($GET(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5)
- +5 SET $PIECE(BDMCUML(270),U,2)=$PIECE(BDMCUML(270),U,2)+1
- +6 ;had both
- IF V]""
- IF T=1
- SET $PIECE(BDMCUML(270),U,3)=$PIECE(BDMCUML(270),U,3)+1
- COMBINED ;USE 260
- +1 IF '$DATA(BDMCUML(260))
- SET BDMCUML(260)="Combined Outcome Measures"
- +2 SET V=$GET(^XTMP("BDMDM14",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^BDMDB1T(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 ;make the call here to the BGP SMOKING DXS taxonomy
- +16 ;p8 ICD-10
- +17 NEW CODE
- +18 SET CODE=$PIECE($$CODEN^BDMUTL($PIECE(T,"-",1),80),"~")
- +19 IF CODE>0
- Begin DoDot:3
- +20 NEW TAX
- +21 SET TAX=$ORDER(^ATXAX("B","BGP SMOKER ONLY DXS",0))
- +22 IF $$ICD^BDMUTL(CODE,"BGP SMOKER ONLY DXS",9)
- IF $PIECE(BDMLPED,U)<$PIECE(BDMALLED(X),U)
- SET %=$PIECE(BDMALLED(X),U)_U_T
- QUIT
- +23 ;I $$ICD^ATXCHK($P(T,"-",1),TAX,9),$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
- +24 ;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
- End DoDot:3
- +25 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=%
- +26 IF %]""
- QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(%,U,1))_" Pt Ed "_$PIECE(%,U,2)
- +27 KILL ^TMP($JOB,"A")
- +28 SET A="^TMP($J,""A"","
- SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(B,A)
- +29 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
- +30 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +31 IF '$PIECE(^AUPNVSIT(V,0),U,9)
- QUIT
- +32 IF $PIECE(^AUPNVSIT(V,0),U,11)
- QUIT
- +33 SET B=$$CLINIC^APCLV(V,"C")
- +34 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
- +35 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
- +36 QUIT
- End DoDot:1
- +37 IF BDMLPED]""
- QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(BDMLPED,U,1))_" "_$PIECE(BDMLPED,U,2)
- +38 SET G=$$CPTI^BDMDBDU(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"
- +39 SET G=$$TRANI^BDMDBDU(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"
- +40 SET G=$$CPTI^BDMDBDU(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"
- +41 SET G=$$TRANI^BDMDBDU(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"
- +42 SET G=$$CPTI^BDMDBDU(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"
- +43 SET G=$$TRANI^BDMDBDU(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"
- +44 SET G=$$CPTI^BDMDBDU(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"
- +45 SET G=$$CPTI^BDMDBDU(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"
- +46 SET G=$$CPTI^BDMDBDU(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"
- +47 SET G=$$TRANI^BDMDBDU(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"
- +48 SET G=$$TRANI^BDMDBDU(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"
- +49 SET G=$$TRANI^BDMDBDU(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"
- +50 SET G=$$CPTI^BDMDBDU(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"
- +51 SET G=$$TRANI^BDMDBDU(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"
- +52 SET G=$$CPTI^BDMDBDU(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"
- +53 SET G=$$TRANI^BDMDBDU(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"
- +54 SET G=$$CPTI^BDMDBDU(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"
- +55 SET G=$$TRANI^BDMDBDU(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"
- +56 IF BDMLPED]""
- QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(BDMLPED,U,1))_" "_$PIECE(BDMLPED,U,2)
- +57 ;now check meds
- +58 KILL BDMMEDS1
- +59 DO GETMEDS^BDMDBDU(P,BDATE,EDATE,,,,,.BDMMEDS1)
- +60 SET T=$ORDER(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))
- +61 SET T1=$ORDER(^ATXAX("B","BGP CMS SMOKING CESSATION NDC",0))
- +62 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
- +63 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +64 ;new in v11.0
- IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
- QUIT
- +65 ;get drug ien
- SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
- +66 IF 'Z
- QUIT
- +67 SET N=$PIECE($GET(^PSDRUG(Z,0)),U)
- +68 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
- +69 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
- +70 SET C=$PIECE($GET(^PSDRUG(Z,2)),U,4)
- +71 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
- +72 IF BDMLPED]""
- QUIT "1 Yes "_$$FMTE^XLFDT($PIECE(BDMLPED,U,1))_" "_$PIECE(BDMLPED,U,2)
- PEDREF ; REFUSALS REMOVED 2014 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