BGP6D7.m

BGP6D7 ; IHS/CMI/LAB - measure 31 06 Nov 2014 2:31 PM ; 

 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

I18 ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPXPHD,BGP1320)=0

 I BGPAGEB<5 S BGPSTOP=1 Q

 I BGPACTUP S BGPD1=1

 I BGPAGEB>4,BGPAGEB<14 S BGPD2=1

 I BGPAGEB>13,BGPAGEB<18 S BGPD3=1

 I BGPAGEB>17,BGPAGEB<25 S BGPD4=1

 I BGPAGEB>24,BGPAGEB<45 S BGPD5=1

 I BGPAGEB>44,BGPAGEB<65 S BGPD6=1

 I BGPAGEB>64 S BGPD7=1

 I BGPSEX="F",$$PREG(DFN,$$FMADD^XLFDT(BGPEDATE,-608),BGPEDATE,1,1,"",BGPBDATE,BGPEDATE) S BGPD8=1

 I '(BGPD1+BGPD2+BGPD3+BGPD4+BGPD5+BGPD6+BGPD7+BGPD8) S BGPSTOP=1 Q

 S BGP20M=$$FMADD^XLFDT(BGPEDATE,-608)

TA ;EP - called from elder

 S BGPTOB=$$TOBHF^BGP6D712(DFN,BGPBDATE,BGPEDATE)  ;get last HF from the 3 categories

 S BGPSDX=$$DX(DFN,BGPBDATE,BGPEDATE)

 S BGPUDX=$$DXU(DFN,BGPBDATE,BGPEDATE)

 S BGPSMDX=$$DXS(DFN,BGPBDATE,BGPEDATE)

 S BGPSLDX=$$DXSL(DFN,BGPBDATE,BGPEDATE)

 S BGPXPHD=$$PED(DFN,BGPBDATE,BGPEDATE)

 S BGP1320=$$DENT(DFN,BGPBDATE,BGPEDATE)

 S BGPSCPT=$$CPTSM(DFN,BGPBDATE,BGPEDATE)

 S BGPN1=$S(BGPTOB]"":1,1:0)

 I BGPSDX]"" S BGPN1=1

 I BGPSLDX]"" S BGPN1=1

 I BGPXPHD]"" S BGPN1=1

 I BGP1320]"" S BGPN1=1

 I BGPSCPT]"" S BGPN1=1

 I BGPUDX]"" S BGPN1=1

 I BGPSMDX]"" S BGPN1=1

 S (BGPVALUE,BGPVAL)=""

 I 'BGPN1 G TAEND

 S F=BGPTOB

 D

 .I $P(F,U,1)["CURRENT"!($P(F,U,1)["CESSATION")!($P(F,U,1)["HEAVY TOBACCO SMOKER")!($P(F,U,1)["LIGHT TOBACCO SMOKER") S BGPN2=1,BGPVAL=$P(BGPTOB,U,2)_" SCREEN, "_$P(BGPTOB,U,2)_" USER" Q  ;SMOKING CATEGORY

 .I $P(F,U,4)["CURRENT"!($P(F,U,4)["CESSATION") S BGPN2=1,BGPVAL=$P(BGPTOB,U,5)_" SCREEN, "_$P(BGPTOB,U,5)_" USER" Q  ;SMOKELESS CATEGORY

 .I BGPUDX]"" S BGPN2=1,BGPVAL=$$DATE^BGP6UTL($P(BGPUDX,U,2))_" SCREEN, "_$$DATE^BGP6UTL($P(BGPUDX,U,2))_" USER" Q

 .I BGPSMDX]"" S BGPN2=1,BGPVAL=$$DATE^BGP6UTL($P(BGPSMDX,U,2))_" SCREEN, "_$$DATE^BGP6UTL($P(BGPSMDX,U,2))_" USER" Q

 .I BGPSLDX]"" S BGPN2=1,BGPVAL=$$DATE^BGP6UTL($P(BGPSLDX,U,2))_" SCREEN, "_$$DATE^BGP6UTL($P(BGPSLDX,U,2))_" USER" Q

 .I ($P(BGPSCPT,U)="1034F")!($P(BGPSCPT,U)="1035F")!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407)!($P(BGPSCPT,U)="G9276") D  Q

 ..S BGPN2=1,BGPVAL=$$DATE^BGP6UTL($P(BGPSCPT,U,2))_" SCREEN, "_$$DATE^BGP6UTL($P(BGPSCPT,U,2))_" USER" Q

 .I $P(BGPSCPT,U)=99406!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8456")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") S BGPN2=1,BGPVAL=$$DATE^BGP6UTL($P(BGPSCPT,U,2))_" SCREEN, "_$$DATE^BGP6UTL($P(BGPSCPT,U,2))_" USER" Q

 ;BGPN3 - SMOKER OR NOT

 D

 .I $P(F,U,1)["CURRENT SMOKER"!($P(F,U,1)="CESSATION-SMOKER")!($P(F,U,1)["HEAVY TOBACCO SMOKER")!($P(F,U,1)["LIGHT TOBACCO SMOKER") S BGPN3=1,BGPVAL=BGPVAL_", "_$P(F,U,2)_" SMOKER" Q

 .I BGPSMDX]"" S BGPN3=1,BGPVAL=BGPVAL_", "_$$DATE^BGP6UTL($P(BGPSMDX,U,2))_" SMOKER" Q

 .I $P(BGPSCPT,U)="1034F"!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407)!($P(BGPSCPT,U)=99406)!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") D

 ..S BGPN3=1,BGPVAL=BGPVAL_", "_$$DATE^BGP6UTL($P(BGPSCPT,U,2))_" SMOKER" Q

 ;BGPN4 - SMOKELESS

 D

 .I $P(F,U,4)="CURRENT SMOKELESS"!($P(F,U,4)="CURRENT SMOKER & SMOKELESS")!($P(F,U,4)="CESSATION-SMOKELESS") S BGPN4=1,BGPVAL=BGPVAL_", "_$P(F,U,5)_" SMOKELESS" Q

 .I $P(BGPSCPT,U)="1035F"!($P(BGPSCPT,U)="G8456") S BGPN4=1,BGPVAL=BGPVAL_", "_$$DATE^BGP6UTL($P(BGPSCPT,U,2))_" SMOKELESS" Q

 .I BGPSLDX]"" S BGPN4=1,BGPVAL=BGPVAL_", "_$$DATE^BGP6UTL($P(BGPSLDX,U,2))_" SMOKELESS" Q

 ;BGPN5 - ETS

 I $P(F,U,7)="SMOKER IN HOME"!($P(F,U,7)["ENVIRON") S BGPN5=1,BGPVAL=$S(BGPVAL["SCREEN":BGPVAL_", "_$P(F,U,8)_" ETS",1:$P(BGPTOB,U,8)_" SCREEN, ETS")

 I BGPN1,BGPVAL="" D

 .I BGPTOB]"" S BGPVAL=$S($P(BGPTOB,U,2)]"":$P(BGPTOB,U,2)_" SCREEN",$P(BGPTOB,U,5)]"":$P(BGPTOB,U,5)_" SCREEN",$P(BGPTOB,U,8)]"":$P(BGPTOB,U,8)_" SCREEN",1:"") Q

 .I BGPSDX]"" S BGPVAL=$$DATE^BGP6UTL($P(BGPSDX,U,2))_" SCREEN" Q

 .I BGPSCPT]"" S BGPVAL=$$DATE^BGP6UTL($P(BGPSCPT,U,2))_" SCREEN" Q

 .I BGPXPHD]"" S BGPVAL=$$DATE^BGP6UTL($P(BGPXPHD,U,2))_" SCREEN" Q

 .I BGP1320]"" S BGPVAL=$$DATE^BGP6UTL($P(BGP1320,U,2))_" SCREEN" Q

 S V=$S(BGPD1:"UP",1:"")_$S(BGPACTCL:",AC",1:"")_$S(BGPD8:",PREG",1:"")

 S BGPVALUE=V_"|||"_BGPVAL

 ;

