Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP4D211

BGP4D211.m

Go to the documentation of this file.
  1. BGP4D211 ; IHS/CMI/LAB - measure 6 ; 19 Sep 2013 8:12 AM
  1. ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
  1. ;
  1. DNKA(V) ;EP
  1. NEW D,N
  1. S D=$$PRIMPOV^APCLV(V,"C")
  1. I D=".0860" Q 1
  1. S N=$$PRIMPOV^APCLV(V,"N")
  1. I $E(D)="V",N["DNKA" Q 1
  1. I $E(D)="V",N["DID NOT KEEP APPOINTMENT" Q 1
  1. I $E(D)="V",N["DID NOT KEEP APPT" Q 1
  1. Q 0
  1. GFR(P,BDATE,EDATE) ;EP
  1. S BGPC=""
  1. S T=$O(^LAB(60,"B","ESTIMATED GFR",0))
  1. S T1=$O(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))
  1. S T2=$O(^ATXAX("B","BGP ESTIMATED GFR LOINC",0))
  1. 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
  1. .S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"") D
  1. ..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"") D
  1. ...Q:'$D(^AUPNVLAB(X,0))
  1. ...Q:$P(^AUPNVLAB(X,0),U,4)=""
  1. ...I T,$P(^AUPNVLAB(X,0),U)=T S BGPC=1_U_(9999999-D) Q
  1. ...I T1,$D(^ATXLAB(T1,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=1_U_(9999999-D) Q
  1. ...Q:'T2
  1. ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
  1. ...Q:'$$LOINC(J,T2)
  1. ...S BGPC=1_U_(9999999-D)
  1. ...Q
  1. Q BGPC
  1. QUANTUP(P,BDATE,EDATE) ;EP
  1. K BGPC,BGPX
  1. S BGPC="",BGPLC=""
  1. K BGPG S %=P_"^LAST LAB [BGP QUANT UACR TESTS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
  1. I $D(BGPG(1)) S BGPLC=1_"^"_$P(BGPG(1),U,3)_"^"_$P(BGPG(1),U)
  1. S T=$O(^ATXAX("B","BGP QUANT UACR LOINC",0))
  1. 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
  1. .S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"") D
  1. ..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"") D
  1. ...Q:'T
  1. ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
  1. ...Q:'$$LOINC(J,T)
  1. ...S %=$$VAL^XBDIQ1(9000010.09,X,.01) ;$P(^AUPNVLAB(X,0),U,4)
  1. ...I $P(BGPLC,U,3)<(9999999-D) S BGPLC=1_U_%_U_(9999999-D)
  1. S %="",E=+$$CODEN^ICPTCOD(82043),%=$$CPTI^BGP4DU(P,BDATE,EDATE,E)
  1. I %]"",$P(BGPLC,U,3)<$P(%,U,2),$$OCPT($P(%,U,3)) S BGPLC="1^CPT 82043/82570^"_$P(%,U,2)
  1. S %="",E=+$$CODEN^ICPTCOD(82043),%=$$TRANI^BGP4DU(P,BDATE,EDATE,E)
  1. I %]"",$P(BGPLC,U,3)<$P(%,U,2),$$OCPT($P(%,U,3)) S BGPLC="1^CPT 84023/82570^"_$P(%,U,2)
  1. Q BGPLC
  1. OCPT(V) ;is there a 82570 on this visit?
  1. NEW X,Y
  1. S X=0,Y=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X D
  1. .I $$VAL^XBDIQ1(9000010.18,X,.01)=82570 S Y=1 Q
  1. I Y Q Y
  1. ;check tran codes
  1. S X=0,Y=0 F S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X D
  1. .I $$VAL^XBDIQ1(9000010.33,X,.07)=82570 S Y=1 Q
  1. Q Y
  1. LOINC(A,B) ;EP
  1. NEW %
  1. S %=$P($G(^LAB(95.3,A,9999999)),U,2)
  1. I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
  1. S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
  1. I $D(^ATXAX(B,21,"B",%)) Q 1
  1. Q ""
  1. ESRD(P,BDATE,EDATE) ;EP
  1. S X=$$LASTDX^BGP4UTL1(P,"BGP ESRD PMS DXS",BDATE,EDATE)
  1. I X Q 1_U_"POV "_$P(X,U,2)_U_$P(X,U,3)
  1. S T=$O(^ATXAX("B","BGP ESRD CPTS",0))
  1. I T D I X]"" Q 1_U_"CPT "_$P(X,U,2)_U_$P(X,U,1)
  1. .S X=$$CPT^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,T,5) I X]"" Q
  1. .S X=$$TRAN^BGP4DU(P,$$DOB^AUPNPAT(P),EDATE,T,5)
  1. S X=$$LASTPRC^BGP4UTL1(P,"BGP ESRD PROCS",BDATE,EDATE)
  1. I X Q 1_U_"PRC "_$P(X,U,2)_U_$P(X,U,3)
  1. Q 0
  1. IGOAL ;EP
  1. I 'BGPACTUP S BGPSTOP=1 Q ;not user pop
  1. S (BGPD1,BGPN1,BGPN2)=0
  1. S BGPD1=1
  1. ;did patient have a goal set with a start date in report period
  1. S BGPSET=$$SET(DFN,BGPBDATE,BGPEDATE)
  1. I BGPSET S BGPN1=1
  1. S BGPMET=$$MET(DFN,BGPBDATE,BGPEDATE)
  1. I BGPMET S BGPN2=1
  1. S BGPVALUE="UP|||"_$S(BGPSET:"GS: "_$$DATE^BGP4UTL(BGPSET),1:"")
  1. I BGPMET D
  1. .S BGPVALUE=BGPVALUE_$S(BGPSET:"; ",1:"")
  1. .S BGPVALUE=BGPVALUE_"GM: "_$$DATE^BGP4UTL(BGPMET)
  1. Q
  1. ;
  1. MET(P,BDATE,EDATE) ;
  1. NEW D,%,X,Y
  1. S X=0,%=""
  1. F S X=$O(^AUPNGOAL("AC",P,X)) Q:X'=+X!(%]"") D
  1. .Q:'$D(^AUPNGOAL(X,0)) ;BAD XREF
  1. .Q:$P(^AUPNGOAL(X,0),U,1)'="S" ;SET ONLY
  1. .Q:$P(^AUPNGOAL(X,0),U,11)'="ME"
  1. .;DURING REPORT PERIOD MODIFIED DATE)
  1. .S G=0
  1. .S D=$P($P(^AUPNGOAL(X,0),U,5),".")
  1. .I D'<BDATE,D'>EDATE S G=1
  1. .Q:'G
  1. .S %=D
  1. Q %
  1. SET(P,BDATE,EDATE) ;
  1. NEW X,Y,Z,%,D
  1. S X=0,%=""
  1. F S X=$O(^AUPNGOAL("AC",P,X)) Q:X'=+X!(%]"") D
  1. .Q:'$D(^AUPNGOAL(X,0)) ;BAD XREF
  1. .Q:$P(^AUPNGOAL(X,0),U,1)'="S" ;SET ONLY
  1. .S D=$P($P(^AUPNGOAL(X,0),U,9),".")
  1. .Q:D=""
  1. .Q:D<BDATE
  1. .Q:D>EDATE
  1. .S %=D
  1. Q %
  1. AWV ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPN1)=0
  1. S BGPVALUE=""
  1. I 'BGPACTCL S BGPSTOP=1 Q ;not active clinical
  1. I BGPAGEB<65 S BGPSTOP=1 Q ;not over 65
  1. S BGPD1=1
  1. I $P(^DPT(DFN,0),U,2)="M" S BGPD2=1
  1. I $P(^DPT(DFN,0),U,2)="F" S BGPD3=1
  1. I BGPAGEB>64,BGPAGEB<75 S BGPD4=1
  1. I BGPAGEB>74,BGPAGEB<85 S BGPD5=1
  1. I BGPAGEB>84 S BGPD6=1
  1. S BGPVAL=$$AWV1(DFN,$$FMADD^XLFDT(BGPEDATE,-456),BGPEDATE)
  1. S BGPN1=$P(BGPVAL,U)
  1. S BGPVALUE="AC|||" I BGPN1 S BGPVALUE=BGPVALUE_$$DATE^BGP4UTL($P(BGPVAL,U,2))_" CPT "_$P(BGPVAL,U,3)
  1. K BGPVAL
  1. Q
  1. ;
  1. AWV1(P,BDATE,EDATE) ;EP
  1. NEW T,X
  1. S T=$O(^ATXAX("B","BGP ANNUAL WELLNESS CPTS",0))
  1. I 'T Q ""
  1. S X=$$CPT^BGP4DU(P,BDATE,EDATE,T,6)
  1. I 'X S X=$$TRAN^BGP4DU(P,BDATE,EDATE,T,6)
  1. Q X