BGP9CPU3.m

BGP9CPU3 ; IHS/CMI/LAB - calc CMS measures ;

 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 ;

 ;

EXCL487 ;EP

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 S BGPXX=$$LASTDXI^BGP9UTL1(DFN,"487.0",$P($P(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP),"HI") I BGPXX S BGPN=$$VAL^XBDIQ1(9000010.07,$P(BGPXX,U,5),.04)

 W !!?2,$S(BGPPEX["L":"*",1:""),"Influenza Dx: "_$S(BGPPEX["L":"Yes, 487.0 "_BGPN,1:"No")

 Q

WFLU ;EP

 S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1

 I $Y>(BGPIOSL-(C+8)) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,"Influenza IZ Status?  "

 I '$D(BGPDATA) Q

 I $D(BGPDATA) S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)

 W !,"NOTE:  If Influenza vaccine received prior to admission, in order to be "

 W !,"included in the CMS measure, it must be determined if the patient received"

 W "it during the CURRENT flu season.  The CMS Data Abstraction Guidelines"

 W !,"define current flu season as beginning when this season's flu vaccine "

 W !,"is made available to the public, e.g. if the vaccine is available in"

 W !,"September, then the flu season is September-February.  However, for this "

 W !,"measure, the hospitals are only responsible for discharges October-February."

 ;W !

 Q

 ;

WWOUND ;EP - write transferred to

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX["J":"*",1:""),"Home Wound Care?  ",$P(X,U,2)

 Q

 ;

WNURSHOM ;EP

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX["H":"*",1:""),"Nursing Home Visit?  ",$P(X,U,2)

 Q

 ;

WHOS2DAY ;EP

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX["G":"*",1:""),"Hospitalized for 2 days in past 3 months?  ",$P(X,U,2)

 Q

 ;

WPRIORHO ;EP

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX["F"!(BGPPEX["G"):"*",1:""),"Prior Hospitalization?  ",$S(X]""!(Y]""):"Yes",1:"No")

 W !?4,"Hospital Stay prior 14 days: ",$S(X]"":"Yes, ",1:"No "),$P(X,U,2)

 W !?4,"Hospitalized at least 2 days: ",$S(Y]"":"Yes",1:"No") I Y]"" W !?6,$P(Y,U,2)," ",$P(Y,U,3)

 Q

 ;

