BGP8D713 ; IHS/CMI/LAB - measure 31 ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
PREGSCRN ;EP
S BGPTOB=$$TOBHF^BGP8D712(DFN,BGP20M,BGPEDATE) ;get last HF from the 3 categories during the report period
S BGPSDX=$$DX^BGP8D7(DFN,BGP20M,BGPEDATE) ;LAST OF ANY SCREENING DX
S BGPUDX=$$DXU^BGP8D7(DFN,BGP20M,BGPEDATE) ;last of user dx
S BGPSMDX=$$DXS^BGP8D7(DFN,BGP20M,BGPEDATE) ;last of smoking
S BGPSLDX=$$DXSL^BGP8D7(DFN,BGP20M,BGPEDATE) ;LAST OF THE SMOKELESS
S BGPXPHD=$$PED^BGP8D7(DFN,BGP20M,BGPEDATE)
S BGP1320=$$DENT^BGP8D7(DFN,BGP20M,BGPEDATE)
S BGPSCPT=$$CPTSM^BGP8D7(DFN,BGP20M,BGPEDATE)
S BGPN6=$S(BGPTOB]"":1,1:0)
I BGPSDX]"" S BGPN6=1
I BGPSLDX]"" S BGPN6=1
I BGPXPHD]"" S BGPN6=1
I BGP1320]"" S BGPN6=1
I BGPSCPT]"" S BGPN6=1
I BGPUDX]"" S BGPN6=1
I BGPSMDX]"" S BGPN6=1
S (BGPVALUE,BGPVAL)=""
S F=BGPTOB
S %=""
S T=$O(^ATXAX("B","BGP TOBACCO PAST USE DXS",0))
I BGPSDX]"" S I=$P(BGPSDX,U,3) I $$ICD^BGP8UTL2(I,T,9) S %=1
;BGPN7 - USER
D
.I $P(F,U,1)["CURRENT"!($P(F,U,1)["CESSATION")!($P(F,U,1)["HEAVY TOBACCO SMOKER")!($P(F,U,1)["LIGHT TOBACCO SMOKER") S BGPN7=1,BGPVAL=$P(BGPTOB,U,2)_" SCREEN (20 MONTHS), "_$P(BGPTOB,U,2)_" USER (20 MONTHS)" Q ;SMOKING CATEGORY
.I $P(F,U,4)["CURRENT"!($P(F,U,4)["CESSATION") S BGPN7=1,BGPVAL=$P(BGPTOB,U,5)_" SCREEN (20 MONTHS), "_$P(BGPTOB,U,5)_" USER (20 MONTHS)" Q ;SMOKELESS CATEGORY
.I $P(F,U,10)["CURRENT"!($P(F,U,10)["CESSATION") S BGPN7=1,BGPVAL=$P(BGPTOB,U,11)_" SCREEN (20 MONTHS), "_$P(BGPTOB,U,11)_" USER (20 MONTHS)" Q ;ENDS
.I BGPUDX]"" S BGPN7=1,BGPVAL=$$DATE^BGP8UTL($P(BGPUDX,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($P(BGPUDX,U,2))_" USER (20 MONTHS)" Q
.I BGPSMDX]"" S BGPN7=1,BGPVAL=$$DATE^BGP8UTL($P(BGPSMDX,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($P(BGPSMDX,U,2))_" USER (20 MONTHS)" Q
.I BGPSLDX]"" S BGPN7=1,BGPVAL=$$DATE^BGP8UTL($P(BGPSLDX,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($P(BGPSLDX,U,2))_" USER (20 MONTHS)" Q
.I ($P(BGPSCPT,U)="1034F")!($P(BGPSCPT,U)="1035F")!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407)!($P(BGPSCPT,U)="G9276") D
..S BGPN7=1,BGPVAL=$$DATE^BGP8UTL($P(BGPSCPT,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($P(BGPSCPT,U,2))_" USER (20 MONTHS)" Q
.I $P(BGPSCPT,U)=99406!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8456")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") D
..S BGPN7=1,BGPVAL=$$DATE^BGP8UTL($P(BGPSCPT,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($P(BGPSCPT,U,2))_" USER (20 MONTHS)" Q
;BGPN8 - SMOKER OR NOT
D
.I $P(F,U,1)["CURRENT SMOKER"!($P(F,U,1)="CESSATION-SMOKER")!($P(F,U,1)["HEAVY TOBACCO SMOKER")!($P(F,U,1)["LIGHT TOBACCO SMOKER") S BGPN8=1,BGPVAL=BGPVAL_", "_$P(F,U,2)_" SMOKER (20 MONTHS)" Q
.I BGPSMDX]"" S BGPN8=1,BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($P(BGPSMDX,U,2))_" SMOKER (20 MONTHS)" Q
.I $P(BGPSCPT,U)="1034F"!($P(BGPSCPT,U)="G0376")!($P(BGPSCPT,U)="G0375")!($P(BGPSCPT,U)=99407)!($P(BGPSCPT,U)=99406)!($P(BGPSCPT,U)="G8455")!($P(BGPSCPT,U)="G8402")!($P(BGPSCPT,U)="G8453") D
..S BGPN8=1,BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($P(BGPSCPT,U,2))_" SMOKER (20 MONTHS)" Q
;BGPN9 - SMOKELESS
D
.I $P(F,U,4)="CURRENT SMOKELESS"!($P(F,U,4)="CURRENT SMOKER & SMOKELESS")!($P(F,U,4)="CESSATION-SMOKELESS") S BGPN9=1,BGPVAL=BGPVAL_", "_$P(F,U,5)_" SMOKELESS (20 MONTHS)" Q
.I $P(BGPSCPT,U)="1035F"!($P(BGPSCPT,U)="G8456") S BGPN9=1,BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($P(BGPSCPT,U,2))_" SMOKELESS (20 MONTHS)" Q
.I BGPSLDX]"" S BGPN9=1,BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($P(BGPSLDX,U,2))_" SMOKELESS (20 MONTHS)" Q
;BGPN5 - ETS
I $P(F,U,7)="SMOKER IN HOME"!($P(F,U,7)["ENVIRON") S BGPN10=1,BGPVAL=$S(BGPVAL["SCREEN (20 MONTHS)":BGPVAL_", "_$P(F,U,8)_" ETS (20 MONTHS)",1:$P(F,U,8)_" SCREEN (20 MONTHS), ETS (20 MONTHS)")
;ENDS USER
D
.I $P(F,U,10)="CURRENT ENDS USER"!($P(F,U,10)="CESSATION ENDS USER") S BGPN12=1,BGPVAL=BGPVAL_", "_$P(F,U,11)_" ENDS (20 MONTHS)" Q
I BGPN6,BGPVAL="" D
.I BGPTOB]"" S BGPVAL=$S($P(BGPTOB,U,2)]"":$P(BGPTOB,U,2)_" SCREEN (20 MONTHS)",$P(BGPTOB,U,5)]"":$P(BGPTOB,U,5)_" SCREEN (20 MONTHS)",$P(BGPTOB,U,8)]"":$P(BGPTOB,U,8)_" SCREEN (20 MONTHS)",1:"") Q
.I BGPSDX]"" S BGPVAL=$$DATE^BGP8UTL($P(BGPSDX,U,2))_" SCREEN (20 MONTHS)" Q
.I BGPSCPT]"" S BGPVAL=$$DATE^BGP8UTL($P(BGPSCPT,U,2))_" SCREEN (20 MONTHS)" Q
.I BGPXPHD]"" S BGPVAL=$$DATE^BGP8UTL($P(BGPXPHD,U,2))_" SCREEN (20 MONTHS)" Q
.I BGP1320]"" S BGPVAL=$$DATE^BGP8UTL($P(BGP1320,U,2))_" SCREEN (20 MONTHS)" Q
S V=$S(BGPD1:"UP",1:"")_$S(BGPACTCL:",AC",1:"")_$S(BGPD8:",PREG",1:"")
S BGPVALUE=V_"|||"_BGPVAL
Q
BGP8D713 ; IHS/CMI/LAB - measure 31 ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
PREGSCRN ;EP
+1 ;get last HF from the 3 categories during the report period
SET BGPTOB=$$TOBHF^BGP8D712(DFN,BGP20M,BGPEDATE)
+2 ;LAST OF ANY SCREENING DX
SET BGPSDX=$$DX^BGP8D7(DFN,BGP20M,BGPEDATE)
+3 ;last of user dx
SET BGPUDX=$$DXU^BGP8D7(DFN,BGP20M,BGPEDATE)
+4 ;last of smoking
SET BGPSMDX=$$DXS^BGP8D7(DFN,BGP20M,BGPEDATE)
+5 ;LAST OF THE SMOKELESS
SET BGPSLDX=$$DXSL^BGP8D7(DFN,BGP20M,BGPEDATE)
+6 SET BGPXPHD=$$PED^BGP8D7(DFN,BGP20M,BGPEDATE)
+7 SET BGP1320=$$DENT^BGP8D7(DFN,BGP20M,BGPEDATE)
+8 SET BGPSCPT=$$CPTSM^BGP8D7(DFN,BGP20M,BGPEDATE)
+9 SET BGPN6=$SELECT(BGPTOB]"":1,1:0)
+10 IF BGPSDX]""
SET BGPN6=1
+11 IF BGPSLDX]""
SET BGPN6=1
+12 IF BGPXPHD]""
SET BGPN6=1
+13 IF BGP1320]""
SET BGPN6=1
+14 IF BGPSCPT]""
SET BGPN6=1
+15 IF BGPUDX]""
SET BGPN6=1
+16 IF BGPSMDX]""
SET BGPN6=1
+17 SET (BGPVALUE,BGPVAL)=""
+18 SET F=BGPTOB
+19 SET %=""
+20 SET T=$ORDER(^ATXAX("B","BGP TOBACCO PAST USE DXS",0))
+21 IF BGPSDX]""
SET I=$PIECE(BGPSDX,U,3)
IF $$ICD^BGP8UTL2(I,T,9)
SET %=1
+22 ;BGPN7 - USER
+23 Begin DoDot:1
+24 ;SMOKING CATEGORY
IF $PIECE(F,U,1)["CURRENT"!($PIECE(F,U,1)["CESSATION")!($PIECE(F,U,1)["HEAVY TOBACCO SMOKER")!($PIECE(F,U,1)["LIGHT TOBACCO SMOKER")
SET BGPN7=1
SET BGPVAL=$PIECE(BGPTOB,U,2)_" SCREEN (20 MONTHS), "_$PIECE(BGPTOB,U,2)_" USER (20 MONTHS)"
QUIT
+25 ;SMOKELESS CATEGORY
IF $PIECE(F,U,4)["CURRENT"!($PIECE(F,U,4)["CESSATION")
SET BGPN7=1
SET BGPVAL=$PIECE(BGPTOB,U,5)_" SCREEN (20 MONTHS), "_$PIECE(BGPTOB,U,5)_" USER (20 MONTHS)"
QUIT
+26 ;ENDS
IF $PIECE(F,U,10)["CURRENT"!($PIECE(F,U,10)["CESSATION")
SET BGPN7=1
SET BGPVAL=$PIECE(BGPTOB,U,11)_" SCREEN (20 MONTHS), "_$PIECE(BGPTOB,U,11)_" USER (20 MONTHS)"
QUIT
+27 IF BGPUDX]""
SET BGPN7=1
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPUDX,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($PIECE(BGPUDX,U,2))_" USER (20 MONTHS)"
QUIT
+28 IF BGPSMDX]""
SET BGPN7=1
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPSMDX,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($PIECE(BGPSMDX,U,2))_" USER (20 MONTHS)"
QUIT
+29 IF BGPSLDX]""
SET BGPN7=1
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPSLDX,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($PIECE(BGPSLDX,U,2))_" USER (20 MONTHS)"
QUIT
+30 IF ($PIECE(BGPSCPT,U)="1034F")!($PIECE(BGPSCPT,U)="1035F")!($PIECE(BGPSCPT,U)="G0376")!($PIECE(BGPSCPT,U)="G0375")!($PIECE(BGPSCPT,U)=99407)!($PIECE(BGPSCPT,U)="G9276")
Begin DoDot:2
+31 SET BGPN7=1
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPSCPT,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($PIECE(BGPSCPT,U,2))_" USER (20 MONTHS)"
QUIT
End DoDot:2
+32 IF $PIECE(BGPSCPT,U)=99406!($PIECE(BGPSCPT,U)="G8455")!($PIECE(BGPSCPT,U)="G8456")!($PIECE(BGPSCPT,U)="G8402")!($PIECE(BGPSCPT,U)="G8453")
Begin DoDot:2
+33 SET BGPN7=1
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPSCPT,U,2))_" SCREEN (20 MONTHS), "_$$DATE^BGP8UTL($PIECE(BGPSCPT,U,2))_" USER (20 MONTHS)"
QUIT
End DoDot:2
End DoDot:1
+34 ;BGPN8 - SMOKER OR NOT
+35 Begin DoDot:1
+36 IF $PIECE(F,U,1)["CURRENT SMOKER"!($PIECE(F,U,1)="CESSATION-SMOKER")!($PIECE(F,U,1)["HEAVY TOBACCO SMOKER")!($PIECE(F,U,1)["LIGHT TOBACCO SMOKER")
SET BGPN8=1
SET BGPVAL=BGPVAL_", "_$PIECE(F,U,2)_" SMOKER (20 MONTHS)"
QUIT
+37 IF BGPSMDX]""
SET BGPN8=1
SET BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($PIECE(BGPSMDX,U,2))_" SMOKER (20 MONTHS)"
QUIT
+38 IF $PIECE(BGPSCPT,U)="1034F"!($PIECE(BGPSCPT,U)="G0376")!($PIECE(BGPSCPT,U)="G0375")!($PIECE(BGPSCPT,U)=99407)!($PIECE(BGPSCPT,U)=99406)!($PIECE(BGPSCPT,U)="G8455")!($PIECE(BGPSCPT,U)="G8402")!($PIECE(BGPSCPT,U)="G8453")
Begin DoDot:2
+39 SET BGPN8=1
SET BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($PIECE(BGPSCPT,U,2))_" SMOKER (20 MONTHS)"
QUIT
End DoDot:2
End DoDot:1
+40 ;BGPN9 - SMOKELESS
+41 Begin DoDot:1
+42 IF $PIECE(F,U,4)="CURRENT SMOKELESS"!($PIECE(F,U,4)="CURRENT SMOKER & SMOKELESS")!($PIECE(F,U,4)="CESSATION-SMOKELESS")
SET BGPN9=1
SET BGPVAL=BGPVAL_", "_$PIECE(F,U,5)_" SMOKELESS (20 MONTHS)"
QUIT
+43 IF $PIECE(BGPSCPT,U)="1035F"!($PIECE(BGPSCPT,U)="G8456")
SET BGPN9=1
SET BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($PIECE(BGPSCPT,U,2))_" SMOKELESS (20 MONTHS)"
QUIT
+44 IF BGPSLDX]""
SET BGPN9=1
SET BGPVAL=BGPVAL_", "_$$DATE^BGP8UTL($PIECE(BGPSLDX,U,2))_" SMOKELESS (20 MONTHS)"
QUIT
End DoDot:1
+45 ;BGPN5 - ETS
+46 IF $PIECE(F,U,7)="SMOKER IN HOME"!($PIECE(F,U,7)["ENVIRON")
SET BGPN10=1
SET BGPVAL=$SELECT(BGPVAL["SCREEN (20 MONTHS)":BGPVAL_", "_$PIECE(F,U,8)_" ETS (20 MONTHS)",1:$PIECE(F,U,8)_" SCREEN (20 MONTHS), ETS (20 MONTHS)")
+47 ;ENDS USER
+48 Begin DoDot:1
+49 IF $PIECE(F,U,10)="CURRENT ENDS USER"!($PIECE(F,U,10)="CESSATION ENDS USER")
SET BGPN12=1
SET BGPVAL=BGPVAL_", "_$PIECE(F,U,11)_" ENDS (20 MONTHS)"
QUIT
End DoDot:1
+50 IF BGPN6
IF BGPVAL=""
Begin DoDot:1
+51 IF BGPTOB]""
SET BGPVAL=$SELECT($PIECE(BGPTOB,U,2)]"":$PIECE(BGPTOB,U,2)_" SCREEN (20 MONTHS)",$PIECE(BGPTOB,U,5)]"":$PIECE(BGPTOB,U,5)_" SCREEN (20 MONTHS)",$PIECE(BGPTOB,U,8)]"":$PIECE(BGPTOB,U,8)_" SCREEN (20 MONTHS)",1:"")
QUIT
+52 IF BGPSDX]""
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPSDX,U,2))_" SCREEN (20 MONTHS)"
QUIT
+53 IF BGPSCPT]""
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPSCPT,U,2))_" SCREEN (20 MONTHS)"
QUIT
+54 IF BGPXPHD]""
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGPXPHD,U,2))_" SCREEN (20 MONTHS)"
QUIT
+55 IF BGP1320]""
SET BGPVAL=$$DATE^BGP8UTL($PIECE(BGP1320,U,2))_" SCREEN (20 MONTHS)"
QUIT
End DoDot:1
+56 SET V=$SELECT(BGPD1:"UP",1:"")_$SELECT(BGPACTCL:",AC",1:"")_$SELECT(BGPD8:",PREG",1:"")
+57 SET BGPVALUE=V_"|||"_BGPVAL
+58 QUIT
