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

BGP8CP4.m

Go to the documentation of this file. 
  1. BGP8CP4 ; IHS/CMI/LAB - IHS gpra print 01 Nov 2007 4:08 PM ; 
  1.  ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008
  1.  ;
  1.  ;
  1. HFALL ;EP
  1.  ;I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  ;S BGPNOBA=1
  1.  ;D WDT^BGP8CPU2(BGPVINP)
  1.  ;Q:BGPQUIT
  1.  ;I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU2(BGPVINP) Q:BGPQUIT
  1.  ;D WPPDPOV^BGP8CPU(BGPVSIT)
  1.  ;K BGPNOBA
  1.  I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  S BGPNOBA=1
  1.  D WRACE^BGP8CPU(DFN)
  1.  Q:BGPQUIT
  1.  D WDOB^BGP8CPU(DFN)
  1.  Q:BGPQUIT
  1.  D WZIP^BGP8CPU(DFN)
  1.  Q:BGPQUIT
  1.  D WINS^BGP8CPU(BGPVSIT,DFN)
  1.  Q:BGPQUIT
  1.  D WADM^BGP8CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WADM92^BGP8CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WADMS92^BGP8CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WDT^BGP8CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WDSGS92^BGP8CPU(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU(BGPVINP) Q:BGPQUIT
  1.  K BGPNOBA
  1.  D WPPDPOV^BGP8CPU(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S BGPNOBA=1
  1.  D OTHDPOVS^BGP8CPU(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D WPRINPRO^BGP8CPU2
  1.  Q:BGPQUIT
  1.  D WOTHPROS^BGP8CPU2
  1.  K BGPNOBA
  1.  Q
  1.  ;
  1. HF1 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  D WDT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP8CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP8CPU2(X)
  1.  Q:BGPQUIT
  1.  S BGPPED=$$DSCHINST^BGP8CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP8CU(BGPVINP))
  1.  D WDSCHINT^BGP8CPU2
  1.  Q:BGPQUIT
  1.  D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP8CPU
  1.  K BGPDATA
  1.  D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP8CPU
  1.  Q
  1.  ;
  1. HF1W ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  D WDT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  D WPPDPOV^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP8CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP8CPU2(X)
  1.  Q:BGPQUIT
  1.  S BGPLVAD=$$LVADEX^BGP8CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP8UTL($P(BGPLVAD,U,3))_"  ["_$P(BGPLVAD,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
  1.  D WLVAD^BGP8CPU2
  1.  Q:BGPQUIT
  1.  S BGPPED=$$DSCHINST^BGP8CU(DFN,$$DSCH^BGP8CU(BGPVINP),$$DSCH^BGP8CU(BGPVINP))
  1.  D WDSCHINT^BGP8CPU2
  1.  Q:BGPQUIT
  1.  D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP8CPU
  1.  K BGPDATA
  1.  D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP8CPU
  1.  Q
  1.  ;
  1. HF2 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  D WDT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP8CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP8CPU2(X)
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  I 'BGPEXCL D
  1.  .S BGPLVAD=$$LVADEX^BGP8CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP8UTL($P(BGPLVAD,U,3))_"  ["_$P(BGPLVAD,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
  1.  .D WLVAD^BGP8CPU2
  1.  Q:BGPQUIT
  1.  D LVS^BGP8CU3(DFN,$$DSCH^BGP8CU(BGPVINP),.BGPDATA,$P($P(BGPVSIT0,U),"."))
  1.  D WLVS^BGP8CPU2
  1.  Q:BGPQUIT
  1.  D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP8CPU
  1.  K BGPDATA
  1.  D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP8CPU
  1.  Q
  1.  ;
  1. HF3 ;EP
  1.  I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  D WDT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  S BGPC=0
  1.  D LVSD^BGP8CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)
  1.  D EJECFRAC^BGP8CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,BGPC)
  1.  D WLVSD^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  S X=$$COMFORT^BGP8CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP8CPU2(X)
  1.  Q:BGPQUIT
  1.  K BGPY,BGPDATA
  1.  Q:BGPQUIT
  1.  S BGPC=0
  1.  D ALLDXS^BGP8CU2(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS AORTIC STENOSIS DXS")
  1.  I 'BGPEXCL D WAORTIC^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA,BGPDX,BGPC
  1.  S BGPXX=0
  1.  D ANGIOED^BGP8CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)
  1.  S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
  1.  K BGPDATA D HYPERKAL^BGP8CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)
  1.  S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
  1.  K BGPDATA D HYPOTEN^BGP8CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)
  1.  S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
  1.  K BGPDATA D RENART^BGP8CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)
  1.  S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
  1.  K BGPDATA D RENAL^BGP8CU6(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)
  1.  S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
  1.  D WDXS^BGP8CPU
  1.  K BGPDATA,BGPY
  1.  Q:BGPQUIT
  1.  S X=$$ACEALLEG^BGP8CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP))
  1.  S Z=$$ARBALLEG^BGP8CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP))
  1.  D WACEALEG^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA,BGPDX
  1.  S BGPC=0
  1.  D NMIDRUG^BGP8CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,"BGP CMS ACEI MEDS",0)
  1.  D NMIDRUG^BGP8CU1(DFN,$$VD^APCLV(BGPVSIT),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,"BGP CMS ARB MEDS",BGPC)
  1.  S E=+$$CODEN^ICPTCOD("G8029")
  1.  S BGPACPT=$$CPTI^BGP8DU(DFN,$$DSCH^BGP8CU(BGPVINP),$$DSCH^BGP8CU(BGPVINP),E) I Z]"" S Z=$$DATE^BGP8UTL($P(Z,U,2))_" [G8029]"
  1.  D WNMIACE^BGP8CPU2
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S BGPLVAD=$$LVADEX^BGP8CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP8UTL($P(BGPLVAD,U,3))_"  ["_$P(BGPLVAD,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
  1.  .D WLVAD^BGP8CPU2
  1.  Q:BGPQUIT
  1.  S X=$$LASTMED^BGP8CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS ACEI MEDS","","BGP CMS ACEI MEDS CLASS")
  1.  S Z=$$LASTMED^BGP8CU1(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($P($P(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS ARB MEDS","","BGP CMS ARB MEDS CLASS")
  1.  D WLASTACE^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP8CPU
  1.  K BGPDATA
  1.  D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP8CPU
  1.  Q
  1.  ;
  1. HF4 ;
  1.  I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  D WDT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU2(BGPVINP)
  1.  Q:BGPQUIT
  1.  I $$TRANS^BGP8CU(BGPVINP) D TRANSN Q:BGPQUIT
  1.  D WPPDPOV^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  D OTHDPOVS^BGP8CPU2(BGPVSIT)
  1.  Q:BGPQUIT
  1.  S X=$$COMFORT^BGP8CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
  1.  D WCOMFORT^BGP8CPU2(X)
  1.  Q:BGPQUIT
  1.  I 'BGPEXCL D
  1.  .S BGPLVAD=$$LVADEX^BGP8CU(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP)) I BGPLVAD S BGPLVAD=$$DATE^BGP8UTL($P(BGPLVAD,U,3))_"  ["_$P(BGPLVAD,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$P(BGPLVAD,U,5),.04)
  1.  .D WLVAD^BGP8CPU2
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  S BGPC=0
  1.  D SMOKER^BGP8CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
  1.  D WSMOKER^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D CESS^BGP8CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
  1.  D WCESS^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D CESSMEDS^BGP8CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),30),.BGPDATA)
  1.  D WCESSMED^BGP8CPU
  1.  K BGPDATA
  1.  Q:BGPQUIT
  1.  D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)
  1.  D WALLALG^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)
  1.  D WALLALGT^BGP8CPU
  1.  Q:BGPQUIT
  1.  K BGPDATA
  1.  D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)
  1.  D WIVUD^BGP8CPU
  1.  Q
  1.  ;
  1. TRANSIN ;
  1.  I $Y>(BGPIOSL-4) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  W !!?3,"NOTE:  Since Admission Type was ","""","Transferred,",""""," review patient's chart"
  1.  W !,"to determine if patient should be excluded if transfer was from another"
  1.  W !,"acute care hospital, including ER from another hospital.",!
  1.  Q
  1.  ;
  1. TRANSN ;
  1.  I $Y>(BGPIOSL-4) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP
  1.  W !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"
  1.  W !,"to determine if patient should be excluded if transferred to another"
  1.  W !,"acute care hospital or federal hospital.",!
  1.  Q
  1.  ;