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