BGP8D722 ; IHS/CMI/LAB - measure MEDS ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
ACEALG(P,BDATE,EDATE) ;EP
K BGPG
D ACEIALG1^BGP8C11(P,EDATE,.BGPG)
S X=$O(BGPG(0))
I 'X Q ""
Q 1_U_BGPG(X)
;
ACECONT(P,BDATE,EDATE,NMIB,NMIE,RPBD,PREGBD) ;EP
NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,SN
S RPBD=$G(RPBD)
K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP CMS AORTIC STENOSIS 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))_" Contra Aortic POV "_$P(BGPG(1),U,2)
;
S BGPG=""
S T=$O(^ATXAX("B","BGP HEDIS ACEI 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))
.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(9000024,N,.04)
..Q
.Q
I BGPG Q BGPG
S BGPG=""
S T=$O(^ATXAX("B","BGP HEDIS ARB 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))
.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)
..Q
.Q
I BGPG Q BGPG
S X=$$PREG^BGP8D715(P,RPBD,RPED,1,1,"",RPBD,RPED) I X Q 1_U_"Contra pregnant"
K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT($S(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(NMIE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1_U_$$DATE^BGP8UTL($P(BGPG(1),U))_" Contra POV "_$P(BGPG(1),U,2)
K BGPG
S Y="BGPG("
S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT($S(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(NMIE) S E=$$START1^APCLDF(X,Y)
S SN=$O(^BGPSNOMR("B","BREASTFEEDING 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 T="BF-BC" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-BP" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-CS" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-EQ" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-FU" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-HC" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-ON" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-M" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-MK" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-N" S %=T_U_$P(BGPG(X),U) Q
.I $P(T,"-")]"",$D(^BGPSNOMR(SN,11,"B",$P(T,"-"))) S %=T_U_$P(BGPG(X),U) Q
I %]"" Q 1_U_$$DATE^BGP8UTL($P(%,U,2))_" Contra "_$P(%,U,1) ;"ACEI Contra - "_%
Q ""
ACERX(P,BDATE,EDATE,BGPNDAYS) ;EP
K BGPMEDS1
S K=0,R=""
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T=$O(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
S T1=$O(^ATXAX("B","BGP HEDIS ACEI NDC",0))
S T2=$O(^ATXAX("B","BGP HEDIS ARB MEDS",0))
S T3=$O(^ATXAX("B","BGP HEDIS ARB NDC",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1 G ACE1
.I T2,$D(^ATXAX(T2,21,"B",D)) S G=1 G ACE1
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
.I N]"",T3,$D(^ATXAX(T3,21,"B",N)) S G=1
.Q:'G
ACE1 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.S S=$$DAYS^BGP8D82(Y,V,EDATE)
.S K=S+K
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_"("_K_" TOTAL DAYS)"
ACEPRIO ;add any before
K BGPMEDS1
D GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1 G ACE2
.I T2,$D(^ATXAX(T2,21,"B",D)) S G=1 G ACE2
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G ACE2
.I N]"",T3,$D(^ATXAX(T3,21,"B",N)) S G=1
.Q:'G
ACE2 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.Q:J]""
.S D=$$FMDIFF^XLFDT(BDATE,$P($P(^AUPNVSIT(V,0),U),"."))
.S S=$P(^AUPNVMED(Y,0),U,7)
.S S=S-D
.S:S<0 S=0
.S K=S+K
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_"("_K_" TOTAL DAYS)"
Q 0_U_"("_K_" TOTAL DAYS)"
;
ACEREF(P,BDATE,EDATE) ;EP
S T=$O(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
S X=0,G="" F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X!(G) D
.Q:'$D(^ATXAX(T,21,"B",X))
.S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D!(G) D
..S Y=9999999-D I Y<BDATE Q
..I Y>EDATE Q
..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N!(G) D
...Q:$P($G(^AUPNPREF(N,0)),U,7)'="R"
...S G=1_U_$$DATE^BGP8UTL(Y)_" Refused "_$P(^PSDRUG(X,0),U,1)
..Q
.Q
I G Q G
S T=$O(^ATXAX("B","BGP HEDIS ARB MEDS",0))
S X=0,G="" F S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X!(G) D
.Q:'$D(^ATXAX(T,21,"B",X))
.S D=0 F S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D!(G) D
..S Y=9999999-D I Y<BDATE Q
..I Y>EDATE Q
..S N=0 F S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N!(G) D
...S G=1_U_$$DATE^BGP8UTL(Y)_" Refused "_$P(^PSDRUG(X,0),U,1)
..Q
.Q
Q G
STATALG(P,BDATE,EDATE,RPB,RPE) ;EP
NEW BGPG,BGPY,Y,X,N,Z,BGPC
S BGPC=""
K BGPG,BGPY S Y="BGPG(",X=P_"^ALL DX [BGP ASA ALLERGY 995.0-995.3;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S X=0 F S X=$O(BGPG(X)) Q:X'=+X S Y=+$P(BGPG(X),U,4) D
.S N=$$VAL^XBDIQ1(9000010.07,Y,.04) S N=$$UP^XLFSTR(N)
.I N["STATIN"!(N["STATINS"),N'["NYSTATIN" S BGPC=1_U_$$DATE^BGP8UTL($P(BGPG(X),U))_" ADR POV "_$P(BGPG(X),U,2)
.S T=$O(^ATXAX("B","BGP ADV EFF CARDIOVASC NEC",0))
.S Z=$P(^AUPNVPOV(Y,0),U,9) I Z]"",$$ICD^BGP8UTL2(Z,T,9) S BGPC=1_U_$$DATE^BGP8UTL($P(BGPG(X),U))_" ADR POV ["_$P(BGPG(X),U,2)_" + "_$P($$ICDDX^BGP8UTL2(Z),U,2)_"] "_N Q
.S Z=$P(^AUPNVPOV(Y,0),U,18) I Z]"",$$ICD^BGP8UTL2(Z,T,9) S BGPC=1_U_$$DATE^BGP8UTL($P(BGPG(X),U))_" ADR POV ["_$P(BGPG(X),U,2)_" + "_$P($$ICDDX^BGP8UTL2(Z),U,2)_"] "_N Q
.S Z=$P(^AUPNVPOV(Y,0),U,19) I Z]"",$$ICD^BGP8UTL2(Z,T,9) S BGPC=1_U_$$DATE^BGP8UTL($P(BGPG(X),U))_" ADR POV ["_$P(BGPG(X),U,2)_" + "_$P($$ICDDX^BGP8UTL2(Z),U,2)_"] "_N Q
.Q
I BGPC Q BGPC
K BGPG S BGPC=0 S Y="BGPG(",X=P_"^ALL DX [BGP HX DRUG ALLERGY NEC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S X=0 F S X=$O(BGPG(X)) Q:X'=+X S Y=+$P(BGPG(X),U,4) D
.S N=$$VAL^XBDIQ1(9000010.07,Y,.04),N=$$UP^XLFSTR(N)
.I N["STATIN"!(N["STATINS"),N'["NYSTATIN" S BGPC=1_U_$$DATE^BGP8UTL($P(BGPG(X),U))_" ADR POV "_$P(BGPG(X),U,2) ;_"]"
I BGPC Q BGPC
;PL
S BGPC=0
S T="",T=$O(^ATXAX("B","BGP ASA ALLERGY 995.0-995.3",0))
S X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
.S I=$P($G(^AUPNPROB(X,0)),U),Y=$P($$ICDDX^BGP8UTL2(I),U,2)
.S N=$$VAL^XBDIQ1(9000011,X,.05),N=$$UP^XLFSTR(N)
.I EDATE,$P(^AUPNPROB(X,0),U,13)>EDATE Q
.I $P(^AUPNPROB(X,0),U,13)="" Q:$P(^AUPNPROB(X,0),U,8)>EDATE
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.I $P(^AUPNPROB(X,0),U,13)]"",$P(^AUPNPROB(X,0),U,13)>EDATE Q
.I $$ICD^BGP8UTL2(I,$O(^ATXAX("B","BGP HX DRUG ALLERGY NEC",0)),9)!($$ICD^BGP8UTL2(I,T,9)),N["STATIN"!(N["STATINS"),N'["NYSTATIN" S BGPC=1_U_$$DATE^BGP8UTL($P(^AUPNPROB(X,0),U,8))_" ADR Problem List "_Y Q
.S S=$$VAL^XBDIQ1(9000011,X,80001)
.I S]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP ADR STATIN",S)) S BGPC=1_U_$$DATE^BGP8UTL($P(^AUPNPROB(X,0),U,8))_" ADR Problem List "_S Q
I BGPC Q BGPC
;ART
S BGPC=0
S X=0 F S X=$O(^GMR(120.8,"B",P,X)) Q:X'=+X D
.Q:$P($P($G(^GMR(120.8,X,0)),U,4),".")>EDATE
.S N=$P($G(^GMR(120.8,X,0)),U,2),N=$$UP^XLFSTR(N)
.I N["STATIN",N'["NYSTATIN" S BGPC=1_U_$$DATE^BGP8UTL($P(^GMR(120.8,X,0),U,4))_" ADR Allergy Tracking "_N
I BGPC Q BGPC
;now go into the report period items
K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP MYOPATHY/MYALGIA;DURING "_$$FMTE^XLFDT(RPB)_"-"_$$FMTE^XLFDT(RPE) S E=$$START1^APCLDF(X,Y)
I $D(BGPG(1)) Q 1_U_$$DATE^BGP8UTL($P(BGPG(1),U))_" ADR POV "_$P(BGPG(1),U,2) ;_"]"
S X=$$PLTAXND^BGP8DU(P,"BGP MYOPATHY/MYALGIA",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"ADR "_$P(X,U,2) ;V17
S X=$$IPLSNOND^BGP8DU(P,"PXRM BGP MYOPATHY MYALGIA",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"ADR "_$P(X,U,2) ;V17
;
S BGPG=""
S T=$O(^ATXAX("B","BGP CREATINE KINASE LOINC",0))
S BGPLT=$O(^ATXLAB("B","BGP CREATINE KINASE TAX",0))
S B=9999999-RPB,E=9999999-RPE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BGPG) 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))
...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) I $$RESCK(X) S BGPG=1_U_$$DATE^BGP8UTL((9999999-D))_" ADR creat kinase of "_$P(^AUPNVLAB(X,0),U,4) Q
...Q:'T
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC^BGP8D2(J,T)
...I $$RESCK(X) S BGPG=1_U_$$DATE^BGP8UTL((9999999-D))_" ADR creat kinase of "_$P(^AUPNVLAB(X,0),U,4) Q
...Q
I BGPG Q BGPG
S T=$O(^ATXAX("B","BGP ALT LOINC",0))
S BGPLT=$O(^ATXLAB("B","DM AUDIT ALT TAX",0))
S T2=$O(^ATXAX("B","BGP AST LOINC",0))
S BGPLT2=$O(^ATXLAB("B","DM AUDIT AST TAX",0))
S B=9999999-$$FMADD^XLFDT(EDATE,-365),E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BGPG) 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))
...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=BGPC+1,BGPC((9999999-D))=X_U_$P(^AUPNVLAB(X,0),U,4)_U_$P($G(^AUPNVLAB(X,11)),U,5) Q
...I BGPLT2,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT2,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=BGPC+1,BGPC((9999999-D))=X_U_$P(^AUPNVLAB(X,0),U,4)_U_$P($G(^AUPNVLAB(X,11)),U,5) Q
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...I '$$LOINC^BGP8D2(J,T),'$$LOINC^BGP8D2(J,T2)
...S BGPC=BGPC+1,BGPC((9999999-D))=X_U_$P(^AUPNVLAB(X,0),U,4)_U_$P($G(^AUPNVLAB(X,11)),U,5) Q
...Q
;are they 2 consecutive
S BGPG=""
S X=0 F S X=$O(BGPC(X)) Q:X'=+X!(BGPG) D
.Q:'$$RESAL(BGPC(X))
.;is next one also bad?
.S Y=$O(BGPC(X))
.Q:Y=""
.I $$RESAL(BGPC(Y)) S BGPG=1_U_" ADR AST/ALT" Q
.Q
I BGPG Q BGPG
Q 0
;
RESAL(Y) ;EP
NEW V,ULN
S V=+$P(Y,U,2),ULN=$P(Y,U,3)
I ULN="" Q ""
I V>(ULN*3) Q 1
Q ""
STV(X) ;EP - strip NON NUMERICS
I X="" Q X
I X="?" Q ""
NEW A,B,L
S L=$L(X)
I $E(X)?1N ;S X=+X
F B=1:1:L S A=$E(X,B) Q:A="" I A'?1N,A'?1"." S X=$$STRIP^XLFSTR(X,A) S B=B-1
I X="" Q ""
S X=$$STRIP^XLFSTR(X," ")
Q X
RESCK(X) ;EP
NEW V,ULN
S V=$P(^AUPNVLAB(X,0),U,4)
S V=$$STV(V)
I V>10000 Q 1
S ULN=$P($G(^AUPNVLAB(X,11)),U,5)
I ULN="" Q 0 ;no upper limit
I V>(ULN*10) Q 1
Q 0
STATCON(P,BDATE,EDATE,NMIB,NMIE) ;EP does patient have an STATIN Contra
NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,SN
;
;pregnant
S X=$$PREG^BGP8D715(P,BDATE,EDATE,1,1,,BDATE,EDATE) I X Q 1_U_"Contra pregnant"
;nmi
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))
.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) ;
.Q
I BGPG Q BGPG
;
K BGPG S Y="BGPG(",X=P_"^LAST DX [BGP BREASTFEEDING 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))_" Contra POV "_$P(BGPG(1),U,2) ;
;
K BGPG
S Y="BGPG("
S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
S SN=$O(^BGPSNOMR("B","BREASTFEEDING 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 T="BF-BC" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-BP" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-CS" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-EQ" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-FU" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-HC" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-ON" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-M" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-MK" S %=T_U_$P(BGPG(X),U) Q
.I T="BF-N" S %=T_U_$P(BGPG(X),U) Q
.I $P(T,"-")]"",$D(^BGPSNOMR(SN,11,"B",$P(T,"-"))) S %=T_U_$P(BGPG(X),U) Q
I %]"" Q 1_U_$$DATE^BGP8UTL($P(%,U,2))_"Contra "_$P(%,U,1)
;
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))_"Contra POV "_$P(BGPG(1),U,2) ;
S X=$$PLTAXND^BGP8DU(P,"BGP ALCOHOL HEPATITIS DXS",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2)
S X=$$IPLSNOND^BGP8DU(P,"PXRM BGP ACUTE ETOH HEPATITIS",EDATE) I X Q 1_U_$$DATE^BGP8UTL($P(X,U,3))_U_"Contra "_$P(X,U,2)
Q ""
STATRX(P,BDATE,EDATE,BGPNDAYS) ;EP
K BGPMEDS1 S K=0,R=""
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T=$O(^ATXAX("B","BGP PQA STATIN MEDS",0))
S T1=$O(^ATXAX("B","BGP PQA STATIN NDC",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1 G STAT1
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
.Q:'G
STAT1 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.S S=$$DAYS^BGP8D82(Y,V,EDATE)
.S K=S+K
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_"("_K_" TOTAL DAYS)"
STATPRIO ;now add in any before BEG
K BGPMEDS1
D GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1 G STAT2
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G STAT2
.Q:'G
STAT2 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.;
.Q:J]""
.S D=$$FMDIFF^XLFDT(BDATE,$P($P(^AUPNVSIT(V,0),U),"."))
.S S=$P(^AUPNVMED(Y,0),U,7)
.S S=S-D
.S:S<0 S=0
.S K=S+K
.I R]"" S R=R_";"
.S R=R_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
I K>BGPNDAYS Q 1_U_"("_K_" TOTAL DAYS)"
Q 0_U_"("_K_" TOTAL DAYS)"
BGP8D722 ; IHS/CMI/LAB - measure MEDS ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
ACEALG(P,BDATE,EDATE) ;EP
+1 KILL BGPG
+2 DO ACEIALG1^BGP8C11(P,EDATE,.BGPG)
+3 SET X=$ORDER(BGPG(0))
+4 IF 'X
QUIT ""
+5 QUIT 1_U_BGPG(X)
+6 ;
ACECONT(P,BDATE,EDATE,NMIB,NMIE,RPBD,PREGBD) ;EP
+1 NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,SN
+2 SET RPBD=$GET(RPBD)
+3 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX [BGP CMS AORTIC STENOSIS 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))_" Contra Aortic POV "_$PIECE(BGPG(1),U,2)
+5 ;
+6 SET BGPG=""
+7 SET T=$ORDER(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
+8 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+9 IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+10 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+11 SET Y=9999999-D
IF Y<NMIB
QUIT
+12 IF Y>NMIE
QUIT
+13 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+14 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+15 SET BGPG=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000024,N,.04)
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 IF BGPG
QUIT BGPG
+19 SET BGPG=""
+20 SET T=$ORDER(^ATXAX("B","BGP HEDIS ARB MEDS",0))
+21 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+22 IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+23 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+24 SET Y=9999999-D
IF Y<NMIB
QUIT
+25 IF Y>NMIE
QUIT
+26 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+27 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+28 SET BGPG=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPREF(N,0),U,3))_" Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04)
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 IF BGPG
QUIT BGPG
+32 SET X=$$PREG^BGP8D715(P,RPBD,RPED,1,1,"",RPBD,RPED)
IF X
QUIT 1_U_"Contra pregnant"
+33 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT($SELECT(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(NMIE)
SET E=$$START1^APCLDF(X,Y)
+34 IF $DATA(BGPG(1))
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG(1),U))_" Contra POV "_$PIECE(BGPG(1),U,2)
+35 KILL BGPG
+36 SET Y="BGPG("
+37 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT($SELECT(RPBD:RPBD,1:NMIB))_"-"_$$FMTE^XLFDT(NMIE)
SET E=$$START1^APCLDF(X,Y)
+38 SET SN=$ORDER(^BGPSNOMR("B","BREASTFEEDING PATIENT ED",0))
+39 SET (X,D)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(%]"")
QUIT
Begin DoDot:1
+40 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPG(X),U,4),0),U)
+41 IF 'T
QUIT
+42 IF '$DATA(^AUTTEDT(T,0))
QUIT
+43 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+44 IF T="BF-BC"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+45 IF T="BF-BP"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+46 IF T="BF-CS"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+47 IF T="BF-EQ"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+48 IF T="BF-FU"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+49 IF T="BF-HC"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+50 IF T="BF-ON"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+51 IF T="BF-M"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+52 IF T="BF-MK"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+53 IF T="BF-N"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+54 IF $PIECE(T,"-")]""
IF $DATA(^BGPSNOMR(SN,11,"B",$PIECE(T,"-")))
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
End DoDot:1
+55 ;"ACEI Contra - "_%
IF %]""
QUIT 1_U_$$DATE^BGP8UTL($PIECE(%,U,2))_" Contra "_$PIECE(%,U,1)
+56 QUIT ""
ACERX(P,BDATE,EDATE,BGPNDAYS) ;EP
+1 KILL BGPMEDS1
+2 SET K=0
SET R=""
+3 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+4 IF '$DATA(BGPMEDS1)
QUIT ""
+5 SET T=$ORDER(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
+6 SET T1=$ORDER(^ATXAX("B","BGP HEDIS ACEI NDC",0))
+7 SET T2=$ORDER(^ATXAX("B","BGP HEDIS ARB MEDS",0))
+8 SET T3=$ORDER(^ATXAX("B","BGP HEDIS ARB NDC",0))
+9 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+10 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+11 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+12 SET G=0
+13 SET D=$PIECE(^AUPNVMED(Y,0),U)
+14 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO ACE1
+15 IF T2
IF $DATA(^ATXAX(T2,21,"B",D))
SET G=1
GOTO ACE1
+16 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+17 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
+18 IF N]""
IF T3
IF $DATA(^ATXAX(T3,21,"B",N))
SET G=1
+19 IF 'G
QUIT
ACE1 ;
+1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+2 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+3 IF 'V
QUIT
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 SET S=$$DAYS^BGP8D82(Y,V,EDATE)
+6 SET K=S+K
+7 IF R]""
SET R=R_";"
+8 SET R=R_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+9 IF K>BGPNDAYS
QUIT 1_U_"("_K_" TOTAL DAYS)"
ACEPRIO ;add any before
+1 KILL BGPMEDS1
+2 DO GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
QUIT ""
+4 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+5 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+6 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+7 SET G=0
+8 SET D=$PIECE(^AUPNVMED(Y,0),U)
+9 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO ACE2
+10 IF T2
IF $DATA(^ATXAX(T2,21,"B",D))
SET G=1
GOTO ACE2
+11 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+12 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
GOTO ACE2
+13 IF N]""
IF T3
IF $DATA(^ATXAX(T3,21,"B",N))
SET G=1
+14 IF 'G
QUIT
ACE2 ;
+1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+2 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+3 IF 'V
QUIT
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 IF J]""
QUIT
+6 SET D=$$FMDIFF^XLFDT(BDATE,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+7 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+8 SET S=S-D
+9 IF S<0
SET S=0
+10 SET K=S+K
+11 IF R]""
SET R=R_";"
+12 SET R=R_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+13 IF K>BGPNDAYS
QUIT 1_U_"("_K_" TOTAL DAYS)"
+14 QUIT 0_U_"("_K_" TOTAL DAYS)"
+15 ;
ACEREF(P,BDATE,EDATE) ;EP
+1 SET T=$ORDER(^ATXAX("B","BGP HEDIS ACEI MEDS",0))
+2 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+3 IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+4 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+5 SET Y=9999999-D
IF Y<BDATE
QUIT
+6 IF Y>EDATE
QUIT
+7 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+8 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="R"
QUIT
+9 SET G=1_U_$$DATE^BGP8UTL(Y)_" Refused "_$PIECE(^PSDRUG(X,0),U,1)
End DoDot:3
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 IF G
QUIT G
+13 SET T=$ORDER(^ATXAX("B","BGP HEDIS ARB MEDS",0))
+14 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+15 IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+16 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D!(G)
QUIT
Begin DoDot:2
+17 SET Y=9999999-D
IF Y<BDATE
QUIT
+18 IF Y>EDATE
QUIT
+19 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N!(G)
QUIT
Begin DoDot:3
+20 SET G=1_U_$$DATE^BGP8UTL(Y)_" Refused "_$PIECE(^PSDRUG(X,0),U,1)
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT G
STATALG(P,BDATE,EDATE,RPB,RPE) ;EP
+1 NEW BGPG,BGPY,Y,X,N,Z,BGPC
+2 SET BGPC=""
+3 KILL BGPG,BGPY
SET Y="BGPG("
SET X=P_"^ALL DX [BGP ASA ALLERGY 995.0-995.3;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 SET X=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPG(X),U,4)
Begin DoDot:1
+5 SET N=$$VAL^XBDIQ1(9000010.07,Y,.04)
SET N=$$UP^XLFSTR(N)
+6 IF N["STATIN"!(N["STATINS")
IF N'["NYSTATIN"
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(BGPG(X),U))_" ADR POV "_$PIECE(BGPG(X),U,2)
+7 SET T=$ORDER(^ATXAX("B","BGP ADV EFF CARDIOVASC NEC",0))
+8 SET Z=$PIECE(^AUPNVPOV(Y,0),U,9)
IF Z]""
IF $$ICD^BGP8UTL2(Z,T,9)
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(BGPG(X),U))_" ADR POV ["_$PIECE(BGPG(X),U,2)_" + "_$PIECE($$ICDDX^BGP8UTL2(Z),U,2)_"] "_N
QUIT
+9 SET Z=$PIECE(^AUPNVPOV(Y,0),U,18)
IF Z]""
IF $$ICD^BGP8UTL2(Z,T,9)
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(BGPG(X),U))_" ADR POV ["_$PIECE(BGPG(X),U,2)_" + "_$PIECE($$ICDDX^BGP8UTL2(Z),U,2)_"] "_N
QUIT
+10 SET Z=$PIECE(^AUPNVPOV(Y,0),U,19)
IF Z]""
IF $$ICD^BGP8UTL2(Z,T,9)
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(BGPG(X),U))_" ADR POV ["_$PIECE(BGPG(X),U,2)_" + "_$PIECE($$ICDDX^BGP8UTL2(Z),U,2)_"] "_N
QUIT
+11 QUIT
End DoDot:1
+12 IF BGPC
QUIT BGPC
+13 KILL BGPG
SET BGPC=0
SET Y="BGPG("
SET X=P_"^ALL DX [BGP HX DRUG ALLERGY NEC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+14 SET X=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPG(X),U,4)
Begin DoDot:1
+15 SET N=$$VAL^XBDIQ1(9000010.07,Y,.04)
SET N=$$UP^XLFSTR(N)
+16 ;_"]"
IF N["STATIN"!(N["STATINS")
IF N'["NYSTATIN"
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(BGPG(X),U))_" ADR POV "_$PIECE(BGPG(X),U,2)
End DoDot:1
+17 IF BGPC
QUIT BGPC
+18 ;PL
+19 SET BGPC=0
+20 SET T=""
SET T=$ORDER(^ATXAX("B","BGP ASA ALLERGY 995.0-995.3",0))
+21 SET X=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+22 SET I=$PIECE($GET(^AUPNPROB(X,0)),U)
SET Y=$PIECE($$ICDDX^BGP8UTL2(I),U,2)
+23 SET N=$$VAL^XBDIQ1(9000011,X,.05)
SET N=$$UP^XLFSTR(N)
+24 IF EDATE
IF $PIECE(^AUPNPROB(X,0),U,13)>EDATE
QUIT
+25 IF $PIECE(^AUPNPROB(X,0),U,13)=""
IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
QUIT
+26 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+27 IF $PIECE(^AUPNPROB(X,0),U,13)]""
IF $PIECE(^AUPNPROB(X,0),U,13)>EDATE
QUIT
+28 IF $$ICD^BGP8UTL2(I,$ORDER(^ATXAX("B","BGP HX DRUG ALLERGY NEC",0)),9)!($$ICD^BGP8UTL2(I,T,9))
IF N["STATIN"!(N["STATINS")
IF N'["NYSTATIN"
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPROB(X,0),U,8))_" ADR Problem List "_Y
QUIT
+29 SET S=$$VAL^XBDIQ1(9000011,X,80001)
+30 IF S]""
IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,"PXRM BGP ADR STATIN",S))
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPROB(X,0),U,8))_" ADR Problem List "_S
QUIT
End DoDot:1
+31 IF BGPC
QUIT BGPC
+32 ;ART
+33 SET BGPC=0
+34 SET X=0
FOR
SET X=$ORDER(^GMR(120.8,"B",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+35 IF $PIECE($PIECE($GET(^GMR(120.8,X,0)),U,4),".")>EDATE
QUIT
+36 SET N=$PIECE($GET(^GMR(120.8,X,0)),U,2)
SET N=$$UP^XLFSTR(N)
+37 IF N["STATIN"
IF N'["NYSTATIN"
SET BGPC=1_U_$$DATE^BGP8UTL($PIECE(^GMR(120.8,X,0),U,4))_" ADR Allergy Tracking "_N
End DoDot:1
+38 IF BGPC
QUIT BGPC
+39 ;now go into the report period items
+40 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX [BGP MYOPATHY/MYALGIA;DURING "_$$FMTE^XLFDT(RPB)_"-"_$$FMTE^XLFDT(RPE)
SET E=$$START1^APCLDF(X,Y)
+41 ;_"]"
IF $DATA(BGPG(1))
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG(1),U))_" ADR POV "_$PIECE(BGPG(1),U,2)
+42 ;V17
SET X=$$PLTAXND^BGP8DU(P,"BGP MYOPATHY/MYALGIA",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"ADR "_$PIECE(X,U,2)
+43 ;V17
SET X=$$IPLSNOND^BGP8DU(P,"PXRM BGP MYOPATHY MYALGIA",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"ADR "_$PIECE(X,U,2)
+44 ;
+45 SET BGPG=""
+46 SET T=$ORDER(^ATXAX("B","BGP CREATINE KINASE LOINC",0))
+47 SET BGPLT=$ORDER(^ATXLAB("B","BGP CREATINE KINASE TAX",0))
+48 SET B=9999999-RPB
SET E=9999999-RPE
SET D=E-1
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(D>B)!(BGPG)
QUIT
Begin DoDot:1
+49 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L
QUIT
Begin DoDot:2
+50 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X
QUIT
Begin DoDot:3
+51 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+52 IF BGPLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BGPLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
IF $$RESCK(X)
SET BGPG=1_U_$$DATE^BGP8UTL((9999999-D))_" ADR creat kinase of "_$PIECE(^AUPNVLAB(X,0),U,4)
QUIT
+53 IF 'T
QUIT
+54 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+55 IF '$$LOINC^BGP8D2(J,T)
QUIT
+56 IF $$RESCK(X)
SET BGPG=1_U_$$DATE^BGP8UTL((9999999-D))_" ADR creat kinase of "_$PIECE(^AUPNVLAB(X,0),U,4)
QUIT
+57 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+58 IF BGPG
QUIT BGPG
+59 SET T=$ORDER(^ATXAX("B","BGP ALT LOINC",0))
+60 SET BGPLT=$ORDER(^ATXLAB("B","DM AUDIT ALT TAX",0))
+61 SET T2=$ORDER(^ATXAX("B","BGP AST LOINC",0))
+62 SET BGPLT2=$ORDER(^ATXLAB("B","DM AUDIT AST TAX",0))
+63 SET B=9999999-$$FMADD^XLFDT(EDATE,-365)
SET E=9999999-EDATE
SET D=E-1
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(D>B)!(BGPG)
QUIT
Begin DoDot:1
+64 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L
QUIT
Begin DoDot:2
+65 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X
QUIT
Begin DoDot:3
+66 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+67 IF BGPLT
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BGPLT,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
SET BGPC=BGPC+1
SET BGPC((9999999-D))=X_U_$PIECE(^AUPNVLAB(X,0),U,4)_U_$PIECE($GET(^AUPNVLAB(X,11)),U,5)
QUIT
+68 IF BGPLT2
IF $PIECE(^AUPNVLAB(X,0),U)
IF $DATA(^ATXLAB(BGPLT2,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
SET BGPC=BGPC+1
SET BGPC((9999999-D))=X_U_$PIECE(^AUPNVLAB(X,0),U,4)_U_$PIECE($GET(^AUPNVLAB(X,11)),U,5)
QUIT
+69 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+70 IF '$$LOINC^BGP8D2(J,T)
IF '$$LOINC^BGP8D2(J,T2)
+71 SET BGPC=BGPC+1
SET BGPC((9999999-D))=X_U_$PIECE(^AUPNVLAB(X,0),U,4)_U_$PIECE($GET(^AUPNVLAB(X,11)),U,5)
QUIT
+72 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+73 ;are they 2 consecutive
+74 SET BGPG=""
+75 SET X=0
FOR
SET X=$ORDER(BGPC(X))
IF X'=+X!(BGPG)
QUIT
Begin DoDot:1
+76 IF '$$RESAL(BGPC(X))
QUIT
+77 ;is next one also bad?
+78 SET Y=$ORDER(BGPC(X))
+79 IF Y=""
QUIT
+80 IF $$RESAL(BGPC(Y))
SET BGPG=1_U_" ADR AST/ALT"
QUIT
+81 QUIT
End DoDot:1
+82 IF BGPG
QUIT BGPG
+83 QUIT 0
+84 ;
RESAL(Y) ;EP
+1 NEW V,ULN
+2 SET V=+$PIECE(Y,U,2)
SET ULN=$PIECE(Y,U,3)
+3 IF ULN=""
QUIT ""
+4 IF V>(ULN*3)
QUIT 1
+5 QUIT ""
STV(X) ;EP - strip NON NUMERICS
+1 IF X=""
QUIT X
+2 IF X="?"
QUIT ""
+3 NEW A,B,L
+4 SET L=$LENGTH(X)
+5 ;S X=+X
IF $EXTRACT(X)?1N
+6 FOR B=1:1:L
SET A=$EXTRACT(X,B)
IF A=""
QUIT
IF A'?1N
IF A'?1"."
SET X=$$STRIP^XLFSTR(X,A)
SET B=B-1
+7 IF X=""
QUIT ""
+8 SET X=$$STRIP^XLFSTR(X," ")
+9 QUIT X
RESCK(X) ;EP
+1 NEW V,ULN
+2 SET V=$PIECE(^AUPNVLAB(X,0),U,4)
+3 SET V=$$STV(V)
+4 IF V>10000
QUIT 1
+5 SET ULN=$PIECE($GET(^AUPNVLAB(X,11)),U,5)
+6 ;no upper limit
IF ULN=""
QUIT 0
+7 IF V>(ULN*10)
QUIT 1
+8 QUIT 0
STATCON(P,BDATE,EDATE,NMIB,NMIE) ;EP does patient have an STATIN Contra
+1 NEW ED,BD,BGPG,BGPC,X,Y,Z,N,E,SN
+2 ;
+3 ;pregnant
+4 SET X=$$PREG^BGP8D715(P,BDATE,EDATE,1,1,,BDATE,EDATE)
IF X
QUIT 1_U_"Contra pregnant"
+5 ;nmi
+6 SET BGPG=""
+7 SET T=$ORDER(^ATXAX("B","BGP PQA STATIN MEDS",0))
+8 SET X=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,50,X))
IF X'=+X
QUIT
Begin DoDot:1
+9 IF '$DATA(^ATXAX(T,21,"B",X))
QUIT
+10 SET D=0
FOR
SET D=$ORDER(^AUPNPREF("AA",P,50,X,D))
IF D'=+D
QUIT
Begin DoDot:2
+11 SET Y=9999999-D
IF Y<NMIB
QUIT
+12 IF Y>NMIE
QUIT
+13 SET N=0
FOR
SET N=$ORDER(^AUPNPREF("AA",P,50,X,D,N))
IF N'=+N
QUIT
Begin DoDot:3
+14 IF $PIECE($GET(^AUPNPREF(N,0)),U,7)'="N"
QUIT
+15 ;
SET BGPG=1_U_$$DATE^BGP8UTL($PIECE(^AUPNPREF(N,0),U,3))_"Contra NMI "_$$VAL^XBDIQ1(9000022,N,.04)
End DoDot:3
End DoDot:2
+16 QUIT
End DoDot:1
+17 IF BGPG
QUIT BGPG
+18 ;
+19 KILL BGPG
SET Y="BGPG("
SET X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+20 ;
IF $DATA(BGPG(1))
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG(1),U))_" Contra POV "_$PIECE(BGPG(1),U,2)
+21 ;
+22 KILL BGPG
+23 SET Y="BGPG("
+24 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+25 SET SN=$ORDER(^BGPSNOMR("B","BREASTFEEDING PATIENT ED",0))
+26 SET (X,D)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(%]"")
QUIT
Begin DoDot:1
+27 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPG(X),U,4),0),U)
+28 IF 'T
QUIT
+29 IF '$DATA(^AUTTEDT(T,0))
QUIT
+30 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+31 IF T="BF-BC"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+32 IF T="BF-BP"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+33 IF T="BF-CS"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+34 IF T="BF-EQ"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+35 IF T="BF-FU"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+36 IF T="BF-HC"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+37 IF T="BF-ON"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+38 IF T="BF-M"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+39 IF T="BF-MK"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+40 IF T="BF-N"
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
+41 IF $PIECE(T,"-")]""
IF $DATA(^BGPSNOMR(SN,11,"B",$PIECE(T,"-")))
SET %=T_U_$PIECE(BGPG(X),U)
QUIT
End DoDot:1
+42 IF %]""
QUIT 1_U_$$DATE^BGP8UTL($PIECE(%,U,2))_"Contra "_$PIECE(%,U,1)
+43 ;
+44 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)
+45 ;
IF $DATA(BGPG(1))
QUIT 1_U_$$DATE^BGP8UTL($PIECE(BGPG(1),U))_"Contra POV "_$PIECE(BGPG(1),U,2)
+46 SET X=$$PLTAXND^BGP8DU(P,"BGP ALCOHOL HEPATITIS DXS",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+47 SET X=$$IPLSNOND^BGP8DU(P,"PXRM BGP ACUTE ETOH HEPATITIS",EDATE)
IF X
QUIT 1_U_$$DATE^BGP8UTL($PIECE(X,U,3))_U_"Contra "_$PIECE(X,U,2)
+48 QUIT ""
STATRX(P,BDATE,EDATE,BGPNDAYS) ;EP
+1 KILL BGPMEDS1
SET K=0
SET R=""
+2 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
QUIT ""
+4 SET T=$ORDER(^ATXAX("B","BGP PQA STATIN MEDS",0))
+5 SET T1=$ORDER(^ATXAX("B","BGP PQA STATIN NDC",0))
+6 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+7 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+8 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+9 SET G=0
+10 SET D=$PIECE(^AUPNVMED(Y,0),U)
+11 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO STAT1
+12 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+13 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
+14 IF 'G
QUIT
STAT1 ;
+1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+2 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+3 IF 'V
QUIT
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 SET S=$$DAYS^BGP8D82(Y,V,EDATE)
+6 SET K=S+K
+7 IF R]""
SET R=R_";"
+8 SET R=R_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+9 IF K>BGPNDAYS
QUIT 1_U_"("_K_" TOTAL DAYS)"
STATPRIO ;now add in any before BEG
+1 KILL BGPMEDS1
+2 DO GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BDATE,-365),BDATE,,,,,.BGPMEDS1)
+3 IF '$DATA(BGPMEDS1)
QUIT ""
+4 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+5 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+6 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+7 SET G=0
+8 SET D=$PIECE(^AUPNVMED(Y,0),U)
+9 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO STAT2
+10 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+11 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
GOTO STAT2
+12 IF 'G
QUIT
STAT2 ;
+1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+2 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+3 IF 'V
QUIT
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 ;
+6 IF J]""
QUIT
+7 SET D=$$FMDIFF^XLFDT(BDATE,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+8 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+9 SET S=S-D
+10 IF S<0
SET S=0
+11 SET K=S+K
+12 IF R]""
SET R=R_";"
+13 SET R=R_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_"("_S_")"
End DoDot:1
+14 IF K>BGPNDAYS
QUIT 1_U_"("_K_" TOTAL DAYS)"
+15 QUIT 0_U_"("_K_" TOTAL DAYS)"
