BGP5D24.m

BGP5D24 ; IHS/CMI/LAB - STI MEASURE 18 Oct 2009 8:37 AM 03 Jul 2010 7:56 AM ;

 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143

 ;

STI ;EP

 D EN^BKMSTIDS(DFN,BGPBDATE,BGPEDATE,"KEY",.BGPYAR,.BGPZAR)

 Q

ISTI ;EP

 NEW BGPCIN

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN15,BGPN16,BGPN17,BGPN18,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0

 S BGPVALUE="",BGPDENV=""

 K BGPYAR,BGPZAR,BGPNUMV

 I $T(EN^BKMSTIDS)="" S BGPSTOP=1 Q  ;no routine to execute

 ; BGPTIME=1 ZW  

 ;D EN^XBNEW("STI^BGP5D24","DFN;BGPBDATE;BGPEDATE;BGPYAR;BGPZAR")

 D EN^BKMSTIDS(DFN,BGPBDATE,BGPEDATE,"KEY",.BGPYAR,.BGPZAR)

 I '$D(BGPZAR) S BGPSTOP=1 Q  ;no incidences or diagnoses

 I $P($G(BGPZAR(0)),U)=0 S BGPSTOP=1 Q  ;no incidences or diagnoses

 S (BGPN1,BGPN2)=$P(BGPZAR(0),U,1)  ;TOTAL # OF INCIDENCES

 S BGPD1=$P(BGPZAR(0),U,2) ;TOTAL # SCREENINGS NEEDED

 S BGPN3=$P(BGPZAR(0),U,3) ;TOTAL # OF SCREENINGS DONE

 S BGPN4=$P(BGPZAR(0),U,4) ;TOTAL # OF REFUSALS

 S BGPN15=$P(BGPZAR(0),U,5)  ;NEW GROUPED DEN

 S BGPN16=$P(BGPZAR(0),U,6)  ;NEW GROUPED NUM

 S BGPN17=$P(BGPZAR(0),U,7)  ;NEW GROUPED REF

 S BGPCIN=0

 S X=0 F  S X=$O(BGPZAR(X)) Q:X'=+X  D

 .S BGPCIN=BGPCIN+1

 .S:BGPDENV]"" BGPDENV=BGPDENV_"; "

 .S BGPNUMV(X)=""

 .S I=0,C=0,BGPHXX="" F  S I=$O(BGPZAR(X,I)) Q:I=""  D

 ..I $D(BGPZAR(X,I,0)) S C=C+1 S BGPDENV=BGPDENV_$S(C=1:BGPCIN_") ",1:", ")_$P(BGPZAR(X,I,0),U,5)

 ..I $G(BGPYAR(I,"NUM","HIV"))=1 S BGPHXX=$O(BGPYAR(I,"NUM","HIV",0)) I BGPHXX S J=$P(BGPYAR(I,"NUM","HIV",BGPHXX),U,2) I J'["POV" S BGPHXX=""

 ..;I BGPHXX S BGPN18=1

 .D

 ..;I $G(BGPZAR(X,"CHL"))]"" S Z=$G(BGPZAR(X,"CHL")) S:$P(Z,U) BGPD2=BGPD2+1 S:$P(Z,U,2) BGPN5=BGPN5+1 S:$P(Z,U,3) BGPN6=BGPN6+1 D

 ..;.S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"CHL-"_$S($P(Z,U,2):"Y",1:"N")_$S($P(Z,U,4)]"":" "_$P(Z,U,4),1:"") ;_"; " ;CHL SCREENINGS NEEDED/DONE

 ..;I $G(BGPZAR(X,"GC"))]"" S Z=$G(BGPZAR(X,"GC")) S:$P(Z,U) BGPD3=BGPD3+1 S:$P(Z,U,2) BGPN7=BGPN7+1 S:$P(Z,U,3) BGPN8=BGPN8+1 D

 ..;.S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"GC-"_$S($P(Z,U,2):"Y",1:"N")_$S($P(Z,U,4)]"":" "_$P(Z,U,4),1:"") ;_"; " ;GON SCREENINGS NEEDED/DONE

 ..I $G(BGPZAR(X,"HIV"))]"" S Z=$G(BGPZAR(X,"HIV")) S:$P(Z,U) BGPD4=BGPD4+1 S:$P(Z,U,2) BGPN9=BGPN9+1 S:$P(Z,U,3) BGPN10=BGPN10+1 D

 ...S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", "

 ...S H=0,I="" S:'($P(Z,U,1)+$P(Z,U,2)) H=1,I="Contraind Prior DX",BGPN18=1

 ...S BGPNUMV(X)=BGPNUMV(X)_"HIV-"_$S($P(Z,U,2):"Y",H:I,1:"N")_$S($P(Z,U,4)]"":" "_$P(Z,U,4),1:"") ;_"; " ;HIV SCREENINGS NEEDED/DONE

 ..;I $G(BGPZAR(X,"SYP"))]"" S Z=$G(BGPZAR(X,"SYP")) S:$P(Z,U) BGPD5=BGPD5+1 S:$P(Z,U,2) BGPN11=BGPN11+1 S:$P(Z,U,3) BGPN12=BGPN12+1 D

 ..;.S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"SYP-"_$S($P(Z,U,2):"Y",1:"N")_$S($P(Z,U,4)]"":" "_$P(Z,U,4),1:"") ;_"; " ;SYP SCREENINGS NEEDED/DONE

 .;I H]"" S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"Prior HIV DX (Contraind): "_$$DATE^BGP5UTL(H)

 .S BGPVALUE="UP"_$S(BGPACTCL:";AC",1:"")_" Visit "_BGPDENV_"|||"

 S BGPCIN=0 S X=0 F  S X=$O(BGPNUMV(X)) Q:X'=+X  S BGPCIN=BGPCIN+1 S BGPVALUE=BGPVALUE_$S(BGPCIN>1:"; ",1:"")_BGPCIN_") "_$S(BGPNUMV(X)="":"N/A",1:BGPNUMV(X))

 Q

 ;

