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

BGP2D711.m

Go to the documentation of this file. 
  1. BGP2D711 ; IHS/CMI/LAB - measure C 30 Jun 2010 12:14 PM ;
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;
  1. SPECNUTR(P,BDATE,EDATE) ;EP
  1.  NEW BGPALLED,BGPG,X,T,D,%
  1.  K BGPALLED,BGPG
  1.  K BGPG S X=P_"^LAST DX [BGP DIETARY SURVEILLANCE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1.  I $D(BGPG(1)) Q $P(BGPG(1),U)_U_$P(BGPG(1),U,2)
  1.  S Y="BGPALLED("
  1.  S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  ;I '$D(BGPALLED(1)) Q ""
  1.  S (X,D)=0,%="",T="" F  S X=$O(BGPALLED(X)) Q:X'=+X!(%]"")  D
  1.  .S T=$P(^AUPNVPED(+$P(BGPALLED(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,"-",2)="N"!($P(T,"-",2)="DT")!($P(T,"-",2)="MNT") S %=$P(BGPALLED(X),U)_U_T_" SN" Q
  1.  .S S=$P(T,"-",1)
  1.  .S S=$$ICDDX^ICDCODE(S)
  1.  .I $P(S,U,1)'="-1",$$ICD^ATXCHK($P(S,U,1),$O(^ATXAX("B","BGP DIETARY SURVEILLANCE DXS",0)),9) S %=$P(BGPALLED(X),U)_U_T_" SN" Q
  1.  .I $P(T,"-",1)="97802"!($P(T,"-",1)="97803")!($P(T,"-",1)="97804")!($P(T,"-")="G0270")!($P(T,"-")="G0271") S %=$P(BGPALLED(X),U)_U_T Q
  1.  Q %
  1.  ;
  1. SPECEX(P,BDATE,EDATE) ;EP
  1.  NEW BGPG,BGPALLED,X,T,%,D
  1.  K BGPALLED
  1.  S X=P_"^LAST DX [BGP EXERCISE COUNSELING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1.  I $D(BGPG(1)) Q $P(BGPG(1),U)_U_$P(BGPG(1),U,2)
  1.  S Y="BGPALLED("
  1.  S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  ;I '$D(BGPALLED(1)) Q ""
  1.  S (X,D)=0,%="",T="" F  S X=$O(BGPALLED(X)) Q:X'=+X!(%]"")  D
  1.  .S T=$P(^AUPNVPED(+$P(BGPALLED(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,"-",2)="EX" S %=$P(BGPALLED(X),U)_U_T Q
  1.  .S S=$P(T,"-",1)
  1.  .S S=$$ICDDX^ICDCODE(S)
  1.  .I $P(S,U,1)'="-1",$$ICD^ATXCHK($P(S,U,1),$O(^ATXAX("B","BGP EXERCISE COUNSELING DXS",0)),9) S %=$P(BGPALLED(X),U)_U_T Q
  1.  Q %
  1. OTHREL(P,BDATE,EDATE) ;EP
  1.  NEW BGPALLED
  1.  K BGPALLED
  1.  S Y="BGPALLED("
  1.  S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  ;I '$D(BGPALLED(1)) Q ""
  1.  S (X,D)=0,%="",T="" F  S X=$O(BGPALLED(X)) Q:X'=+X!(%]"")  D
  1.  .S T=$P(^AUPNVPED(+$P(BGPALLED(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,"-",2)="LA"!($P(T,"-",1)="OBS") S %=$P(BGPALLED(X),U)_U_T Q
  1.  .S S=$P(T,"-",1)
  1.  .S S=$$ICDDX^ICDCODE(S)
  1.  .I $P(S,U,1)'="-1",$$ICD^ATXCHK($P(S,U,1),$O(^ATXAX("B","BGP OTHER REL WT EDUC DXS",0)),9) S %=$P(BGPALLED(X),U)_U_T Q
  1.  .I S="S9449"!(S="S9451")!(S="S9452")!(S="S9470") S %=$P(BGPALLED(X),U)_U_T Q
  1.  I % Q %
  1.  ;NOW CHECK V CPT
  1.   S %=$$CPT^BGP2DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP OTHER REL EDUC CPTS",0)),5)
  1.   Q %
  1. MEDNUTRD(P,BDATE,EDATE) ;EP
  1.  K ^TMP($J)
  1.  NEW E,%,X,Y,D,Z,W,BGPG,BGPC
  1.  K BGPG,BGPC
  1.  S E=+$$CODEN^ICPTCOD(97802),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"
  1.  S E=+$$CODEN^ICPTCOD(97803),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97803"
  1.  S E=+$$CODEN^ICPTCOD(97804),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"
  1.  S E=+$$CODEN^ICPTCOD("G0270"),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"
  1.  S E=+$$CODEN^ICPTCOD("G0271"),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"
  1.  ;TRAN CODES
  1.  S E=+$$CODEN^ICPTCOD(97802),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"
  1.  S E=+$$CODEN^ICPTCOD(97803),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)-"^97803"
  1.  S E=+$$CODEN^ICPTCOD(97804),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"
  1.  S E=+$$CODEN^ICPTCOD("G0270"),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"
  1.  S E=+$$CODEN^ICPTCOD("G0271"),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"
  1.  S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
  1.  S (X,Y,D)="" F  S X=$O(BGPG(X)) Q:X'=+X!(Y)  D
  1.  .S Z=0 F  S Z=$O(^AUPNVPRV("AD",$P(BGPG(X),U,5),Z)) Q:Z'=+Z!(Y)  D
  1.  ..S W=$P($G(^AUPNVPRV(Z,0)),U,1)
  1.  ..Q:W=""
  1.  ..S R=$$VALI^XBDIQ1(200,W,53.5)
  1.  ..I R="" Q
  1.  ..S R=$P($G(^DIC(7,R,9999999)),U,1)
  1.  ..I R="07"!(R=29),'$$DNKA($P(BGPG(X),U,5)) S Y=1,D=$P(BGPG(X),U)
  1.  I Y Q D_"^Prv "_R
  1.  S (X,Y,D)="" F  S X=$O(BGPG(X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(BGPG(X),U,5),"C") I (R=67!(R=36)),'$$DNKA($P(BGPG(X),U,5)) S Y=1,D=$P(BGPG(X),U)
  1.  I Y Q D_"^Cl "_R
  1.  Q ""
  1. MEDNUTR(P,BDATE,EDATE) ;EP
  1.  K ^TMP($J),BGPG,BGPC
  1.  S E=+$$CODEN^ICPTCOD(97802),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"
  1.  S E=+$$CODEN^ICPTCOD(97803),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97803"
  1.  S E=+$$CODEN^ICPTCOD(97804),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"
  1.  S E=+$$CODEN^ICPTCOD("G0270"),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"
  1.  S E=+$$CODEN^ICPTCOD("G0271"),%=$$CPTI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"
  1.  ;TRAN CODES
  1.  S E=+$$CODEN^ICPTCOD(97802),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"
  1.  S E=+$$CODEN^ICPTCOD(97803),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)-"^97803"
  1.  S E=+$$CODEN^ICPTCOD(97804),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"
  1.  S E=+$$CODEN^ICPTCOD("G0270"),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"
  1.  S E=+$$CODEN^ICPTCOD("G0271"),%=$$TRANI^BGP2DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"
  1.  S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
  1.  S (X,Y,D)="" F  S X=$O(BGPG(X)) Q:X'=+X!(Y)  D
  1.  .S Z=0 F  S Z=$O(^AUPNVPRV("AD",$P(BGPG(X),U,5),Z)) Q:Z'=+Z!(Y)  D
  1.  ..S W=$P($G(^AUPNVPRV(Z,0)),U,1)
  1.  ..Q:W=""
  1.  ..S R=$$VALI^XBDIQ1(200,W,53.5)
  1.  ..I R="" Q
  1.  ..S R=$P($G(^DIC(7,R,9999999)),U,1)
  1.  ..I R="07"!(R=29)!(R=97)!(R=99),'$$DNKA($P(BGPG(X),U,5)) S Y=1,D=$P(BGPG(X),U)
  1.  ;S R=$$PRIMPROV^APCLV($P(BGPG(X),U,5),"D") I (R="07"!(R=29))!(R=97)!(R=99),'$$DNKA($P(BGPG(X),U,5)) S Y=1,D=$P(BGPG(X),U)
  1.  I Y Q D_"^Prv "_R
  1.  S (X,Y,D)="" F  S X=$O(BGPG(X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(BGPG(X),U,5),"C") I (R=67!(R=36)),'$$DNKA($P(BGPG(X),U,5)) S Y=1,D=$P(BGPG(X),U)
  1.  I Y Q D_"^Cl "_R
  1.  Q ""
  1. DNKA(V) ;EP - is this a DNKA visit?
  1.  NEW D,N
  1.  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. PED(P,BDATE,EDATE,FORE) ;EP
  1.  S FORE=$G(FORE)
  1.  NEW BGPALLED,X,Y,%,T,G,A,B,E,Z,BGPLPED
  1.  K BGPALLED
  1.  S BGPLPED=""
  1.  S Y="BGPALLED("
  1.  S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(BGPALLED(1)) S %="" D  I %]"" S BGPLPED=%
  1.  .S (X,D)=0,T="" F  S X=$O(BGPALLED(X)) Q:X'=+X  D
  1.  ..S T=$P(^AUPNVPED(+$P(BGPALLED(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 $G(BGPRTYPE)=3,T="TO-M" Q
  1.  ..I $P(T,"-")="TO",$P(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q
  1.  ..I $P(T,"-",2)="TO",$P(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q
  1.  ..I $P(T,"-",2)="SHS",$P(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q
  1.  ..S S=$P(T,"-",1)
  1.  ..S S=$$ICDDX^ICDCODE(S)
  1.  ..I $P(S,U,1)'="-1",$$ICD^ATXCHK($P(S,U,1),$O(^ATXAX("B","BGP TOBACCO DXS",0)),9) S %=$P(BGPALLED(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(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q
  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.  ;I '$D(^TMP($J,"A",1)) Q ""
  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(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"Cl 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(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"ADA 1320" Q
  1.  .Q
  1.  ;I G]"" Q G
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT D1320"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN D1320"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT 99406"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 99406"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT 99407"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 99407"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G0375"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G0376"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT 4000F"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G0375"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G0376"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 4000F"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4001F")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CESSATION MED - CPT 4001F"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4001F")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 4001F"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G8402"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G8402"
  1.  S G=$$CPTI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G8453"
  1.  S G=$$TRANI^BGP2DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G8453"
  1.  ;now check meds - new in 8.0
  1.  K BGPMEDS1
  1.  D GETMEDS^BGP2UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
  1.  ;I '$D(BGPMEDS1) G PEDREF
  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(BGPMEDS1(X)) Q:X'=+X  S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(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 PATCH")!(N["NICOTINE POLACRILEX")!(N["NICOTINE INHALER")!(N["NICOTINE NASAL SPRAY") D
  1.  ..I $P(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$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(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N
  1.  I FORE Q BGPLPED  ;if in forecaster mode skip Refusals
  1.  I 'FORE,BGPLPED]"" Q BGPLPED
  1. PEDREF ; 
  1.  S G=$$REFTOED(P,$S(FORE:$$FMADD^XLFDT(EDATE,-365),1:BDATE),EDATE)
  1.  I $P(BGPLPED,U)<$P(G,U,1) Q G
  1.  ;CPT REFUSALS NEW FOR 11.1
  1.  S G=$$CPTREFT^BGP2UTL1(P,BDATE,EDATE,$O(^ATXAX("B","BGP TOB CESS REFUSAL CPTS",0)))
  1.  I $P(BGPLPED,U)<$P(G,U,1) Q $P(G,U,2)_"^Refused CPT "_$P(G,U,4)
  1.  Q BGPLPED
  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 $G(BGPRTYPE)=3,Y="TO-M" Q
  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