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

BDMDB11.m

Go to the documentation of this file.
  1. BDMDB11 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
  1. ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
  1. ;
  1. IMM ;
  1. S:'$D(BDMCUML(140)) BDMCUML(140)="IMMUNIZATIONS"
  1. S $P(BDMCUML(140),U,2)=$P(BDMCUML(140),U,2)+1
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))
  1. I $E(V)="1" S $P(BDMCUML(140),U,3)=$P(BDMCUML(140),U,3)+1
  1. I $E(V)="3" S $P(BDMCUML(140),U,6)=$P(BDMCUML(140),U,6)+1
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))
  1. I $E(V)="1" S $P(BDMCUML(140),U,4)=$P(BDMCUML(140),U,4)+1
  1. I $E(V)="3" S $P(BDMCUML(140),U,7)=$P(BDMCUML(140),U,7)+1
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))
  1. I $E(V)="1" S $P(BDMCUML(140),U,5)=$P(BDMCUML(140),U,5)+1
  1. I $E(V)="3" S $P(BDMCUML(140),U,8)=$P(BDMCUML(140),U,8)+1
  1. ;HEP B
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,115))
  1. I $E(V)="1" S $P(BDMCUML(140),U,9)=$P(BDMCUML(140),U,9)+1
  1. I $E(V)="3" S $P(BDMCUML(140),U,10)=$P(BDMCUML(140),U,10)+1
  1. ;
  1. QUAN ;
  1. ;145
  1. ;title^total pts^total YES^NO^REF^UACR^UPCR^24HR^MICRO STRIP^MICRO ONLY^DIPSTICK
  1. K BDMOFLG
  1. S BDMOFLG=0
  1. S:'$D(BDMCUML(145)) BDMCUML(145)="LABORATORY EXAMS"
  1. S $P(BDMCUML(145),U,2)=$P(BDMCUML(145),U,2)+1 ;TOTAL # of patients
  1. S Q=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))
  1. S V=$E($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))) ;test done?
  1. ;S T=$P($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5) ;type of test
  1. S R=$S($P(Q,U,6)]"":$P(Q,U,6),1:$P(Q,U,2)) ;value/result
  1. I V'=1 S $P(BDMCUML(145),U,4)=$P(BDMCUML(145),U,4)+1 ;no UACR
  1. I V=1 D
  1. .S $P(BDMCUML(145),U,3)=$P(BDMCUML(145),U,3)+1 ;TOTAL WITH UACR
  1. .I R[">" S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 Q
  1. .;I $$UP^XLFSTR(R)["COMMENT" S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q
  1. .S R=$$STV^BDMDB18(R,8)
  1. .I R="" S $P(BDMCUML(145),U,15)=$P(BDMCUML(145),U,15)+1 Q ;NO RESULT
  1. .S R=+R
  1. .I R<30 S $P(BDMCUML(145),U,12)=$P(BDMCUML(145),U,12)+1 Q ;NORMAL UACR
  1. .I R<300.9999 S $P(BDMCUML(145),U,13)=$P(BDMCUML(145),U,13)+1 Q ;INREACSED 30-300
  1. .S $P(BDMCUML(145),U,14)=$P(BDMCUML(145),U,14)+1 ;INCREASED >300
  1. S G=$P($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),U,2) ;egfr value
  1. S H=0
  1. I $$AGE^AUPNPAT(BDMPD,BDMADAT)>17 D
  1. .S G=$$AS^BDMDB18(G)
  1. .S G=$$STV^BDMDB18(G,5,1)
  1. .I G="" Q
  1. .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
  1. EKG ;need date of last ekg
  1. ;
  1. CREAT ;
  1. ;
  1. GFR ;
  1. G:$$AGE^AUPNPAT(BDMPD,BDMADAT)<18 TCHOL
  1. S:'$D(BDMCUML(175)) BDMCUML(175)="e-GFR to assess kidney function obtained during audit period"
  1. S $P(BDMCUML(175),U,2)=$P(BDMCUML(175),U,2)+1 ;total pts over 18
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,79))
  1. I $E(V)=1 S $P(BDMCUML(175),U,5)=$P(BDMCUML(175),U,5)+1
  1. S V=$P(V,U,2)
  1. I $E(V)=">" S $P(BDMCUML(175),U,6)=$P(BDMCUML(175),U,6)+1 G TCHOL ;>60
  1. S V=$$STV^BDMDB18(V,5,1)
  1. I V="" S $P(BDMCUML(175),U,10)=$P(BDMCUML(175),U,10)+1 G TCHOL
  1. I +V>59 S $P(BDMCUML(175),U,6)=$P(BDMCUML(175),U,6)+1 G TCHOL
  1. I +V<15 S $P(BDMCUML(175),U,9)=$P(BDMCUML(175),U,9)+1 G TCHOL
  1. I +V>29,+V<60 S $P(BDMCUML(175),U,7)=$P(BDMCUML(175),U,7)+1 G TCHOL
  1. I +V>14,+V<30 S $P(BDMCUML(175),U,8)=$P(BDMCUML(175),U,8)+1 G TCHOL
  1. ;
  1. TCHOL ;
  1. S:'$D(BDMCUML(180)) BDMCUML(180)="Total Cholesterol obtained in past 12 months"
  1. S $P(BDMCUML(180),U,2)=$P(BDMCUML(180),U,2)+1
  1. S V=$$CHOL^BDMDB18(BDMPD,BDMBDAT,BDMADAT,"I")
  1. I V="" S $P(BDMCUML(180),U,6)=$P(BDMCUML(180),U,6)+1 G NONHDL
  1. S V=$P(V,U)
  1. S V=$$STV^BDMDB18(V,5,1)
  1. I V="" S $P(BDMCUML(180),U,7)=$P(BDMCUML(180),U,7)+1 G NONHDL
  1. I $E(V)'=+$E(V)!(+V=0) S $P(BDMCUML(180),U,7)=$P(BDMCUML(180),U,7)+1 G NONHDL
  1. I V<200 S $P(BDMCUML(180),U,3)=$P(BDMCUML(180),U,3)+1 G NONHDL
  1. I V<240 S $P(BDMCUML(180),U,4)=$P(BDMCUML(180),U,4)+1 G NONHDL
  1. S $P(BDMCUML(180),U,5)=$P(BDMCUML(180),U,5)+1
  1. NONHDL ;
  1. S:'$D(BDMCUML(185)) BDMCUML(185)="Non-HDL cholesterol"
  1. S $P(BDMCUML(185),U,2)=$P(BDMCUML(185),U,2)+1 ;TOTAL PTS
  1. S V=$P($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,117)),U,1) ;non hdl
  1. I V="" S $P(BDMCUML(185),U,7)=$P(BDMCUML(185),U,7)+1 G LDL
  1. I $E(V)'=+$E(V)!(+V=0) S $P(BDMCUML(185),U,7)=$P(BDMCUML(185),U,7)+1 G LDL
  1. I V<130 S $P(BDMCUML(185),U,3)=$P(BDMCUML(185),U,3)+1 G LDL
  1. I V>129,V<160 S $P(BDMCUML(185),U,4)=$P(BDMCUML(185),U,4)+1 G LDL
  1. I V>159,V<191 S $P(BDMCUML(185),U,5)=$P(BDMCUML(185),U,5)+1 G LDL
  1. S $P(BDMCUML(185),U,6)=$P(BDMCUML(185),U,6)+1
  1. LDL ;
  1. S:'$D(BDMCUML(190)) BDMCUML(190)="LDL Cholesterol obtained during audit period"
  1. S $P(BDMCUML(190),U,2)=$P(BDMCUML(190),U,2)+1
  1. S V=$$LDL^BDMDB18(BDMPD,BDMBDAT,BDMADAT,"I")
  1. I V="" S $P(BDMCUML(190),U,7)=$P(BDMCUML(190),U,7)+1 G HDL
  1. S V=$P(V,U)
  1. ;S V=$$STV^BDMDB18(V,4)
  1. 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
  1. I V<100 S $P(BDMCUML(190),U,3)=$P(BDMCUML(190),U,3)+1 G HDL
  1. I V<130 S $P(BDMCUML(190),U,4)=$P(BDMCUML(190),U,4)+1 G HDL
  1. I V<160.1 S $P(BDMCUML(190),U,5)=$P(BDMCUML(190),U,5)+1 G HDL
  1. S $P(BDMCUML(190),U,6)=$P(BDMCUML(190),U,6)+1
  1. HDL ;
  1. S:'$D(BDMCUML(195)) BDMCUML(195)="HDL Cholesterol obtained during audit period"
  1. S V=$$HDL^BDMDB18(BDMPD,BDMBDAT,BDMADAT,"I")
  1. S S=$P(^DPT(BDMPD,0),U,2) ;GENDER
  1. I S="F" D
  1. .S $P(BDMCUML(195),U,2)=$P(BDMCUML(195),U,2)+1
  1. .I V="" S $P(BDMCUML(195),U,5)=$P(BDMCUML(195),U,5)+1 Q
  1. .S V=$P(V,U)
  1. .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
  1. .S V=$P(V,"."),V=$$STV^BDMDB18(V,5,1)
  1. .I $E(V)'=+$E(V)!(+V=0)!(V="") S $P(BDMCUML(195),U,5)=$P(BDMCUML(195),U,5)+1 Q
  1. .I V'>50 S $P(BDMCUML(195),U,3)=$P(BDMCUML(195),U,3)+1 Q
  1. .S $P(BDMCUML(195),U,4)=$P(BDMCUML(195),U,4)+1 Q
  1. I S="M" D
  1. .S $P(BDMCUML(195),U,6)=$P(BDMCUML(195),U,6)+1
  1. .I V="" S $P(BDMCUML(195),U,9)=$P(BDMCUML(195),U,9)+1 Q
  1. .S V=$P(V,U)
  1. .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
  1. .S V=$P(V,"."),V=$$STV^BDMDB18(V,5,1)
  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
  1. .I V'>40 S $P(BDMCUML(195),U,7)=$P(BDMCUML(195),U,7)+1 Q
  1. .S $P(BDMCUML(195),U,8)=$P(BDMCUML(195),U,8)+1 Q
  1. TRIG ;
  1. S:'$D(BDMCUML(200)) BDMCUML(200)="Triglycerides obtained in past 12 months"
  1. S $P(BDMCUML(200),U,2)=$P(BDMCUML(200),U,2)+1
  1. S V=$$TRIG^BDMDB18(BDMPD,BDMBDAT,BDMADAT,"I")
  1. I V="" S $P(BDMCUML(200),U,7)=$P(BDMCUML(200),U,7)+1 G SELF
  1. S V=$P(V,U)
  1. 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
  1. I V'>400 S $P(BDMCUML(200),U,3)=$P(BDMCUML(200),U,3)+1 G SELF
  1. S $P(BDMCUML(200),U,4)=$P(BDMCUML(200),U,4)+1
  1. SELF ;
  1. CVD ;USE 250
  1. S:'$D(BDMCUML(250)) BDMCUML(250)="Cardiovascular Disease"
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))
  1. I $E(V)=1 S $P(BDMCUML(250),U,3)=$P(BDMCUML(250),U,3)+1
  1. S $P(BDMCUML(250),U,2)=$P(BDMCUML(250),U,2)+1
  1. EGFRQUP ;
  1. S:'$D(BDMCUML(270)) BDMCUML(270)="eGFR and QUANTITATIVE URINARY PROTEIN ASSESSMENT"
  1. G:$$AGE^AUPNPAT(BDMPD,BDMADAT)<18 COMBINED
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),V=$$STV^BDMDB18($P(V,U,2),5)
  1. S T=$P($G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5) ;type of test
  1. S $P(BDMCUML(270),U,2)=$P(BDMCUML(270),U,2)+1
  1. I V]"",T=1 S $P(BDMCUML(270),U,3)=$P(BDMCUML(270),U,3)+1 ;had both
  1. COMBINED ;USE 260
  1. S:'$D(BDMCUML(260)) BDMCUML(260)="Combined Outcome Measures"
  1. S V=$G(^XTMP("BDMDM14",BDMJOB,BDMBTH,"AUDIT",BDMPD,118))
  1. I $E(V)=1 S $P(BDMCUML(260),U,3)=$P(BDMCUML(260),U,3)+1
  1. S $P(BDMCUML(260),U,2)=$P(BDMCUML(260),U,2)+1
  1. Q
  1. CESS(P,BDATE,EDATE) ;EP - find any cessation hf in 12 months before E
  1. I '$G(P) Q ""
  1. I $P($$TOBACCO^BDMDB1T(P,$$DOB^AUPNPAT(P),EDATE),U,1)'=1 Q ""
  1. NEW BDM,E,X,G,T,O,D,H,C
  1. K BDM
  1. S T=$O(^ATXAX("B","DM AUDIT CESSATION HLTH FACTOR",0))
  1. S (H,D)=0 S O=""
  1. S H=0 F S H=$O(^AUPNVHF("AA",P,H)) Q:H'=+H!(O]"") D
  1. .S G=0
  1. .I $D(^ATXAX(T,21,"AA",H)) S G=1
  1. .I $P(^AUTTHF(H,0),U,1)["CESSATION",$$VAL^XBDIQ1(9999999.64,H,.03)["TOBACCO" S G=1
  1. .Q:'G
  1. .S D="" F S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D!(O]"") D
  1. ..Q:(9999999-D)>EDATE ;after time frame
  1. ..Q:(9999999-D)<BDATE ;before time frame
  1. ..S O="1 Yes- "_$$FMTE^XLFDT(9999999-D)_" HF: "_$P(^AUTTHF(H,0),U)
  1. .Q
  1. I O Q O ;found a cessation hf so quit
  1. S O=$$CESSOTH(P,BDATE,EDATE)
  1. I O Q O
  1. Q "2 No"
  1. ;
  1. CESSOTH(P,BDATE,EDATE) ;EP
  1. NEW BDMALLED,X,Y,%,T,G,A,B,E,Z,BDMLPED,BDMMEDS1
  1. K BDMALLED
  1. S BDMLPED=""
  1. S Y="BDMALLED("
  1. S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. S %="" I $D(BDMALLED(1)) S %="" D I %]"" S BDMLPED=%
  1. .S (X,D)=0,T="" F S X=$O(BDMALLED(X)) Q:X'=+X D
  1. ..S T=$P(^AUPNVPED(+$P(BDMALLED(X),U,4),0),U)
  1. ..Q:'T
  1. ..Q:'$D(^AUTTEDT(T,0))
  1. ..S T=$P(^AUTTEDT(T,0),U,2)
  1. ..I $P(T,"-")="TO",$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
  1. ..I $P(T,"-",2)="TO",$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
  1. ..I $P(T,"-",2)="SHS",$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
  1. ..;make the call here to the BGP SMOKING DXS taxonomy
  1. ..;p8 ICD-10
  1. ..N CODE
  1. ..S CODE=$P($$CODEN^BDMUTL($P(T,"-",1),80),"~")
  1. ..I CODE>0 D
  1. ...N TAX
  1. ...S TAX=$O(^ATXAX("B","BGP SMOKER ONLY DXS",0))
  1. ...I $$ICD^BDMUTL(CODE,"BGP SMOKER ONLY DXS",9),$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
  1. ...;I $$ICD^ATXCHK($P(T,"-",1),TAX,9),$P(BDMLPED,U)<$P(BDMALLED(X),U) S %=$P(BDMALLED(X),U)_U_T Q
  1. ...;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
  1. ..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
  1. I %]"" Q "1 Yes "_$$FMTE^XLFDT($P(%,U,1))_" Pt Ed "_$P(%,U,2)
  1. K ^TMP($J,"A")
  1. S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .S B=$$CLINIC^APCLV(V,"C")
  1. .I B=94,$P(BDMLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BDMLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"Clinic 94" Q
  1. .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
  1. .Q
  1. I BDMLPED]"" Q "1 Yes "_$$FMTE^XLFDT($P(BDMLPED,U,1))_" "_$P(BDMLPED,U,2)
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. 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"
  1. I BDMLPED]"" Q "1 Yes "_$$FMTE^XLFDT($P(BDMLPED,U,1))_" "_$P(BDMLPED,U,2)
  1. ;now check meds
  1. K BDMMEDS1
  1. D GETMEDS^BDMDBDU(P,BDATE,EDATE,,,,,.BDMMEDS1)
  1. S T=$O(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))
  1. S T1=$O(^ATXAX("B","BGP CMS SMOKING CESSATION NDC",0))
  1. 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
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK" ;new in v11.0
  1. .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1. .Q:'Z
  1. .S N=$P($G(^PSDRUG(Z,0)),U)
  1. .I $D(^ATXAX(T,21,"B",Z))!(N["NICOTINE TRANS")!(N["NICOTINE PATCH")!(N["NICOTINE POLACRILEX")!(N["NICOTINE INHALER")!(N["NICOTINE NASAL SPRAY") D
  1. ..I $P(BDMLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BDMLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N
  1. .S C=$P($G(^PSDRUG(Z,2)),U,4)
  1. .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
  1. I BDMLPED]"" Q "1 Yes "_$$FMTE^XLFDT($P(BDMLPED,U,1))_" "_$P(BDMLPED,U,2)
  1. PEDREF ; REFUSALS REMOVED 2014 AUDIT
  1. Q ""
  1. REFTOED(P,BDATE,EDATE) ;EP - now check all Refusals of these education topics
  1. S G="",X=0 F S X=$O(^AUPNPREF("AA",P,9999999.09,X)) Q:X=""!(G]"") D
  1. .S D=0 F S D=$O(^AUPNPREF("AA",P,9999999.09,X,D)) Q:D=""!(G]"") D
  1. ..S I=0 F S I=$O(^AUPNPREF("AA",P,9999999.09,X,D,I)) Q:I'=+I!(G]"") D
  1. ...S Z=$P($G(^AUPNPREF(I,0)),U,3)
  1. ...Q:Z=""
  1. ...I Z<BDATE Q
  1. ...I Z>EDATE Q
  1. ...S Y=$P($G(^AUTTEDT(X,0)),U,2)
  1. ...I $P(Y,"-")="TO"!($P(Y,"-",2)="TO")!($P(Y,"-",2)="SHS") S G=Z_U_"Refused "_Y
  1. ...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
  1. Q G