IASB ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0

 S BGPVALUE=""

 I 'BGPACTUP S BGPSTOP=1 Q

 I BGPAGEB<15 S BGPSTOP=1 Q

 I BGPAGEB>34 S BGPSTOP=1 Q

 K BGPERV  ;will return array of all er visits with injury diagnosis fm date^injury dx^screen^positive^text^bni^bni text

 D ERINJ(DFN,BGPBDATE,BGPEDATE,.BGPERV)

 I '$G(BGPERV(0)) S BGPSTOP=1 Q  ;no injury visits

 S BGPD1=BGPERV(0)  ;total # of visits

 I BGPAGEB>14,BGPAGEB<25 S BGPD2=BGPERV(0)

 I BGPAGEB>24,BGPAGEB<35 S BGPD3=BGPERV(0)

 S X=0,BGPN1=0 F  S X=$O(BGPERV(X)) Q:X'=+X  I $P(BGPERV(X),U,4) S BGPN1=BGPN1+1  ;SCREEN ON EVERY VISIT?

 S X=0,BGPN2=0 F  S X=$O(BGPERV(X)) Q:X'=+X  I $P(BGPERV(X),U,5) S BGPN2=BGPN2+1  ;positive on at least one

 I BGPN2 S X=0,BGPN3=0 F  S X=$O(BGPERV(X)) Q:X'=+X  D

 .I $P(BGPERV(X),U,5),$P(BGPERV(X),U,7) S BGPN3=BGPN3+1

 I BGPN3 S X=0 F  S X=$O(BGPERV(X)) Q:X'=+X  I $P(BGPERV(X),U,5) S:$P(BGPERV(X),U,10)=1 BGPN4=BGPN4+1 S:$P(BGPERV(X),U,10)=2 BGPN5=BGPN5+1

 S BGPVALUE="UP"_$S(BGPACTCB:",AC+BH",1:"")

 S V="",X=0,D="" F  S X=$O(BGPERV(X)) Q:X'=+X  S D=D_$S(D]"":"; ",1:"")_"ER "_X_") "_$$DATE^BGP5UTL($P(BGPERV(X),U,1))_" POV "_$P(BGPERV(X),U,3) D

 .;S V=V_$S(V]"":"; ",1:"")

 .;S V=V_"ER Visit "_X_") "

 .I '$P(BGPERV(X),U,4) S D=D_", SCREEN: None" Q

 .S D=D_$S($P(BGPERV(X),U,5):", SCREEN: Pos",1:", SCREEN: Neg/No Res")_" "_$P(BGPERV(X),U,6)

 .I '$P(BGPERV(X),U,5) Q

 .I '$P(BGPERV(X),U,7) S D=D_", BNI: No" Q

 .S D=D_", BNI: "_$S($P(BGPERV(X),U,10)=1:$$DATE^BGP5UTL($P(BGPERV(X),U,8))_" Yes ER",1:" Yes Not ER")_" "_$P(BGPERV(X),U,9)

 S BGPVALUE=BGPVALUE_"|||"_D

 Q

 ;

