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

BGP2CPU2.m

Go to the documentation of this file. 
  1. BGP2CPU2 ; IHS/CMI/LAB - calc CMS measures 02 Jul 2010 9:24 AM ;
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;
  1. WNMIACE ;EP - write out nmi ACE/ARB
  1.  I '$D(BGPDATA) D  Q
  1.  .I $Y>(BGPIOSL-2) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  .W !!?2,"NMI Refusal?  No"
  1.  .I BGPACPT]"" W !!?4,"CPT: ",BGPACPT
  1.  I $Y>(BGPIOSL-6) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"NMI Refusal:  Yes"
  1.  ;NEW Y S Y=0 F  S Y=$O(BGPDATA(Y)) Q:Y'=+Y  D
  1.  S BGPXX=0 F  S BGPXX=$O(BGPDATA(BGPXX)) Q:BGPXX'=+BGPXX  D
  1.  .I $Y>(IOSL-2) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  .W !?4,BGPDATA(BGPXX)
  1.  ;W !?4,BGPDATA(Y)
  1.  I $Y>(BGPIOSL-6) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  I BGPACPT]"" W !!?4,"CPT: ",BGPACPT
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if this was"
  1.  W !,"documented by a physician/APN/PA before it is used to exclude patients"
  1.  W !,"from the denominator."
  1.  Q
  1. WLVS ;EP write out lvs FUNCTION
  1.  S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"Evaluation of LVS Function? "
  1.  ;S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  D
  1.  S BGPXX=0 F  S BGPXX=$O(BGPDATA(BGPXX)) Q:BGPXX'=+BGPXX  D
  1.  .I $Y>(IOSL-2) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  .W !?4,BGPDATA(BGPXX)
  1.  ;W !?4,BGPDATA(X)
  1.  ;W !
  1.  Q
  1. WDSCHINT ;EP - write out discharge instructions
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"Discharge Instructions?  ",BGPPED,!
  1.  Q
  1. WLVAD ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,$S(BGPPEX[1:"*",1:""),"LVAD/Heart Transplant?  ",BGPLVAD
  1.  Q
  1. WCOMFORT(X) ;EP - write out comfort message
  1.  I X="" D  Q
  1.  .I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  .W !!?2,"Comfort Measures?  None Recorded."
  1.  I $Y>(BGPIOSL-5) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"Comfort Measures?  ",X
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if"
  1.  W !,"this was documented by a physician/APN/PA before it is used"
  1.  W !,"to exclude patients from the denominator.   "
  1.  Q
  1.  ;
  1. WDOD(V) ;EP - write dod
  1.  I $Y>(BGPIOSL-2) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  I $$DOD^AUPNPAT(V)]"" D
  1.  .W !!?2,"*Date of Death:  ",$$DATE^BGP2UTL($$DOD^AUPNPAT(V))
  1.  Q
  1.  ;
  1. WDT(V) ;EP - write discharge type at column 3
  1.  I $Y>(BGPIOSL-2) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W:'$D(BGPNOBA) ! W !?2,$S(BGPPEX[2:"*",1:""),"Discharge Type:  ",$$VAL^XBDIQ1(9000010.02,V,.06)
  1.  Q
  1.  ;
  1. WTT(V) ;EP - write transferred to
  1.  I $Y>(BGPIOSL-2) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W:'$D(BGPNOBA) ! W !?2,"Transferred to:  ",$$VAL^XBDIQ1(9000010.02,V,.09)
  1.  Q
  1.  ;
  1. WPPDPOV(V) ;EP
  1.  I $Y>(BGPIOSL-2) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W:'$D(BGPNOBA) ! W !?2,"Primary Discharge POV: "_$$PRIMPOV^APCLV(V,"C"),"  ",$$PRIMPOV^APCLV(V,"N")
  1.  Q
  1.  ;
  1. OTHDPOVS(V) ;EP write out other discharge povs
  1.  NEW X,C
  1.  S (X,C)=0 F  S X=$O(^AUPNVPOV("AD",BGPVSIT,X)) Q:X'=+X  D
  1.  .Q:'$D(^AUPNVPOV(X,0))
  1.  .Q:$P(^AUPNVPOV(X,0),U,12)="P"
  1.  .S C=C+1
  1.  .Q
  1.  I $Y>(BGPIOSL-(C+2)) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"Other Discharge POVs for this visit:",$S(C=0:"  None",1:"")
  1.  S (X,C)=0 F  S X=$O(^AUPNVPOV("AD",BGPVSIT,X)) Q:X'=+X  D
  1.  .Q:'$D(^AUPNVPOV(X,0))
  1.  .Q:$P(^AUPNVPOV(X,0),U,12)="P"
  1.  .S C=C+1
  1.  .S I=$P(^AUPNVPOV(X,0),U),I=$P($$ICDDX^ICDCODE(I),U,2)
  1.  .S N=$$VAL^XBDIQ1(9000010.07,X,.04),N=$$UP^XLFSTR(N)
  1.  .W !?4,I,?11,N
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:80)-$L(X)\2)_X
  1.  ;
  1. WPCI ;EP write out 
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"PCI:  "
  1.  W ?4,BGPPCI
  1.  Q:BGPPCI=""  ;only display note if found procedure
  1.  I $Y>(BGPIOSL-5) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !,"NOTE: For this to be used to exclude patients from the denominator, it must "
  1.  W !,"be described as non-primary by a physician/APN/PA.  For this to be used to "
  1.  W !,"include patients in the numerator, the PCI must be performed within 90 "
  1.  W !,"minutes of hospital arrival.  The patient's chart must be reviewed to make"
  1.  W !,"these determinations.",!
  1.  Q
  1.  ;
  1. WFIB ;EP - write out fib meds
  1.  S (X,C)=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1
  1.  S X=0 F  S X=$O(BGPUD(X)) Q:X'=+X  S Y=0 F  S Y=$O(BGPUD(X,Y)) Q:Y'=+Y  S C=C+1
  1.  I $Y>(BGPIOSL-(C+2)) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"Fibronolytic Therapy Rx Status?  "
  1.  I $D(BGPDATA) W !?4,"Outpatient Rx: " D
  1.  .S BGPXX=0 F  S BGPXX=$O(BGPDATA(BGPXX)) Q:BGPXX'=+BGPXX!(BGPQUIT)  D
  1.  ..K BGPLETXT S BGPLETP("ICL")=0,BGPLETP("LGTH")=70,BGPLETP("NRQ")=BGPDATA(BGPXX),BGPLETP("TXT")="",BGPLEC=0
  1.  ..D GETTXT^BGP2CPU4
  1.  ..S BGPZZ=0 F  S BGPZZ=$O(BGPLETXT(BGPZZ)) Q:BGPZZ'=+BGPZZ!(BGPQUIT)  D
  1.  ...D:$Y>(BGPIOSL-3) HDR^BGP2CP Q:BGPQUIT  W !?4,BGPLETXT(BGPZZ)
  1.  ;S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)
  1.  I $D(BGPUD) W !?4,"IV/Unit Dose: " W BGPUD D
  1.  .S BGPXX=0 F  S BGPXX=$O(BGPUD(BGPXX)) Q:BGPXX'=+BGPXX!(BGPQUIT)  D
  1.  ..K BGPLETXT S BGPLETP("ICL")=0,BGPLETP("LGTH")=70,BGPLETP("NRQ")=BGPUD(BGPXX),BGPLETP("TXT")="",BGPLEC=0
  1.  ..D GETTXT^BGP2CPU4
  1.  ..S BGPZZ=0 F  S BGPZZ=$O(BGPLETXT(BGPZZ)) Q:BGPZZ'=+BGPZZ!(BGPQUIT)  D
  1.  ...D:$Y>(BGPIOSL-3) HDR^BGP2CP Q:BGPQUIT  W !?4,BGPLETXT(BGPZZ)
  1.  ;S X=0 F  S X=$O(BGPUD(X)) Q:X'=+X  W !?4,BGPUD(X)
  1.  I BGPTAPRO]"" W !?4,"Procedure: ",BGPTAPRO
  1.  I '$D(BGPDATA),'$D(BGPUD),BGPTAPRO="" Q  ;no data so no note
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !,"NOTE: In order to be included in the numerator, the therapy must have been"
  1.  W !,"received within 30 minutes or less from hospital arrival.  The patient's"
  1.  W !,"chart must be reviewed to make this determination.",!
  1.  Q
  1. WLBBB ;EP - write out lbbb on ecg
  1.  I $Y>(BGPIOSL-6) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"LBBB on ECG: "
  1.  W !?4,BGPLBDX
  1.  S X=0 F  S X=$O(BGPLBPC(X)) Q:X'=+X  W !?4,BGPLBPC(X)
  1.  I BGPLBDX="",'$D(BGPLBPC) Q  ;no note if no data
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if other"
  1.  W !,"ST-Segment Elevations or LBBB on ECGs are noted and which was performed"
  1.  W !,"closest to hospital arrival."
  1.  Q
  1. WST ;EP write out st segment elevation
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"ST-Segment Elevation:  "
  1.  W ?4,BGPST1
  1.  I BGPST1="" Q
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if other"
  1.  W !,"ST-Segment Elevations or LBBB on ECGs are noted and which was performed"
  1.  W !,"closest to hospital arrival."
  1.  Q
  1. WCS ;EP -write out circulatory shock
  1.  I $Y>(BGPIOSL-6) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,$S(BGPPEX["B":"*",1:""),"Circulatory Shock? "
  1.  I '$D(BGPDATA) W "  No, Not recorded" Q
  1.  S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if the patient"
  1.  W !,"should be excluded if circulatory shock occurred on on arrival or within 24"
  1.  W !,"hours after arrival."
  1.  Q
  1. WHF ;EP - write out HF diagnosis
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,$S(BGPPEX["A":"*",1:""),"Heart Failure? "
  1.  I '$D(BGPDATA) W "  No, Not recorded" Q
  1.  ;S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)
  1.  S BGPXX=0 F  S BGPXX=$O(BGPDATA(BGPXX)) Q:BGPXX'=+BGPXX  D
  1.  .I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  .W !?4,BGPDATA(BGPXX)
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if the patient"
  1.  W !,"should be excluded if heart failure occurred on on arrival or within 24 "
  1.  W !,"hours after arrival."
  1.  Q
  1. W23RD ;EP write out 2/3 degree
  1.  I $Y>(BGPIOSL-5) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,"2nd/3rd Degree heart Block? "
  1.  I '$D(BGP23RD) W "  No, Not recorded"
  1.  I $D(BGP23RD),'BGPPACE W "  Yes. "
  1.  I $D(BGP23RD),BGPPACE W "  Yes, but pacemaker present  " ;D
  1.  ;.S X=0 F  S X=$O(BGP23RD(X)) Q:X'=+X  W !?4,BGP23RD(X)
  1.  I $D(BGP23RD) S X=0 F  S X=$O(BGP23RD(X)) Q:X'=+X  W !?4,BGP23RD(X)
  1.  I '$D(BGP23RD) Q
  1.  I $Y>(BGPIOSL-6) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if the patient"
  1.  W !,"should be excluded if the patient has a 2nd/3rd degree heart block "
  1.  W !,"on ECG during stay AND does not have a pacemaker (also see Pacemaker"
  1.  W !,"below)."
  1. PACE ;
  1.  W !!?2,"Pacemaker? ",$S($P(BGPPACE,U,2)]"":$P(BGPPACE,U,2),1:"No, Not recorded")
  1.  Q
  1.  ;
  1. WBRADY6 ;EP write out bradycardia data
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,$S(BGPPEX[9:"*",1:""),"Bradycardia? "
  1.  I '$D(BGPBRADY) W "  No, Not recorded" Q
  1.  S BGPXX=0 F  S BGPXX=$O(BGPBRADY(BGPXX)) Q:BGPXX'=+BGPXX  D
  1.  .I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  .W !?4,BGPBRADY(BGPXX)
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if the patient"
  1.  W !,"should be excluded if bradycardia occurred on arrival or within"
  1.  W !,"24 hours after arrival AND if patient was not on a beta blocker at"
  1.  W !,"the time of bradycardia (also see Beta Blocker Rx Status below)."
  1.  Q
  1. WBRADY5 ;EP write out bradycardia data
  1.  I $Y>(BGPIOSL-4) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !!?2,$S(BGPPEX[9:"*",1:""),"Bradycardia? "
  1.  I '$D(BGPBRADY) W "  No, Not recorded" Q
  1.  S BGPXX=0 F  S BGPXX=$O(BGPBRADY(BGPXX)) Q:BGPXX'=+BGPXX  D
  1.  .I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  .W !?4,BGPBRADY(BGPXX)
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !,"NOTE:  The patient's chart needs to be reviewed to determine if the"
  1.  W !,"patient should be excluded if bradycardia occurred on day of discharge"
  1.  W !,"or day prior to discharge AND if patient was not on a beta blocker at"
  1.  W !,"the time of bradycardia (also see Beta Blocker Rx Status below)."
  1.  Q
  1. WPRINPRO ;EP
  1.  K BGPXX
  1.  S BGPC=""
  1.  S BGPB=(9999999-$$DSCH^BGP2CU(BGPVINP))-1,BGPE=9999999-$P($P(^AUPNVSIT(BGPVSIT,0),U),".")
  1.  F  S BGPB=$O(^AUPNVPRC("AA",DFN,BGPB)) Q:BGPB'=+BGPB!(BGPB>BGPE)  D
  1.  .S X=0 F  S X=$O(^AUPNVPRC("AA",DFN,BGPB,X)) Q:X'=+X  D
  1.  ..Q:'$D(^AUPNVPRC(X,0))
  1.  ..Q:$P(^AUPNVPRC(X,0),U,7)'="Y"
  1.  ..S BGPC=$$VAL^XBDIQ1(9000010.08,X,.01)_"  "_$$VAL^XBDIQ1(9000010.08,X,.04)
  1.  I $Y>(BGPIOSL-3) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !?2,"Principle Procedure:  ",BGPC
  1.  Q
  1. WOTHPROS ;EP
  1.  K BGPXX
  1.  S BGPC=0
  1.  S BGPB=(9999999-$$DSCH^BGP2CU(BGPVINP))-1,BGPE=9999999-$P($P(^AUPNVSIT(BGPVSIT,0),U),".")
  1.  F  S BGPB=$O(^AUPNVPRC("AA",DFN,BGPB)) Q:BGPB'=+BGPB!(BGPB>BGPE)  D
  1.  .S X=0 F  S X=$O(^AUPNVPRC("AA",DFN,BGPB,X)) Q:X'=+X  D
  1.  ..Q:'$D(^AUPNVPRC(X,0))
  1.  ..S V=$P(^AUPNVPRC(X,0),U,3)
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:"IH"'[$P(^AUPNVSIT(V,0),U,7)
  1.  ..Q:$P(^AUPNVPRC(X,0),U,7)="Y"
  1.  ..S BGPC=BGPC+1,BGPXX(BGPC)=$$VAL^XBDIQ1(9000010.08,X,.01)_"  "_$$VAL^XBDIQ1(9000010.08,X,.04)
  1.  ;go through visits in a date range for this patient, check cpts
  1.  NEW D,BD,ED,Y,D,V
  1.  S BGPB=9999999-$$DSCH^BGP2CU(BGPVINP),BGPE=9999999-$P($P(^AUPNVSIT(BGPVSIT,0),U),".")
  1.  F  S BGPB=$O(^AUPNVSIT("AA",DFN,BGPB)) Q:BGPB=""!($P(BGPB,".")>BGPE)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",DFN,BGPB,V)) Q:V'=+V  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:'$D(^AUPNVCPT("AD",V))
  1.  ..Q:"IH"'[$P(^AUPNVSIT(V,0),U,7)
  1.  ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X  D
  1.  ...S BGPC=BGPC+1,BGPXX(BGPC)=$$VAL^XBDIQ1(9000010.18,X,.01)_"  "_$P($$CPT^ICPTCOD($P(^AUPNVCPT(X,0),U),(9999999-BGPB)),U,3)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  S (C,X)=0 F  S X=$O(BGPXX(X)) Q:X'=+X  S C=C+1
  1.  I $Y>(BGPIOSL-(C+3)) D HDR^BGP2CP Q:BGPQUIT  D L1H^BGP2CP
  1.  W !?2,"Other Procedures for this Visit:"
  1.  S BGPX=0 F  S BGPX=$O(BGPXX(BGPX)) Q:BGPX'=+BGPX  W !?4,BGPXX(BGPX)
  1.  Q
  1.  ;