WEXCL1 ;EP

 S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1

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

 S BGPAST=""

 I BGPPEX["A"!(BGPPEX["B")!(BGPPEX["C")!(BGPPEX["D")!(BGPPEX["E")!(BGPPEX["K")!(BGPPEX["I") S BGPAST=1

 W !!?2,$S(BGPAST:"*",1:""),"HIV Positive/AIDS, Systemic Chemotherapy/Immunosuppressive Therapy,"

 W !?2,"Leukemia, Lymphoma, Radiation Therapy, or Chronic Dialysis?  "

 I '$D(BGPDATA) W !?4,"No, Not recorded." Q

 I $D(BGPDATA) S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)

 ;W !

 Q

WOTHINF ;EP

 I $Y>(BGPIOSL-7) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,"Other Suspected Source of Infection? "

 I X W !?4,"Admitting Diagnosis: ["_$P(X,U,2)_"]"

 I X="" Q

 W !,"NOTE:  If patient had other suspected source of infection, this criterion "

 W !,"should only be used to exclude patients when the patient did not receive"

 W !,"an antibiotic regimen recommended for pneumonia but did receive"

 W !,"antibiotics within the first 24 hours of hospitalization."

 Q

 ;

WPSEUDO ;EP

 I $Y>(BGPIOSL-7) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,"Pseudomonas Risk?  "

 I BGPPSE]"" W !?4,$P(BGPPSE,U,2)

 I BGPCOPD]"" W !?4,$P(BGPCOPD,U,2)

 I BGPCOPD]"",BGPPSE="" D

 .W !,"NOTE:  The patient's chart needs to be reviewed to see if there is"

 .W !,"physician/NP/PA documented history of repeated antibiotics or chronic "

 .W !,"corticosteroid use before this patient can be considered to have risk of"

 .W !,"pseudomonas."

 .Q

 Q

 ;

WERBC ;EP

 S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1

 I $Y>(BGPIOSL-(C+2)) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX[6:"*",1:""),"ER Visit with Blood Culture Status:  "

 I $D(BGPDATA) S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)

 W !

 Q

WANTIRX ;EP

 S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1

 I $Y>(BGPIOSL-(C+2)) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX[8!(BGPPEX[7):"*",1:""),"Recent Antibiotic Rx Status:  "

 I $D(BGPDATA) S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)

 ;W !

 Q

 ;

WPNEUMO ;EP

 S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1

 I $Y>(BGPIOSL-(C+2)) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,"Pneumovax Status?  "

 I $D(BGPDATA) S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)

 W !

 Q

 ;

WCYSTIC ;EP

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX[5:"*",1:""),"Cystic Fibrosis?  ",$P(X,U,2)

 Q

 ;

WADMDX ;EP

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX[3:"*",1:""),"Admitting Dx?  ",$$VAL^XBDIQ1(9000010.02,BGPVINP,.12)_"  "_$P($$ICDDX^ICDCODE($P(^AUPNVINP(BGPVINP,0),U,12),$$VD^APCLV(BGPVSIT)),U,4)

 Q

 ;

WERPNEU ;EP 

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,$S(BGPPEX[4:"*",1:""),"ER Visit w/ No Pneumonia DX?  ",$P(X,U,2)

 Q

 ;

WCHEST ;EP - write out chest xray data

 S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S Y=0 F  S Y=$O(BGPDATA(X,Y)) Q:Y'=+Y  S C=C+1

 S X=0 F  S X=$O(BGPSCAN(X)) Q:X'=+X  S Y=0 F  S Y=$O(BGPSCAN(X,Y)) Q:Y'=+Y  S C=C+1

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

 W !!?2,"Chest X-ray/CT Scan?  "

 I $D(BGPDATA)!($D(BGPSCAN)) D

 .S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S Y=0 F  S Y=$O(BGPDATA(X,Y)) Q:Y'=+Y  W !?4,BGPDATA(X,Y)

 .S X=0 F  S X=$O(BGPSCAN(X)) Q:X'=+X  S Y=0 F  S Y=$O(BGPSCAN(X,Y)) Q:Y'=+Y  W !?4,BGPSCAN(X,Y)

 .W !,"NOTE: The patient's chart needs to be reviewed to determine if patient"

 .W !,"should be excluded if the finding was not abnormal."

 Q

 ;

WABGPO ;EP - write out chest xray data

 S X=0,C=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  S C=C+1

 I $Y>(BGPIOSL-(C+6)) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,"ABG/PO Status?  "

 I '$D(BGPDATA) Q

 I $D(BGPDATA) S X=0 F  S X=$O(BGPDATA(X)) Q:X'=+X  W !?4,BGPDATA(X)

 W !,"NOTE: The patient's chart needs to be reviewed to determine if"

 W !,"the oxygen saturation was performed either within 24 hours prior"

 W !,"to arrival or within 24 hours after hospital arrival."

 ;W !

 Q

WCOMFORT(X) ;EP - write out comfort message

 I X="" D  Q

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

 .W !!?2,"Comfort Measures?  None Recorded."

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

 W !!?2,"Comfort Measures?  ",X

 W !,"NOTE:  The patient's chart needs to be reviewed to determine if"

 W !,"this was documented by a physician/APN/PA before it is used"

 W !,"to exclude patients from the denominator."

 Q

 ;

WDOD(V) ;EP - write dod

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 I $$DOD^AUPNPAT(V)]"" D

 .W !!?2,"Date of Death:  ",$$DATE^BGP9UTL($$DOD^AUPNPAT(V))

 Q

 ;

WDT(V) ;EP - write discharge type at column 3

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W:'$D(BGPNOBA) ! W !?2,$S(BGPPEX[2:"*",1:""),"Discharge Type:  ",$$VAL^XBDIQ1(9000010.02,V,.06)

 Q

 ;

WDT9(V) ;EP - write discharge type at column 3

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W:'$D(BGPNOBA) ! W !?2,$S(BGPPEX[9:"*",1:""),"Discharge Type:  ",$$VAL^XBDIQ1(9000010.02,V,.06)

 Q

WTT(V) ;EP - write transferred to

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !?2,"Transferred to:  ",$$VAL^XBDIQ1(9000010.02,V,.09)

 Q

 ;

WPNEUPOV(V) ;EP

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

 S X=$$PNEUMODX^BGP9CU(V)

 W:'$D(BGPNOBA) ! W !?2,"Pneumonia Discharge POV:"

 W !?4,$P(X,U) I $P(X,U,2)]"" W !?4,$P(X,U,2)

 Q

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:80)-$L(X)\2)_X

