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

BGP6D26.m

Go to the documentation of this file. 
  1. BGP6D26 ; IHS/CMI/LAB - measure 6 03 Jun 2016 3:16 PM 12 Jul 2016 9:31 AM ; 
  1.  ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
  1.  ;
  1. COMPHS ;EP
  1.  S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
  1.  I 'BGPACTCL S BGPSTOP=1 Q  ;not active clinical
  1.  S BGPVALUE=""
  1.  I BGPAGEB<2 S BGPSTOP=1 Q  ;needs to be at least 2
  1.  I BGPAGEB>11,BGPAGEB<76 S BGPD3=1  ;alcohol screening
  1.  I BGPAGEB>17 S BGPD4=1  ;depression screening
  1.  I BGPAGEB>13,BGPAGEB<47,BGPSEX="F" S BGPD5=1  ;ipv/dv screening
  1.  I BGPAGEB>4 S BGPD6=1  ;tobacco screening
  1.  I BGPAGEB>1,BGPAGEB<75 S BGPD7=1  ;BMI
  1.  I BGPAGEB>19 S BGPD8=1  ;BP Assessed
  1.  I BGPAGEB>4 S BGPD9=1  ;PA Assessed
  1.  I '(BGPD3+BGPD4+BGPD5+BGPD6+BGPD7+BGPD8+BGPD9) W BGPBOMB
  1.  S BGPD1=1
  1.  S BGPD2=1
  1.  ;now set up numerators
  1.  S BGPVAL=""
  1.  I BGPD3 D  I BGPVAL S BGPN3=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"ALC: "_$P(BGPVAL,U,3)_" "_$P(BGPVAL,U,2)
  1.  .S BGPVAL=$$ALSCRNRP(DFN,BGPBDATE,BGPEDATE) I BGPVAL Q
  1.  .S BGPVAL=$$ALDX^BGP6D55(DFN,BGPBDATE,BGPEDATE) I BGPVAL Q
  1.  .S BGPVAL=$$ALPRC^BGP6D5(DFN,BGPBDATE,BGPEDATE)
  1.  S BGPVAL=""
  1.  I BGPD4 D  I BGPVAL S BGPN4=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"DEPR: "_$P(BGPVAL,U,3)_" "_$S($P(BGPVAL,U,5)]"":$P(BGPVAL,U,5),1:$P(BGPVAL,U,2))
  1.  .S BGPVAL=$$DEPSCR^BGP6D25(DFN,BGPBDATE,BGPEDATE) I BGPVAL Q
  1.  .S BGPVAL=$$DEP^BGP6D25(DFN,BGPBDATE,BGPEDATE) Q
  1.  S BGPVAL=""
  1.  I BGPD5 D  I BGPVAL S BGPN5=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"IPV: "_$P(BGPVAL,U,5)_" "_$P(BGPVAL,U,4)
  1.  .S BGPVAL=$$DVEX^BGP6D5(DFN,BGPBDATE,BGPEDATE) I BGPVAL Q
  1.  .S BGPVAL=$$DVDX^BGP6D5(DFN,BGPBDATE,BGPEDATE) I BGPVAL Q  ;DX ONLY
  1.  .S BGPVAL=$$DVPED^BGP6D5(DFN,BGPBDATE,BGPEDATE) I BGPVAL Q  ;W/O V61.11
  1.  .S BGPVAL=$$DV61^BGP6D5(DFN,BGPBDATE,BGPEDATE) I BGPVAL Q  ;include in education for gpra
  1.  I BGPD6 D
  1.  .S BGPVAL=$$TOBACCO^BGP6D7(DFN,BGPBDATE,BGPEDATE) I $P(BGPVAL,U,1)]"" S BGPN6=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"TOB: "_$P(BGPVAL,U,2)_" "_$P(BGPVAL,U,1) Q
  1.  .S BGPVAL=$$DX^BGP6D7(DFN,BGPBDATE,BGPEDATE) I $P(BGPVAL,U,1)]"" S BGPN6=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"TOB: "_$$DATE^BGP6UTL($P(BGPVAL,U,2))_" "_$P(BGPVAL,U,1) Q
  1.  .S BGPVAL=$$PED^BGP6D7(DFN,BGPBDATE,BGPEDATE) I $P(BGPVAL,U,1)]"" S BGPN6=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"TOB: "_$$DATE^BGP6UTL($P(BGPVAL,U,2))_" "_$P(BGPVAL,U,1) Q
  1.  .S BGPVAL=$$DENT^BGP6D7(DFN,BGPBDATE,BGPEDATE) I $P(BGPVAL,U,1)]"" S BGPN6=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"TOB: "_$$DATE^BGP6UTL($P(BGPVAL,U,2))_" "_$P(BGPVAL,U,1) Q
  1.  .S BGPVAL=$$CPTSM^BGP6D7(DFN,BGPBDATE,BGPEDATE) I $P(BGPVAL,U,1)]"" S BGPN6=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"TOB: "_$$DATE^BGP6UTL($P(BGPVAL,U,2))_" "_$P(BGPVAL,U,1) Q
  1.  I BGPD7 D  I $P(BGPVAL,U,1)]"" S BGPN7=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"BMI: "_$$SB^BGP6PDL1($J($P(BGPVAL,U),6,2))
  1.  .S BGPVAL=$$BMI^BGP6D6(DFN,BGPEDATE,BGPAGEE)
  1.  I BGPD8 D  I BGPVAL]"" S BGPN8=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"BP: "_$P($P(BGPVAL,U,1)," ")
  1.  .S BGPVAL=$$MEANBP(DFN,$$FMADD^XLFDT(BGPEDATE,-(2*365)),BGPEDATE,1) I BGPVAL]"",BGPVAL'["unknown" Q
  1.  .I BGPVAL["unknown" S BGPVAL=$P($$BPCPT^BGP6D22(DFN,BGPBDATE,BGPEDATE),U,2)
  1.  I BGPD9 D
  1.  .S BGPVAL=$$FIRSTHF^BGP6D8(DFN,BGPBDATE,BGPEDATE,"ACTIVITY LEVEL")  ;get the first health factor in this category recorded in this time period
  1.  .I BGPVAL S BGPN9=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"PHYS ACT: "_$P(BGPVAL,U,3)_" "_$P(BGPVAL,U,4)
  1.  S G=1
  1.  I BGPD1 D
  1.  .I BGPD3 I 'BGPN3 S G=0
  1.  .I BGPD4 I 'BGPN4 S G=0
  1.  .I BGPD5 I 'BGPN5 S G=0
  1.  .I BGPD6 I 'BGPN6 S G=0
  1.  .I BGPD7 I 'BGPN7 S G=0
  1.  .I BGPD8 I 'BGPN8 S G=0
  1.  .I BGPD9 I 'BGPN9 S G=0
  1.  .I G S BGPN1=1,BGPVALUE="ALL COMP HEALTH: "_BGPVALUE
  1.  S H=1
  1.  I BGPD1 D
  1.  .I BGPD3 I 'BGPN3 S H=0
  1.  .I BGPD4 I 'BGPN4 S H=0
  1.  .I BGPD5 I 'BGPN5 S H=0
  1.  .I BGPD6 I 'BGPN6 S H=0
  1.  .I BGPD7 I 'BGPN7 S H=0
  1.  .I BGPD8 I 'BGPN8 S H=0
  1.  .I H S BGPN2=1 I 'G S BGPVALUE="COMP HEALTH: "_BGPVALUE
  1.  S BGPVALUE="AC|||"_BGPVALUE
  1.  Q
  1. ALSCRNRP(P,BDATE,EDATE) ;EP - alcohol hf or screening pov
  1.  NEW BGPG,%,E,BGPSC,V,BGPC,T,F,D,R,BGPCT,BGPX,BGPV,BGPVD,BGPIVD,BGPVALF,A
  1.  S BGPVALF=""
  1. PCC ;check PCC first
  1.  S BGPCT=$O(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0))
  1.  K ^TMP($J,"A")
  1.  S A="^TMP($J,""A"","
  1.  S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,A)
  1.  S BGPX=0 F  S BGPX=$O(^TMP($J,"A",BGPX)) Q:BGPX'=+BGPX!(BGPVALF)  S BGPV=$P(^TMP($J,"A",BGPX),U,5) D
  1.  .S BGPVD=$$VD^APCLV(BGPV)
  1. PCCEX .;
  1.  .S E=0 F  S E=$O(^AUPNVXAM("AD",BGPV,E)) Q:E'=+E!(BGPVALF)  D
  1.  ..S I=$P($G(^AUPNVXAM(E,0)),U,1)
  1.  ..Q:'I
  1.  ..Q:$P($G(^AUTTEXAM(I,0)),U,2)'=35
  1.  ..S BGPVALF=1_"^Ex 35^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  .Q:BGPVALF
  1. PCCHF .;
  1.  .S E=0 F  S E=$O(^AUPNVHF("AD",BGPV,E)) Q:E'=+E!(BGPVALF)  D
  1.  ..S I=$P($G(^AUPNVHF(E,0)),U,1)
  1.  ..S I=$P($G(^AUTTHF(I,0)),U,1)
  1.  ..I I'="CAGE 0/4",I'="CAGE 1/4",I'="CAGE 2/4",I'="CAGE 3/4",I'="CAGE 4/4" Q  ;cage only
  1.  ..S BGPVALF=1_"^HF "_I_"^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  .Q:BGPVALF
  1. PCCDX .;
  1.  .S E=0 F  S E=$O(^AUPNVPOV("AD",BGPV,E)) Q:E'=+E!(BGPVALF)  D
  1.  ..S I=$$VAL^XBDIQ1(9000010.07,E,.01)
  1.  ..I '$$ICD^BGP6UTL2($$VALI^XBDIQ1(9000010.07,E,.01),$O(^ATXAX("B","BGP ALCOHOL SCREEN DXS",0)),9) Q
  1.  ..S BGPVALF=1_U_"POV "_I_U_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  .Q:BGPVALF
  1. PCCCPT .;
  1.  .S E=0 F  S E=$O(^AUPNVCPT("AD",BGPV,E)) Q:E'=+E!(BGPVALF)  D
  1.  ..S I=$P($G(^AUPNVCPT(E,0)),U,1)
  1.  ..Q:'I
  1.  ..S J=$P(^ICPT(I,0),U)
  1.  ..Q:'$$ICD^BGP6UTL2(I,BGPCT,1)
  1.  ..S BGPVALF=1_"^CPT "_J_"^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  .Q:BGPVALF
  1. PCCMEAS .;now add in v measurements
  1.  .S E=0 F  S E=$O(^AUPNVMSR("AD",BGPV,E)) Q:E'=+E!(BGPVALF)  D
  1.  ..S I=$$VAL^XBDIQ1(9000010.01,E,.01)
  1.  ..I I'="AUDT",I'="AUDC",I'="CRFT" Q
  1.  ..S BGPVALF=1_"^MEAS "_I_"^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  I BGPVALF Q BGPVALF
  1. BH ;CHECK BH VISITS
  1.  S BGPC="",T="",F=""
  1.  S E=9999999-BDATE,D=9999999-EDATE-1_".99"
  1.  F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!($P(D,".")>E)!(BGPVALF)  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V  D
  1. BHEX .;
  1.  .S BGPVD=9999999-$P(D,"."),BGPIVD=$P(D,".")
  1.  .S X=$P($G(^AMHREC(V,14)),U,3)
  1.  .I X="P"!(X="N") D
  1.  ..S BGPVALF=1_"^BH Ex 35^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  .Q:BGPVALF
  1. BHHF .;
  1.  .S X=0 F  S X=$O(^AMHRHF("AD",V,X)) Q:X'=+X!(BGPVALF)  D
  1.  ..S I=$P($G(^AMHRHF(X,0)),U,1)
  1.  ..Q:'I
  1.  ..S I=$P($G(^AUTTHF(I,0)),U,1)
  1.  ..I I'="CAGE 0/4",I'="CAGE 1/4",I'="CAGE 2/4",I'="CAGE 3/4",I'="CAGE 4/4" Q  ;cage only
  1.  ..S BGPVALF=1_"^BH HF: "_I_"^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  ..Q
  1.  .Q:BGPVALF
  1. BHDX .;
  1.  .S X=0 F  S X=$O(^AMHRPRO("AD",V,X)) Q:X'=+X!(BGPVALF)  D
  1.  ..S I=$$VAL^XBDIQ1(9002011.01,X,.01)
  1.  ..I '$$ICD^BGP6UTL2($$VALI^XBDIQ1(9002011.01,X,.01),$O(^ATXAX("B","BGP ALCOHOL SCREEN DXS",0)),9),I'="29.1" Q
  1.  ..S BGPVALF=1_U_"BH DX "_I_U_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  ..Q
  1.  .Q:BGPVALF
  1. BHMEAS .;
  1.  .S X=0 F  S X=$O(^AMHRMSR("AD",V,X)) Q:X'=+X!(BGPVALF)  D
  1.  ..S I=$$VAL^XBDIQ1(9002011.12,X,.01)
  1.  ..I I'="AUDT",I'="AUDC",I'="CRFT" Q
  1.  ..S BGPVALF=1_"^BH Meas "_I_"^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  .Q:BGPVALF
  1. BHCPT .;now add in CPT codes
  1.  .S X=0 F  S X=$O(^AMHRPROC("AD",V,X)) Q:X'=+X!(BGPVALF)  D
  1.  ..S I=$P($G(^AMHRPROC(X,0)),U,1)
  1.  ..Q:'I
  1.  ..Q:'$$ICD^BGP6UTL2(I,BGPCT,1)
  1.  ..S J=$P($G(^ICPT(I,0)),U,1)
  1.  ..S BGPVALF=1_"^BH CPT: "_J_"^"_$$DATE^BGP6UTL(BGPVD)_U_BGPVD
  1.  ..Q
  1.  .Q:BGPVALF
  1.  Q BGPVALF
  1. MEANBP(P,BDATE,EDATE,GDEV) ;EP
  1.  S GDEV=$G(GDEV)
  1.  S X=$$BPS(P,BDATE,EDATE,"I",GDEV)
  1.  S S=$$SYSMEAN(X) I S="" Q "unknown^^"
  1.  S DS=$$DIAMEAN(X) I DS="" Q "unknown^^"
  1.  ;I S>159!(DS>99) Q S_"/"_DS_" STG 2 HTN"_U_6
  1.  ;I S>139&(S<160)!(DS>89&(DS<100)) Q S_"/"_DS_" STG 1 HTN"_U_5
  1.  ;I S>129&(S<140)!(DS>80&(DS<90)) Q S_"/"_DS_" PRE HTN 2"_U_4
  1.  ;I S>119&(S<130)!(DS=80) Q S_"/"_DS_" PRE HTN 1"_U_3
  1.  ;I S<120&(DS<80) Q S_"/"_DS_" NORMAL"_U_2
  1.  Q S_"/"_DS_U_1
  1. SYSMEAN(X) ;EP
  1.  I X="" Q ""
  1.  S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1.  I C<2 Q ""
  1.  S T=0 F Y=1:1:3 S T=$P($P(X,";",Y),"/")+T
  1.  Q T\C
  1.  ;Q $$STRIP^XLFSTR($J((T/C),5,1)," ")
  1.  ;
  1. DIAMEAN(X) ;EP
  1.  I X="" Q ""
  1.  S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1.  I C<2 Q ""
  1.  S T=0 F Y=1:1:3 S T=$P($P(X,";",Y),"/",2)+T
  1.  Q T\C
  1.  ;Q $$STRIP^XLFSTR($J((T/C),5,1)," ")
  1.  ;
  1. BPS(P,BDATE,EDATE,F,GDEV) ;EP ;
  1.  I $G(F)="" S F="E"
  1.  S GDEV=$G(GDEV)
  1.  NEW BGPGLL,BGPGV,BGPG,X,Y,BGPBP,V,T,Z
  1.  S BGPGLL=0,BGPGV=""
  1.  K BGPG
  1.  K ^TMP($J,"BPV")
  1.  S A="^TMP($J,""BPV"",",B=P_"^LAST 365 VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"BPV",1)) Q ""
  1.  ;S X=P_"^LAST 50 MEAS BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BGPG(")
  1.  ;S BGPGL=0 F  S BGPGL=$O(BGPG(BGPGL)) Q:BGPGL'=+BGPGL!(BGPGLL=3)  S BGPGBP=$P($G(BGPG(BGPGL)),U,2) D
  1.  S Y=0 F  S Y=$O(^TMP($J,"BPV",Y)) Q:Y'=+Y!(BGPGLL=3)  D
  1.  .S V=$P(^TMP($J,"BPV",Y),U,5)
  1.  .Q:$$CLINIC^APCLV(V,"C")=30  ;NO ER CLINIC VISITS COUNTED
  1.  .I $G(GDEV) Q:$$GDEV^BGP6D2(V)
  1.  .Q:'$D(^AUPNVMSR("AD",V))  ;no measurements to look at
  1.  .;NOW GET ALL BPS ON THIS VISIT
  1.  .S BGPBP=""
  1.  .S X=0 F  S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X  D
  1.  ..Q:'$D(^AUPNVMSR(X,0))  ;BAD AD XREF
  1.  ..Q:$P($G(^AUPNVMSR(X,2)),U,1)
  1.  ..S T=$P($G(^AUPNVMSR(X,0)),U)
  1.  ..Q:T=""  ;BAD AD XREF
  1.  ..Q:$P($G(^AUTTMSR(T,0)),U)'="BP"  ;not a BP measurement type
  1.  ..S Z=$P(^AUPNVMSR(X,0),U,4)  ;blood pressure value
  1.  ..I BGPBP="" S BGPBP=Z Q
  1.  ..I $P(Z,"/")'>$P(BGPBP,"/") S BGPBP=Z
  1.  .Q:BGPBP=""
  1.  .S BGPGLL=BGPGLL+1
  1.  .I F="E" S $P(BGPGV,";",BGPGLL)=BGPBP_"  "_$$FMTE^XLFDT($P(^TMP($J,"BPV",V),U))
  1.  .I F="I" S $P(BGPGV,";",BGPGLL)=$P(BGPBP," ")
  1.  K ^TMP($J,"BPV")
  1.  Q BGPGV