TAEND ;now check pregnancy if necessary

 S V=$S(BGPD1:"UP",1:"")_$S(BGPACTCL:",AC",1:"")_$S(BGPD8:",PREG",1:"")

 S BGPVALUE=V_"|||"_BGPVAL

 I BGPRTYPE'=5,BGPD8,'BGPN1 D PREGSCRN

 K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,BGPSDX,BGPXPHD,BGP1320,BGP20M

 K ^TMP($J,"A")

 Q

 ;

PREGSCRN ;

 G PREGSCRN^BGP6D713

 ;

I023 ;EP - PHN

 K BGPN1,BGPN2,BGPN3,BGPN4,BGPVALUE

 I 'BGPACTUP S BGPSTOP=1 Q

 S (BGPN1,BGPN2)=0

 S BGPVALUE=$$PHNV(DFN,BGP365,BGPEDATE,BGPHOME)

 S BGPN1=BGPVALUE

 S BGPVALUE="UP|||"_$P(BGPVALUE,U)_" all PHN; "_$P(BGPVALUE,U,2)_" home; "_$P(BGPVALUE,U,12)_" driver all; "_$P(BGPVALUE,U,13)_" driver home"

 K ^TMP($J,"A")

 Q

PHNV(P,BDATE,EDATE,HOMELOC) ;

 S HOMELOC=$G(HOMELOC)

 K ^TMP($J,"A") S A="^TMP($J,""A"","

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

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

 S (X,Y)=0,C="0^0^0^0^0^0^0^0^0^0^0^0^0" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X  S V=$P(^TMP($J,"A",X),U,5) D

 .;S Y=0 I $$CLINIC^APCLV(V,"C")=45 S Y=1 Q

 .S (D,Y,Z)=0

 .F  S D=$O(^AUPNVPRV("AD",V,D)) Q:D'=+D  S Q=$P(^AUPNVPRV(D,0),U) D

 ..Q:Q=""

 ..S %=$$VALI^XBDIQ1($S($P(^DD(9000010.06,.01,0),U,2)["200":200,1:6),Q,$S($P(^DD(9000010.06,.01,0),U,2)["200":53.5,1:2))

 ..I % S %=$P($G(^DIC(7,+%,9999999)),U)

 ..I %'=13,%'=91 Q  ;not a phn or driver

 ..S $P(C,U,1)=$P(C,U,1)+1

 ..I %=91 S $P(C,U,12)=$P(C,U,12)+1

 ..D HOME

 ..D AGE

 Q C

 ;

HOME ;

 S HV=0

 I $$CLINIC^APCLV(V,"C")=11 S $P(C,U,2)=$P(C,U,2)+1,HV=1 S:%=91 $P(C,U,13)=$P(C,U,13)+1 Q

 Q:HOMELOC=""

 I HOMELOC=$P(^AUPNVSIT(V,0),U,6) S $P(C,U,2)=$P(C,U,2)+1,HV=1 S:%=91 $P(C,U,13)=$P(C,U,13)+1 Q

 Q

AGE ;

 S DAYS=$$FMDIFF^XLFDT($P($P(^AUPNVSIT(V,0),U),"."),$P(^DPT(P,0),U,3))

 S YRS=$$AGE^AUPNPAT(P,$P($P(^AUPNVSIT(V,0),U),"."))

 I DAYS<29 S $P(C,U,3)=$P(C,U,3)+1 S:HV=1 $P(C,U,4)=$P(C,U,4)+1 Q

 I DAYS>28,YRS<1 S $P(C,U,5)=$P(C,U,5)+1 S:HV=1 $P(C,U,6)=$P(C,U,6)+1 Q

 I YRS>0,YRS<65 S $P(C,U,7)=$P(C,U,7)+1 S:HV=1 $P(C,U,8)=$P(C,U,8)+1 Q

 I YRS>64 S $P(C,U,9)=$P(C,U,9)+1 S:HV=1 $P(C,U,10)=$P(C,U,10)+1 Q

 W BGPBOMB

 Q

DENT(P,BDATE,EDATE) ;EP

 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,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S V=$P(^TMP($J,"A",X),U,5) D

 .Q:V']""

 .Q:'$D(^AUPNVSIT(V,0))

 .Q:'$P(^AUPNVSIT(V,0),U,9)

 .Q:$P(^AUPNVSIT(V,0),U,11)

 .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 S G=1_U_$P($P(^AUPNVSIT(V,0),U),".")

 .Q

 I G=0 Q ""

 Q "ADA 1320"_U_$P(G,U,2)

PED(P,BDATE,EDATE) ;EP

 NEW BGPG,S,SN,Y,E,X,D,T

 K BGPG

 S Y="BGPG("

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

 I '$D(BGPG) Q ""

 S SN=$O(^BGPSNOMM("B","TOBACCO SCREEN PATIENT ED",0))

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

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

 .Q:'T

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

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

 .I $P(T,"-")="TO" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-",2)="TO" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-",2)="SHS" S %=T_U_$P(BGPG(X),U) Q

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

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

 .I $P(S,U,1)'="-1",$$ICD^BGP6UTL2($P(S,U,1),$O(^ATXAX("B","BGP TOBACCO DXS",0)),9) S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="D1320" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="99406" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="99407" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G0375" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G0376" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="1034F" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="1035F" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="1036F" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="1000F" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G8455" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G8456" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G8457" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G8402" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G8453" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G9276" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")="G9275" S %=T_U_$P(BGPG(X),U) Q

 .I $P(T,"-")]"",$D(^BGPSNOMM(SN,11,"B",$P(T,"-"))) S %=T_U_$P(BGPG(X),U) Q

 Q %