ERINJ(P,BDATE,EDATE,BGPRET) ;

 ;did patient P have an ER visit with an injury dx?

 K ^TMP($J,"A")

 K BGPRET

 NEW A,G,B,E,D,CNT,T

 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 T=$O(^ATXAX("B","BGP INJURY DIAGNOSES",0))

 S E=$O(^ATXAX("B","BGP CAUSE OF INJURY ECODES",0))

 S (X,G,CNT)=0 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)

 .Q:$P(^AUPNVSIT(V,0),U,7)'="A"  ;ambulatory only

 .Q:$$CLINIC^APCLV(V,"C")'=30

 .Q:"CV"[$P(^AUPNVSIT(V,0),U,3)  ;no Contract health

 .Q:$P(^AUPNVSIT(V,0),U,6)=""

 .S D=$P($P(^AUPNVSIT(V,0),U),".")

 .;check diagnosis for injury

 .S (G,A)=0 F  S A=$O(^AUPNVPOV("AD",V,A)) Q:A'=+A!(G)  D

 ..S B=$P($G(^AUPNVPOV(A,0)),U)

 ..I $$ICD^BGP5UTL2(B,T,9) S CNT=CNT+1,BGPRET(CNT)=D_U_V_U_$P($$ICDDX^BGP5UTL2(B),U,2),G=1,$P(BGPRET(CNT),U,4)=$$ERAS(V),$P(BGPRET(CNT),U,7)=$$BNI(P,V,BGPRET(CNT)) Q

 ..S B=$P($G(^AUPNVPOV(A,0)),U,9)

 ..I $$ICD^BGP5UTL2(B,E,9) S CNT=CNT+1,BGPRET(CNT)=D_U_V_U_$P($$ICDDX^BGP5UTL2(B),U,2),G=1,$P(BGPRET(CNT),U,4)=$$ERAS(V),$P(BGPRET(CNT),U,7)=$$BNI(P,V,BGPRET(CNT)) Q

 S BGPRET(0)=CNT

 Q

 ;

ERAS(V) ;was there screening on this visit V and was it positive

 I $G(V)="" Q ""

 NEW X,Y,Z,A,T

 S X=0,Z="" F  S X=$O(^AUPNVXAM("AD",V,X)) Q:X'=+X!($P(Z,U,2))  I $P(^AUTTEXAM(+$G(^AUPNVXAM(X,0)),0),U,2)=35 D

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

 .S Z=1_U_$S(Y="PO":"1^Ex 35",1:"0^Ex 35")

 .Q

 I $P(Z,U),$P(Z,U,2) Q Z

 ;check measurements

 S X=0,Z="" F  S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X!($P(Z,U,2))  D

 .Q:$P($G(^AUPNVMSR(X,2)),U,1)

 .I $P(^AUTTMSR(+$G(^AUPNVMSR(X,0)),0),U,1)="AUDT" D  Q

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

 ..S Z=1_U_$S(Y>7.99999:"1^MSR AUDT",1:"0^MSR AUDT")

 .I $P(^AUTTMSR(+$G(^AUPNVMSR(X,0)),0),U,1)="AUDC" D

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

 ..I $P(^DPT(P,0),U,2)="M" S Z=1_U_$S(Y]""&(Y'<4):"1^MSR AUDC",1:"0^MSR AUDC")

 ..I $P(^DPT(P,0),U,2)="F" S Z=1_U_$S(Y]""&(Y'<3):"1^MSR AUDC",1:"0^MSR AUDC")

 .I $P(^AUTTMSR(+$G(^AUPNVMSR(X,0)),0),U,1)="CRFT" D  Q

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

 ..S Z=1_U_$S(Y=2!(Y=3)!(Y=4)!(Y=5)!(Y=6):"1^MSR CRFT",1:"0^MSR CRFT")

 I $P(Z,U),$P(Z,U,2) Q Z

 S X=0 F  S X=$O(^AUPNVHF("AD",V,X)) Q:X'=+X!($P(Z,U,2))  I $P(^AUTTHF($P(^AUTTHF(+$G(^AUPNVHF(X,0)),0),U,3),0),U)["ALCOHOL" D

 .S Y=$P(^AUTTHF(+$G(^AUPNVHF(X,0)),0),U)

 .S A="" I Y["CAGE",Y'[0 S A=1

 .S Z=1_U_A_U_Y

 I Z]"",$P(Z,U,2) Q Z

 ;screening CPT

 S T=$O(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0))

 S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!($P(Z,U,2))  D

 .I $$ICD^BGP5UTL2($P(+$G(^AUPNVCPT(X,0)),U,1),T,1) D

 ..S Y=$$VAL^XBDIQ1(9000010.18,X,.01)

 ..S Z=1_U_U_"CPT "_Y

 ..I Y="G0396"!(Y="G0397")!(Y=99408)!(Y=99409) S $P(Z,U,2)=1

 .Q

 I Z]"" Q Z

 ;screening pov

 S X=0 F  S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!($P(Z,U,2))  I $$ICD^BGP5UTL2(+^AUPNVPOV(X,0),$O(^ATXAX("B","BGP SCREEN FOR ALCOHOLISM DX",0)),9) D

 .S Z=1_U_U_"POV "_$$VAL^XBDIQ1(9000010.07,X,.01)

 .Q

 Q Z

 ;

BNI(P,V,E) ;

 I $P(E,U,4)'=1 Q ""  ;not a positive screen

 NEW D,X,%

 S D=$P($P(^AUPNVSIT(V,0),U),"."),%=""

 S X=0 F  S X=$O(^AUPNVPED("AD",V,X)) Q:X'=+X!(%]"")  S Z=$P(^AUTTEDT(+$G(^AUPNVPED(X,0)),0),U,2) I Z="AOD-BNI"!($P(Z,"-")="99408")!($P(Z,"-")="99409")!($P(Z,"-")="H0050")!($P(Z,"-")="G0397")!($P(Z,"-")="G0396") S %=1_U_D_U_Z_U_1

 I %]"" Q %

 S T=$O(^ATXAX("B","BGP BNI CPTS",0))

 S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(%]"")  D

 .Q:'$$ICD^BGP5UTL2($P(+$G(^AUPNVCPT(X,0)),U,1),T,1)

 .S %=1_U_D_U_"CPT "_$$VAL^XBDIQ1(9000010.18,X,.01)_U_1

 I %]"" Q %

 S X=$$BNII(P,D)

 Q X

