BGP0CP3.m

BGP0CP3 ; IHS/CMI/LAB - IHS gpra print 02 Jul 2009 9:07 AM ;

 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 ;

 ;

 ;

AMI4 ;EP

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

 D WDT^BGP0CPU(BGPVINP)

 Q:BGPQUIT

 I $$TRANS^BGP0CU(BGPVINP) D WTT^BGP0CPU(BGPVINP)

 Q:BGPQUIT

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

 D WPPDPOV^BGP0CPU(BGPVSIT)

 Q:BGPQUIT

 D OTHDPOVS^BGP0CPU(BGPVSIT)

 Q:BGPQUIT

 K BGPDATA

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

 D WCOMFORT^BGP0CPU(X)

 Q:BGPQUIT

 K BGPDATA

 S BGPC=0

 D SMOKER^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WSMOKER^BGP0CPU

 Q:BGPQUIT

 K BGPDATA

 D CESS^BGP0CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WCESS^BGP0CPU

 Q:BGPQUIT

 K BGPDATA

 D CESSMEDS^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),.BGPDATA)

 D WCESSMED^BGP0CPU

 K BGPDATA

 Q:BGPQUIT

 D ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WALLALG^BGP0CPU

 Q:BGPQUIT

 K BGPDATA

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

 D WALLALGT^BGP0CPU

 K BGPDATA

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

 D WIVUD^BGP0CPU

 Q

 ;