PREG(P,BDATE,EDATE,NORXCHR,NORX,FORM,CPBD,CPED) ;EP

 G PREG^BGP6D714

 ;

DX(P,BDATE,EDATE) ;EP  - WAS THERE SCREENING?

 K BGPG

 S BGPG(1)=$$LASTDX^BGP6UTL1(P,"BGP TOBACCO DXS",BDATE,EDATE)

 I BGPG(1)]"" Q $P($$ICDDX^BGP6UTL2($P(BGPG(1),U,4),$P(BGPG(1),U,1)),U,2)_U_$P(BGPG(1),U,3)_U_$P(BGPG(1),U,4)

 S T=$O(^ATXAX("B","BGP TOBACCO DXS",0))

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

 .Q:$P(^AUPNPROB(X,0),U,12)="I"

 .Q:$P(^AUPNPROB(X,0),U,12)="D"

 .Q:$P(^AUPNPROB(X,0),U,3)>EDATE

 .Q:$P(^AUPNPROB(X,0),U,3)<BDATE

 .S Y=$P(^AUPNPROB(X,0),U)

 .Q:'$$ICD^BGP6UTL2(Y,T,9)

 .S G=$P($$ICDDX^BGP6UTL2(Y),U,2)_U_$P(^AUPNPROB(X,0),U,3)_U_Y

 .Q

 Q G

