BGP8CP11.m

BGP8CP11 ; IHS/CMI/LAB - IHS gpra print ;

 ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008

 ;

 ;

 ;

AMI3W ;EP

 I $Y>(BGPIOSL-3) D HDR^BGP8CP Q:BGPQUIT  D L1H^BGP8CP

 D WDOD^BGP8CPU(DFN)

 D WDT^BGP8CPU(BGPVINP)

 Q:BGPQUIT

 I $$TRANS^BGP8CU(BGPVINP) D WTT^BGP8CPU(BGPVINP)

 Q:BGPQUIT

 I $$TRANS^BGP8CU(BGPVINP) D TRANSN^BGP8CP2 Q:BGPQUIT

 D WPPDPOV^BGP8CPU(BGPVSIT)

 Q:BGPQUIT

 D OTHDPOVS^BGP8CPU(BGPVSIT)

 Q:BGPQUIT

 K BGPDATA

 S BGPC=0

 D LVSD^BGP8CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)

 D EJECFRAC^BGP8CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,BGPC)

 D WLVSD^BGP8CPU

 Q:BGPQUIT

 K BGPDATA

 S X=$$COMFORT^BGP8CU(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."))

 D WCOMFORT^BGP8CPU(X)

 K BGPDATA

 K BGPY

 Q:BGPQUIT

 S X=$$ACEALLEG^BGP8CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP))

 S Z=$$ARBALLEG^BGP8CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP))

 D WACEALEG^BGP8CPU

 K BGPDATA

 S BGPC=0

 D ALLDXS^BGP8CU2(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS AORTIC STENOSIS DXS")

 D WAORTIC^BGP8CPU

 Q:BGPQUIT

 K BGPDATA,BGPDX

 S BGPXX=0

 D ANGIOED^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CPU

 K BGPDATA

 K BGPY

 Q:BGPQUIT

 K BGPDATA

 S BGPC=0

 D NMIDRUG^BGP8CU1(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ACEI MEDS",0)

 D NMIDRUG^BGP8CU1(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$P($P(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ARB MEDS",BGPC)

 D WNMIACE^BGP8CPU(.BGPDATA)

 Q:BGPQUIT

 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")

 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")

 D WLASTACE^BGP8CPU

 Q:BGPQUIT

 Q:BGPQUIT

 D ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)

 D WALLALG^BGP8CPU

 Q:BGPQUIT

 K BGPDATA

 D ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)

 D WALLALGT^BGP8CPU

 K BGPDATA

 D IVUD^BGP8CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)

 D WIVUD^BGP8CPU

 Q

 ;

BGP8CP11  ; IHS/CMI/LAB - IHS gpra print ;

 +1       ;;8.0;IHS CLINICAL REPORTING;**2**;MAR 12, 2008

 +2       ;

 +3       ;

 +4       ;

AMI3W     ;EP

 +1        IF $Y>(BGPIOSL-3)

               DO HDR^BGP8CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP8CP

 +2        DO WDOD^BGP8CPU(DFN)

 +3        DO WDT^BGP8CPU(BGPVINP)

 +4        IF BGPQUIT

               QUIT 

 +5        IF $$TRANS^BGP8CU(BGPVINP)

               DO WTT^BGP8CPU(BGPVINP)

 +6        IF BGPQUIT

               QUIT 

 +7        IF $$TRANS^BGP8CU(BGPVINP)

               DO TRANSN^BGP8CP2

               IF BGPQUIT

                   QUIT 

 +8        DO WPPDPOV^BGP8CPU(BGPVSIT)

 +9        IF BGPQUIT

               QUIT 

 +10       DO OTHDPOVS^BGP8CPU(BGPVSIT)

 +11       IF BGPQUIT

               QUIT 

 +12       KILL BGPDATA

 +13       SET BGPC=0

 +14       DO LVSD^BGP8CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,0)

 +15       DO EJECFRAC^BGP8CU1(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,BGPC)

 +16       DO WLVSD^BGP8CPU

 +17       IF BGPQUIT

               QUIT 

 +18       KILL BGPDATA

 +19       SET X=$$COMFORT^BGP8CU(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."))

 +20       DO WCOMFORT^BGP8CPU(X)

 +21       KILL BGPDATA

 +22       KILL BGPY

 +23       IF BGPQUIT

               QUIT 

 +24       SET X=$$ACEALLEG^BGP8CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP))

 +25       SET Z=$$ARBALLEG^BGP8CU1(DFN,$$DOB^AUPNPAT(DFN),$$DSCH^BGP8CU(BGPVINP))

 +26       DO WACEALEG^BGP8CPU

 +27       KILL BGPDATA

 +28       SET BGPC=0

 +29       DO ALLDXS^BGP8CU2(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(BGPVINP),.BGPDATA,BGPC,"BGP CMS AORTIC STENOSIS DXS")

 +30       DO WAORTIC^BGP8CPU

 +31       IF BGPQUIT

               QUIT 

 +32       KILL BGPDATA,BGPDX

 +33       SET BGPXX=0

 +34       DO ANGIOED^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CU6(DFN,$$FMADD^XLFDT($$DSCH^BGP8CU(BGPVINP),-365),$$DSCH^BGP8CU(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^BGP8CPU

 +45       KILL BGPDATA

 +46       KILL BGPY

 +47       IF BGPQUIT

               QUIT 

 +48       KILL BGPDATA

 +49       SET BGPC=0

 +50       DO NMIDRUG^BGP8CU1(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ACEI MEDS",0)

 +51       DO NMIDRUG^BGP8CU1(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$PIECE($PIECE(^AUPNVINP(BGPVINP,0),U),"."),.BGPDATA,"BGP CMS ARB MEDS",BGPC)

 +52       DO WNMIACE^BGP8CPU(.BGPDATA)

 +53       IF BGPQUIT

               QUIT 

 +54       SET X=$$LASTMED^BGP8CU1(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^BGP8CU1(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^BGP8CPU

 +57       IF BGPQUIT

               QUIT 

 +58       IF BGPQUIT

               QUIT 

 +59       DO ALLALG1^BGP8CU1(DFN,DT,$$DSCH^BGP8CU(BGPVINP),.BGPDATA)

 +60       DO WALLALG^BGP8CPU

 +61       IF BGPQUIT

               QUIT 

 +62       KILL BGPDATA

 +63       DO ALLALGA1^BGP8CU1(DFN,DT,.BGPDATA)

 +64       DO WALLALGT^BGP8CPU

 +65       KILL BGPDATA

 +66       DO IVUD^BGP8CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP8CU(BGPVINP),,.BGPDATA)

 +67       DO WIVUD^BGP8CPU

 +68       QUIT 

 +69      ;