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