DXSL(P,BDATE,EDATE) ;EP - WAS THERE A SMOKELESS USER DX?

 K BGPG

 S BGPG(1)=$$LASTDX^BGP6UTL1(P,"BGP GPRA SMOKELESS DXS",BDATE,EDATE)

 I BGPG(1)]"" Q $P($$ICDDX^BGP6UTL2($P(BGPG(1),U,4),$P(BGPG(1),U,1)),U,2)_U_$P(BGPG(1),U,3)_U_$P(BGPG(1),U,4)

 S T=$O(^ATXAX("B","BGP GPRA SMOKELESS DXS",0))

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

 .Q:$P(^AUPNPROB(X,0),U,12)="I"

 .Q:$P(^AUPNPROB(X,0),U,12)="D"

 .Q:$P(^AUPNPROB(X,0),U,3)>EDATE

 .Q:$P(^AUPNPROB(X,0),U,3)<BDATE

 .S Y=$P(^AUPNPROB(X,0),U)

 .Q:'$$ICD^BGP6UTL2(Y,T,9)

 .S G=$P($$ICDDX^BGP6UTL2(Y),U,2)_U_$P(^AUPNPROB(X,0),U,3)_U_Y

 .Q

 Q G

DXU(P,BDATE,EDATE) ;EP - WAS THERE A USER DX?

 K BGPG

 S BGPG(1)=$$LASTDX^BGP6UTL1(P,"BGP TOBACCO USER DXS",BDATE,EDATE)

 I BGPG(1)]"" Q $P($$ICDDX^BGP6UTL2($P(BGPG(1),U,4),$P(BGPG(1),U,1)),U,2)_U_$P(BGPG(1),U,3)_U_$P(BGPG(1),U,4)

 S T=$O(^ATXAX("B","BGP TOBACCO USER DXS",0))

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

 .Q:$P(^AUPNPROB(X,0),U,12)="I"

 .Q:$P(^AUPNPROB(X,0),U,12)="D"

 .Q:$P(^AUPNPROB(X,0),U,3)>EDATE

 .Q:$P(^AUPNPROB(X,0),U,3)<BDATE

 .S Y=$P(^AUPNPROB(X,0),U)

 .Q:'$$ICD^BGP6UTL2(Y,T,9)

 .S G=$P($$ICDDX^BGP6UTL2(Y),U,2)_U_$P(^AUPNPROB(X,0),U,3)_U_Y

 .Q

 Q G