WPPDPOV(V) ;EP

 I $Y>(BGPIOSL-2) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W:'$D(BGPNOBA) ! W !?2,"Primary Discharge POV: "_$$PRIMPOV^APCLV(V,"C"),"  ",$$PRIMPOV^APCLV(V,"N")

 Q

 ;

OTHDPOVS(V) ;EP write out other discharge povs

 NEW X,C

 S (X,C)=0 F  S X=$O(^AUPNVPOV("AD",BGPVSIT,X)) Q:X'=+X  D

 .Q:'$D(^AUPNVPOV(X,0))

 .Q:$P(^AUPNVPOV(X,0),U,12)="P"

 .S C=C+1

 .Q

 I $Y>(BGPIOSL-(C+2)) D HDR^BGP9CP Q:BGPQUIT  D L1H^BGP9CP

 W !!?2,"Other Discharge POVs for this visit:",$S(C=0:"  None",1:"")

 S (X,C)=0 F  S X=$O(^AUPNVPOV("AD",BGPVSIT,X)) Q:X'=+X  D

 .Q:'$D(^AUPNVPOV(X,0))

 .Q:$P(^AUPNVPOV(X,0),U,12)="P"

 .S C=C+1

 .S I=$P(^AUPNVPOV(X,0),U),I=$P($$ICDDX^ICDCODE(I),U,2)

 .S N=$$VAL^XBDIQ1(9000010.07,X,.04),N=$$UP^XLFSTR(N)

 .W !?4,I,?11,N

 Q

BGP9CPU3  ; IHS/CMI/LAB - calc CMS measures ;

 +1       ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 +2       ;

 +3       ;