AMI4W ;EP

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

 D WDOD^BGP0CPU(DFN)

 D WDT^BGP0CPU(BGPVINP)

 Q:BGPQUIT

 I $$TRANS^BGP0CU(BGPVINP) D WTT^BGP0CPU(BGPVINP)

 Q:BGPQUIT

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

 D WPPDPOV^BGP0CPU(BGPVSIT)

 Q:BGPQUIT

 D OTHDPOVS^BGP0CPU(BGPVSIT)

 Q:BGPQUIT

 K BGPDATA

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

 D WCOMFORT^BGP0CPU(X)

 Q:BGPQUIT

 K BGPDATA

 S BGPC=0

 D SMOKER^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WSMOKER^BGP0CPU

 Q:BGPQUIT

 K BGPDATA

 D CESS^BGP0CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WCESS^BGP0CPU

 Q:BGPQUIT

 K BGPDATA

 D CESSMEDS^BGP0CU2(DFN,$P($P(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WCESSMED^BGP0CPU

 K BGPDATA

 Q:BGPQUIT

 D ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WALLALG^BGP0CPU

 Q:BGPQUIT

 K BGPDATA

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

 D WALLALGT^BGP0CPU

 K BGPDATA

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

 D WIVUD^BGP0CPU

 Q

 ;

AMI8AW ;EP

 S BGPASTER=0

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

 I $$TRANSIN^BGP0CU(BGPVINP) D TRANSIN Q:BGPQUIT

 D WDT^BGP0CPU(BGPVINP)

 Q:BGPQUIT

 I $$TRANS^BGP0CU(BGPVINP) D WTT^BGP0CPU(BGPVINP)

 Q:BGPQUIT

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

 D WPPDPOV^BGP0CPU(BGPVSIT)

 Q:BGPQUIT

 D OTHDPOVS^BGP0CPU(BGPVSIT)

 Q:BGPQUIT

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

 D WCOMFORT^BGP0CPU(X)

 Q:BGPQUIT

 ;FIB MEDS

 S BGPFIB=""

 K BGPDATA

 D TARX^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),0,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 K BGPUD

 D IVUD^BGP0CU1(DFN,$P($P(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),$O(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$O(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))

 S BGPTAPRO=$$LASTPRCI^BGP0UTL1(DFN,"99.10",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP)) I BGPTAPRO S BGPTAPRO=$$DATE^BGP0UTL($P(BGPTAPRO,U,3))_"  ["_$P(BGPTAPRO,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$P(BGPTAPRO,U,5),.04)

 D WFIB^BGP0CPU2

 Q:BGPQUIT

 K BGPST1

 S BGPST1=$$LASTDX^BGP0UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP))

 I BGPST1 S BGPST1=$$DATE^BGP0UTL($P(BGPST1,U,3))_"  ["_$P(BGPST1,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$P(BGPST1,U,5),.04)

 D WST^BGP0CPU2

 ;LBBB ON ECG

 K BGPLBPC,BGPLBDX

 S BGPLBDX=$$LBBBDX^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP)) I BGPLBDX S BGPLBDX=$$DATE^BGP0UTL($P(BGPLBDX,U,3))_"  ["_$P(BGPLBDX,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$P(BGPLBDX,U,5),.04)

 D LBBBPROC^BGP0CU2(DFN,$$FMADD^XLFDT($P($P(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP),.BGPLBPC)

 D WLBBB^BGP0CPU2

 Q:BGPQUIT

 S BGPPCI=$$LASTPRCI^BGP0UTL1(DFN,"00.66",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP)) I BGPPCI S BGPPCI=$$DATE^BGP0UTL($P(BGPPCI,U,3))_"  ["_$P(BGPPCI,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$P(BGPPCI,U,5),.04)

 D WPCI^BGP0CPU2

 Q:BGPQUIT

 D ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 D WALLALG^BGP0CPU

 Q:BGPQUIT

 K BGPDATA

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

 D WALLALGT^BGP0CPU

 K BGPDATA

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

 D WIVUD^BGP0CPU

 Q

 ;

TRANSIN ;EP

 I $Y>(BGPIOSL-4) D HDR^BGP0CP Q:BGPQUIT  D L1H^BGP0CP

 W !!?3,"NOTE:  Since Admission Type was ","""","Transferred,",""""," review patient's chart"

 W !,"to determine if patient should be excluded if transfer was from another"

 W !,"acute care hospital, including ER from another hospital."

 Q

 ;

TRANSN ;

 I $Y>(BGPIOSL-4) D HDR^BGP0CP Q:BGPQUIT  D L1H^BGP0CP

 W !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"

 W !,"to determine if patient should be excluded if transferred to another"

 W !,"acute care hospital or federal hospital."

 Q

 ;

BGP0CP3   ; IHS/CMI/LAB - IHS gpra print 02 Jul 2009 9:07 AM ;

 +1       ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 +2       ;

 +3       ;

 +4       ;

AMI4      ;EP

 +1        IF $Y>(BGPIOSL-3)

               DO HDR^BGP0CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP0CP

 +2        DO WDT^BGP0CPU(BGPVINP)

 +3        IF BGPQUIT

               QUIT 

 +4        IF $$TRANS^BGP0CU(BGPVINP)

               DO WTT^BGP0CPU(BGPVINP)

 +5        IF BGPQUIT

               QUIT 

 +6        IF $$TRANS^BGP0CU(BGPVINP)

               DO TRANSN

               IF BGPQUIT

                   QUIT 

 +7        DO WPPDPOV^BGP0CPU(BGPVSIT)

 +8        IF BGPQUIT

               QUIT 

 +9        DO OTHDPOVS^BGP0CPU(BGPVSIT)

 +10       IF BGPQUIT

               QUIT 

 +11       KILL BGPDATA

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

 +13       DO WCOMFORT^BGP0CPU(X)

 +14       IF BGPQUIT

               QUIT 

 +15       KILL BGPDATA

 +16       SET BGPC=0

 +17       DO SMOKER^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +18       DO WSMOKER^BGP0CPU

 +19       IF BGPQUIT

               QUIT 

 +20       KILL BGPDATA

 +21       DO CESS^BGP0CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +22       DO WCESS^BGP0CPU

 +23       IF BGPQUIT

               QUIT 

 +24       KILL BGPDATA

 +25       DO CESSMEDS^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),.BGPDATA)

 +26       DO WCESSMED^BGP0CPU

 +27       KILL BGPDATA

 +28       IF BGPQUIT

               QUIT 

 +29       DO ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +30       DO WALLALG^BGP0CPU

 +31       IF BGPQUIT

               QUIT 

 +32       KILL BGPDATA

 +33       DO ALLALGA1^BGP0CU1(DFN,DT,.BGPDATA)

 +34       DO WALLALGT^BGP0CPU

 +35       KILL BGPDATA

 +36       DO IVUD^BGP0CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),,.BGPDATA)

 +37       DO WIVUD^BGP0CPU

 +38       QUIT 

 +39      ;