DXS(P,BDATE,EDATE) ;EP - WAS THERE A SMOKING USER DX?

 K BGPG

 S BGPG(1)=$$LASTDX^BGP6UTL1(P,"BGP GPRA SMOKING DXS",BDATE,EDATE)

 I BGPG(1)]"" Q $P($$ICDDX^BGP6UTL2($P(BGPG(1),U,4),$P(BGPG(1),U,1)),U,2)_U_$P(BGPG(1),U,3)_U_$P(BGPG(1),U,4)

 S T=$O(^ATXAX("B","BGP GPRA SMOKING DXS",0))

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

 .Q:$P(^AUPNPROB(X,0),U,12)="I"

 .Q:$P(^AUPNPROB(X,0),U,12)="D"

 .Q:$P(^AUPNPROB(X,0),U,3)>EDATE

 .Q:$P(^AUPNPROB(X,0),U,3)<BDATE

 .S Y=$P(^AUPNPROB(X,0),U)

 .Q:'$$ICD^BGP6UTL2(Y,T,9)

 .S G=$P($$ICDDX^BGP6UTL2(Y),U,2)_U_$P(^AUPNPROB(X,0),U,3)_U_Y

 .Q

 Q G

TOBACCO(P,BDATE,EDATE,CESSIN) ;EP - USED FOR TOBACCO SCREEN ONLY

 K BGPTOB,BGP

 S CESSIN=$G(CESSIN)

 D TOBACCO1

 I BGPTOB]"" Q BGPTOB

 D TOBACCO0

 I $D(BGPTOB) Q BGPTOB

 Q ""

TOBACCO1 ;check for tobacco documented in health factors

 K BGPTOB

 S BGPTOB=$$LASTHF(P,"TOBACCO (SMOKING)",BDATE,EDATE) K O,D,H

 Q:BGPTOB]""

 S BGPTOB=$$LASTHF(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE) K O,D,H

 Q:BGPTOB]""

 I 'CESSIN S BGPTOB=$$LASTHF(P,"TOBACCO (EXPOSURE)",BDATE,EDATE) K O,D,H

 Q:BGPTOB]""

 S BGPTOB=$$LASTHF(P,"TOBACCO",BDATE,EDATE) K O,D,H

 Q

TOBACCO0 ;lookup in health status

 S (X,Y)=0 F  S X=$O(^AUPNHF("AA",P,X)) Q:X'=+X!(Y)  I $$VAL^XBDIQ1(9999999.64,X,.03)="TOBACCO" S Y=X

 Q:'Y

 S E=$O(^AUPNHF("AA",P,Y,0)) Q:'E

 I (9999999-E)>EDATE Q  ;documented after time frame

 I (9999999-E)<BDATE Q  ;documented before year

 S Y=$P(^AUTTHF(Y,0),U)

 S BGPTOB=Y_"^"_$$DATE^BGP6UTL(9999999-E)_"^"_(9999999-E)

 K Y,E,X

 Q

 ;

LASTHF(P,C,BDATE,EDATE) ;EP - get last factor in category C for patient P

 S C=$O(^AUTTHF("B",C,0)) ;ien of category passed

 I '$G(C) Q ""

 S (H,D)=0 K O

 F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D

 .Q:'$D(^AUPNVHF("AA",P,H))

 .S D="" F  S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D  D

 ..Q:(9999999-D)>EDATE  ;after time frame

 ..Q:(9999999-D)<BDATE  ;before time frame

 ..S O(D)=$O(^AUPNVHF("AA",P,H,D,""))

 .Q

 S D=$O(O(0))

 I D="" Q D

 Q $$VAL^XBDIQ1(9000010.23,O(D),.01)_"^"_$$DATE^BGP6UTL(9999999-D)_"^"_(9999999-D)

 ;

