BGP4D711.m

BGP4D711 ; IHS/CMI/LAB - measure C 30 Jun 2010 12:14 PM ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 ;

SPECNUTR(P,BDATE,EDATE) ;EP

 NEW BGPALLED,BGPG,X,T,D,%

 K BGPALLED,BGPG

 K BGPG S X=P_"^LAST DX [BGP DIETARY SURVEILLANCE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")

 I $D(BGPG(1)) Q $P(BGPG(1),U)_U_$P(BGPG(1),U,2)

 S Y="BGPALLED("

 S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 ;I '$D(BGPALLED(1)) Q ""

 S (X,D)=0,%="",T="" F  S X=$O(BGPALLED(X)) Q:X'=+X!(%]"")  D

 .S T=$P(^AUPNVPED(+$P(BGPALLED(X),U,4),0),U)

 .Q:'T

 .Q:'$D(^AUTTEDT(T,0))

 .S T=$P(^AUTTEDT(T,0),U,2)

 .I $P(T,"-",2)="N"!($P(T,"-",2)="DT")!($P(T,"-",2)="MNT") S %=$P(BGPALLED(X),U)_U_T_" SN" Q

 .S S=$P(T,"-",1)

 .S S=$$ICDDX^BGP4UTL2(S)

 .I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP DIETARY SURVEILLANCE DXS",0)),9) S %=$P(BGPALLED(X),U)_U_T_" SN" Q

 .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

 I %]"" Q %

 ;NOW CHECK FOR PATIENT GOAL OF NUTRITION

 S X=0,%=""

 F  S X=$O(^AUPNGOAL("AC",P,X)) Q:X'=+X!(%]"")  D

 .Q:'$D(^AUPNGOAL(X,0))  ;BAD XREF

 .Q:$P(^AUPNGOAL(X,0),U,1)'="S"  ;SET ONLY

 .S G=0

 .S Y=0 F  S Y=$O(^AUPNGOAL(X,10,Y)) Q:Y'=+Y!(G)  D

 ..S Z=$P($G(^AUPNGOAL(X,10,Y,0)),U,1)

 ..I Z,$$VAL^XBDIQ1(9001002.4,Z,.01)="NUTRITION" S G=1

 .Q:'G  ; not nutrition

 .S G=0

 .I $P(^AUPNGOAL(X,0),U,11)="ME" S G=1

 .I $P(^AUPNGOAL(X,0),U,11)="A" S G=1

 .I $P(^AUPNGOAL(X,0),U,11)="MA" S G=1

 .Q:'G

 .;DURING REPORT PERIOD (CREATE OR MODIFIED DATE)

 .S G=0

 .S D=$P($P(^AUPNGOAL(X,0),U,3),".")

 .I D'<BDATE,D'>EDATE S G=1

 .S D=$P($P(^AUPNGOAL(X,0),U,5),".")

 .I D'<BDATE,D'>EDATE S G=1

 .Q:'G

 .S %=$P(^AUPNGOAL(X,0),U,5)

 .I %="" S %=$P(^AUPNGOAL(X,0),U,3)

 .S %=%_U_"Goal Nutrition"

 Q %

 ;

