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

BGP8C4.m

Go to the documentation of this file.
BGP8C4 ; IHS/CMI/LAB - calc CMS measures ;
 ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
 ;
SCALL ;EP
 K BGPDATA
 D SCIP^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
 Q:'$D(BGPDATA)
 K BGPDATA
 I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
 S ^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=""
 Q
 ;
SCIP1 ;EP
 S BGPEX=""
 K BGPDATA
 D SCIP1^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
 I '$D(BGPDATA) Q  ;no procedure
 I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
 ;exclusions
 I $$ADMPRIM^BGP8CU5(BGPVINP,"BGP CMS INFECTIOUS DXS") S BGPEX=BGPEX_"1|"
SCIP1A ;
 I $G(BGPEXCL),BGPEX]"" Q
 S ^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
 Q
 ;
SCIP3 ;EP
 S BGPEX=""
 K BGPDATA
 D SCIP1^BGP8CU5(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
 I '$D(BGPDATA) Q  ;no procedure
 I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
 ;exclusions
 I $$ADMPRIM^BGP8CU5(BGPVINP,"BGP CMS INFECTIOUS DXS") S BGPEX=BGPEX_"1|"
 K BGPDATA
 D ANTIRX^BGP8CU3(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
 I '$D(BGPDATA) S BGPEX=BGPEX_"|7"
SCIP3A ;
 I $G(BGPEXCL),BGPEX]"" Q
 S ^XTMP("BGP8C1",BGPJ,BGPH,"LIST",BGPIND,BGPPLSTL,$P(^DPT(DFN,0),U),DFN,BGPVSIT)=BGPEX
 Q
 ;