BNII(P,BD) ;

 NEW Y,BGPG,E,X,T,%,D

 S Y=$$CPT^BGP5DU(P,BD,$$FMADD^XLFDT(BD,7),$O(^ATXAX("B","BGP BNI CPTS",0)),6,"CT")

 I $P(Y,U) Q 1_U_$P(Y,U,2)_U_"CPT "_$P(Y,U,3)_U_2

 K BGPG

 S Y="BGPG(",BGPDEP=""

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

 I '$D(BGPG(1)) G BNIMH

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

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

 .Q:'V

 .Q:$P($G(^AUPNVSIT(V,0)),U,7)="C"

 .Q:$P($G(^AUPNVSIT(V,0)),U,7)="T"

 .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 T="AOD-BNI"!($P(T,"-")="99408")!($P(T,"-")="99409")!($P(T,"-")="H0050")!($P(T,"-")="G0397")!($P(T,"-")="G0396") S %=1_U_$P(BGPG(X),U)_U_T_U_2

 .Q

 I %]"" Q %

BNIMH ;

 S T="",%="" S E=9999999-BD,D=9999999-($$FMADD^XLFDT(BD,7))-1_".99" F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!($P(D,".")>E)!(%]"")  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(%]"")  D

 .S Z=$P(^AMHREC(V,0),U,7) I Z S Z=$P(^AMHTSET(Z,0),U,2) Q:Z=1  Q:Z=10  Q:Z=7

 .S X=0,%="" F  S X=$O(^AMHREDU("AD",V,X)) Q:X'=+X!(%]"")  S T=$P($G(^AMHREDU(X,0)),U) D

 ..Q:'T

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

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

 ..I T="AOD-BNI"!($P(T,"-")="99408")!($P(T,"-")="99409")!($P(T,"-")="H0050")!($P(T,"-")="G0397")!($P(T,"-")="G0396") S %=1_U_(9999999-D)_U_T_U_2 Q

 .S T=$O(^ATXAX("B","BGP BNI CPTS",0))

 .S X=0 F  S X=$O(^AMHRPROC("AD",V,X)) Q:X'=+X!(%]"")  D

 ..Q:'$$ICD^BGP5UTL2($P(+$G(^AMHRPROC(X,0)),U,1),T,1)

 ..S %=1_U_(9999999-D)_U_"BH CPT: "_$$VAL^XBDIQ1(9002011.04,X,.01)_U_2 Q

 ..Q

 Q %

