- BGP1CP11 ; IHS/CMI/LAB - IHS gpra print ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- ;
- ;
- AMI3W ;EP
- I $Y>(BGPIOSL-3) D HDR^BGP1CP Q:BGPQUIT D L1H^BGP1CP
- D WDOD^BGP1CPU(DFN)
- D WDT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D WTT^BGP1CPU(BGPVINP)
- Q:BGPQUIT
- I $$TRANS^BGP1CU(BGPVINP) D TRANSN^BGP1CP2 Q:BGPQUIT
- D WPPDPOV^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- D OTHDPOVS^BGP1CPU(BGPVSIT)
- Q:BGPQUIT
- K BGPDATA
- S BGPC=0
- D LVSD^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- D EJECFRAC^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC)
- D WLVSD^BGP1CPU
- Q:BGPQUIT
- K BGPDATA
- S X=$$COMFORT^BGP1CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))
- D WCOMFORT^BGP1CPU(X)
- K BGPDATA
- K BGPY
- Q:BGPQUIT
- S X=$$ACEALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- S Z=$$ARBALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- D WACEALEG^BGP1CPU
- K BGPDATA
- S BGPC=0
- D ALLDXS^BGP1CU2(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS AORTIC STENOSIS DXS")
- D WAORTIC^BGP1CPU
- Q:BGPQUIT
- K BGPDATA,BGPDX
- S BGPXX=0
- D ANGIOED^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
- K BGPDATA D HYPERKAL^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
- K BGPDATA D HYPOTEN^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
- K BGPDATA D RENART^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
- K BGPDATA D RENAL^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- S X=0 F S X=$O(BGPDATA(X)) Q:X'=+X S BGPXX=BGPXX+1,BGPDX(BGPXX)=BGPDATA(X)
- D WDXS^BGP1CPU
- K BGPDATA
- K BGPY
- Q:BGPQUIT
- K BGPDATA
- S BGPC=0
- D NMIDRUG^BGP1CU1(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ACEI MEDS",0)
- D NMIDRUG^BGP1CU1(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ARB MEDS",BGPC)
- D WNMIACE^BGP1CPU(.BGPDATA)
- Q:BGPQUIT
- S X=$$LASTMED^BGP1CU1(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")
- S Z=$$LASTMED^BGP1CU1(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")
- D WLASTACE^BGP1CPU
- Q:BGPQUIT
- Q:BGPQUIT
- D ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- D WALLALG^BGP1CPU
- Q:BGPQUIT
- K BGPDATA
- D ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- D WALLALGT^BGP1CPU
- K BGPDATA
- D IVUD^BGP1CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- D WIVUD^BGP1CPU
- Q
- ;
- BGP1CP11 ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- +2 ;
- +3 ;
- +4 ;
- AMI3W ;EP
- +1 IF $Y>(BGPIOSL-3)
- DO HDR^BGP1CP
- IF BGPQUIT
- QUIT
- DO L1H^BGP1CP
- +2 DO WDOD^BGP1CPU(DFN)
- +3 DO WDT^BGP1CPU(BGPVINP)
- +4 IF BGPQUIT
- QUIT
- +5 IF $$TRANS^BGP1CU(BGPVINP)
- DO WTT^BGP1CPU(BGPVINP)
- +6 IF BGPQUIT
- QUIT
- +7 IF $$TRANS^BGP1CU(BGPVINP)
- DO TRANSN^BGP1CP2
- IF BGPQUIT
- QUIT
- +8 DO WPPDPOV^BGP1CPU(BGPVSIT)
- +9 IF BGPQUIT
- QUIT
- +10 DO OTHDPOVS^BGP1CPU(BGPVSIT)
- +11 IF BGPQUIT
- QUIT
- +12 KILL BGPDATA
- +13 SET BGPC=0
- +14 DO LVSD^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- +15 DO EJECFRAC^BGP1CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC)
- +16 DO WLVSD^BGP1CPU
- +17 IF BGPQUIT
- QUIT
- +18 KILL BGPDATA
- +19 SET X=$$COMFORT^BGP1CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))
- +20 DO WCOMFORT^BGP1CPU(X)
- +21 KILL BGPDATA
- +22 KILL BGPY
- +23 IF BGPQUIT
- QUIT
- +24 SET X=$$ACEALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +25 SET Z=$$ARBALLEG^BGP1CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP1CU(BGPVINP))
- +26 DO WACEALEG^BGP1CPU
- +27 KILL BGPDATA
- +28 SET BGPC=0
- +29 DO ALLDXS^BGP1CU2(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS AORTIC STENOSIS DXS")
- +30 DO WAORTIC^BGP1CPU
- +31 IF BGPQUIT
- QUIT
- +32 KILL BGPDATA,BGPDX
- +33 SET BGPXX=0
- +34 DO ANGIOED^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- +35 SET X=0
- FOR
- SET X=$ORDER(BGPDATA(X))
- IF X'=+X
- QUIT
- SET BGPXX=BGPXX+1
- SET BGPDX(BGPXX)=BGPDATA(X)
- +36 KILL BGPDATA
- DO HYPERKAL^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- +37 SET X=0
- FOR
- SET X=$ORDER(BGPDATA(X))
- IF X'=+X
- QUIT
- SET BGPXX=BGPXX+1
- SET BGPDX(BGPXX)=BGPDATA(X)
- +38 KILL BGPDATA
- DO HYPOTEN^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- +39 SET X=0
- FOR
- SET X=$ORDER(BGPDATA(X))
- IF X'=+X
- QUIT
- SET BGPXX=BGPXX+1
- SET BGPDX(BGPXX)=BGPDATA(X)
- +40 KILL BGPDATA
- DO RENART^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- +41 SET X=0
- FOR
- SET X=$ORDER(BGPDATA(X))
- IF X'=+X
- QUIT
- SET BGPXX=BGPXX+1
- SET BGPDX(BGPXX)=BGPDATA(X)
- +42 KILL BGPDATA
- DO RENAL^BGP1CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP1CU(BGPVINP),-365),$$DSCH^BGP1CU(BGPVINP),.BGPDATA,0)
- +43 SET X=0
- FOR
- SET X=$ORDER(BGPDATA(X))
- IF X'=+X
- QUIT
- SET BGPXX=BGPXX+1
- SET BGPDX(BGPXX)=BGPDATA(X)
- +44 DO WDXS^BGP1CPU
- +45 KILL BGPDATA
- +46 KILL BGPY
- +47 IF BGPQUIT
- QUIT
- +48 KILL BGPDATA
- +49 SET BGPC=0
- +50 DO NMIDRUG^BGP1CU1(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ACEI MEDS",0)
- +51 DO NMIDRUG^BGP1CU1(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ARB MEDS",BGPC)
- +52 DO WNMIACE^BGP1CPU(.BGPDATA)
- +53 IF BGPQUIT
- QUIT
- +54 SET X=$$LASTMED^BGP1CU1(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS ACEI MEDS","","BGP CMS ACEI MEDS CLASS")
- +55 SET Z=$$LASTMED^BGP1CU1(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),30),"BGP CMS ARB MEDS","","BGP CMS ARB MEDS CLASS")
- +56 DO WLASTACE^BGP1CPU
- +57 IF BGPQUIT
- QUIT
- +58 IF BGPQUIT
- QUIT
- +59 DO ALLALG1^BGP1CU1(DFN,DT,$$DSCH^BGP1CU(BGPVINP),.BGPDATA)
- +60 DO WALLALG^BGP1CPU
- +61 IF BGPQUIT
- QUIT
- +62 KILL BGPDATA
- +63 DO ALLALGA1^BGP1CU1(DFN,DT,.BGPDATA)
- +64 DO WALLALGT^BGP1CPU
- +65 KILL BGPDATA
- +66 DO IVUD^BGP1CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP1CU(BGPVINP),,.BGPDATA)
- +67 DO WIVUD^BGP1CPU
- +68 QUIT
- +69 ;