LOINC(A,B) ;

 NEW %

 S %=$P($G(^LAB(95.3,A,9999999)),U,2)

 I %]"",$D(^ATXAX(B,21,"B",%)) Q 1

 S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)

 I $D(^ATXAX(B,21,"B",%)) Q 1

 Q ""

 ;

CPTSM(P,BDATE,EDATE) ;EP - did pat have TOBACCO SCREENING cpt?

 NEW X

 S X=$$CPT^BGP6DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP TOBACCO SCREEN CPTS",0)),5)

 I X]"" Q $P(X,U,2)_U_$P(X,U,1)

 Q ""

BGP6D7    ; IHS/CMI/LAB - measure 31 06 Nov 2014 2:31 PM ; 

 +1       ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

I18       ;EP

 +1        SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPXPHD,BGP1320)=0

 +2        IF BGPAGEB<5

               SET BGPSTOP=1

               QUIT 

 +3        IF BGPACTUP

               SET BGPD1=1

 +4        IF BGPAGEB>4

               IF BGPAGEB<14

                   SET BGPD2=1

 +5        IF BGPAGEB>13

               IF BGPAGEB<18

                   SET BGPD3=1

 +6        IF BGPAGEB>17

               IF BGPAGEB<25

                   SET BGPD4=1

 +7        IF BGPAGEB>24

               IF BGPAGEB<45

                   SET BGPD5=1

 +8        IF BGPAGEB>44

               IF BGPAGEB<65

                   SET BGPD6=1

 +9        IF BGPAGEB>64

               SET BGPD7=1

 +10       IF BGPSEX="F"

               IF $$PREG(DFN,$$FMADD^XLFDT(BGPEDATE,-608),BGPEDATE,1,1,"",BGPBDATE,BGPEDATE)

                   SET BGPD8=1

 +11       IF '(BGPD1+BGPD2+BGPD3+BGPD4+BGPD5+BGPD6+BGPD7+BGPD8)

               SET BGPSTOP=1

               QUIT 

 +12       SET BGP20M=$$FMADD^XLFDT(BGPEDATE,-608)