IPC ;EP

 S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0

 S BGPVALUE=""

 I 'BGPACTCL Q  ;not active clinical

 S BGPVAL=$$PCV(DFN,BGPBDATE,BGPEDATE)  ;return #visits^list string

 S BGPN1=$P(BGPVAL,U)

 I BGPAGEB<18 S BGPN2=BGPN1

 I BGPAGEB>17,BGPAGEB<55 S BGPN3=BGPN1

 I BGPAGEB>54 S BGPN4=BGPN1

 ;I BGPCANCE,BGPN1>1 S BGPN5=1

 S BGPVALUE="AC"_"|||"_BGPN1_$S(BGPN1'=1:" visits: ",1:" visit: ")_$P(BGPVAL,U,2)

 K BGPVAL

 Q

 ;

PCV(P,BDATE,EDATE) ;EP

 ;all dxs BGP PALLIATIVE CARE  DXS and get unique visits count

 NEW BGPG,X,Y,E

 K BGPG

 S Y="BGPG("

 S X=P_"^ALL DX [BGP PALLIATIVE CARE DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)

 I '$D(BGPG(1)) Q 0  ;no visits

 NEW X,C,R

 S R="",C=0

 S X=0 F  S X=$O(BGPG(X)) Q:X'=+X  I '$D(X($P(BGPG(X),U,5))) D

 .S X($P(BGPG(X),U,5))=""

 .S C=C+1

 .S R=R_$S(R="":"",1:", ")_$$DATE^BGP5UTL($P($P(^AUPNVSIT($P(BGPG(X),U,5),0),U),"."))

 Q C_U_R

BGP5D24   ; IHS/CMI/LAB - STI MEASURE 18 Oct 2009 8:37 AM 03 Jul 2010 7:56 AM ;

 +1       ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143

 +2       ;

STI       ;EP

 +1        DO EN^BKMSTIDS(DFN,BGPBDATE,BGPEDATE,"KEY",.BGPYAR,.BGPZAR)

 +2        QUIT 

ISTI      ;EP

 +1        NEW BGPCIN

 +2        SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN15,BGPN16,BGPN17,BGPN18,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0

 +3        SET BGPVALUE=""

           SET BGPDENV=""

 +4        KILL BGPYAR,BGPZAR,BGPNUMV

 +5       ;no routine to execute

           IF $TEXT(EN^BKMSTIDS)=""

               SET BGPSTOP=1

               QUIT 

 +6       ; BGPTIME=1 ZW  

 +7       ;D EN^XBNEW("STI^BGP5D24","DFN;BGPBDATE;BGPEDATE;BGPYAR;BGPZAR")

 +8        DO EN^BKMSTIDS(DFN,BGPBDATE,BGPEDATE,"KEY",.BGPYAR,.BGPZAR)

 +9       ;no incidences or diagnoses

           IF '$DATA(BGPZAR)

               SET BGPSTOP=1

               QUIT 

 +10      ;no incidences or diagnoses

           IF $PIECE($GET(BGPZAR(0)),U)=0

               SET BGPSTOP=1

               QUIT 

 +11      ;TOTAL # OF INCIDENCES

           SET (BGPN1,BGPN2)=$PIECE(BGPZAR(0),U,1)

 +12      ;TOTAL # SCREENINGS NEEDED

           SET BGPD1=$PIECE(BGPZAR(0),U,2)

 +13      ;TOTAL # OF SCREENINGS DONE

           SET BGPN3=$PIECE(BGPZAR(0),U,3)

 +14      ;TOTAL # OF REFUSALS

           SET BGPN4=$PIECE(BGPZAR(0),U,4)

 +15      ;NEW GROUPED DEN

           SET BGPN15=$PIECE(BGPZAR(0),U,5)

 +16      ;NEW GROUPED NUM

           SET BGPN16=$PIECE(BGPZAR(0),U,6)

 +17      ;NEW GROUPED REF

           SET BGPN17=$PIECE(BGPZAR(0),U,7)

 +18       SET BGPCIN=0

 +19       SET X=0

           FOR 

               SET X=$ORDER(BGPZAR(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +20               SET BGPCIN=BGPCIN+1

 +21               IF BGPDENV]""

                       SET BGPDENV=BGPDENV_"; "

 +22               SET BGPNUMV(X)=""

 +23               SET I=0

                   SET C=0

                   SET BGPHXX=""

                   FOR 

                       SET I=$ORDER(BGPZAR(X,I))

                       IF I=""

                           QUIT 

                       Begin DoDot:2

 +24                       IF $DATA(BGPZAR(X,I,0))

                               SET C=C+1

                               SET BGPDENV=BGPDENV_$SELECT(C=1:BGPCIN_") ",1:", ")_$PIECE(BGPZAR(X,I,0),U,5)

 +25                       IF $GET(BGPYAR(I,"NUM","HIV"))=1

                               SET BGPHXX=$ORDER(BGPYAR(I,"NUM","HIV",0))

                               IF BGPHXX

                                   SET J=$PIECE(BGPYAR(I,"NUM","HIV",BGPHXX),U,2)

                                   IF J'["POV"

                                       SET BGPHXX=""

 +26      ;I BGPHXX S BGPN18=1

                       End DoDot:2

 +27               Begin DoDot:2

 +28      ;I $G(BGPZAR(X,"CHL"))]"" S Z=$G(BGPZAR(X,"CHL")) S:$P(Z,U) BGPD2=BGPD2+1 S:$P(Z,U,2) BGPN5=BGPN5+1 S:$P(Z,U,3) BGPN6=BGPN6+1 D

 +29      ;.S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"CHL-"_$S($P(Z,U,2):"Y",1:"N")_$S($P(Z,U,4)]"":" "_$P(Z,U,4),1:"") ;_"; " ;CHL SCREENINGS NEEDED/DONE

 +30      ;I $G(BGPZAR(X,"GC"))]"" S Z=$G(BGPZAR(X,"GC")) S:$P(Z,U) BGPD3=BGPD3+1 S:$P(Z,U,2) BGPN7=BGPN7+1 S:$P(Z,U,3) BGPN8=BGPN8+1 D

 +31      ;.S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"GC-"_$S($P(Z,U,2):"Y",1:"N")_$S($P(Z,U,4)]"":" "_$P(Z,U,4),1:"") ;_"; " ;GON SCREENINGS NEEDED/DONE

 +32                   IF $GET(BGPZAR(X,"HIV"))]""

                           SET Z=$GET(BGPZAR(X,"HIV"))

                           IF $PIECE(Z,U)

                               SET BGPD4=BGPD4+1

                           IF $PIECE(Z,U,2)

                               SET BGPN9=BGPN9+1

                           IF $PIECE(Z,U,3)

                               SET BGPN10=BGPN10+1

                           Begin DoDot:3

 +33                           IF BGPNUMV(X)]""

                                   SET BGPNUMV(X)=BGPNUMV(X)_", "

 +34                           SET H=0

                               SET I=""

                               IF '($PIECE(Z,U,1)+$PIECE(Z,U,2))

                                   SET H=1

                                   SET I="Contraind Prior DX"

                                   SET BGPN18=1

 +35      ;_"; " ;HIV SCREENINGS NEEDED/DONE

                               SET BGPNUMV(X)=BGPNUMV(X)_"HIV-"_$SELECT($PIECE(Z,U,2):"Y",H:I,1:"N")_$SELECT($PIECE(Z,U,4)]"":" "_$PIECE(Z,U,4),1:"")

                           End DoDot:3

 +36      ;I $G(BGPZAR(X,"SYP"))]"" S Z=$G(BGPZAR(X,"SYP")) S:$P(Z,U) BGPD5=BGPD5+1 S:$P(Z,U,2) BGPN11=BGPN11+1 S:$P(Z,U,3) BGPN12=BGPN12+1 D

 +37      ;.S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"SYP-"_$S($P(Z,U,2):"Y",1:"N")_$S($P(Z,U,4)]"":" "_$P(Z,U,4),1:"") ;_"; " ;SYP SCREENINGS NEEDED/DONE

                   End DoDot:2

 +38      ;I H]"" S:BGPNUMV(X)]"" BGPNUMV(X)=BGPNUMV(X)_", " S BGPNUMV(X)=BGPNUMV(X)_"Prior HIV DX (Contraind): "_$$DATE^BGP5UTL(H)

 +39               SET BGPVALUE="UP"_$SELECT(BGPACTCL:";AC",1:"")_" Visit "_BGPDENV_"|||"

               End DoDot:1

 +40       SET BGPCIN=0

           SET X=0

           FOR 

               SET X=$ORDER(BGPNUMV(X))

               IF X'=+X

                   QUIT 

               SET BGPCIN=BGPCIN+1

               SET BGPVALUE=BGPVALUE_$SELECT(BGPCIN>1:"; ",1:"")_BGPCIN_") "_$SELECT(BGPNUMV(X)="":"N/A",1:BGPNUMV(X))

 +41       QUIT 

 +42      ;