AMI4W     ;EP

 +1        IF $Y>(BGPIOSL-3)

               DO HDR^BGP0CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP0CP

 +2        DO WDOD^BGP0CPU(DFN)

 +3        DO WDT^BGP0CPU(BGPVINP)

 +4        IF BGPQUIT

               QUIT 

 +5        IF $$TRANS^BGP0CU(BGPVINP)

               DO WTT^BGP0CPU(BGPVINP)

 +6        IF BGPQUIT

               QUIT 

 +7        IF $$TRANS^BGP0CU(BGPVINP)

               DO TRANSN

               IF BGPQUIT

                   QUIT 

 +8        DO WPPDPOV^BGP0CPU(BGPVSIT)

 +9        IF BGPQUIT

               QUIT 

 +10       DO OTHDPOVS^BGP0CPU(BGPVSIT)

 +11       IF BGPQUIT

               QUIT 

 +12       KILL BGPDATA

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

 +14       DO WCOMFORT^BGP0CPU(X)

 +15       IF BGPQUIT

               QUIT 

 +16       KILL BGPDATA

 +17       SET BGPC=0

 +18       DO SMOKER^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +19       DO WSMOKER^BGP0CPU

 +20       IF BGPQUIT

               QUIT 

 +21       KILL BGPDATA

 +22       DO CESS^BGP0CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +23       DO WCESS^BGP0CPU

 +24       IF BGPQUIT

               QUIT 

 +25       KILL BGPDATA

 +26       DO CESSMEDS^BGP0CU2(DFN,$PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +27       DO WCESSMED^BGP0CPU

 +28       KILL BGPDATA

 +29       IF BGPQUIT

               QUIT 

 +30       DO ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +31       DO WALLALG^BGP0CPU

 +32       IF BGPQUIT

               QUIT 

 +33       KILL BGPDATA

 +34       DO ALLALGA1^BGP0CU1(DFN,DT,.BGPDATA)

 +35       DO WALLALGT^BGP0CPU

 +36       KILL BGPDATA

 +37       DO IVUD^BGP0CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),,.BGPDATA)

 +38       DO WIVUD^BGP0CPU

 +39       QUIT 

 +40      ;

