- 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 ;;