IASB      ;EP

 +1        SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0

 +2        SET BGPVALUE=""

 +3        IF 'BGPACTUP

               SET BGPSTOP=1

               QUIT 

 +4        IF BGPAGEB<15

               SET BGPSTOP=1

               QUIT 

 +5        IF BGPAGEB>34

               SET BGPSTOP=1

               QUIT 

 +6       ;will return array of all er visits with injury diagnosis fm date^injury dx^screen^positive^text^bni^bni text

           KILL BGPERV

 +7        DO ERINJ(DFN,BGPBDATE,BGPEDATE,.BGPERV)

 +8       ;no injury visits

           IF '$GET(BGPERV(0))

               SET BGPSTOP=1

               QUIT 

 +9       ;total # of visits

           SET BGPD1=BGPERV(0)

 +10       IF BGPAGEB>14

               IF BGPAGEB<25

                   SET BGPD2=BGPERV(0)

 +11       IF BGPAGEB>24

               IF BGPAGEB<35

                   SET BGPD3=BGPERV(0)

 +12      ;SCREEN ON EVERY VISIT?

           SET X=0

           SET BGPN1=0

           FOR 

               SET X=$ORDER(BGPERV(X))

               IF X'=+X

                   QUIT 

               IF $PIECE(BGPERV(X),U,4)

                   SET BGPN1=BGPN1+1

 +13      ;positive on at least one

           SET X=0

           SET BGPN2=0

           FOR 

               SET X=$ORDER(BGPERV(X))

               IF X'=+X

                   QUIT 

               IF $PIECE(BGPERV(X),U,5)

                   SET BGPN2=BGPN2+1

 +14       IF BGPN2

               SET X=0

               SET BGPN3=0

               FOR 

                   SET X=$ORDER(BGPERV(X))

                   IF X'=+X

                       QUIT 

                   Begin DoDot:1

 +15                   IF $PIECE(BGPERV(X),U,5)

                           IF $PIECE(BGPERV(X),U,7)

                               SET BGPN3=BGPN3+1

                   End DoDot:1

 +16       IF BGPN3

               SET X=0

               FOR 

                   SET X=$ORDER(BGPERV(X))

                   IF X'=+X

                       QUIT 

                   IF $PIECE(BGPERV(X),U,5)

                       IF $PIECE(BGPERV(X),U,10)=1

                           SET BGPN4=BGPN4+1

                       IF $PIECE(BGPERV(X),U,10)=2

                           SET BGPN5=BGPN5+1

 +17       SET BGPVALUE="UP"_$SELECT(BGPACTCB:",AC+BH",1:"")

 +18       SET V=""

           SET X=0

           SET D=""

           FOR 

               SET X=$ORDER(BGPERV(X))

               IF X'=+X

                   QUIT 

               SET D=D_$SELECT(D]"":"; ",1:"")_"ER "_X_") "_$$DATE^BGP5UTL($PIECE(BGPERV(X),U,1))_" POV "_$PIECE(BGPERV(X),U,3)

               Begin DoDot:1

 +19      ;S V=V_$S(V]"":"; ",1:"")

 +20      ;S V=V_"ER Visit "_X_") "

 +21               IF '$PIECE(BGPERV(X),U,4)

                       SET D=D_", SCREEN: None"

                       QUIT 

 +22               SET D=D_$SELECT($PIECE(BGPERV(X),U,5):", SCREEN: Pos",1:", SCREEN: Neg/No Res")_" "_$PIECE(BGPERV(X),U,6)

 +23               IF '$PIECE(BGPERV(X),U,5)

                       QUIT 

 +24               IF '$PIECE(BGPERV(X),U,7)

                       SET D=D_", BNI: No"

                       QUIT 

 +25               SET D=D_", BNI: "_$SELECT($PIECE(BGPERV(X),U,10)=1:$$DATE^BGP5UTL($PIECE(BGPERV(X),U,8))_" Yes ER",1:" Yes Not ER")_" "_$PIECE(BGPERV(X),U,9)

               End DoDot:1

 +26       SET BGPVALUE=BGPVALUE_"|||"_D

 +27       QUIT 

 +28      ;