SPECEX(P,BDATE,EDATE) ;EP

 NEW BGPG,BGPALLED,X,T,%,D

 K BGPALLED

 S X=P_"^LAST DX [BGP EXERCISE COUNSELING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")

 I $D(BGPG(1)) Q $P(BGPG(1),U)_U_$P(BGPG(1),U,2)

 S Y="BGPALLED("

 S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 ;I '$D(BGPALLED(1)) Q ""

 S (X,D)=0,%="",T="" F  S X=$O(BGPALLED(X)) Q:X'=+X!(%]"")  D

 .S T=$P(^AUPNVPED(+$P(BGPALLED(X),U,4),0),U)

 .Q:'T

 .Q:'$D(^AUTTEDT(T,0))

 .S T=$P(^AUTTEDT(T,0),U,2)

 .I $P(T,"-",2)="EX" S %=$P(BGPALLED(X),U)_U_T Q

 .S S=$P(T,"-",1)

 .S S=$$ICDDX^BGP4UTL2(S)

 .I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP EXERCISE COUNSELING DXS",0)),9) S %=$P(BGPALLED(X),U)_U_T Q

 I %]"" Q %

 ;NOW CHECK FOR PATIENT GOAL OF NUTRITION

 S X=0,%=""

 F  S X=$O(^AUPNGOAL("AC",P,X)) Q:X'=+X!(%]"")  D

 .Q:'$D(^AUPNGOAL(X,0))  ;BAD XREF

 .Q:$P(^AUPNGOAL(X,0),U,1)'="S"  ;SET ONLY

 .S G=0

 .S Y=0 F  S Y=$O(^AUPNGOAL(X,10,Y)) Q:Y'=+Y!(G)  D

 ..S Z=$P($G(^AUPNGOAL(X,10,Y,0)),U,1)

 ..I Z,$$VAL^XBDIQ1(9001002.4,Z,.01)="PHYSICAL ACTIVITY" S G=1

 .Q:'G  ; not nutrition

 .S G=0

 .I $P(^AUPNGOAL(X,0),U,11)="ME" S G=1

 .I $P(^AUPNGOAL(X,0),U,11)="A" S G=1

 .I $P(^AUPNGOAL(X,0),U,11)="MA" S G=1

 .Q:'G

 .;DURING REPORT PERIOD (CREATE OR MODIFIED DATE)

 .S G=0

 .S D=$P($P(^AUPNGOAL(X,0),U,3),".")

 .I D'<BDATE,D'>EDATE S G=1

 .S D=$P($P(^AUPNGOAL(X,0),U,5),".")

 .I D'<BDATE,D'>EDATE S G=1

 .Q:'G

 .S %=$P(^AUPNGOAL(X,0),U,5)

 .I %="" S %=$P(^AUPNGOAL(X,0),U,3)

 .S %=%_U_"Goal Physical Activity"

 Q %

OTHREL(P,BDATE,EDATE) ;EP

 NEW BGPALLED

 K BGPALLED

 S Y="BGPALLED("

 S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 ;I '$D(BGPALLED(1)) Q ""

 S (X,D)=0,%="",T="" F  S X=$O(BGPALLED(X)) Q:X'=+X!(%]"")  D

 .S T=$P(^AUPNVPED(+$P(BGPALLED(X),U,4),0),U)

 .Q:'T

 .Q:'$D(^AUTTEDT(T,0))

 .S T=$P(^AUTTEDT(T,0),U,2)

 .I $P(T,"-",2)="LA"!($P(T,"-",1)="OBS") S %=$P(BGPALLED(X),U)_U_T Q

 .S S=$P(T,"-",1)

 .S S=$$ICDDX^BGP4UTL2(S)

 .I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP OTHER REL WT EDUC DXS",0)),9) S %=$P(BGPALLED(X),U)_U_T Q

 .I S="S9449"!(S="S9451")!(S="S9452")!(S="S9470") S %=$P(BGPALLED(X),U)_U_T Q

 I % Q %

 ;NOW CHECK V CPT

  S %=$$CPT^BGP4DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP OTHER REL EDUC CPTS",0)),5)

  Q %

