BGP8PC5 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018 11:25 AM
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
AIZ ;EP
I 'BGPIPCUP S BGPSTOP=1 Q ;must be ipc up
I BGPAGEB<19 S BGPSTOP=1 Q ;must be 19 or older
;
S (BGP1959,BGP6064,BGP65,BGPD1,BGPN1,BGPTDAP,BGPTD,BGPTDCOM,BGPZOST,BGPZOC,BGPN46,BGPN47,BGPN48,BGPPNCON,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y,BGPPPCON,BGPPCCON)=0
S BGPD1=1
S BGPVALUE=""
I BGPAGEB>64 S BGP65=1
I BGPAGEB>18,BGPAGEB<60 S BGP1959=1
I BGPAGEB>59,BGPAGEB<65 S BGP6064=1
;
;AGE 19-59 FIRST
S BGPTDAP=$$DTAP^BGP8D3A(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
S BGPTD=$$DTAPTD^BGP8D3A(DFN,$$FMADD^XLFDT(BGPEDATE,-(10*365)),BGPEDATE)
I BGPTD,BGPTDAP S BGPTDCOM=1 ;026.N.1 1 Tdap/Td in past 10 years BGPN10
I BGPTDCOM,BGP1959 S BGPN1=1 G SV
I BGP1959 G SV
;age 60-64 add in zoster
S BGPZOST=$$IZOSTER^BGP8D3C(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
I $P(BGPZOST,U,3)=1!($P(BGPZOST,U,3)=3) S BGPZOC=1
I BGP6064,BGPZOC,BGPTD,BGPTDAP S BGPN1=1 G SV
I BGP6064 G SV
;AGE 65+
;I BGPAGEB<65 G N1
S BGPPPCON=$$PPCONT^BGP8D3B(DFN,BGPEDATE) ;I BGPPPCON S (BGPPPSEV,BGPPP5Y,BGPPP1Y,BGPPP65)=BGPPPCON G N1 ;did they have a contraindication
S BGPPCCON=$$PCCONT^BGP8D3B(DFN,BGPEDATE) ;I BGPPCCON S (BGPPCVEV,BGPPC5Y,BGPPC1Y,BGPPC19)=BGPPCCON G N1 ;did they have a contraindication
;I BGPPCON S (BGPN1,BGPN8,BGPN37,BGPN46,BGPN47,BGPN48,BGPN49,BGPN50,BGPN51,BGPN52)=1 G N1
S BGPPPSEV=$$PPSV23^BGP8D3C(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) ;PPSV23 EVER
S BGPPCVEV=$$PCV13^BGP8D3C(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) ;PCV13 EVER
S BGPPP5Y=$$PPSV23^BGP8D3C(DFN,$$FMADD^XLFDT(BGPEDATE,-(5*365)),BGPEDATE) ;PPSV23 LAST 5 YEARS
S BGPPC5Y=$$PCV13^BGP8D3C(DFN,$$FMADD^XLFDT(BGPEDATE,-(5*365)),BGPEDATE) ;PCV13 LAST 5 YEARS
S BGPPC1Y=$$PCV13^BGP8D3C(DFN,BGPBDATE,BGPEDATE) ;PCV13 PAST YEAR
S BGPPP1Y=$$PPSV23^BGP8D3C(DFN,BGPBDATE,BGPEDATE) ;PPSV23 PAST YEAR
S B=$$DOB^AUPNPAT(DFN)
S BGPA65BD=$E(B,1,3)+65_$E(B,4,7)
I BGPAGEB>64 S BGPPP65=$$PPSV23^BGP8D3C(DFN,BGPA65BD,BGPEDATE),BGPPC65=$$PCV13^BGP8D3C(DFN,BGPA65BD,BGPEDATE)
S BGPA19BD=$E(B,1,3)+19_$E(B,4,7)
S BGPPC19=$$PCV13^BGP8D3C(DFN,BGPA19BD,BGPEDATE)
N1 S BGPN47=0 ;026.C.26
I BGPPC19!(BGPPP1Y) S BGPN47=1
I BGPPCCON S BGPN47=1
S BGPN48=0 ;026.C.27
I BGPPPCON!(BGPPC1Y) S BGPN48=1
I BGPPP5Y!(BGPPP65) S BGPN48=1
S BGPN46=0 ;026.C.25 UP TO DATE
;I BGPPPCON!(BGPPCCON) S BGPN46=1
I BGPN47,BGPN48 S BGPN46=1 ;UP TO DATE
I BGPN46,BGPZOC,BGPTDAP,BGPTD S BGPN1=1
;
SV ;
I BGPTDAP S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:""),BGPVALUE=BGPVALUE_"TDAP: "_$P(BGPTDAP,U,2)_" (ever)"
I BGPTD S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:""),BGPVALUE=BGPVALUE_"TDAP/TD: "_$P(BGPTD,U,2)_" (past 10 yrs)"
I BGPZOST S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:""),BGPVALUE=BGPVALUE_"ZOSTER: "_$P(BGPZOST,U,2)_" (ever)"
I BGPPPCON S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"PPSV23: "_$$DATE^BGP8UTL($P(BGPPPCON,U,1))_" "_$P(BGPPPCON,U,2)
I BGPPCCON S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"PCV13: "_$$DATE^BGP8UTL($P(BGPPCCON,U,1))_" "_$P(BGPPCCON,U,2)
;PPSV23
I BGPPPSEV D
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"PPSV23: "_$$DATE^BGP8UTL($P(BGPPPSEV,U,1))_" "_$P(BGPPPSEV,U,2)_" (ever)"
.S:BGPPP5Y BGPVALUE=BGPVALUE_" (past 5 yrs)" S:BGPPP1Y BGPVALUE=BGPVALUE_" (past 1 yr)" S:BGPPP65 BGPVALUE=BGPVALUE_" (after 65)" I BGPN46 S BGPVALUE=BGPVALUE_" (up-to-date)"
I BGPPCVEV D
.S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_"PCV13: "_$$DATE^BGP8UTL($P(BGPPCVEV,U,1))_" "_$P(BGPPCVEV,U,2)_" (ever)"
.S:BGPPC5Y BGPVALUE=BGPVALUE_" (past 5 yrs)" S:BGPPC1Y BGPVALUE=BGPVALUE_" (past 1 yr)" S:BGPPC65 BGPVALUE=BGPVALUE_" (after 65)" S:BGPPC19 BGPVALUE=BGPVALUE_" (after 19)" I BGPN46 S BGPVALUE=BGPVALUE_" (up-to-date)"
S BGPVALUE="IPCUP|||"_$S(BGPN1:"*** ",1:"")_BGPVALUE
;I BGPN1 S BGPVALUE=$BGPVALUE_" **"
K BGP1959,BGPPNEU,BGP6064,BGP65,BGPTDAP,BGPA19BD,BGPA65BD,BGPTD,BGPZOST,BGPZOC,BGPN46,BGPN47,BGPN48,BGPTDCOM,BGPPNCON,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y,BGPPPCON,BGPPCCON
Q
BGP8PC5 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018 11:25 AM
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
AIZ ;EP
+1 ;must be ipc up
IF 'BGPIPCUP
SET BGPSTOP=1
QUIT
+2 ;must be 19 or older
IF BGPAGEB<19
SET BGPSTOP=1
QUIT
+3 ;
+4 SET (BGP1959,BGP6064,BGP65,BGPD1,BGPN1,BGPTDAP,BGPTD,BGPTDCOM,BGPZOST,BGPZOC,BGPN46,BGPN47,BGPN48,BGPPNCON,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y,BGPPPCON,BGPPCCON)=0
+5 SET BGPD1=1
+6 SET BGPVALUE=""
+7 IF BGPAGEB>64
SET BGP65=1
+8 IF BGPAGEB>18
IF BGPAGEB<60
SET BGP1959=1
+9 IF BGPAGEB>59
IF BGPAGEB<65
SET BGP6064=1
+10 ;
+11 ;AGE 19-59 FIRST
+12 SET BGPTDAP=$$DTAP^BGP8D3A(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+13 SET BGPTD=$$DTAPTD^BGP8D3A(DFN,$$FMADD^XLFDT(BGPEDATE,-(10*365)),BGPEDATE)
+14 ;026.N.1 1 Tdap/Td in past 10 years BGPN10
IF BGPTD
IF BGPTDAP
SET BGPTDCOM=1
+15 IF BGPTDCOM
IF BGP1959
SET BGPN1=1
GOTO SV
+16 IF BGP1959
GOTO SV
+17 ;age 60-64 add in zoster
+18 SET BGPZOST=$$IZOSTER^BGP8D3C(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+19 IF $PIECE(BGPZOST,U,3)=1!($PIECE(BGPZOST,U,3)=3)
SET BGPZOC=1
+20 IF BGP6064
IF BGPZOC
IF BGPTD
IF BGPTDAP
SET BGPN1=1
GOTO SV
+21 IF BGP6064
GOTO SV
+22 ;AGE 65+
+23 ;I BGPAGEB<65 G N1
+24 ;I BGPPPCON S (BGPPPSEV,BGPPP5Y,BGPPP1Y,BGPPP65)=BGPPPCON G N1 ;did they have a contraindication
SET BGPPPCON=$$PPCONT^BGP8D3B(DFN,BGPEDATE)
+25 ;I BGPPCCON S (BGPPCVEV,BGPPC5Y,BGPPC1Y,BGPPC19)=BGPPCCON G N1 ;did they have a contraindication
SET BGPPCCON=$$PCCONT^BGP8D3B(DFN,BGPEDATE)
+26 ;I BGPPCON S (BGPN1,BGPN8,BGPN37,BGPN46,BGPN47,BGPN48,BGPN49,BGPN50,BGPN51,BGPN52)=1 G N1
+27 ;PPSV23 EVER
SET BGPPPSEV=$$PPSV23^BGP8D3C(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+28 ;PCV13 EVER
SET BGPPCVEV=$$PCV13^BGP8D3C(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+29 ;PPSV23 LAST 5 YEARS
SET BGPPP5Y=$$PPSV23^BGP8D3C(DFN,$$FMADD^XLFDT(BGPEDATE,-(5*365)),BGPEDATE)
+30 ;PCV13 LAST 5 YEARS
SET BGPPC5Y=$$PCV13^BGP8D3C(DFN,$$FMADD^XLFDT(BGPEDATE,-(5*365)),BGPEDATE)
+31 ;PCV13 PAST YEAR
SET BGPPC1Y=$$PCV13^BGP8D3C(DFN,BGPBDATE,BGPEDATE)
+32 ;PPSV23 PAST YEAR
SET BGPPP1Y=$$PPSV23^BGP8D3C(DFN,BGPBDATE,BGPEDATE)
+33 SET B=$$DOB^AUPNPAT(DFN)
+34 SET BGPA65BD=$EXTRACT(B,1,3)+65_$EXTRACT(B,4,7)
+35 IF BGPAGEB>64
SET BGPPP65=$$PPSV23^BGP8D3C(DFN,BGPA65BD,BGPEDATE)
SET BGPPC65=$$PCV13^BGP8D3C(DFN,BGPA65BD,BGPEDATE)
+36 SET BGPA19BD=$EXTRACT(B,1,3)+19_$EXTRACT(B,4,7)
+37 SET BGPPC19=$$PCV13^BGP8D3C(DFN,BGPA19BD,BGPEDATE)
N1 ;026.C.26
SET BGPN47=0
+1 IF BGPPC19!(BGPPP1Y)
SET BGPN47=1
+2 IF BGPPCCON
SET BGPN47=1
+3 ;026.C.27
SET BGPN48=0
+4 IF BGPPPCON!(BGPPC1Y)
SET BGPN48=1
+5 IF BGPPP5Y!(BGPPP65)
SET BGPN48=1
+6 ;026.C.25 UP TO DATE
SET BGPN46=0
+7 ;I BGPPPCON!(BGPPCCON) S BGPN46=1
+8 ;UP TO DATE
IF BGPN47
IF BGPN48
SET BGPN46=1
+9 IF BGPN46
IF BGPZOC
IF BGPTDAP
IF BGPTD
SET BGPN1=1
+10 ;
SV ;
+1 IF BGPTDAP
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")
SET BGPVALUE=BGPVALUE_"TDAP: "_$PIECE(BGPTDAP,U,2)_" (ever)"
+2 IF BGPTD
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")
SET BGPVALUE=BGPVALUE_"TDAP/TD: "_$PIECE(BGPTD,U,2)_" (past 10 yrs)"
+3 IF BGPZOST
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")
SET BGPVALUE=BGPVALUE_"ZOSTER: "_$PIECE(BGPZOST,U,2)_" (ever)"
+4 IF BGPPPCON
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_"PPSV23: "_$$DATE^BGP8UTL($PIECE(BGPPPCON,U,1))_" "_$PIECE(BGPPPCON,U,2)
+5 IF BGPPCCON
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_"PCV13: "_$$DATE^BGP8UTL($PIECE(BGPPCCON,U,1))_" "_$PIECE(BGPPCCON,U,2)
+6 ;PPSV23
+7 IF BGPPPSEV
Begin DoDot:1
+8 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_"PPSV23: "_$$DATE^BGP8UTL($PIECE(BGPPPSEV,U,1))_" "_$PIECE(BGPPPSEV,U,2)_" (ever)"
+9 IF BGPPP5Y
SET BGPVALUE=BGPVALUE_" (past 5 yrs)"
IF BGPPP1Y
SET BGPVALUE=BGPVALUE_" (past 1 yr)"
IF BGPPP65
SET BGPVALUE=BGPVALUE_" (after 65)"
IF BGPN46
SET BGPVALUE=BGPVALUE_" (up-to-date)"
End DoDot:1
+10 IF BGPPCVEV
Begin DoDot:1
+11 SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":"; ",1:"")_"PCV13: "_$$DATE^BGP8UTL($PIECE(BGPPCVEV,U,1))_" "_$PIECE(BGPPCVEV,U,2)_" (ever)"
+12 IF BGPPC5Y
SET BGPVALUE=BGPVALUE_" (past 5 yrs)"
IF BGPPC1Y
SET BGPVALUE=BGPVALUE_" (past 1 yr)"
IF BGPPC65
SET BGPVALUE=BGPVALUE_" (after 65)"
IF BGPPC19
SET BGPVALUE=BGPVALUE_" (after 19)"
IF BGPN46
SET BGPVALUE=BGPVALUE_" (up-to-date)"
End DoDot:1
+13 SET BGPVALUE="IPCUP|||"_$SELECT(BGPN1:"*** ",1:"")_BGPVALUE
+14 ;I BGPN1 S BGPVALUE=$BGPVALUE_" **"
+15 KILL BGP1959,BGPPNEU,BGP6064,BGP65,BGPTDAP,BGPA19BD,BGPA65BD,BGPTD,BGPZOST,BGPZOC,BGPN46,BGPN47,BGPN48,BGPTDCOM,BGPPNCON,BGPPPSEV,BGPPCVEV,BGPPP65,BGPPC65,BGPPP5Y,BGPPC5Y,BGPPC1Y,BGPPC19,BGPPP1Y,BGPPPCON,BGPPCCON
+16 QUIT
