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

BGP9C3.m

Go to the documentation of this file. 
  1. BGP9C3 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2008 2:38 PM ;
  1.  ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
  1.  ;
  1. PNALL ;EP
  1.  ;was there pneumonia on this visit?
  1.  Q:$$PNEUMODX^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. PN1 ;EP
  1.  S BGPEX=""
  1.  Q:$$PNEUMODX^BGP9CU(BGPVSIT)=""  ;no pneumonia dx
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  ;exclusions
  1.  I $$DDA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=1  ;discharged on day of arrival, exclusion 1
  1.  I $$DEATHAMA^BGP9CU(BGPVINP),$$DODA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=BGPEX_"|2"  ;death/ama, discharged day of or day after arrival
  1.  S BGPADMER="",BGPERPN=""
  1.  I '$$ADMDX^BGP9CU(BGPVINP,"BGP CMS PNEUMONIA DXS") S BGPADMER="|3"  ;no admitting dx of pneumonia
  1.  I '$$ERPNEU^BGP9CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS") S BGPERPN="|4"
  1.  I BGPADMER]""&(BGPERPN]"") S BGPEX=BGPADMER_BGPERPN
  1.  I $$LASTDX^BGP9UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|5"
  1. PN1A ;
  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. PN2 ;EP
  1.  S BGPEX=""
  1.  Q:$$PNEUMODX^BGP9CU(BGPVSIT)=""  ;no pneumonia dx
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<65 Q  ; no one under 18 at admission date
  1.  ;exclusions
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=BGPEX_"|9"  ;death/ama, discharged day of or day after arrival
  1.  I $$LASTDX^BGP9UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|5"
  1. PN2A ;
  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. PN3B ;EP
  1.  S BGPEX=""
  1.  Q:$$PNEUMODX^BGP9CU(BGPVSIT)=""  ;no pneumonia dx
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  S BGPERBC=""
  1.  K BGPDATA
  1.  D ERBC^BGP9CU3(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),.BGPDATA)
  1.  I $D(BGPDATA) S BGPERBC=1
  1.  S BGPANTIH=""
  1.  K BGPDATA
  1.  D ANTIRX^BGP9CU3(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA)
  1.  I $D(BGPDATA) S BGPANTIH=1
  1.  I 'BGPANTIH!('BGPERBC) Q  ;S BGPEX="|6"
  1.  ;exclusions
  1.  I $$DDA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=1  ;discharged on day of arrival, exclusion 1
  1.  S BGPADMER="",BGPERPN=""
  1.  I '$$ADMDX^BGP9CU(BGPVINP,"BGP CMS PNEUMONIA DXS") S BGPADMER="|3"  ;no admitting dx of pneumonia
  1.  I '$$ERPNEU^BGP9CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS") S BGPERPN="|4"
  1.  I BGPADMER]""&(BGPERPN]"") S BGPEX=BGPADMER_BGPERPN
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=BGPEX_"|9"  ;death/ama, discharged day of or day after arrival
  1.  I $$LASTDX^BGP9UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|5"
  1. PN3A ;
  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. PN4 ;EP
  1.  S BGPEX=""
  1.  Q:$$PNEUMODX^BGP9CU(BGPVSIT)=""  ;no pneumonia dx
  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.  ;exclusions
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=BGPEX_"|9"  ;death/ama, discharged day of or day after arrival
  1.  I $$LASTDX^BGP9UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|5"
  1. PN4A ;
  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. PN5B ;EP
  1.  S BGPEX=""
  1.  Q:$$PNEUMODX^BGP9CU(BGPVSIT)=""  ;no pneumonia dx
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  ;exclusions
  1.  I $$DDA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=BGPEX_"|1"  ;discharged on day of arrival, exclusion 1
  1.  S BGPADMER="",BGPERPN=""
  1.  I '$$ADMDX^BGP9CU(BGPVINP,"BGP CMS PNEUMONIA DXS") S BGPADMER="|3"  ;no admitting dx of pneumonia
  1.  I '$$ERPNEU^BGP9CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS") S BGPERPN="|4"
  1.  I BGPADMER]""&(BGPERPN]"") S BGPEX=BGPADMER_BGPERPN
  1.  I $$DEATHAMA^BGP9CU(BGPVINP),$$DODA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=BGPEX_"|2"  ;death/ama, discharged day of or day after arrival
  1.  I $$LASTDX^BGP9UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|5"
  1.  S BGPANTIH=""
  1.  K BGPDATA,BGPY
  1.  D ANTIRX^BGP9CU3(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP),.BGPDATA)
  1.  I '$D(BGPDATA) S BGPEX=BGPEX_"|7"
  1.  D GETMEDS^BGP9CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-180),$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),"BGP CMS ANTIBIOTIC MEDS","BGP CMS ANTIBIOTIC MEDS NDC","BGP CMS ANTIBIOTICS MEDS CLASS",1,"","",0,1)
  1.  I $G(BGPY)]"" S BGPEX=BGPEX_"|8"
  1. PN5BA ;
  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. PN6 ;EP
  1.  S BGPEX=""
  1.  Q:$$PNEUMODX^BGP9CU(BGPVSIT)=""  ;no pneumonia dx
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<18 Q  ; no one under 18 at admission date
  1.  ;exclusions
  1.  I $$DDA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=BGPEX_"|1"  ;discharged on day of arrival, exclusion 1
  1.  S BGPADMER="",BGPERPN=""
  1.  I '$$ADMDX^BGP9CU(BGPVINP,"BGP CMS PNEUMONIA DXS") S BGPADMER="|3"  ;no admitting dx of pneumonia
  1.  I '$$ERPNEU^BGP9CU(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$P($P(BGPVSIT0,U),"."),"BGP CMS PNEUMONIA DXS") S BGPERPN="|4"
  1.  I BGPADMER]""&(BGPERPN]"") S BGPEX=BGPADMER_BGPERPN
  1.  I $$DEATHAMA^BGP9CU(BGPVINP),$$DODA^BGP9CU(BGPVSIT,BGPVINP) S BGPEX=BGPEX_"|2"  ;death/ama, discharged day of or day after arrival
  1.  I $$LASTDX^BGP9UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|5"
  1.  K BGPDATA
  1.  I $$HIV^BGP9CU4(DFN,$$DOB^AUPNPAT(DFN),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|A"
  1.  I $$SYSCHEMO^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|B"
  1.  I $$SYSIMMUN^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|C"
  1.  I $$LEUKEMIA^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|D"
  1.  I $$LYMPHOMA^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|K"
  1.  I $$RADTHER^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|E"
  1.  I $$PRIORHOS^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-14),$P($P(BGPVSIT0,U),"."),BGPVSIT) S BGPEX=BGPEX_"|F"
  1.  I $$HOS2DAYS^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|G"
  1.  I $$NURSHOME^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-90),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|H"
  1.  I $$CHRDIAL^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-30),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|I"
  1.  I $$WOUNDCAR^BGP9CU4(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-30),$P($P(BGPVSIT0,U),".")) S BGPEX=BGPEX_"|J"
  1. PN6BA ;
  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. PN7 ;EP
  1.  S BGPEX=""
  1.  Q:$$PNEUMODX^BGP9CU(BGPVSIT)=""  ;no pneumonia dx
  1.  I $$AGE^AUPNPAT(DFN,$P($P(BGPVSIT0,U),"."))<50 Q  ; no one under 18 at admission date
  1.  S M=$E($$DSCH^BGP9CU(BGPVINP),4,5)
  1.  I +M>2,+M<10 Q  ;only 10 through 2 months
  1.  ;exclusions
  1.  I $$DEATHAMA^BGP9CU(BGPVINP) S BGPEX=BGPEX_"|9"  ;death/ama, discharged day of or day after arrival
  1.  I $$LASTDXI^BGP9UTL1(DFN,"487.0",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP),"HI") S BGPEX=BGPEX_"|L"
  1.  I $$LASTDX^BGP9UTL1(DFN,"BGP CMS CYSTIC FIBROSIS DXS",$$DOB^AUPNPAT(DFN),$$DSCH^BGP9CU(BGPVINP)) S BGPEX=BGPEX_"|5"
  1. PN7A ;
  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.  ;