- 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
