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

BGP2D89.m

Go to the documentation of this file. 
  1. BGP2D89 ; IHS/CMI/LAB - measure C 03 Jul 2010 7:05 AM ;
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;
  1. VS ;EP
  1.  S (BGPN1,BGPN2,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11)=0
  1.  I 'BGPACTCL S BGPSTOP=1 Q  ;not active clinical pt
  1.  ;SET UP DENOMINATORS
  1.  S BGPD1=1  ;all A/C
  1.  I BGPAGEB>1,BGPAGEB<19 S BGPD2=1
  1.  I BGPAGEB>4 S BGPD3=1
  1.  I BGPAGEB>11,BGPAGEB<19 S BGPD4=1
  1.  I BGPAGEB>11,BGPAGEB<76 S BGPD5=1
  1.  I BGPSEX="F",BGPAGEB>14,BGPAGEB<41 S BGPD6=1
  1.  I BGPSEX="F",BGPAGEB>14,BGPAGEB<45 S BGPD7=1
  1.  I BGPAGEB>17 S BGPD8=1
  1.  I BGPAGEB>64 S BGPD9=1
  1.  I $$TOBUSER(DFN,BGPBDATE) S BGPD10=1
  1.  S BGPQV=$$VISIT(DFN,BGPBDATE,BGPEDATE)
  1.  I 'BGPQV S BGPN1=1
  1.  S BGPURO=$$UCONLY(DFN,BGP3YE,BGPEDATE)
  1.  I 'BGPURO S BGPN2=1  ;urgent care only visit
  1.  S D="AC"
  1.  I BGPD2 S D=D_",AC 2-18"
  1.  I BGPD3 S D=D_",AC =>5"
  1.  I BGPD4 S D=D_",AC 12-18"
  1.  I BGPD5 S D=D_",AC 12-75"
  1.  I BGPD6 S D=D_",FEM AC 15-40"
  1.  I BGPD7 S D=D_",FEM AC 15-44"
  1.  I BGPD8 S D=D_",AC =>18"
  1.  I BGPD9 S D=D_",AC =>65"
  1.  I BGPD10 S D=D_",AC TOB USER"
  1.  S BGPVALUE="AC|||"_$S('BGPN1:"No visit in time period",1:"Visit in time period "_$$DATE^BGP2UTL(BGPQV))_" Urgent Care Only: "_$$DATE^BGP2UTL(BGPURO)
  1.  S BGPVALUD="AC|||"
  1.  K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T
  1.  K BGPEDUC,BGPHIV
  1.  Q
  1. VISIT(P,BDATE,EDATE) ;
  1.  K ^TMP($J,"A")
  1.  NEW A,C,B,E,X,G,V
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:"SAHOR"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .S C=$$CLINIC^APCLV(V,"C")
  1.  .Q:C=42
  1.  .Q:C=51
  1.  .Q:C=52
  1.  .Q:C=53
  1.  .S G=$$VD^APCLV(V)
  1.  .Q
  1.  Q G
  1. TOBUSER(P,BDATE) ;EP
  1.  NEW BGPTUSER,%,BGPTOBP,BGPSDX,BGPSCPT,F
  1.  S BGPTUSER=""
  1.  S BGPTOBP=$$TOBHF^BGP2D712(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
  1.  S BGPSDX=$$DX^BGP2D7(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
  1.  S BGPSCPT=$$CPTSM^BGP2D7(P,$$DOB^AUPNPAT(P),$$FMADD^XLFDT(BDATE,-1))
  1.  S %=""
  1.  ;I BGPSDX]"",$P(BGPSDX,U)="V15.82" S %=1
  1.  ;I BGPSDX]"",$P(BGPSDX,U)="305.13" S %=1
  1.  S T=$O(^ATXAX("B","BGP TOBACCO PAST USE DXS",0))
  1.  I BGPSDX]"" S I=$P(BGPSDX,U,3) I $$ICD^ATXCHK(I,T,9) S %=1
  1.  S F=BGPTOBP
  1.  D
  1.  .I $P(F,U,1)["CURRENT"!($P(F,U,1)["CESSATION") S BGPTUSER=1 Q
  1.  .I $P(F,U,4)["CURRENT"!($P(F,U,4)["CESSATION") S BGPTUSER=1 Q
  1.  .I (BGPSDX]""&(%="")) S BGPTUSER=1 Q
  1.  .I ($P(BGPSCPT,U)="1034F")!($P(BGPSCPT,U)="1035F")!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407) S BGPTUSER=1 Q
  1.  .I $P(BGPSCPT,U)=99406!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8456")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") S BGPTUSER=1 Q
  1.  ;S F=$P(BGPTOBP,U,1)
  1.  ;I $P(BGPTOBP,U,1)["CURRENT"!(BGPSDX]""&(%=""))!(F["CESSATION")!($P(BGPSCPT,U)="1034F")!($P(BGPSCPT,U)="1035F")!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407) S BGPTUSER=1
  1.  ;I $P(BGPSCPT,U)=99406!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8456")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") S BGPTUSER=1
  1.  Q BGPTUSER
  1. UCONLY(P,BDATE,EDATE) ;EP - clinical user
  1.  K ^TMP($J,"A")
  1.  NEW A,C,B,E,X,G,V,UCC,ALV
  1.  S (UCC,ALV)=0
  1.  ;UCC - urgent care clinic count
  1.  ;ALV - all visit count
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S (X,G,F,S)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:'$D(^AUPNVPRV("AD",V))
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .S B=$$CLINIC^APCLV(V,"C")
  1.  .Q:B=""
  1.  .I B=80 S UCC=UCC+1 Q
  1.  .I 'G,$D(^BGPCTRL($O(^BGPCTRL("B",2012,0)),11,"B",B)) S G=V  ;must be a primary clinic S G=V
  1.  .I V'=G,$D(^BGPCTRL($O(^BGPCTRL("B",2012,0)),12,"B",B)) S S=1
  1.  .I G,S S F=1
  1.  .Q
  1.  Q $S(F:1,1:0)