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

BGP7D211.m

Go to the documentation of this file. 
  1. BGP7D211 ; IHS/CMI/LAB - measure 6 19 Sep 2014 8:12 AM ;
  1.  ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
  1.  ;
  1. JVN ;EP
  1.  NEW BGPVAL,A,E,%,Y,X,R,D,V
  1.  S BGPVAL=""
  1.  K ^TMP($J,"A")
  1.  S R=$NA(^TMP($J,"A"))
  1.  D ALLV^APCLAPIU(P,BDATE,EDATE,R)
  1.  S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R="A2",'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
  1.  I Y S $P(BGPVAL,U,1)="JVN: "_$$DATE^BGP7UTL(D)_" Cl "_R
  1.  ;OPHTHALMOLOGY
  1.  S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  D
  1.  .S V=$P(^TMP($J,"A",X),U,5)
  1.  .Q:$P($G(^AUPNVSIT(V,0)),U,7)="C"
  1.  .Q:$P($G(^AUPNVSIT(V,0)),U,7)="T"
  1.  .S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C")
  1.  .Q:R'=17
  1.  .Q:$$DNKA($P(^TMP($J,"A",X),U,5))
  1.  .S J=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D")
  1.  .Q:J'=79
  1.  .S Y=1,D=$P(^TMP($J,"A",X),U)
  1.  I Y S $P(BGPVAL,U,2)="Ophth: "_$$DATE^BGP7UTL(D)_" Cl/Prv "_R_"/"_J
  1.  ;I 'Y D
  1.  ;.S (X,Y)=0,D="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D") I R=79,'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
  1.  ;.I Y S $P(BGPVAL,U,2)="Ophth: "_$$DATE^BGP7UTL(D)_" Prv "_R
  1.  ;S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R=18,'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
  1.  ;I Y S $P(BGPVAL,U,3)="Optom: "_$$DATE^BGP7UTL(D)_" Cl "_R
  1.  ;I 'Y D
  1.  ;.S (X,Y)=0,D="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  S R=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D") I R="08"!(R=24),'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
  1.  ;OPTOMETRY
  1.  S X=0,Y=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y)  D
  1.  .S V=$P(^TMP($J,"A",X),U,5)
  1.  .Q:$P($G(^AUPNVSIT(V,0)),U,7)="C"
  1.  .Q:$P($G(^AUPNVSIT(V,0)),U,7)="T"
  1.  .S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C")
  1.  .Q:R'=18
  1.  .Q:$$DNKA($P(^TMP($J,"A",X),U,5))
  1.  .S J=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D")
  1.  .I J'="08",J'=24 Q
  1.  .S Y=1,D=$P(^TMP($J,"A",X),U)
  1.  I Y S $P(BGPVAL,U,3)="Optom: "_$$DATE^BGP7UTL(D)_" Cl/Prv "_R_"/"_J
  1.  Q BGPVAL
  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^BGP7DU(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^BGP7DU(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,D,E,%
  1.  S D=$$VD^APCLV(V)  ;date of visit
  1.  S E=+$$CODEN^ICPTCOD("82570"),%=$$CPTI^BGP7DU(P,D,D,E)
  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 % Q 1
  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.  S E=+$$CODEN^ICPTCOD("82570"),%=$$TRANI^BGP7DU(P,D,D,E)
  1.  I % Q 1
  1.  Q ""
  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.  NEW X,T,A,B,C
  1.  S X=$$LASTDX^BGP7UTL1(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^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,T,5) I X]"" Q
  1.  .S X=$$TRAN^BGP7DU(P,$$DOB^AUPNPAT(P),EDATE,T,5)
  1.  S X=$$LASTPRC^BGP7UTL1(P,"BGP ESRD PROCS",BDATE,EDATE)
  1.  I X Q 1_U_"PRC "_$P(X,U,2)_U_$P(X,U,3)
  1.  ;added non-deleted problem list icd/snomed
  1.  S X=$$PLTAXND^BGP7DU(P,"BGP ESRD PMS DXS",EDATE)
  1.  I X Q X
  1.  S X=$$IPLSNOND^BGP7DU(P,"PXRM END STAGE RENAL DISEASE",EDATE)
  1.  I X Q X
  1.  Q 0
  1. S ;
  1.  S BGPSET($P(^APCDTPGT(X,0),U,1))=0,BGPMET($P(^APCDTPGT(X,0),U,1))=0
  1.  Q
  1. IGOAL ;EP
  1.  NEW BGPSET,BGPMET
  1.  ;
  1.  I 'BGPACTUP S BGPSTOP=1 Q  ;not user pop
  1.  F X=1:1:23 S @("BGPN"_X)=0
  1.  S BGPD1=1  ;USER POP
  1.  S BGPD2=0  ;# goals set
  1.  S BGPD3=0 ;# goals met
  1.  S X=0 F  S X=$O(^APCDTPGT(X)) Q:X'=+X  D
  1.  .S Y=$P(^APCDTPGT(X,0),U,1)
  1.  .I Y="PHYSICAL ACTIVITY" D S
  1.  .I Y="NUTRITION" D S
  1.  .I Y="MEDICATIONS" D S
  1.  .I Y="WELLNESS AND SAFETY" D S
  1.  .I Y="TOBACCO" D S
  1.  .I Y="ALCOHOL OR OTHER DRUGS" D S
  1.  .I Y="STRESS AND COPING" D S
  1.  .I Y="MONITORING" D S
  1.  .I Y="DIABETES CURRICULUM" D S
  1.  .I Y="OTHER" D S
  1.  ;did patient have a goal set with a start date in report period
  1.  D SET
  1.  I BGPD2 S BGPN1=1
  1.  S C=2,X=0
  1.  F  S X=$O(BGPSET(X)) Q:X=""  S C=C+1 S @("BGPN"_C)=@("BGPN"_C)+BGPSET(X)
  1.  D MET
  1.  I BGPD3 S BGPN2=1
  1.  S C=12,X=0
  1.  F  S X=$O(BGPMET(X)) Q:X=""  S C=C+1 S @("BGPN"_C)=@("BGPN"_C)+BGPMET(X)
  1.  S BGPVALUE="UP|||"
  1.  S X="",Y="" F  S X=$O(BGPSET(X)) Q:X=""  I $P(BGPSET(X),U,1) D
  1.  .F J=2:1 S D=$P(BGPSET(X),U,J) Q:D=""  D
  1.  ..I Y]"" S Y=Y_", "
  1.  ..S Y=Y_$$DATE^BGP7UTL(D)_" - "_X
  1.  I Y]"" S Y="GS: "_Y,BGPVALUE=BGPVALUE_Y
  1.  S Y=""
  1.  S X="",Y="" F  S X=$O(BGPMET(X)) Q:X=""  I $P(BGPMET(X),U,1) D
  1.  .F J=2:1 S D=$P(BGPMET(X),U,J) Q:D=""  D
  1.  ..I Y]"" S Y=Y_", "
  1.  ..S Y=Y_$$DATE^BGP7UTL(D)_" - "_X
  1.  I Y]"" S Y="; GM: "_Y,BGPVALUE=BGPVALUE_Y
  1.  K BGPSET,BGPMET
  1.  Q
  1.  ;
  1. MET ;
  1.  NEW D,%,X,Y
  1.  S X=0,%=""
  1.  F  S X=$O(^AUPNGOAL("AC",DFN,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'<BGPBDATE,D'>BGPEDATE S G=1
  1.  .Q:'G
  1.  .S Y=0 F  S Y=$O(^AUPNGOAL(X,10,Y)) Q:Y'=+Y  D
  1.  ..S Z=$P($G(^AUPNGOAL(X,10,Y,0)),U,1)
  1.  ..Q:'Z
  1.  ..S BGPD3=BGPD3+1
  1.  ..S Z=$P($G(^APCDTPGT(Z,0)),U,1)
  1.  ..Q:Z=""
  1.  ..S $P(BGPMET(Z),U,1)=$P(BGPMET(Z),U,1)+1,J=$P(BGPMET(Z),U,1),J=J+1,$P(BGPMET(Z),U,J)=D
  1.  Q
  1. SET ;
  1.  NEW X,Y,Z,%,D
  1.  S X=0,%=""
  1.  F  S X=$O(^AUPNGOAL("AC",DFN,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<BGPBDATE
  1.  .Q:D>BGPEDATE
  1.  .S Y=0 F  S Y=$O(^AUPNGOAL(X,10,Y)) Q:Y'=+Y  D
  1.  ..S Z=$P($G(^AUPNGOAL(X,10,Y,0)),U,1)
  1.  ..Q:'Z
  1.  ..S BGPD2=BGPD2+1
  1.  ..S Z=$P($G(^APCDTPGT(Z,0)),U,1)
  1.  ..Q:Z=""
  1.  ..S $P(BGPSET(Z),U,1)=$P(BGPSET(Z),U,1)+1,J=$P(BGPSET(Z),U,1),J=J+1,$P(BGPSET(Z),U,J)=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^BGP7UTL($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^BGP7DU(P,BDATE,EDATE,T,6)
  1.  I 'X S X=$$TRAN^BGP7DU(P,BDATE,EDATE,T,6)
  1.  Q X
  1. DMPVPL(P,BDATE,EDATE) ;EP - DM ON PL OR 2 DM VISITS EVER
  1.  I '$G(P) Q ""
  1.  I $$PLTAXND^BGP7DU(P,"SURVEILLANCE DIABETES",EDATE) Q 1
  1.  I $$IPLSNOND^BGP7DU(P,"PXRM DIABETES",EDATE) Q 1
  1.  I $$V2DM^BGP7D1(P,BDATE,EDATE) Q 1
  1.  Q ""
  1. DMFB(P,EDATE) ;EP - DM V POV BEFORE TIME PERIOD OR PL BEFORE TIME PERIOD
  1.  I '$G(P) Q ""
  1.  I $$PLTAXND^BGP7DU(P,"SURVEILLANCE DIABETES",EDATE) Q 1
  1.  I $$IPLSNOND^BGP7DU(P,"PXRM DIABETES",EDATE) Q 1
  1.  NEW X,BGPG,E,Y
  1.  K BGPG
  1.  S Y="BGPG("
  1.  S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
  1.  I '$D(BGPG(1)) Q ""
  1.  I $P(BGPG(1),U,1)'>EDATE Q 1
  1.  Q ""