MEDNUTRD(P,BDATE,EDATE) ;EP

 K ^TMP($J)

 NEW E,%,X,Y,D,Z,W,BGPG,BGPC

 K BGPG,BGPC

 S E=+$$CODEN^ICPTCOD(97802),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"

 S E=+$$CODEN^ICPTCOD(97803),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97803"

 S E=+$$CODEN^ICPTCOD(97804),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"

 S E=+$$CODEN^ICPTCOD("G0270"),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"

 S E=+$$CODEN^ICPTCOD("G0271"),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"

 ;TRAN CODES

 S E=+$$CODEN^ICPTCOD(97802),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"

 S E=+$$CODEN^ICPTCOD(97803),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)-"^97803"

 S E=+$$CODEN^ICPTCOD(97804),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"

 S E=+$$CODEN^ICPTCOD("G0270"),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"

 S E=+$$CODEN^ICPTCOD("G0271"),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"

 S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 S (X,Y,D)="" F  S X=$O(BGPG(X)) Q:X'=+X!(Y)  D

 .S Z=0 F  S Z=$O(^AUPNVPRV("AD",$P(BGPG(X),U,5),Z)) Q:Z'=+Z!(Y)  D

 ..S W=$P($G(^AUPNVPRV(Z,0)),U,1)

 ..Q:W=""

 ..S R=$$VALI^XBDIQ1(200,W,53.5)

 ..I R="" Q

 ..S R=$P($G(^DIC(7,R,9999999)),U,1)

 ..I R="07"!(R=29),'$$DNKA($P(BGPG(X),U,5)) S Y=1,D=$P(BGPG(X),U)

 I Y Q D_"^Prv "_R

 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)

 I Y Q D_"^Cl "_R

 Q ""

MEDNUTR(P,BDATE,EDATE) ;EP

 K ^TMP($J),BGPG,BGPC

 S E=+$$CODEN^ICPTCOD(97802),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"

 S E=+$$CODEN^ICPTCOD(97803),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97803"

 S E=+$$CODEN^ICPTCOD(97804),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"

 S E=+$$CODEN^ICPTCOD("G0270"),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"

 S E=+$$CODEN^ICPTCOD("G0271"),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"

 ;TRAN CODES

 S E=+$$CODEN^ICPTCOD(97802),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97802"

 S E=+$$CODEN^ICPTCOD(97803),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)-"^97803"

 S E=+$$CODEN^ICPTCOD(97804),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^97804"

 S E=+$$CODEN^ICPTCOD("G0270"),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0270"

 S E=+$$CODEN^ICPTCOD("G0271"),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E) I %]"" Q $P(%,U,2)_"^G0271"

 S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 S (X,Y,D)="" F  S X=$O(BGPG(X)) Q:X'=+X!(Y)  D

 .S Z=0 F  S Z=$O(^AUPNVPRV("AD",$P(BGPG(X),U,5),Z)) Q:Z'=+Z!(Y)  D

 ..S W=$P($G(^AUPNVPRV(Z,0)),U,1)

 ..Q:W=""

 ..S R=$$VALI^XBDIQ1(200,W,53.5)

 ..I R="" Q

 ..S R=$P($G(^DIC(7,R,9999999)),U,1)

 ..I R="07"!(R=29)!(R=97)!(R=99),'$$DNKA($P(BGPG(X),U,5)) S Y=1,D=$P(BGPG(X),U)

 ;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)

 I Y Q D_"^Prv "_R

 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)

 I Y Q D_"^Cl "_R

 Q ""