EXCL487   ;EP

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        SET BGPXX=$$LASTDXI^BGP9UTL1(DFN,"487.0",$PIECE($PIECE(BGPVSIT0,U),"."),$$DSCH^BGP9CU(BGPVINP),"HI")

           IF BGPXX

               SET BGPN=$$VAL^XBDIQ1(9000010.07,$PIECE(BGPXX,U,5),.04)

 +3        WRITE !!?2,$SELECT(BGPPEX["L":"*",1:""),"Influenza Dx: "_$SELECT(BGPPEX["L":"Yes, 487.0 "_BGPN,1:"No")

 +4        QUIT 

WFLU      ;EP

 +1        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPDATA(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +2        IF $Y>(BGPIOSL-(C+8))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +3        WRITE !!?2,"Influenza IZ Status?  "

 +4        IF '$DATA(BGPDATA)

               QUIT 

 +5        IF $DATA(BGPDATA)

               SET X=0

               FOR 

                   SET X=$ORDER(BGPDATA(X))

                   IF X'=+X

                       QUIT 

                   WRITE !?4,BGPDATA(X)

 +6        WRITE !,"NOTE:  If Influenza vaccine received prior to admission, in order to be "

 +7        WRITE !,"included in the CMS measure, it must be determined if the patient received"

 +8        WRITE "it during the CURRENT flu season.  The CMS Data Abstraction Guidelines"

 +9        WRITE !,"define current flu season as beginning when this season's flu vaccine "

 +10       WRITE !,"is made available to the public, e.g. if the vaccine is available in"

 +11       WRITE !,"September, then the flu season is September-February.  However, for this "

 +12       WRITE !,"measure, the hospitals are only responsible for discharges October-February."

 +13      ;W !

 +14       QUIT 

 +15      ;

WWOUND    ;EP - write transferred to

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,$SELECT(BGPPEX["J":"*",1:""),"Home Wound Care?  ",$PIECE(X,U,2)

 +3        QUIT 

 +4       ;

WNURSHOM  ;EP

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,$SELECT(BGPPEX["H":"*",1:""),"Nursing Home Visit?  ",$PIECE(X,U,2)

 +3        QUIT 

 +4       ;

WHOS2DAY  ;EP

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,$SELECT(BGPPEX["G":"*",1:""),"Hospitalized for 2 days in past 3 months?  ",$PIECE(X,U,2)

 +3        QUIT 

 +4       ;

WPRIORHO  ;EP

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,$SELECT(BGPPEX["F"!(BGPPEX["G"):"*",1:""),"Prior Hospitalization?  ",$SELECT(X]""!(Y]""):"Yes",1:"No")

 +3        WRITE !?4,"Hospital Stay prior 14 days: ",$SELECT(X]"":"Yes, ",1:"No "),$PIECE(X,U,2)

 +4        WRITE !?4,"Hospitalized at least 2 days: ",$SELECT(Y]"":"Yes",1:"No")

           IF Y]""

               WRITE !?6,$PIECE(Y,U,2)," ",$PIECE(Y,U,3)

 +5        QUIT 

 +6       ;

WEXCL1    ;EP

 +1        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPDATA(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +2        IF $Y>(BGPIOSL-(C+4))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +3        SET BGPAST=""

 +4        IF BGPPEX["A"!(BGPPEX["B")!(BGPPEX["C")!(BGPPEX["D")!(BGPPEX["E")!(BGPPEX["K")!(BGPPEX["I")

               SET BGPAST=1

 +5        WRITE !!?2,$SELECT(BGPAST:"*",1:""),"HIV Positive/AIDS, Systemic Chemotherapy/Immunosuppressive Therapy,"

 +6        WRITE !?2,"Leukemia, Lymphoma, Radiation Therapy, or Chronic Dialysis?  "

 +7        IF '$DATA(BGPDATA)

               WRITE !?4,"No, Not recorded."

               QUIT 

 +8        IF $DATA(BGPDATA)

               SET X=0

               FOR 

                   SET X=$ORDER(BGPDATA(X))

                   IF X'=+X

                       QUIT 

                   WRITE !?4,BGPDATA(X)

 +9       ;W !

 +10       QUIT 

WOTHINF   ;EP

 +1        IF $Y>(BGPIOSL-7)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,"Other Suspected Source of Infection? "

 +3        IF X

               WRITE !?4,"Admitting Diagnosis: ["_$PIECE(X,U,2)_"]"

 +4        IF X=""

               QUIT 

 +5        WRITE !,"NOTE:  If patient had other suspected source of infection, this criterion "

 +6        WRITE !,"should only be used to exclude patients when the patient did not receive"

 +7        WRITE !,"an antibiotic regimen recommended for pneumonia but did receive"

 +8        WRITE !,"antibiotics within the first 24 hours of hospitalization."

 +9        QUIT 

 +10      ;

WPSEUDO   ;EP

 +1        IF $Y>(BGPIOSL-7)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,"Pseudomonas Risk?  "

 +3        IF BGPPSE]""

               WRITE !?4,$PIECE(BGPPSE,U,2)

 +4        IF BGPCOPD]""

               WRITE !?4,$PIECE(BGPCOPD,U,2)

 +5        IF BGPCOPD]""

               IF BGPPSE=""

                   Begin DoDot:1

 +6                    WRITE !,"NOTE:  The patient's chart needs to be reviewed to see if there is"

 +7                    WRITE !,"physician/NP/PA documented history of repeated antibiotics or chronic "

 +8                    WRITE !,"corticosteroid use before this patient can be considered to have risk of"

 +9                    WRITE !,"pseudomonas."

 +10                   QUIT 

                   End DoDot:1

 +11       QUIT 

 +12      ;

WERBC     ;EP

 +1        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPDATA(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +2        IF $Y>(BGPIOSL-(C+2))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +3        WRITE !!?2,$SELECT(BGPPEX[6:"*",1:""),"ER Visit with Blood Culture Status:  "

 +4        IF $DATA(BGPDATA)

               SET X=0

               FOR 

                   SET X=$ORDER(BGPDATA(X))

                   IF X'=+X

                       QUIT 

                   WRITE !?4,BGPDATA(X)

 +5        WRITE !

 +6        QUIT 

WANTIRX   ;EP

 +1        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPDATA(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +2        IF $Y>(BGPIOSL-(C+2))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +3        WRITE !!?2,$SELECT(BGPPEX[8!(BGPPEX[7):"*",1:""),"Recent Antibiotic Rx Status:  "

 +4        IF $DATA(BGPDATA)

               SET X=0

               FOR 

                   SET X=$ORDER(BGPDATA(X))

                   IF X'=+X

                       QUIT 

                   WRITE !?4,BGPDATA(X)

 +5       ;W !

 +6        QUIT 

 +7       ;

WPNEUMO   ;EP

 +1        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPDATA(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +2        IF $Y>(BGPIOSL-(C+2))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +3        WRITE !!?2,"Pneumovax Status?  "

 +4        IF $DATA(BGPDATA)

               SET X=0

               FOR 

                   SET X=$ORDER(BGPDATA(X))

                   IF X'=+X

                       QUIT 

                   WRITE !?4,BGPDATA(X)

 +5        WRITE !

 +6        QUIT 

 +7       ;

WCYSTIC   ;EP

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,$SELECT(BGPPEX[5:"*",1:""),"Cystic Fibrosis?  ",$PIECE(X,U,2)

 +3        QUIT 

 +4       ;

WADMDX    ;EP

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,$SELECT(BGPPEX[3:"*",1:""),"Admitting Dx?  ",$$VAL^XBDIQ1(9000010.02,BGPVINP,.12)_"  "_$PIECE($$ICDDX^ICDCODE($PIECE(^AUPNVINP(BGPVINP,0),U,12),$$VD^APCLV(BGPVSIT)),U,4)

 +3        QUIT 

 +4       ;

WERPNEU   ;EP 

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !!?2,$SELECT(BGPPEX[4:"*",1:""),"ER Visit w/ No Pneumonia DX?  ",$PIECE(X,U,2)

 +3        QUIT 

 +4       ;

WCHEST    ;EP - write out chest xray data

 +1        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPDATA(X))

               IF X'=+X

                   QUIT 

               SET Y=0

               FOR 

                   SET Y=$ORDER(BGPDATA(X,Y))

                   IF Y'=+Y

                       QUIT 

                   SET C=C+1

 +2        SET X=0

           FOR 

               SET X=$ORDER(BGPSCAN(X))

               IF X'=+X

                   QUIT 

               SET Y=0

               FOR 

                   SET Y=$ORDER(BGPSCAN(X,Y))

                   IF Y'=+Y

                       QUIT 

                   SET C=C+1

 +3        IF $Y>(BGPIOSL-(C+3))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +4        WRITE !!?2,"Chest X-ray/CT Scan?  "

 +5        IF $DATA(BGPDATA)!($DATA(BGPSCAN))

               Begin DoDot:1

 +6                SET X=0

                   FOR 

                       SET X=$ORDER(BGPDATA(X))

                       IF X'=+X

                           QUIT 

                       SET Y=0

                       FOR 

                           SET Y=$ORDER(BGPDATA(X,Y))

                           IF Y'=+Y

                               QUIT 

                           WRITE !?4,BGPDATA(X,Y)

 +7                SET X=0

                   FOR 

                       SET X=$ORDER(BGPSCAN(X))

                       IF X'=+X

                           QUIT 

                       SET Y=0

                       FOR 

                           SET Y=$ORDER(BGPSCAN(X,Y))

                           IF Y'=+Y

                               QUIT 

                           WRITE !?4,BGPSCAN(X,Y)

 +8                WRITE !,"NOTE: The patient's chart needs to be reviewed to determine if patient"

 +9                WRITE !,"should be excluded if the finding was not abnormal."

               End DoDot:1

 +10       QUIT 

 +11      ;

WABGPO    ;EP - write out chest xray data

 +1        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPDATA(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +2        IF $Y>(BGPIOSL-(C+6))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +3        WRITE !!?2,"ABG/PO Status?  "

 +4        IF '$DATA(BGPDATA)

               QUIT 

 +5        IF $DATA(BGPDATA)

               SET X=0

               FOR 

                   SET X=$ORDER(BGPDATA(X))

                   IF X'=+X

                       QUIT 

                   WRITE !?4,BGPDATA(X)

 +6        WRITE !,"NOTE: The patient's chart needs to be reviewed to determine if"

 +7        WRITE !,"the oxygen saturation was performed either within 24 hours prior"

 +8        WRITE !,"to arrival or within 24 hours after hospital arrival."

 +9       ;W !

 +10       QUIT 

WCOMFORT(X) ;EP - write out comfort message

 +1        IF X=""

               Begin DoDot:1

 +2                IF $Y>(BGPIOSL-4)

                       DO HDR^BGP9CP

                       IF BGPQUIT

                           QUIT 

                       DO L1H^BGP9CP

 +3                WRITE !!?2,"Comfort Measures?  None Recorded."

               End DoDot:1

               QUIT 

 +4        IF $Y>(BGPIOSL-4)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +5        WRITE !!?2,"Comfort Measures?  ",X

 +6        WRITE !,"NOTE:  The patient's chart needs to be reviewed to determine if"

 +7        WRITE !,"this was documented by a physician/APN/PA before it is used"

 +8        WRITE !,"to exclude patients from the denominator."

 +9        QUIT 

 +10      ;

WDOD(V)   ;EP - write dod

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        IF $$DOD^AUPNPAT(V)]""

               Begin DoDot:1

 +3                WRITE !!?2,"Date of Death:  ",$$DATE^BGP9UTL($$DOD^AUPNPAT(V))

               End DoDot:1

 +4        QUIT 

 +5       ;

WDT(V)    ;EP - write discharge type at column 3

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        IF '$DATA(BGPNOBA)

               WRITE !

           WRITE !?2,$SELECT(BGPPEX[2:"*",1:""),"Discharge Type:  ",$$VAL^XBDIQ1(9000010.02,V,.06)

 +3        QUIT 

 +4       ;

WDT9(V)   ;EP - write discharge type at column 3

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        IF '$DATA(BGPNOBA)

               WRITE !

           WRITE !?2,$SELECT(BGPPEX[9:"*",1:""),"Discharge Type:  ",$$VAL^XBDIQ1(9000010.02,V,.06)

 +3        QUIT 

WTT(V)    ;EP - write transferred to

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        WRITE !?2,"Transferred to:  ",$$VAL^XBDIQ1(9000010.02,V,.09)

 +3        QUIT 

 +4       ;

WPNEUPOV(V) ;EP

 +1        IF $Y>(BGPIOSL-4)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        SET X=$$PNEUMODX^BGP9CU(V)

 +3        IF '$DATA(BGPNOBA)

               WRITE !

           WRITE !?2,"Pneumonia Discharge POV:"

 +4        WRITE !?4,$PIECE(X,U)

           IF $PIECE(X,U,2)]""

               WRITE !?4,$PIECE(X,U,2)

 +5        QUIT 

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:80)-$LENGTH(X)\2)_X

WPPDPOV(V) ;EP

 +1        IF $Y>(BGPIOSL-2)

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +2        IF '$DATA(BGPNOBA)

               WRITE !

           WRITE !?2,"Primary Discharge POV: "_$$PRIMPOV^APCLV(V,"C"),"  ",$$PRIMPOV^APCLV(V,"N")

 +3        QUIT 

 +4       ;

OTHDPOVS(V) ;EP write out other discharge povs

 +1        NEW X,C

 +2        SET (X,C)=0

           FOR 

               SET X=$ORDER(^AUPNVPOV("AD",BGPVSIT,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(^AUPNVPOV(X,0))

                       QUIT 

 +4                IF $PIECE(^AUPNVPOV(X,0),U,12)="P"

                       QUIT 

 +5                SET C=C+1

 +6                QUIT 

               End DoDot:1

 +7        IF $Y>(BGPIOSL-(C+2))

               DO HDR^BGP9CP

               IF BGPQUIT

                   QUIT 

               DO L1H^BGP9CP

 +8        WRITE !!?2,"Other Discharge POVs for this visit:",$SELECT(C=0:"  None",1:"")