BGP8D212 ; IHS/CMI/LAB - measure 6 19 Sep 2014 8:12 AM ; 25 Jan 2018 3:18 PM
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
LOINC(A,B) ;EP
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 ""
STRC ;EP - called from report execution
I 'BGPDMD1 S BGPSTOP=1 Q ;only up diabetics
I BGPAGEB<21 S BGPSTOP=1 Q ;ONLY 21+
NEW BGPCVDL
F X=1:1:12 S Y="BGPD"_X S @Y="" ;12 denominators
S (BGPN1,BGPN2,BGPN3)="" ;numerators
S BGPCVDL=$$CHDLDL(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) ;CHD OR LDL^CHD^LDL
I BGPAGEB>20,BGPAGEB<40,'BGPCVDL S BGPSTOP=1 Q ;21-39 and no cvd/ldl
I BGPAGEB>75,'BGPCVDL S BGPSTOP=1 Q ;>75 and no cvd/ldl
;DENOM 1
I BGPDMD2,BGPAGEB>39,BGPAGEB<76 S BGPD1=1 ;active diabetic ages 40-75
I BGPDMD2,BGPAGEB>20,BGPCVDL S BGPD1=1 ;or active diabetic 21+ w/CVD or LDL =>190
;DENOM 2 21-39, active diabetic with CVD or LDL >=190
I BGPDMD2,BGPAGEB>20,BGPAGEB<40,BGPCVDL S BGPD2=1
;DENOM 3 40-75, active diabetic with CVD or LDL =>190
I BGPDMD2,BGPAGEB>39,BGPAGEB<76,BGPCVDL S BGPD3=1
;DENOM 4 76+ with cvd or ldl >=190
I BGPDMD2,BGPAGEB>75,BGPCVDL S BGPD4=1
;DENOM 5 active diabetic 40-75
I BGPDMD2,BGPAGEB>39,BGPAGEB<76 S BGPD5=1
;W/EXCLU
I BGPD1 S BGPD6=1
;DENOM 7 UP DM 40-75 or 12+ with cvd/ldl
I BGPDMD6,BGPAGEB>39,BGPAGEB<76 S BGPD7=1 ;NEW DMD6 V18 GPRA
I BGPDMD6,BGPAGEB>20,BGPCVDL S BGPD7=1
;DENOM 8 21-39, UP DM with CVD or LDL >=190
I BGPDMD6,BGPAGEB>20,BGPAGEB<40,BGPCVDL S BGPD8=1
;DENOM 9 40-75, UP DM with CVD or LDL =>190
I BGPDMD6,BGPAGEB>39,BGPAGEB<76,BGPCVDL S BGPD9=1
;DENOM 10 UP DM 76+ with cvd or ldl >=190
I BGPDMD6,BGPAGEB>75,BGPCVDL S BGPD10=1
;DENOM 11 up dm 40-75
I BGPDMD6,BGPAGEB>39,BGPAGEB<76 S BGPD11=1
I BGPD7 S BGPD12=1
;now exclude people
S (BGPEXL1,BGPEXL2,BGPEXL3,BGPEXL4,BGPEXL5,BGPSTAT,BGPEXL6,BGPEXL7)=""
S BGPEXL1=$$STATALG^BGP8D213(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE) I BGPEXL1 S (BGPN2,BGPN3)=1 G ND ;excl 1
;ALCOHOL HEP
S BGPEXL1=$$ALCHEP(DFN,BGPBDATE,BGPEDATE) I BGPEXL1 S BGPN2=1 G ND
;NMI
S BGPEXL1=$$STATNMI(DFN,BGPBDATE,BGPEDATE) I BGPEXL1 S BGPN2=1 G ND
;PREGNANCY
S BGPEXL2=$$PREG^BGP8D715(DFN,BGPBDATE,BGPEDATE,1,1,,BGPBDATE,BGPEDATE,1) I BGPEXL2 S BGPN2=1 G ND ;V17.1 CMI/LAB ADDED DATES FOR CURRENTLY PREGNANT
;cirrhosis of liver
S BGPEXL6=$$CLIVER^BGP8D213(DFN,BGPPBD,BGPEDATE) I BGPEXL6 S BGPN2=1 G ND
;breastfeeding
S BGPEXL2=$$BF^BGP8D21(DFN,BGPBDATE,BGPEDATE) I BGPEXL2 S BGPN2=1 G ND
;PALLIATIVE
S BGPEXL3=$$LASTDX^BGP8UTL1(DFN,"BGP PALLIATIVE CARE DXS",BGPBDATE,BGPEDATE) I BGPEXL3 S BGPN2=1,BGPEXL3=1_U_$$DATE^BGP8UTL($P(BGPEXL3,U,3))_" Palliative Care" G ND ;excl 3
;ESRD
S BGPEXL4=$$ESRD^BGP8D211(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) I BGPEXL4 S BGPEXL4=1_U_$$DATE^BGP8UTL($P(BGPEXL4,U,3))_" ESRD" S BGPN2=1 G ND ;excl 4 ESRD
S BGPEXL7=$$HEPA^BGP8D21A(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) I BGPEXL7 S BGPEXL7=1_U_$$DATE^BGP8UTL($P(BGPEXL7,U,3))_" HEP A" S BGPN2=1 G ND
S BGPEXL7=$$HEPB^BGP8D21A(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) I BGPEXL7 S BGPEXL7=1_U_$$DATE^BGP8UTL($P(BGPEXL7,U,3))_" HEP B" S BGPN2=1 G ND
;EXCL 5
S BGPSTAT=$$STATIN^BGP8D214(DFN,BGPBDATE,BGPEDATE,0)
S BGPEXL5=$$LASTLDLV(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) I BGPEXL5,'$P(BGPCVDL,U,3),'BGPSTAT S BGPN2=1 G ND ;excl 5
;
ND ;
;DENOM 6 active diabetic 21+
I BGPN2,BGPD1 S BGPD6=1
I BGPN2,BGPD7 S BGPD12=1
I BGPN2 S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)="" ;EXCLUDE EXCLUSIONS FROM DENOMINATORS
I '(BGPD1+BGPD2+BGPD3+BGPD4+BGPD5+BGPD6+BGPD7+BGPD8+BGPD9+BGPD10+BGPD11+BGPD12) S BGPSTOP=1 Q ;not in at least UP denominator
;numerator
I 'BGPN2 S BGPN1=BGPSTAT
SETL ;
;S BGPVALUE=$S(BGPD1:"STA.1.1",1:"")_" "_$S(BGPD2:"STA.2.1",1:"")_" "_$S(BGPD3:"STA.3.1",1:"")_" "_$S(BGPD4:"STA.4.1",1:"")_" "_$S(BGPD5:"STA.5.1",1:"")_" "_$S(BGPD6:"STA.6.1",1:"")_" "_$S(BGPD7:"STA.7.1",1:"")
S BGPVALUE=$S(BGPDMD6:"UPDM",1:"")_$S(BGPDMD2:",AD",1:"")_$S(BGPDMD3:",AAD",1:"")_$S($P(BGPCVDL,U,2):" (CHD)",$P(BGPCVDL,U,3):" (LDL)",$P(BGPCVDL,U,4):" (HYPER CHOL)",1:"")_"|||"
I BGPN1 S BGPVALUE=BGPVALUE_$P(BGPN1,U,2)
I BGPEXL1 S BGPVALUE=BGPVALUE_"Exclusion: "_$P(BGPEXL1,U,2)
I BGPEXL2 S BGPVALUE=BGPVALUE_"Exclusion: "_$P(BGPEXL2,U,2)_" Pregnant/Breastfeeding"
I BGPEXL3 S BGPVALUE=BGPVALUE_"Exclusion: "_$P(BGPEXL3,U,2)
I BGPEXL4 S BGPVALUE=BGPVALUE_"Exclusion: "_$P(BGPEXL4,U,2)
I BGPEXL6 S BGPVALUE=BGPVALUE_"Exclusion: "_$P(BGPEXL6,U,2)_" Cirrhosis/Liver Dis"
I BGPEXL5,BGPN2 S BGPVALUE=BGPVALUE_"Exclusion: "_$P(BGPEXL5,U,2)
I BGPEXL7 S BGPVALUE=BGPVALUE_"Exclusion: "_$P(BGPEXL7,U,2)
K BGPEXL1,BGPEXL2,BGPEXL3,BGPEXL4,BGPEXL5,BGPCVDL,BGPSTAT,BGPEXL6,BGPEXL7
Q
CHDLDL(P,BDATE,EDATE) ;EP - chd or ldl =>190
NEW RESULT
S RESULT=""
I $$CHD(P,BDATE,EDATE,0) S RESULT="1^1"
K TMP($J,"A")
I $$HYPERCHO(P,BDATE,EDATE) S $P(RESULT,U,4)=1,$P(RESULT,U,1)=1
I $$LDL190(P,BDATE,EDATE) S $P(RESULT,U,3)=1,$P(RESULT,U,1)=1
K ^TMP($J,"A")
Q RESULT
ALCHEP(P,BDATE,EDATE) ;EP
;NOW CHECK ALCOHOL HEPATITIS
NEW BGPG,Y,X,E
K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP ALCOHOL HEPATITIS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1_U_$$DATE^BGP8UTL($P(BGPG(1),U,1))_" Alc Hep"
S X=$$PLTAXID^BGP8DU(P,"BGP ALCOHOL HEPATITIS DXS",BDATE,EDATE)
I X Q 1_U_"Prob List Alc Hep"
S X=$$IPLSNOID^BGP8DU(P,"PXRM BGP ACUTE ETOH HEPATITIS",BDATE,EDATE)
I X Q 1_U_"Prob List Alc Hep"
Q ""
HYPERCHO(P,BDATE,EDATE) ;
;NOW CHECK ALCOHOL HEPATITIS
NEW BGPG,Y,X,E
K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP HYPERCHOLESTEROLEMIA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1 ;_U_$$DATE^BGP8UTL($P(BGPG(1),U,1))_" Alc Hep"
S X=$$PLTAXID^BGP8DU(P,"BGP HYPERCHOLESTEROLEMIA DXS",BDATE,EDATE)
I X Q 1 ;_U_"Prob List Alc Hep"
S X=$$IPLSNOID^BGP8DU(P,"PXRM BGP HYPERCHOLESTEROLEMIA",BDATE,EDATE)
I X Q 1 ;_U_"Prob List Alc Hep"
Q ""
CHD(P,BDATE,EDATE,MIN) ;EP
NEW A,B,E,T,X,G,V,Y,%,G,F,BGPG,BGPCNT,T1,BGPALL,T2,T3,T4,H
S X=$$CHDPL^BGP8D21A(P,EDATE)
I X Q 1
K BGPALL
S BGPCNT=0
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 T=$O(^ATXAX("B","BGP CHD DXS",0))
S T1=$O(^ATXAX("B","BGP AMI DXS PAMT",0))
S T2=$O(^ATXAX("B","BGP IVD DXS",0))
S T3=$O(^ATXAX("B","BGP TIA DXS",0))
S T4=$O(^ATXAX("B","BGP ARTERIAL DISEASE DXS",0))
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(BGPCNT>MIN) 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:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(BGPCNT>MIN) I $D(^AUPNVPOV(Y,0)) D
..S %=$P(^AUPNVPOV(Y,0),U)
..I $$ICD^BGP8UTL2(%,T,9) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2(%,T1,9) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2(%,T2,9) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2(%,T3,9) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2(%,T4,9) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
I BGPCNT>MIN Q 1
CHDP ;NOW CHECK FOR MINPROC
;S BGPCNT=0
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(BGPCNT>MIN) 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:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.S T1=$O(^ATXAX("B","BGP PCI DXS",0))
.S T2=$O(^ATXAX("B","BGP CABG DXS",0))
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(BGPCNT>MIN) I $D(^AUPNVPOV(Y,0)) D
..S %=$P(^AUPNVPOV(Y,0),U)
..I $$ICD^BGP8UTL2(%,T1,9) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2(%,T2,9) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
.I BGPCNT>MIN Q
.;check for procedure in BGP CABG PROCS
.S E=$O(^ATXAX("B","BGP CABG PROCS",0))
.S F=$O(^ATXAX("B","BGP PCI CM PROCS",0))
.S G=$O(^ATXAX("B","BGP CAROTID INTERVENTION PROCS",0))
.S Y=0 F S Y=$O(^AUPNVPRC("AD",V,Y)) Q:Y'=+Y!(BGPCNT>MIN) D
..Q:'$D(^AUPNVPRC(Y,0))
..I $$ICD^BGP8UTL2($P(^AUPNVPRC(Y,0),U,1),E,0) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2($P(^AUPNVPRC(Y,0),U,1),F,0) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2($P(^AUPNVPRC(Y,0),U,1),G,0) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
.I BGPCNT>MIN Q
.;now check cpts
.S E=$O(^ATXAX("B","BGP CABG CPTS",0))
.S F=$O(^ATXAX("B","BGP PCI CPTS",0))
.S G=$O(^ATXAX("B","BGP REVASCULARIZATION CPTS",0))
.S Y=0 F S Y=$O(^AUPNVCPT("AD",V,Y)) Q:Y'=+Y!(BGPCNT>MIN) D
..Q:'$D(^AUPNVCPT(Y,0))
..I $$ICD^BGP8UTL2($P(^AUPNVCPT(Y,0),U,1),E,1) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2($P(^AUPNVCPT(Y,0),U,1),F,1) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2($P(^AUPNVCPT(Y,0),U,1),G,1) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
.I BGPCNT>MIN Q
.;now check TRANS
.S E=$O(^ATXAX("B","BGP CABG CPTS",0))
.S F=$O(^ATXAX("B","BGP PCI CPTS",0))
.S G=$O(^ATXAX("B","BGP REVASCULARIZATION CPTS",0))
.S Y=0 F S Y=$O(^AUPNVTC("AD",V,Y)) Q:Y'=+Y!(BGPCNT>MIN) D
..Q:'$D(^AUPNVTC(Y,0))
..S I=$P(^AUPNVTC(Y,0),U,7)
..Q:I=""
..I $$ICD^BGP8UTL2(I,E,1) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2(I,F,1) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
..I $$ICD^BGP8UTL2(I,G,1) I '$D(BGPALL(V)) S BGPALL(V)="",BGPCNT=BGPCNT+1 Q
.Q
I BGPCNT>MIN Q 1
Q ""
LDL190(P,BDATE,EDATE) ;EP ldl >=190? EVER
NEW T,A,E,LT,G,X,J,R
K ^TMP($J,"A")
S A="^TMP($J,""A"",",%=P_"^ALL LAB;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,A)
I '$D(^TMP($J,"A",1)) Q ""
;now go through all lab tests and see if any are the loinc codes in the taxonomy
S T=$O(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
S LT=$O(^ATXAX("B","BGP LDL LOINC CODES",0))
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G) S I=+$P(^TMP($J,"A",X),U,4) D
.S %=+^AUPNVLAB(I,0),R=$P(^AUPNVLAB(I,0),U,4)
.I $D(^ATXLAB(T,21,"B",%)),+R>189.999999 S G=1 Q
.S J=$P($G(^AUPNVLAB(I,11)),U,13)
.Q:J=""
.I $$LOINC^BGP8D21(J,LT),+R>189.99999 S G=1
K ^TMP($J,"A")
Q G
LASTLDLV(P,BDATE,EDATE) ;EP
NEW BGPG,BGPT,BGPC,BGPLT,T,B,E,D,L,X,R,G,C,%
K BGPG,BGPT,BGPC
S BGPC=0
;now get all loinc/taxonomy tests
S T=$O(^ATXAX("B","BGP LDL LOINC CODES",0))
S BGPLT=$O(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BGPC) D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X D
...Q:'$D(^AUPNVLAB(X,0))
...Q:$P(^AUPNVLAB(X,0),U,4)="" ;NO RESULT
...Q:'+$P(^AUPNVLAB(X,0),U,4) ;NON-NUMERIC RESULT
...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=BGPC+1,BGPT(BGPC)=$P(^AUPNVLAB(X,0),U,4)_U_(9999999-D) Q
...Q:'T
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,T)
...S R=$P(^AUPNVLAB(X,0),U,4)
...I 'R S R=""
...S BGPC=BGPC+1,BGPT(BGPC)=$P(^AUPNVLAB(X,0),U,4)_U_(9999999-D)
...Q
I 'BGPC Q ""
I +BGPT(BGPC)<70 Q 1_U_$$DATE^BGP8UTL($P(BGPT(BGPC),U,2))_" LDL < 70"
Q ""
STATNMI(P,NMIB,NMIE) ;EP
;nmi
NEW BGPG,X,T,D,Y,N
S BGPG=""
S T=$O(^ATXAX("B","BGP PQA STATIN MEDS",0))
S X=0 F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X D
.Q:'$D(^ATXAX(T,21,"B",X)) ;not an STATI
.S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D D
..S Y=9999999-D I Y<NMIB Q
..I Y>NMIE Q
..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N D
...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
...S BGPG=1_U_$$DATE^BGP8UTL($P(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04) ;_" "_" "_$$VAL^XBDIQ1(9000022,X,1101)
..Q
.Q
I BGPG Q BGPG
Q ""
BGP8D212 ; IHS/CMI/LAB - measure 6 19 Sep 2014 8:12 AM ; 25 Jan 2018 3:18 PM
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
LOINC(A,B) ;EP
+1 NEW %
+2 SET %=$PIECE($GET(^LAB(95.3,A,9999999)),U,2)
+3 IF %]""
IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+4 SET %=$PIECE($GET(^LAB(95.3,A,0)),U)_"-"_$PIECE($GET(^LAB(95.3,A,0)),U,15)
+5 IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+6 QUIT ""
STRC ;EP - called from report execution
+1 ;only up diabetics
IF 'BGPDMD1
SET BGPSTOP=1
QUIT
+2 ;ONLY 21+
IF BGPAGEB<21
SET BGPSTOP=1
QUIT
+3 NEW BGPCVDL
+4 ;12 denominators
FOR X=1:1:12
SET Y="BGPD"_X
SET @Y=""
+5 ;numerators
SET (BGPN1,BGPN2,BGPN3)=""
+6 ;CHD OR LDL^CHD^LDL
SET BGPCVDL=$$CHDLDL(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+7 ;21-39 and no cvd/ldl
IF BGPAGEB>20
IF BGPAGEB<40
IF 'BGPCVDL
SET BGPSTOP=1
QUIT
+8 ;>75 and no cvd/ldl
IF BGPAGEB>75
IF 'BGPCVDL
SET BGPSTOP=1
QUIT
+9 ;DENOM 1
+10 ;active diabetic ages 40-75
IF BGPDMD2
IF BGPAGEB>39
IF BGPAGEB<76
SET BGPD1=1
+11 ;or active diabetic 21+ w/CVD or LDL =>190
IF BGPDMD2
IF BGPAGEB>20
IF BGPCVDL
SET BGPD1=1
+12 ;DENOM 2 21-39, active diabetic with CVD or LDL >=190
+13 IF BGPDMD2
IF BGPAGEB>20
IF BGPAGEB<40
IF BGPCVDL
SET BGPD2=1
+14 ;DENOM 3 40-75, active diabetic with CVD or LDL =>190
+15 IF BGPDMD2
IF BGPAGEB>39
IF BGPAGEB<76
IF BGPCVDL
SET BGPD3=1
+16 ;DENOM 4 76+ with cvd or ldl >=190
+17 IF BGPDMD2
IF BGPAGEB>75
IF BGPCVDL
SET BGPD4=1
+18 ;DENOM 5 active diabetic 40-75
+19 IF BGPDMD2
IF BGPAGEB>39
IF BGPAGEB<76
SET BGPD5=1
+20 ;W/EXCLU
+21 IF BGPD1
SET BGPD6=1
+22 ;DENOM 7 UP DM 40-75 or 12+ with cvd/ldl
+23 ;NEW DMD6 V18 GPRA
IF BGPDMD6
IF BGPAGEB>39
IF BGPAGEB<76
SET BGPD7=1
+24 IF BGPDMD6
IF BGPAGEB>20
IF BGPCVDL
SET BGPD7=1
+25 ;DENOM 8 21-39, UP DM with CVD or LDL >=190
+26 IF BGPDMD6
IF BGPAGEB>20
IF BGPAGEB<40
IF BGPCVDL
SET BGPD8=1
+27 ;DENOM 9 40-75, UP DM with CVD or LDL =>190
+28 IF BGPDMD6
IF BGPAGEB>39
IF BGPAGEB<76
IF BGPCVDL
SET BGPD9=1
+29 ;DENOM 10 UP DM 76+ with cvd or ldl >=190
+30 IF BGPDMD6
IF BGPAGEB>75
IF BGPCVDL
SET BGPD10=1
+31 ;DENOM 11 up dm 40-75
+32 IF BGPDMD6
IF BGPAGEB>39
IF BGPAGEB<76
SET BGPD11=1
+33 IF BGPD7
SET BGPD12=1
+34 ;now exclude people
+35 SET (BGPEXL1,BGPEXL2,BGPEXL3,BGPEXL4,BGPEXL5,BGPSTAT,BGPEXL6,BGPEXL7)=""
+36 ;excl 1
SET BGPEXL1=$$STATALG^BGP8D213(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE,BGPBDATE,BGPEDATE)
IF BGPEXL1
SET (BGPN2,BGPN3)=1
GOTO ND
+37 ;ALCOHOL HEP
+38 SET BGPEXL1=$$ALCHEP(DFN,BGPBDATE,BGPEDATE)
IF BGPEXL1
SET BGPN2=1
GOTO ND
+39 ;NMI
+40 SET BGPEXL1=$$STATNMI(DFN,BGPBDATE,BGPEDATE)
IF BGPEXL1
SET BGPN2=1
GOTO ND
+41 ;PREGNANCY
+42 ;V17.1 CMI/LAB ADDED DATES FOR CURRENTLY PREGNANT
SET BGPEXL2=$$PREG^BGP8D715(DFN,BGPBDATE,BGPEDATE,1,1,,BGPBDATE,BGPEDATE,1)
IF BGPEXL2
SET BGPN2=1
GOTO ND
+43 ;cirrhosis of liver
+44 SET BGPEXL6=$$CLIVER^BGP8D213(DFN,BGPPBD,BGPEDATE)
IF BGPEXL6
SET BGPN2=1
GOTO ND
+45 ;breastfeeding
+46 SET BGPEXL2=$$BF^BGP8D21(DFN,BGPBDATE,BGPEDATE)
IF BGPEXL2
SET BGPN2=1
GOTO ND
+47 ;PALLIATIVE
+48 ;excl 3
SET BGPEXL3=$$LASTDX^BGP8UTL1(DFN,"BGP PALLIATIVE CARE DXS",BGPBDATE,BGPEDATE)
IF BGPEXL3
SET BGPN2=1
SET BGPEXL3=1_U_$$DATE^BGP8UTL($PIECE(BGPEXL3,U,3))_" Palliative Care"
GOTO ND
+49 ;ESRD
+50 ;excl 4 ESRD
SET BGPEXL4=$$ESRD^BGP8D211(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
IF BGPEXL4
SET BGPEXL4=1_U_$$DATE^BGP8UTL($PIECE(BGPEXL4,U,3))_" ESRD"
SET BGPN2=1
GOTO ND
+51 SET BGPEXL7=$$HEPA^BGP8D21A(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
IF BGPEXL7
SET BGPEXL7=1_U_$$DATE^BGP8UTL($PIECE(BGPEXL7,U,3))_" HEP A"
SET BGPN2=1
GOTO ND
+52 SET BGPEXL7=$$HEPB^BGP8D21A(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
IF BGPEXL7
SET BGPEXL7=1_U_$$DATE^BGP8UTL($PIECE(BGPEXL7,U,3))_" HEP B"
SET BGPN2=1
GOTO ND
+53 ;EXCL 5
+54 SET BGPSTAT=$$STATIN^BGP8D214(DFN,BGPBDATE,BGPEDATE,0)
+55 ;excl 5
SET BGPEXL5=$$LASTLDLV(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
IF BGPEXL5
IF '$PIECE(BGPCVDL,U,3)
IF 'BGPSTAT
SET BGPN2=1
GOTO ND
+56 ;
ND ;
+1 ;DENOM 6 active diabetic 21+
+2 IF BGPN2
IF BGPD1
SET BGPD6=1
+3 IF BGPN2
IF BGPD7
SET BGPD12=1
+4 ;EXCLUDE EXCLUSIONS FROM DENOMINATORS
IF BGPN2
SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=""
+5 ;not in at least UP denominator
IF '(BGPD1+BGPD2+BGPD3+BGPD4+BGPD5+BGPD6+BGPD7+BGPD8+BGPD9+BGPD10+BGPD11+BGPD12)
SET BGPSTOP=1
QUIT
+6 ;numerator
+7 IF 'BGPN2
SET BGPN1=BGPSTAT
SETL ;
+1 ;S BGPVALUE=$S(BGPD1:"STA.1.1",1:"")_" "_$S(BGPD2:"STA.2.1",1:"")_" "_$S(BGPD3:"STA.3.1",1:"")_" "_$S(BGPD4:"STA.4.1",1:"")_" "_$S(BGPD5:"STA.5.1",1:"")_" "_$S(BGPD6:"STA.6.1",1:"")_" "_$S(BGPD7:"STA.7.1",1:"")
+2 SET BGPVALUE=$SELECT(BGPDMD6:"UPDM",1:"")_$SELECT(BGPDMD2:",AD",1:"")_$SELECT(BGPDMD3:",AAD",1:"")_$SELECT($PIECE(BGPCVDL,U,2):" (CHD)",$PIECE(BGPCVDL,U,3):" (LDL)",$PIECE(BGPCVDL,U,4):" (HYPER CHOL)",1:"")_"|||"
+3 IF BGPN1
SET BGPVALUE=BGPVALUE_$PIECE(BGPN1,U,2)
+4 IF BGPEXL1
SET BGPVALUE=BGPVALUE_"Exclusion: "_$PIECE(BGPEXL1,U,2)
+5 IF BGPEXL2
SET BGPVALUE=BGPVALUE_"Exclusion: "_$PIECE(BGPEXL2,U,2)_" Pregnant/Breastfeeding"
+6 IF BGPEXL3
SET BGPVALUE=BGPVALUE_"Exclusion: "_$PIECE(BGPEXL3,U,2)
+7 IF BGPEXL4
SET BGPVALUE=BGPVALUE_"Exclusion: "_$PIECE(BGPEXL4,U,2)
+8 IF BGPEXL6
SET BGPVALUE=BGPVALUE_"Exclusion: "_$PIECE(BGPEXL6,U,2)_" Cirrhosis/Liver Dis"
+9 IF BGPEXL5
IF BGPN2
SET BGPVALUE=BGPVALUE_"Exclusion: "_$PIECE(BGPEXL5,U,2)
+10 IF BGPEXL7
SET BGPVALUE=BGPVALUE_"Exclusion: "_$PIECE(BGPEXL7,U,2)
+11 KILL BGPEXL1,BGPEXL2,BGPEXL3,BGPEXL4,BGPEXL5,BGPCVDL,BGPSTAT,BGPEXL6,BGPEXL7
+12 QUIT
CHDLDL(P,BDATE,EDATE) ;EP - chd or ldl =>190
+1 NEW RESULT
+2 SET RESULT=""
+3 IF $$CHD(P,BDATE,EDATE,0)
SET RESULT="1^1"
+4 KILL TMP($JOB,"A")
+5 IF $$HYPERCHO(P,BDATE,EDATE)
SET $PIECE(RESULT,U,4)=1
SET $PIECE(RESULT,U,1)=1
+6 IF $$LDL190(P,BDATE,EDATE)
SET $PIECE(RESULT,U,3)=1
SET $PIECE(RESULT,U,1)=1
+7 KILL ^TMP($JOB,"A")
+8 QUIT RESULT
ALCHEP(P,BDATE,EDATE) ;EP
+1 ;NOW CHECK ALCOHOL HEPATITIS
+2 NEW BGPG,Y,X,E
+3 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX [BGP ALCOHOL HEPATITIS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 IF $DATA(BGPG(1))
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG(1),U,1))_" Alc Hep"
+5 SET X=$$PLTAXID^BGP8DU(P,"BGP ALCOHOL HEPATITIS DXS",BDATE,EDATE)
+6 IF X
QUIT 1_U_"Prob List Alc Hep"
+7 SET X=$$IPLSNOID^BGP8DU(P,"PXRM BGP ACUTE ETOH HEPATITIS",BDATE,EDATE)
+8 IF X
QUIT 1_U_"Prob List Alc Hep"
+9 QUIT ""
HYPERCHO(P,BDATE,EDATE) ;
+1 ;NOW CHECK ALCOHOL HEPATITIS
+2 NEW BGPG,Y,X,E
+3 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX [BGP HYPERCHOLESTEROLEMIA DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 ;_U_$$DATE^BGP8UTL($P(BGPG(1),U,1))_" Alc Hep"
IF $DATA(BGPG(1))
QUIT 1
+5 SET X=$$PLTAXID^BGP8DU(P,"BGP HYPERCHOLESTEROLEMIA DXS",BDATE,EDATE)
+6 ;_U_"Prob List Alc Hep"
IF X
QUIT 1
+7 SET X=$$IPLSNOID^BGP8DU(P,"PXRM BGP HYPERCHOLESTEROLEMIA",BDATE,EDATE)
+8 ;_U_"Prob List Alc Hep"
IF X
QUIT 1
+9 QUIT ""
CHD(P,BDATE,EDATE,MIN) ;EP
+1 NEW A,B,E,T,X,G,V,Y,%,G,F,BGPG,BGPCNT,T1,BGPALL,T2,T3,T4,H
+2 SET X=$$CHDPL^BGP8D21A(P,EDATE)
+3 IF X
QUIT 1
+4 KILL BGPALL
+5 SET BGPCNT=0
+6 KILL ^TMP($JOB,"A")
+7 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+8 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+9 SET T=$ORDER(^ATXAX("B","BGP CHD DXS",0))
+10 SET T1=$ORDER(^ATXAX("B","BGP AMI DXS PAMT",0))
+11 SET T2=$ORDER(^ATXAX("B","BGP IVD DXS",0))
+12 SET T3=$ORDER(^ATXAX("B","BGP TIA DXS",0))
+13 SET T4=$ORDER(^ATXAX("B","BGP ARTERIAL DISEASE DXS",0))
+14 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(BGPCNT>MIN)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+15 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+16 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+17 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+18 ;Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
+19 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(BGPCNT>MIN)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
Begin DoDot:2
+20 SET %=$PIECE(^AUPNVPOV(Y,0),U)
+21 IF $$ICD^BGP8UTL2(%,T,9)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+22 IF $$ICD^BGP8UTL2(%,T1,9)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+23 IF $$ICD^BGP8UTL2(%,T2,9)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+24 IF $$ICD^BGP8UTL2(%,T3,9)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+25 IF $$ICD^BGP8UTL2(%,T4,9)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
End DoDot:2
End DoDot:1
+26 IF BGPCNT>MIN
QUIT 1
CHDP ;NOW CHECK FOR MINPROC
+1 ;S BGPCNT=0
+2 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(BGPCNT>MIN)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+3 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+4 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+5 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+6 ;Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
+7 SET T1=$ORDER(^ATXAX("B","BGP PCI DXS",0))
+8 SET T2=$ORDER(^ATXAX("B","BGP CABG DXS",0))
+9 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(BGPCNT>MIN)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
Begin DoDot:2
+10 SET %=$PIECE(^AUPNVPOV(Y,0),U)
+11 IF $$ICD^BGP8UTL2(%,T1,9)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+12 IF $$ICD^BGP8UTL2(%,T2,9)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
End DoDot:2
+13 IF BGPCNT>MIN
QUIT
+14 ;check for procedure in BGP CABG PROCS
+15 SET E=$ORDER(^ATXAX("B","BGP CABG PROCS",0))
+16 SET F=$ORDER(^ATXAX("B","BGP PCI CM PROCS",0))
+17 SET G=$ORDER(^ATXAX("B","BGP CAROTID INTERVENTION PROCS",0))
+18 SET Y=0
FOR
SET Y=$ORDER(^AUPNVPRC("AD",V,Y))
IF Y'=+Y!(BGPCNT>MIN)
QUIT
Begin DoDot:2
+19 IF '$DATA(^AUPNVPRC(Y,0))
QUIT
+20 IF $$ICD^BGP8UTL2($PIECE(^AUPNVPRC(Y,0),U,1),E,0)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+21 IF $$ICD^BGP8UTL2($PIECE(^AUPNVPRC(Y,0),U,1),F,0)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+22 IF $$ICD^BGP8UTL2($PIECE(^AUPNVPRC(Y,0),U,1),G,0)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
End DoDot:2
+23 IF BGPCNT>MIN
QUIT
+24 ;now check cpts
+25 SET E=$ORDER(^ATXAX("B","BGP CABG CPTS",0))
+26 SET F=$ORDER(^ATXAX("B","BGP PCI CPTS",0))
+27 SET G=$ORDER(^ATXAX("B","BGP REVASCULARIZATION CPTS",0))
+28 SET Y=0
FOR
SET Y=$ORDER(^AUPNVCPT("AD",V,Y))
IF Y'=+Y!(BGPCNT>MIN)
QUIT
Begin DoDot:2
+29 IF '$DATA(^AUPNVCPT(Y,0))
QUIT
+30 IF $$ICD^BGP8UTL2($PIECE(^AUPNVCPT(Y,0),U,1),E,1)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+31 IF $$ICD^BGP8UTL2($PIECE(^AUPNVCPT(Y,0),U,1),F,1)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+32 IF $$ICD^BGP8UTL2($PIECE(^AUPNVCPT(Y,0),U,1),G,1)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
End DoDot:2
+33 IF BGPCNT>MIN
QUIT
+34 ;now check TRANS
+35 SET E=$ORDER(^ATXAX("B","BGP CABG CPTS",0))
+36 SET F=$ORDER(^ATXAX("B","BGP PCI CPTS",0))
+37 SET G=$ORDER(^ATXAX("B","BGP REVASCULARIZATION CPTS",0))
+38 SET Y=0
FOR
SET Y=$ORDER(^AUPNVTC("AD",V,Y))
IF Y'=+Y!(BGPCNT>MIN)
QUIT
Begin DoDot:2
+39 IF '$DATA(^AUPNVTC(Y,0))
QUIT
+40 SET I=$PIECE(^AUPNVTC(Y,0),U,7)
+41 IF I=""
QUIT
+42 IF $$ICD^BGP8UTL2(I,E,1)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+43 IF $$ICD^BGP8UTL2(I,F,1)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
+44 IF $$ICD^BGP8UTL2(I,G,1)
IF '$DATA(BGPALL(V))
SET BGPALL(V)=""
SET BGPCNT=BGPCNT+1
QUIT
End DoDot:2
+45 QUIT
End DoDot:1
+46 IF BGPCNT>MIN
QUIT 1
+47 QUIT ""
LDL190(P,BDATE,EDATE) ;EP ldl >=190? EVER
+1 NEW T,A,E,LT,G,X,J,R
+2 KILL ^TMP($JOB,"A")
+3 SET A="^TMP($J,""A"","
SET %=P_"^ALL LAB;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,A)
+4 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+5 ;now go through all lab tests and see if any are the loinc codes in the taxonomy
+6 SET T=$ORDER(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
+7 SET LT=$ORDER(^ATXAX("B","BGP LDL LOINC CODES",0))
+8 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
QUIT
SET I=+$PIECE(^TMP($JOB,"A",X),U,4)
Begin DoDot:1
+9 SET %=+^AUPNVLAB(I,0)
SET R=$PIECE(^AUPNVLAB(I,0),U,4)
+10 IF $DATA(^ATXLAB(T,21,"B",%))
IF +R>189.999999
SET G=1
QUIT
+11 SET J=$PIECE($GET(^AUPNVLAB(I,11)),U,13)
+12 IF J=""
QUIT
+13 IF $$LOINC^BGP8D21(J,LT)
IF +R>189.99999
SET G=1
End DoDot:1
+14 KILL ^TMP($JOB,"A")
+15 QUIT G
LASTLDLV(P,BDATE,EDATE) ;EP
+1 NEW BGPG,BGPT,BGPC,BGPLT,T,B,E,D,L,X,R,G,C,%
+2 KILL BGPG,BGPT,BGPC
+3 SET BGPC=0
+4 ;now get all loinc/taxonomy tests
+5 SET T=$ORDER(^ATXAX("B","BGP LDL LOINC CODES",0))
+6 SET BGPLT=$ORDER(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
+7 SET B=9999999-BDATE
SET E=9999999-EDATE
SET D=E-1
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(D>B)!(BGPC)
QUIT
Begin DoDot:1
+8 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L
QUIT
Begin DoDot:2
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X
QUIT
Begin DoDot:3
+10 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+11 ;NO RESULT
IF $PIECE(^AUPNVLAB(X,0),U,4)=""
QUIT
+12 ;NON-NUMERIC RESULT
IF '+$PIECE(^AUPNVLAB(X,0),U,4)
QUIT
+13 IF BGPLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BGPLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
SET BGPC=BGPC+1
SET BGPT(BGPC)=$PIECE(^AUPNVLAB(X,0),U,4)_U_(9999999-D)
QUIT
+14 IF 'T
QUIT
+15 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+16 IF '$$LOINC(J,T)
QUIT
+17 SET R=$PIECE(^AUPNVLAB(X,0),U,4)
+18 IF 'R
SET R=""
+19 SET BGPC=BGPC+1
SET BGPT(BGPC)=$PIECE(^AUPNVLAB(X,0),U,4)_U_(9999999-D)
+20 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF 'BGPC
QUIT ""
+22 IF +BGPT(BGPC)<70
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPT(BGPC),U,2))_" LDL < 70"
+23 QUIT ""
STATNMI(P,NMIB,NMIE) ;EP
+1 ;nmi
+2 NEW BGPG,X,T,D,Y,N
+3 SET BGPG=""
+4 SET T=$ORDER(^ATXAX("B","BGP PQA STATIN MEDS",0))
+5 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 ;not an STATI
IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+7 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+8 SET Y=9999999-D
IF Y<NMIB
QUIT
+9 IF Y>NMIE
QUIT
+10 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+11 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+12 ;_" "_" "_$$VAL^XBDIQ1(9000022,X,1101)
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04)
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 IF BGPG
QUIT BGPG
+16 QUIT ""