TA        ;EP - called from elder

 +1       ;get last HF from the 3 categories

           SET BGPTOB=$$TOBHF^BGP6D712(DFN,BGPBDATE,BGPEDATE)

 +2        SET BGPSDX=$$DX(DFN,BGPBDATE,BGPEDATE)

 +3        SET BGPUDX=$$DXU(DFN,BGPBDATE,BGPEDATE)

 +4        SET BGPSMDX=$$DXS(DFN,BGPBDATE,BGPEDATE)

 +5        SET BGPSLDX=$$DXSL(DFN,BGPBDATE,BGPEDATE)

 +6        SET BGPXPHD=$$PED(DFN,BGPBDATE,BGPEDATE)

 +7        SET BGP1320=$$DENT(DFN,BGPBDATE,BGPEDATE)

 +8        SET BGPSCPT=$$CPTSM(DFN,BGPBDATE,BGPEDATE)

 +9        SET BGPN1=$SELECT(BGPTOB]"":1,1:0)

 +10       IF BGPSDX]""

               SET BGPN1=1

 +11       IF BGPSLDX]""

               SET BGPN1=1

 +12       IF BGPXPHD]""

               SET BGPN1=1

 +13       IF BGP1320]""

               SET BGPN1=1

 +14       IF BGPSCPT]""

               SET BGPN1=1

 +15       IF BGPUDX]""

               SET BGPN1=1

 +16       IF BGPSMDX]""

               SET BGPN1=1

 +17       SET (BGPVALUE,BGPVAL)=""

 +18       IF 'BGPN1

               GOTO TAEND

 +19       SET F=BGPTOB

 +20       Begin DoDot:1

 +21      ;SMOKING CATEGORY

               IF $PIECE(F,U,1)["CURRENT"!($PIECE(F,U,1)["CESSATION")!($PIECE(F,U,1)["HEAVY TOBACCO SMOKER")!($PIECE(F,U,1)["LIGHT TOBACCO SMOKER")

                   SET BGPN2=1

                   SET BGPVAL=$PIECE(BGPTOB,U,2)_" SCREEN, "_$PIECE(BGPTOB,U,2)_" USER"

                   QUIT 

 +22      ;SMOKELESS CATEGORY

               IF $PIECE(F,U,4)["CURRENT"!($PIECE(F,U,4)["CESSATION")

                   SET BGPN2=1

                   SET BGPVAL=$PIECE(BGPTOB,U,5)_" SCREEN, "_$PIECE(BGPTOB,U,5)_" USER"

                   QUIT 

 +23           IF BGPUDX]""

                   SET BGPN2=1

                   SET BGPVAL=$$DATE^BGP6UTL($PIECE(BGPUDX,U,2))_" SCREEN, "_$$DATE^BGP6UTL($PIECE(BGPUDX,U,2))_" USER"

                   QUIT 

 +24           IF BGPSMDX]""

                   SET BGPN2=1

                   SET BGPVAL=$$DATE^BGP6UTL($PIECE(BGPSMDX,U,2))_" SCREEN, "_$$DATE^BGP6UTL($PIECE(BGPSMDX,U,2))_" USER"

                   QUIT 

 +25           IF BGPSLDX]""

                   SET BGPN2=1

                   SET BGPVAL=$$DATE^BGP6UTL($PIECE(BGPSLDX,U,2))_" SCREEN, "_$$DATE^BGP6UTL($PIECE(BGPSLDX,U,2))_" USER"

                   QUIT 

 +26           IF ($PIECE(BGPSCPT,U)="1034F")!($PIECE(BGPSCPT,U)="1035F")!($PIECE(BGPSCPT,U)="G0376")!($PIECE(BGPSCPT,U)="G0375")!($PIECE(BGPSCPT,U)=99407)!($PIECE(BGPSCPT,U)="G9276")

                   Begin DoDot:2

 +27                   SET BGPN2=1

                       SET BGPVAL=$$DATE^BGP6UTL($PIECE(BGPSCPT,U,2))_" SCREEN, "_$$DATE^BGP6UTL($PIECE(BGPSCPT,U,2))_" USER"

                       QUIT 

                   End DoDot:2

                   QUIT 

 +28           IF $PIECE(BGPSCPT,U)=99406!($PIECE(BGPSCPT,U)="G8455")!($PIECE(BGPSCPT,U)="G8456")!($PIECE(BGPSCPT,U)="G8402")!($PIECE(BGPSCPT,U)="G8453")

                   SET BGPN2=1

                   SET BGPVAL=$$DATE^BGP6UTL($PIECE(BGPSCPT,U,2))_" SCREEN, "_$$DATE^BGP6UTL($PIECE(BGPSCPT,U,2))_" USER"

                   QUIT 

           End DoDot:1

 +29      ;BGPN3 - SMOKER OR NOT

 +30       Begin DoDot:1

 +31           IF $PIECE(F,U,1)["CURRENT SMOKER"!($PIECE(F,U,1)="CESSATION-SMOKER")!($PIECE(F,U,1)["HEAVY TOBACCO SMOKER")!($PIECE(F,U,1)["LIGHT TOBACCO SMOKER")

                   SET BGPN3=1

                   SET BGPVAL=BGPVAL_", "_$PIECE(F,U,2)_" SMOKER"

                   QUIT 

 +32           IF BGPSMDX]""

                   SET BGPN3=1

                   SET BGPVAL=BGPVAL_", "_$$DATE^BGP6UTL($PIECE(BGPSMDX,U,2))_" SMOKER"

                   QUIT 

 +33           IF $PIECE(BGPSCPT,U)="1034F"!($PIECE(BGPSCPT,U)="G0376")!($PIECE(BGPSCPT,U)="G0375")!($PIECE(BGPSCPT,U)=99407)!($PIECE(BGPSCPT,U)=99406)!($PIECE(BGPSCPT,U)="G8455")!($PIECE(BGPSCPT,U)="G8402")!($PIECE(BGPSCPT,U)="G8453")