BGPD30 ; IHS/CMI/LAB - indicator 30 ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
I30 ;EP ;EP - indicator 30
;Q:'$D(BGPIND(26))
S BGPSEX=$P(^DPT(DFN,0),U,2),BGPSEX=$S(BGPSEX="M":1,1:2)
I BGPAGEB>11&(BGPAGEB<18) D
.D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),2,BGPSEX,1)
.S BGPP=$$TOBACCO(DFN,BGPEDATE)
.I BGPP]"" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),4,BGPSEX,1)
.I BGPP["CURRENT" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),6,BGPSEX,1)
.I BGPP["SMOKER IN HOME" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),8,BGPSEX,1)
.I $D(BGPLIST(26)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
I BGPAGEB>17&(BGPAGEB<35) D
.D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),3,BGPSEX,1)
.S BGPP=$$TOBACCO(DFN,BGPEDATE)
.I BGPP]"" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),5,BGPSEX,1)
.I BGPP["CURRENT" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),7,BGPSEX,1)
.I BGPP["SMOKER IN HOME" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),9,BGPSEX,1)
.I $D(BGPLIST(26)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
I BGPAGEB>34&(BGPAGEB<55) D
.D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),11,BGPSEX,1)
.S BGPP=$$TOBACCO(DFN,BGPEDATE)
.I BGPP]"" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),12,BGPSEX,1)
.I BGPP["CURRENT" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),13,BGPSEX,1)
.I BGPP["SMOKER IN HOME" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),14,BGPSEX,1)
.I $D(BGPLIST(26)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
I BGPAGEB>54 D
.D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),15,BGPSEX,1)
.S BGPP=$$TOBACCO(DFN,BGPEDATE)
.I BGPP]"" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),16,BGPSEX,1)
.I BGPP["CURRENT" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),17,BGPSEX,1)
.I BGPP["SMOKER IN HOME" D SAGE(BGPRPT,$S(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),18,BGPSEX,1)
.I $D(BGPLIST(26)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
Q
SAGE(R,N,P,S,V) ;set age into file
I 'V Q ;no value
NEW X,Y
S X=$P($G(^BGPD(R,N)),U,P)
S $P(X,"!",S)=$P(X,"!",S)+V
S $P(^BGPD(R,N),U,P)=X
Q
S(R,N,P,V) ;
I 'V Q ;no value to add
S $P(^BGPD(R,N),U,P)=$P($G(^BGPD(R,N)),U,P)+V
Q
;
TOBACCO(P,EDATE) ;EP
;get last health factor in date range from V Health Factors
;if none, check health status and check date
I '$G(P) Q ""
NEW BGPTOB,BGP,X,E
K BGPTOB
D TOBACCO1
I $D(BGPTOB) Q BGPTOB
D TOBACCO0
I $D(BGPTOB) Q BGPTOB
Q ""
TOBACCO1 ;check for tobacco documented in health factors
K BGPTOB S BGPTOB=$$LASTHF(P,"TOBACCO",EDATE)
Q
TOBACCO0 ;lookup in health status
S (X,Y)=0 F S X=$O(^AUPNHF("AA",P,X)) Q:X'=+X!(Y) I $$VAL^XBDIQ1(9999999.64,X,.03)="TOBACCO" S Y=X
Q:'Y
S E=$O(^AUPNHF("AA",P,Y,E)) Q:'E
I (9999999-E)>EDATE Q ;documented after time frame
S Y=$P(^AUTTHF(Y,0),U)
I Y["NON" S BGPTOB="NEVER USED" Q
I Y["SMOKE FREE HOME" S BGPTOB="NEVER USED" Q
I Y["PREVIOUS" S BGPTOB="PAST USE" Q
I Y="SMOKER IN HOME" S BGPTOB="SMOKER IN HOME" Q
S BGPTOB="CURRENT USER"
Q
;
LASTHF(P,C,EDATE) ;EP - get last factor in category C for patient P
I '$G(P) Q ""
I $G(C)="" Q ""
I $G(F)="" S F=""
S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
I '$G(C) Q ""
NEW H,D,O S H=0 K O
F S H=$O(^AUTTHF("AC",C,H)) Q:'+H D
. Q:'$D(^AUPNVHF("AA",P,H))
. S D="" F S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D D
.. Q:(9999999-D)>EDATE ;after time frame
.. S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
. Q
S D=$O(O(0))
I D="" Q D
Q $$VAL^XBDIQ1(9000010.23,O(D),.01)
;
;;
BGPD30 ; IHS/CMI/LAB - indicator 30 ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
I30 ;EP ;EP - indicator 30
+1 ;Q:'$D(BGPIND(26))
+2 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
SET BGPSEX=$SELECT(BGPSEX="M":1,1:2)
+3 IF BGPAGEB>11&(BGPAGEB<18)
Begin DoDot:1
+4 DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),2,BGPSEX,1)
+5 SET BGPP=$$TOBACCO(DFN,BGPEDATE)
+6 IF BGPP]""
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),4,BGPSEX,1)
+7 IF BGPP["CURRENT"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),6,BGPSEX,1)
+8 IF BGPP["SMOKER IN HOME"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),8,BGPSEX,1)
+9 IF $DATA(BGPLIST(26))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
End DoDot:1
+10 IF BGPAGEB>17&(BGPAGEB<35)
Begin DoDot:1
+11 DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),3,BGPSEX,1)
+12 SET BGPP=$$TOBACCO(DFN,BGPEDATE)
+13 IF BGPP]""
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),5,BGPSEX,1)
+14 IF BGPP["CURRENT"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),7,BGPSEX,1)
+15 IF BGPP["SMOKER IN HOME"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),9,BGPSEX,1)
+16 IF $DATA(BGPLIST(26))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
End DoDot:1
+17 IF BGPAGEB>34&(BGPAGEB<55)
Begin DoDot:1
+18 DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),11,BGPSEX,1)
+19 SET BGPP=$$TOBACCO(DFN,BGPEDATE)
+20 IF BGPP]""
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),12,BGPSEX,1)
+21 IF BGPP["CURRENT"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),13,BGPSEX,1)
+22 IF BGPP["SMOKER IN HOME"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),14,BGPSEX,1)
+23 IF $DATA(BGPLIST(26))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
End DoDot:1
+24 IF BGPAGEB>54
Begin DoDot:1
+25 DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),15,BGPSEX,1)
+26 SET BGPP=$$TOBACCO(DFN,BGPEDATE)
+27 IF BGPP]""
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),16,BGPSEX,1)
+28 IF BGPP["CURRENT"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),17,BGPSEX,1)
+29 IF BGPP["SMOKER IN HOME"
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:19,BGPTIME=0:49,BGPTIME=8:89,1:999),18,BGPSEX,1)
+30 IF $DATA(BGPLIST(26))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",26,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
End DoDot:1
+31 QUIT
SAGE(R,N,P,S,V) ;set age into file
+1 ;no value
IF 'V
QUIT
+2 NEW X,Y
+3 SET X=$PIECE($GET(^BGPD(R,N)),U,P)
+4 SET $PIECE(X,"!",S)=$PIECE(X,"!",S)+V
+5 SET $PIECE(^BGPD(R,N),U,P)=X
+6 QUIT
S(R,N,P,V) ;
+1 ;no value to add
IF 'V
QUIT
+2 SET $PIECE(^BGPD(R,N),U,P)=$PIECE($GET(^BGPD(R,N)),U,P)+V
+3 QUIT
+4 ;
TOBACCO(P,EDATE) ;EP
+1 ;get last health factor in date range from V Health Factors
+2 ;if none, check health status and check date
+3 IF '$GET(P)
QUIT ""
+4 NEW BGPTOB,BGP,X,E
+5 KILL BGPTOB
+6 DO TOBACCO1
+7 IF $DATA(BGPTOB)
QUIT BGPTOB
+8 DO TOBACCO0
+9 IF $DATA(BGPTOB)
QUIT BGPTOB
+10 QUIT ""
TOBACCO1 ;check for tobacco documented in health factors
+1 KILL BGPTOB
SET BGPTOB=$$LASTHF(P,"TOBACCO",EDATE)
+2 QUIT
TOBACCO0 ;lookup in health status
+1 SET (X,Y)=0
FOR
SET X=$ORDER(^AUPNHF("AA",P,X))
IF X'=+X!(Y)
QUIT
IF $$VAL^XBDIQ1(9999999.64,X,.03)="TOBACCO"
SET Y=X
+2 IF 'Y
QUIT
+3 SET E=$ORDER(^AUPNHF("AA",P,Y,E))
IF 'E
QUIT
+4 ;documented after time frame
IF (9999999-E)>EDATE
QUIT
+5 SET Y=$PIECE(^AUTTHF(Y,0),U)
+6 IF Y["NON"
SET BGPTOB="NEVER USED"
QUIT
+7 IF Y["SMOKE FREE HOME"
SET BGPTOB="NEVER USED"
QUIT
+8 IF Y["PREVIOUS"
SET BGPTOB="PAST USE"
QUIT
+9 IF Y="SMOKER IN HOME"
SET BGPTOB="SMOKER IN HOME"
QUIT
+10 SET BGPTOB="CURRENT USER"
+11 QUIT
+12 ;
LASTHF(P,C,EDATE) ;EP - get last factor in category C for patient P
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(C)=""
QUIT ""
+3 IF $GET(F)=""
SET F=""
+4 ;ien of category passed
SET C=$ORDER(^AUTTHF("B",C,0))
+5 IF '$GET(C)
QUIT ""
+6 NEW H,D,O
SET H=0
KILL O
+7 FOR
SET H=$ORDER(^AUTTHF("AC",C,H))
IF '+H
QUIT
Begin DoDot:1
+8 IF '$DATA(^AUPNVHF("AA",P,H))
QUIT
+9 SET D=""
FOR
SET D=$ORDER(^AUPNVHF("AA",P,H,D))
IF D'=+D
QUIT
Begin DoDot:2
+10 ;after time frame
IF (9999999-D)>EDATE
QUIT
+11 SET O(D)=$ORDER(^AUPNVHF("AA",P,H,D,""))
End DoDot:2
+12 QUIT
End DoDot:1
+13 SET D=$ORDER(O(0))
+14 IF D=""
QUIT D
+15 QUIT $$VAL^XBDIQ1(9000010.23,O(D),.01)
+16 ;
+17 ;;