AMI8AW    ;EP

 +1        SET BGPASTER=0

 +2        IF $Y>(BGPIOSL-3)

               DO HDR^BGP0CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP0CP

 +3        IF $$TRANSIN^BGP0CU(BGPVINP)

               DO TRANSIN

               IF BGPQUIT

                   QUIT 

 +4        DO WDT^BGP0CPU(BGPVINP)

 +5        IF BGPQUIT

               QUIT 

 +6        IF $$TRANS^BGP0CU(BGPVINP)

               DO WTT^BGP0CPU(BGPVINP)

 +7        IF BGPQUIT

               QUIT 

 +8        IF $$TRANS^BGP0CU(BGPVINP)

               DO TRANSN

               IF BGPQUIT

                   QUIT 

 +9        DO WPPDPOV^BGP0CPU(BGPVSIT)

 +10       IF BGPQUIT

               QUIT 

 +11       DO OTHDPOVS^BGP0CPU(BGPVSIT)

 +12       IF BGPQUIT

               QUIT 

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

 +14       DO WCOMFORT^BGP0CPU(X)

 +15       IF BGPQUIT

               QUIT 

 +16      ;FIB MEDS

 +17       SET BGPFIB=""

 +18       KILL BGPDATA

 +19       DO TARX^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(^AUPNVSIT(BGPVSIT,0),U),"."),-365),$$FMADD^XLFDT($$DSCH^BGP0CU(BGPVINP),30),0,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +20       KILL BGPUD

 +21       DO IVUD^BGP0CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),$ORDER(^ATXAX("B","BGP CMS THROMBOLYTIC MEDS",0)),.BGPUD,"",$ORDER(^ATXAX("B","BGP THROMBOLYTIC AGENTS CLASS",0)))

 +22       SET BGPTAPRO=$$LASTPRCI^BGP0UTL1(DFN,"99.10",$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP))

           IF BGPTAPRO

               SET BGPTAPRO=$$DATE^BGP0UTL($PIECE(BGPTAPRO,U,3))_"  ["_$PIECE(BGPTAPRO,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPTAPRO,U,5),.04)

 +23       DO WFIB^BGP0CPU2

 +24       IF BGPQUIT

               QUIT 

 +25       KILL BGPST1

 +26       SET BGPST1=$$LASTDX^BGP0UTL1(DFN,"BGP ST ELEVATION DX",$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP))

 +27       IF BGPST1

               SET BGPST1=$$DATE^BGP0UTL($PIECE(BGPST1,U,3))_"  ["_$PIECE(BGPST1,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPST1,U,5),.04)

 +28       DO WST^BGP0CPU2

 +29      ;LBBB ON ECG

 +30       KILL BGPLBPC,BGPLBDX

 +31       SET BGPLBDX=$$LBBBDX^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP))

           IF BGPLBDX

               SET BGPLBDX=$$DATE^BGP0UTL($PIECE(BGPLBDX,U,3))_"  ["_$PIECE(BGPLBDX,U,2)_"]  "_$$VAL^XBDIQ1(9000010.07,$PIECE(BGPLBDX,U,5),.04)

 +32       DO LBBBPROC^BGP0CU2(DFN,$$FMADD^XLFDT($PIECE($PIECE(BGPVSIT0,U),"."),-1),$$DSCH^BGP0CU(BGPVINP),.BGPLBPC)

 +33       DO WLBBB^BGP0CPU2

 +34       IF BGPQUIT

               QUIT 

 +35       SET BGPPCI=$$LASTPRCI^BGP0UTL1(DFN,"00.66",$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP))

           IF BGPPCI

               SET BGPPCI=$$DATE^BGP0UTL($PIECE(BGPPCI,U,3))_"  ["_$PIECE(BGPPCI,U,2)_"]  "_$$VAL^XBDIQ1(9000010.08,$PIECE(BGPPCI,U,5),.04)

 +36       DO WPCI^BGP0CPU2

 +37       IF BGPQUIT

               QUIT 

 +38       DO ALLALG1^BGP0CU1(DFN,DT,$$DSCH^BGP0CU(BGPVINP),.BGPDATA)

 +39       DO WALLALG^BGP0CPU

 +40       IF BGPQUIT

               QUIT 

 +41       KILL BGPDATA

 +42       DO ALLALGA1^BGP0CU1(DFN,DT,.BGPDATA)

 +43       DO WALLALGT^BGP0CPU

 +44       KILL BGPDATA

 +45       DO IVUD^BGP0CU1(DFN,$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP0CU(BGPVINP),,.BGPDATA)

 +46       DO WIVUD^BGP0CPU

 +47       QUIT 

 +48      ;

TRANSIN   ;EP

 +1        IF $Y>(BGPIOSL-4)

               DO HDR^BGP0CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP0CP

 +2        WRITE !!?3,"NOTE:  Since Admission Type was ","""","Transferred,",""""," review patient's chart"

 +3        WRITE !,"to determine if patient should be excluded if transfer was from another"

 +4        WRITE !,"acute care hospital, including ER from another hospital."

 +5        QUIT 

 +6       ;

TRANSN    ;

 +1        IF $Y>(BGPIOSL-4)

               DO HDR^BGP0CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP0CP

 +2        WRITE !!?3,"NOTE:  Since Discharge Type was ","""","Transferred,",""""," review patient's chart"

 +3        WRITE !,"to determine if patient should be excluded if transferred to another"

 +4        WRITE !,"acute care hospital or federal hospital."

 +5        QUIT 

 +6       ;