ERINJ(P,BDATE,EDATE,BGPRET) ;

 +1       ;did patient P have an ER visit with an injury dx?

 +2        KILL ^TMP($JOB,"A")

 +3        KILL BGPRET

 +4        NEW A,G,B,E,D,CNT,T

 +5        SET A="^TMP($J,""A"","

           SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)

           SET E=$$START1^APCLDF(B,A)

 +6        IF '$DATA(^TMP($JOB,"A",1))

               QUIT ""

 +7        SET T=$ORDER(^ATXAX("B","BGP INJURY DIAGNOSES",0))

 +8        SET E=$ORDER(^ATXAX("B","BGP CAUSE OF INJURY ECODES",0))

 +9        SET (X,G,CNT)=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"A",X))

               IF X'=+X

                   QUIT 

               SET V=$PIECE(^TMP($JOB,"A",X),U,5)

               Begin DoDot:1

 +10               IF '$DATA(^AUPNVSIT(V,0))

                       QUIT 

 +11               IF '$PIECE(^AUPNVSIT(V,0),U,9)

                       QUIT 

 +12               IF $PIECE(^AUPNVSIT(V,0),U,11)

                       QUIT 

 +13      ;ambulatory only

                   IF $PIECE(^AUPNVSIT(V,0),U,7)'="A"

                       QUIT 

 +14               IF $$CLINIC^APCLV(V,"C")'=30

                       QUIT 

 +15      ;no Contract health

                   IF "CV"[$PIECE(^AUPNVSIT(V,0),U,3)

                       QUIT 

 +16               IF $PIECE(^AUPNVSIT(V,0),U,6)=""

                       QUIT 

 +17               SET D=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")