Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP9C1

BGP9C1.m

Go to the documentation of this file. 
  1. BGP9C1 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2008 2:38 PM 02 Nov 2007 10:20 AM ;
  1.  ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
  1.  ;
  1. PROC ;EP
  1.  D ^APCDCHKJ
  1.  S BGPBT=$H
  1.  S BGPJ=$J,BGPH=$H
  1.  K ^XTMP("BGP9C1",BGPJ,BGPH),BGPCOUNT
  1.  D XTMP^BGP9UTL("BGP9C1","CRS CMS Report")
  1.  S BGPSD=$$FMADD^XLFDT(BGPBD,-1),BGPSD=BGPSD_".9999"
  1.  F  S BGPSD=$O(^AUPNVINP("B",BGPSD)) Q:BGPSD=""!($P(BGPSD,".")>BGPED)  D
  1.  .S BGPVINP=0 F  S BGPVINP=$O(^AUPNVINP("B",BGPSD,BGPVINP)) Q:BGPVINP'=+BGPVINP  S BGPVSIT=$P($G(^AUPNVINP(BGPVINP,0)),U,3) I BGPVSIT D PROC1
  1.  S BGPET=$H
  1.  Q
  1.  ;
  1. PROC1 ;current time period
  1.  K BGPEXCL
  1.  Q:'$D(^AUPNVSIT(BGPVSIT,0))
  1.  S BGPVSIT0=^AUPNVSIT(BGPVSIT,0)
  1.  Q:$P(BGPVSIT0,U,7)'="H"
  1.  Q:$P(BGPVSIT0,U,11)
  1.  Q:'$P(BGPVSIT0,U,9)
  1.  Q:$P(BGPVSIT0,U,6)'=BGPHOSP
  1.  Q:$P(BGPVSIT0,U,3)="C"
  1.  S DFN=$P(BGPVSIT0,U,5)
  1.  Q:$P($G(^DPT(DFN,0)),U)["DEMO,PATIENT"
  1.  I $P($G(^BGPSITE(DUZ(2),0)),U,12) Q:$D(^DIBT($P(^BGPSITE(DUZ(2),0),U,12),1,DFN))
  1.  I BGPBEN=1,$$BEN^AUPNPAT(DFN,"C")'="01" Q  ;must be Indian/Alaskan Native
  1.  I BGPBEN=2,$$BEN^AUPNPAT(DFN,"C")="01" Q   ;must not be I/A
  1.  S BGPIND=0 F  S BGPIND=$O(BGPPLSTL(BGPIND)) Q:BGPIND'=+BGPIND  D
  1.  .S BGPPLSTL=0 F  S BGPPLSTL=$O(BGPPLSTL(BGPIND,BGPPLSTL)) Q:BGPPLSTL'=+BGPPLSTL  D
  1.  ..X ^BGPCMSMN(BGPPLSTL,2)
  1.  Q
  1. AMIALL ;EP
  1.  ;was there an AMI pov on this visit
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=""
  1.  Q
  1.  ;
  1. AMI1 ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  ;EXCLUSION 1 DISCHARGE TYPE
  1.  I $$DEATHAMA^BGP9CU(BGPVINP),$$DODA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=1  ;ama or death and day of or day after admission
  1.  ;EXCLUSION 2 DODA
  1.  I $$DDA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=BGPEX_"|2"  ;discharged on day of arrival
  1.  ;EXCLUSION 3 ASA ALLERGY
  1.  I $$ASAALLEG^BGP9CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|3"  ;has aspirin allergy documented through discharge date
  1.  ;EXCLUSION 4 WARFARIN RX
  1.  K BGPDATA
  1.  D WARRX^BGP9CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),1,.BGPDATA)
  1.  I $D(BGPDATA) S BGPEX=BGPEX_"|4"  ;has warfarin meds on admission date
  1. AMI1A ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q
  1.  ;
  1. AMI2 ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=5  ;ama or death and day of or day after admission
  1.  I $$ASAALLEG^BGP9CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|3"  ;has aspirin allergy
  1.  K BGPDATA
  1.  D WARRX^BGP9CU1(DFN,$P($P(^AUPNVINP(BGPVINP,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."),1,.BGPDATA)
  1.  I $D(BGPDATA) S BGPEX=BGPEX_"|4"  ;has warfarin meds on discharge
  1. AMI2A ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q
  1.  ;
  1. AMI3 ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  K BGPDATA S BGPLVSD=0
  1.  D LVSD^BGP9CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP9CU(BGPVINP),-365),$$DSCH^BGP9CU(BGPVINP),.BGPDATA)
  1.  I $D(BGPDATA) S BGPLVSD=1
  1.  K BGPDATA S BGPEJEC=0
  1.  D EJECFRAC^BGP9CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP9CU(BGPVINP),-365),$$DSCH^BGP9CU(BGPVINP),.BGPDATA)
  1.  I $D(BGPDATA) S BGPEJEC=1
  1.  I 'BGPLVSD,'BGPEJEC Q  ;no lsvd or ejection fraction
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=5 ;ama or death and day of or day after admission
  1.  I $$ACEALLEG^BGP9CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)),$$ARBALLEG^BGP9CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|6"
  1.  I $$SAORSTEN^BGP9CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP9CU(BGPVINP),-365),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|7"
  1. AMI3A ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q
  1.  ;
  1. AMI4 ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  K BGPDATA
  1.  D SMOKER^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP9CU(BGPVINP),.BGPDATA)
  1.  I '$D(BGPDATA) Q  ;not a smoker
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=5  ;ama or death
  1. AMI4A ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q
  1.  ;
  1. AMI5 ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=5  ;ama or death and day of or day after admission
  1.  I $$BETAALEG^BGP9CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|8"  ;has BETA allergy
  1.  ;K BGPDATA S BGPBRADY="",BGPC=0
  1.  ;D ALLDXS^BGP9CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS BRADYCARDIA DXS")
  1.  ;I $D(BGPDATA) S BGPBRADY=1
  1.  ;on active med for beta blocker?
  1.  ;S BGPBETA=""
  1.  ;K BGPDATA
  1.  ;D BETARX^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP9CU(BGPVINP),1,.BGPDATA)
  1.  ;I $D(BGPDATA) S BGPBETA=1
  1.  ;I '$D(BGPDATA) S E=+$$CODEN^ICPTCOD("G8009") S BGPBETA=$$CPTI^BGP9DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),E),BGPBETA=+BGPBETA
  1.  ;I BGPBRADY,'BGPBETA S BGPEX=BGPEX_"|9"
  1.  ;K BGPDATA
  1.  ;S BGP23RD=""
  1.  ;D ALLDXS^BGP9CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS 2/3 HEART BLOCK DXS")
  1.  ;I $D(BGPDATA) S BGP23RD=1
  1.  ;S BGPPACE=$$PACE^BGP9CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP))
  1.  ;I BGP23RD,'BGPPACE S BGPEX=BGPEX_"|0"
  1. AMI5A ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q
  1.  ;
  1. AMI6 ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  I $P($P(^AUPNVSIT(BGPVSIT,0),U),".")=$P($P(^AUPNVINP(BGPVINP,0),U),".") S BGPEX=2
  1.  I $$DEATHAMA^BGP9CU(BGPVINP),$$DODA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=BGPEX_"|1" ;ama or death and day of or day after admission
  1.  I $$BETAALEG^BGP9CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|8"  ;has BETA allergy
  1.  ;K BGPDATA S BGPBRADY="",BGPC=0
  1.  ;D ALLDXS^BGP9CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS BRADYCARDIA DXS")
  1.  ;I $D(BGPDATA) S BGPBRADY=1
  1.  ;on active med for beta blocker?
  1.  ;S BGPBETA=""
  1.  ;K BGPDATA
  1.  ;D BETARX^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$$DSCH^BGP9CU(BGPVINP),1,.BGPDATA)
  1.  ;I $D(BGPDATA) S BGPBETA=1
  1.  ;I '$D(BGPDATA) S E=+$$CODEN^ICPTCOD("G8009") S BGPBETA=$$CPTI^BGP9DU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),E),BGPBETA=+BGPBETA
  1.  ;I BGPBRADY,'BGPBETA S BGPEX=BGPEX_"|9"
  1.  ;D ALLDXS^BGP9CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS HEART FAILURE DXS")
  1.  ;I $D(BGPDATA) S BGPEX=BGPEX_"|A" ;heart failure on visit
  1.  ;K BGPDATA
  1.  ;S BGP23RD=""
  1.  ;D ALLDXS^BGP9CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS 2/3 HEART BLOCK DXS")
  1.  ;I $D(BGPDATA) S BGP23RD=1
  1.  ;S BGPPACE=$$PACE^BGP9CU2(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP))
  1.  ;I BGP23RD,'BGPPACE S BGPEX=BGPEX_"|0"
  1.  ;D ALLDXS^BGP9CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS CIRCULATORY SHOCK DXS")
  1.  ;I $D(BGPDATA) S BGPEX=BGPEX_"|B"  ;circulatory on visit
  1. AMI6A ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q
  1.  ;
  1. AMI7A ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  K BGPST1,BGPLBDX,BGPLBPC
  1.  S BGPST1=$$LASTDX^BGP9UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP9CU(BGPVINP))
  1.  S BGPLBDX=$$LBBBDX^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP9CU(BGPVINP))
  1.  D LBBBPROC^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP9CU(BGPVINP),.BGPLBPC)
  1.  I 'BGPST1&('BGPLBDX!('$D(BGPLBPC))) Q  ;no st1 or lbbb DX AND PROCEDURE
  1.  S BGPFIB=""
  1.  K BGPDATA
  1.  D TARX^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-180),$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),1,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),.BGPDATA)
  1.  K BGPUD
  1.  D IVUD^BGP9CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP),$O(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$O(^ATXAX("B","BGP THROMBOLYTIC AGENT CLASS",0)))
  1.  S BGPTAPRO=$$LASTPRCI^BGP9UTL1(DFN,"99.10",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP))
  1.  I '$D(BGPDATA),'$D(BGPUD),'BGPTAPRO Q  ;no fibrom meds
  1. AMI7AW ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q
  1. AMI8A ;EP
  1.  S BGPEX=""
  1.  Q:'$$AMIDX^BGP9CU(BGPVSIT)
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  K BGPST1,BGPLBDX,BGPLBPC
  1.  S BGPST1=$$LASTDX^BGP9UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP9CU(BGPVINP))
  1.  S BGPLBDX=$$LBBBDX^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP9CU(BGPVINP))
  1.  D LBBBPROC^BGP9CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP9CU(BGPVINP),.BGPLBPC)
  1.  I 'BGPST1&('BGPLBDX!('$D(BGPLBPC))) Q  ;no st1 or lbbb DX AND PROCEDURE
  1.  S BGPPCI=$$LASTPRCI^BGP9UTL1(DFN,"00.66",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP))
  1.  I 'BGPPCI Q  ;no PCI
  1. AMI8AW ;
  1.  I $G(BGPEXCL),BGPEX]"" Q
  1.  S ^XTMP("BGP9C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
  1.  Q