DNKA(V) ;EP - is this a DNKA visit?

 NEW D,N

 S D=$$PRIMPOV^APCLV(V,"C")

 I D=".0860" Q 1

 S N=$$PRIMPOV^APCLV(V,"N")

 I $E(D)="V",N["DNKA" Q 1

 I $E(D)="V",N["DID NOT KEEP APPOINTMENT" Q 1

 I $E(D)="V",N["DID NOT KEEP APPT" Q 1

 Q 0

PED(P,BDATE,EDATE,FORE) ;EP

 S FORE=$G(FORE)

 NEW BGPALLED,X,Y,%,T,G,A,B,E,Z,BGPLPED

 K BGPALLED

 S BGPLPED=""

 S Y="BGPALLED("

 S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 I $D(BGPALLED(1)) S %="" D  I %]"" S BGPLPED=%

 .S (X,D)=0,T="" F  S X=$O(BGPALLED(X)) Q:X'=+X  D

 ..S T=$P(^AUPNVPED(+$P(BGPALLED(X),U,4),0),U)

 ..Q:'T

 ..Q:'$D(^AUTTEDT(T,0))

 ..S T=$P(^AUTTEDT(T,0),U,2)

 ..I $G(BGPRTYPE)=3,T="TO-M" Q

 ..I $P(T,"-")="TO",$P(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q

 ..I $P(T,"-",2)="TO",$P(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q

 ..I $P(T,"-",2)="SHS",$P(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q

 ..S S=$P(T,"-",1)

 ..S S=$$ICDDX^BGP4UTL2(S)

 ..I $P(S,U,1)'="-1",$$ICD^BGP4UTL2($P(S,U,1),$O(^ATXAX("B","BGP TOBACCO DXS",0)),9) S %=$P(BGPALLED(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(BGPLPED,U)<$P(BGPALLED(X),U) S %=$P(BGPALLED(X),U)_U_T Q

 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)

 ;I '$D(^TMP($J,"A",1)) Q ""

 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(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"Cl 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(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"ADA 1320" Q

 .Q

 ;I G]"" Q G

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT D1320"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("D1320")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN D1320"

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT 99406"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99406)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 99406"

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT 99407"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD(99407)) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 99407"

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G0375"

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G0376"

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT 4000F"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0375")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G0375"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G0376")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G0376"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4000F")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 4000F"

 S G=$$CPTI^BGP4DU(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"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("4001F")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN 4001F"

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G8402"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8402")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G8402"

 S G=$$CPTI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"CPT G8453"

 S G=$$TRANI^BGP4DU(P,BDATE,EDATE,+$$CODEN^ICPTCOD("G8453")) I G,$P(BGPLPED,U)<$P(G,U,2) S BGPLPED=$P(G,U,2)_U_"TRAN G8453"

 ;now check meds - new in 8.0

 K BGPMEDS1

 D GETMEDS^BGP4UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)

 ;I '$D(BGPMEDS1) G PEDREF

 S T=$O(^ATXAX("B","BGP CMS SMOKING CESSATION MEDS",0))

 S T1=$O(^ATXAX("B","BGP CMS SMOKING CESSATION VAPI",0))

 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

 .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 PATCH")!(N["NICOTINE POLACRILEX")!(N["NICOTINE INHALER")!(N["NICOTINE NASAL SPRAY") D

 ..I $P(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N

 .S C=$P($G(^PSDRUG(Z,2)),U,4)

 .I $$VAPI^BGP4D81(Z,T1) I $P(BGPLPED,U)<$P($P(^AUPNVSIT(V,0),U),".") S BGPLPED=$P($P(^AUPNVSIT(V,0),U),".")_U_"CESSATION MED - "_N

 Q BGPLPED

BGP4D711  ; IHS/CMI/LAB - measure C 30 Jun 2010 12:14 PM ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +2       ;

SPECNUTR(P,BDATE,EDATE) ;EP

 +1        NEW BGPALLED,BGPG,X,T,D,%

 +2        KILL BGPALLED,BGPG

 +3        KILL BGPG

           SET X=P_"^LAST DX [BGP DIETARY SURVEILLANCE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)

           SET E=$$START1^APCLDF(X,"BGPG(")

 +4        IF $DATA(BGPG(1))

               QUIT $PIECE(BGPG(1),U)_U_$PIECE(BGPG(1),U,2)

 +5        SET Y="BGPALLED("

 +6        SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)

           SET E=$$START1^APCLDF(X,Y)

 +7       ;I '$D(BGPALLED(1)) Q ""

 +8        SET (X,D)=0

           SET %=""

           SET T=""

           FOR 

               SET X=$ORDER(BGPALLED(X))

               IF X'=+X!(%]"")

                   QUIT 

               Begin DoDot:1

 +9                SET T=$PIECE(^AUPNVPED(+$PIECE(BGPALLED(X),U,4),0),U)

 +10               IF 'T

                       QUIT 

 +11               IF '$DATA(^AUTTEDT(T,0))

                       QUIT 

 +12               SET T=$PIECE(^AUTTEDT(T,0),U,2)

 +13               IF $PIECE(T,"-",2)="N"!($PIECE(T,"-",2)="DT")!($PIECE(T,"-",2)="MNT")

                       SET %=$PIECE(BGPALLED(X),U)_U_T_" SN"

                       QUIT 

 +14               SET S=$PIECE(T,"-",1)

 +15               SET S=$$ICDDX^BGP4UTL2(S)

 +16               IF $PIECE(S,U,1)'="-1"

                       IF $$ICD^BGP4UTL2($PIECE(S,U,1),$ORDER(^ATXAX("B","BGP DIETARY SURVEILLANCE DXS",0)),9)

                           SET %=$PIECE(BGPALLED(X),U)_U_T_" SN"

                           QUIT 

 +17               IF $PIECE(T,"-",1)="97802"!($PIECE(T,"-",1)="97803")!($PIECE(T,"-",1)="97804")!($PIECE(T,"-")="G0270")!($PIECE(T,"-")="G0271")

                       SET %=$PIECE(BGPALLED(X),U)_U_T

                       QUIT 

               End DoDot:1

 +18       IF %]""

               QUIT %

 +19      ;NOW CHECK FOR PATIENT GOAL OF NUTRITION

 +20       SET X=0

           SET %=""

 +21       FOR 

               SET X=$ORDER(^AUPNGOAL("AC",P,X))

               IF X'=+X!(%]"")

                   QUIT 

               Begin DoDot:1

 +22      ;BAD XREF

                   IF '$DATA(^AUPNGOAL(X,0))

                       QUIT 

 +23      ;SET ONLY

                   IF $PIECE(^AUPNGOAL(X,0),U,1)'="S"

                       QUIT 

 +24               SET G=0

 +25               SET Y=0

                   FOR 

                       SET Y=$ORDER(^AUPNGOAL(X,10,Y))

                       IF Y'=+Y!(G)

                           QUIT 

                       Begin DoDot:2

 +26                       SET Z=$PIECE($GET(^AUPNGOAL(X,10,Y,0)),U,1)

 +27                       IF Z

                               IF $$VAL^XBDIQ1(9001002.4,Z,.01)="NUTRITION"

                                   SET G=1

                       End DoDot:2

 +28      ; not nutrition

                   IF 'G

                       QUIT 

 +29               SET G=0

 +30               IF $PIECE(^AUPNGOAL(X,0),U,11)="ME"

                       SET G=1

 +31               IF $PIECE(^AUPNGOAL(X,0),U,11)="A"

                       SET G=1

 +32               IF $PIECE(^AUPNGOAL(X,0),U,11)="MA"

                       SET G=1

 +33               IF 'G

                       QUIT 

 +34      ;DURING REPORT PERIOD (CREATE OR MODIFIED DATE)

 +35               SET G=0

 +36               SET D=$PIECE($PIECE(^AUPNGOAL(X,0),U,3),".")

 +37               IF D'<BDATE

                       IF D'>EDATE

                           SET G=1

 +38               SET D=$PIECE($PIECE(^AUPNGOAL(X,0),U,5),".")

 +39               IF D'<BDATE

                       IF D'>EDATE

                           SET G=1

 +40               IF 'G

                       QUIT 

 +41               SET %=$PIECE(^AUPNGOAL(X,0),U,5)

 +42               IF %=""

                       SET %=$PIECE(^AUPNGOAL(X,0),U,3)

 +43               SET %=%_U_"Goal Nutrition"

               End DoDot:1

 +44       QUIT %

 +45      ;

SPECEX(P,BDATE,EDATE) ;EP

 +1        NEW BGPG,BGPALLED,X,T,%,D

 +2        KILL BGPALLED

 +3        SET X=P_"^LAST DX [BGP EXERCISE COUNSELING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)

           SET E=$$START1^APCLDF(X,"BGPG(")

 +4        IF $DATA(BGPG(1))

               QUIT $PIECE(BGPG(1),U)_U_$PIECE(BGPG(1),U,2)