Routine: BGP3CL

BGP3CL ; IHS/CMI/LAB - IHS GPRA 10 CMS REPORT DRIVER 01 Jul 2010 8:19 PM 30 Mar 2013 6:08 PM ;

 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 W:$D(IOF) @IOF

 W !!,$$CTR("IHS 2013 CRS - RPMS PATIENT DATA FOR ANNUAL CMS HOSPITAL REPORTING",80)

INTRO ;

 D XIT

WARN ;

 W !,"                     ***************************"

 W !,"                     ****** W A R N I N G ******"

 W !,"                     ***************************"

W !

 W !,"This report was last updated in April 2009 through the CMS Specifications "

 W !,"Manual for discharges effective 4/1/2009, and the CRS CMS Report was included"

 W !,"in CRS Version 8.0."

W !

 W !,"It is recommended this report NOT be used until it is updated.  OIT "

 W !,"anticipates this report will be updated with CRS Version 11.0."

W !

 W !,"If you decide to use the information included in this report, because the"

 W !,"information may be inaccurate you will need to validate the information "

 W !,"reported against the current CMS Specifications Manual.  The URL for the "

 W !,"current manual is listed below."

 W !!,"http://www.qualitynet.org/dcs/ContentServer?c=Page&pagename=QnetPublic%2FPage%2FQnetTier2&cid=1141662756099"

W !

 S DIR(0)="Y",DIR("A")="Do you want to continue with this report",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 I 'Y D XIT Q

 S BGPRPTYR=$O(^BGPCTRL("B",2013,0))

 S X=0 F  S X=$O(^BGPCTRL(BGPRPTYR,42,X)) Q:X'=+X  W !,^BGPCTRL(BGPRPTYR,42,X,0)

 D PAUSE

GETLOC ;

 K DIC S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Enter the name of your Hospital: ",DIC("B")=$P(^DIC(4,DUZ(2),0),U) D ^DIC

 I Y=-1 D XIT Q

 S BGPHOSP=+Y

SETIND ;

 K BGPIND

 D EP^BGP3CSI

 I '$D(BGPIND) W !!,"No measures selected." D PAUSE,XIT Q

SETLIST ;

 K BGPPLST,BGPPLSTL

 F BGPXX=0 F  S BGPXX=$O(BGPIND(BGPXX)) Q:BGPXX=""  D

 .W !!,"You will now be asked to select which patient lists you want"

 .W !,"within the ",$P(^BGPCMSIB(BGPXX,0),U,3)," topic.",!

 .D PAUSE

 .D EN^BGP3CSII

 .I '$D(BGPPLSTL(BGPXX)) W !!,"No lists selected for topic ",$P(^BGPCMSIB(BGPXX,0),U,3),"." D PAUSE

 I '$D(BGPPLSTL) W !!,"No patient lists selected." D PAUSE,XIT Q

 D TAXCHK^BGP3CTXC

TP1 S (BGPBD,BGPED,BGPTP)=""

W !

 S DIR(0)="S^1:1st Quarter January 1 - March 31;2:2nd Quarter April 1 - June 30;3:3rd Quarter July 1 - September 30;4:4th Quarter October 1 - December 31;5:User-Defined Report Period (enter beginning and ending date)"

 S DIR("A")="Enter the date range for your report"

 KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 S BGPQTR=Y

 I BGPQTR=5 D ENDDATE

 I BGPQTR'=5 D F

 I BGPPER="" W !,"Year not entered.",! G TP1

 I BGPQTR=1 S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"0331"

 I BGPQTR=2 S BGPBD=$E(BGPPER,1,3)_"0401",BGPED=$E(BGPPER,1,3)_"0630"

 I BGPQTR=3 S BGPBD=$E(BGPPER,1,3)_"0701",BGPED=$E(BGPPER,1,3)_"0930"

 I BGPQTR=4 S BGPBD=$E(BGPPER,1,3)_"1001",BGPED=$E(BGPPER,1,3)_"1231"

 I BGPQTR=5 S BGPBD=BGPUDBD,BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"

 I BGPED>DT D  G:BGPDO=1 TP1

 .W !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."

 .W !,"The end date of this report is in the future; your data will not be",!,"complete.",!

 .K DIR S BGPDO=0 S DIR(0)="Y",DIR("A")="Do you want to change your Current Report Dates",DIR("B")="N" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S BGPDO=1 Q

 .I Y S BGPDO=1 Q

.Q

 W !!,"The date range for this report is: ",$$FMTE^XLFDT(BGPBD)," to ",$$FMTE^XLFDT(BGPED),!!

BEN ;

 S BGPBEN=""

 S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"

 S DIR("B")="3" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G TP1

 S BGPBEN=Y

TEXT ;

 S BGPTEXD=""

W !

 S DIR(0)="Y",DIR("A")="Do you want to have the explanatory/logic text printed with your report",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G BEN

 S BGPTEXD=Y

ZIS ;call to XBDBQUE

 K IOP,%ZIS

 W !! S %ZIS="PQM" D ^%ZIS

 I POP D XIT Q

ZIS1 ;

 I $D(IO("Q")) G TSKMN

DRIVER ;

 I $D(ZTQUEUED) S ZTREQ="@"

 D ^BGP3C1

 U IO

 D ^BGP3CP

 D ^%ZISC

 D XIT

TSKMN ;EP ENTRY POINT FROM TASKMAN

 S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST

 I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))

 I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL

 K ZTSAVE S ZTSAVE("BGP*")=""

 S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BGP3CL",ZTDTH="",ZTDESC="CRS 13 CMS REPORT" D ^%ZTLOAD D XIT Q

XIT ;

 D ^%ZISC

 D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"

 K DIRUT,DUOUT,DIR,DOD

 K DIADD,DLAYGO

 D KILL^AUPNPAT

 K X,X1,X2,X3,X4,X5,X6

 K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 K N,N1,N2,N3,N4,N5,N6

 K BD,ED

 D KILL^AUPNPAT

 D ^XBFMK

PAUSE ;EP - pause

 K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR("A")="Press Enter to Continue",DIR(0)="E" D ^DIR KILL DIR

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

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

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR KILL DIR

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return location name from file 4 based on DUZ(2).

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------

ENDDATE ;

 W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2013)"

 W !,"will assume a year in the past, if you want to put in a future date,"

 W !,"remember to enter the full 4 digit year.  For example, if today is"

 W !,"January 4, 2013 and you type in 6/30/08 the system will assume the year"

 W !,"as 1908 since that is a date in the past.  You must type 6/30/2013 if you"

 W !,"want a date in the future."

 S (BGPPER,BGPVDT)=""

DATES ;

 S BGPUDBD="",BGPUDED=""

 K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"

 D ^DIR Q:Y<1  S BGPUDBD=Y

 K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date"

 D ^DIR Q:Y<1  S (BGPPER,BGPVDT)=Y

 I BGPVDT<BGPUDBD D  G DATES

 . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."

F ;calendar year

 S (BGPPER,BGPVDT)=""

 W !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2013"

 S DIR(0)="D^::EP"

 S DIR("A")="Enter Year"

 S DIR("?")="This report is compiled for a period.  Enter a valid date."

 D ^DIR KILL DIR

 I $D(DIRUT) Q

 I $D(DUOUT) S DIRUT=1 Q

 S BGPVDT=Y

 I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F

 S BGPPER=BGPVDT

BGP3CL    ; IHS/CMI/LAB - IHS GPRA 10 CMS REPORT DRIVER 01 Jul 2010 8:19 PM 30 Mar 2013 6:08 PM ;

 +1       ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE !!,$$CTR("IHS 2013 CRS - RPMS PATIENT DATA FOR ANNUAL CMS HOSPITAL REPORTING",80)

INTRO     ;

 +1        DO XIT

WARN      ;

 +1        WRITE !,"                     ***************************"

 +2        WRITE !,"                     ****** W A R N I N G ******"

 +3        WRITE !,"                     ***************************"

 +4        WRITE !

 +5        WRITE !,"This report was last updated in April 2009 through the CMS Specifications "

 +6        WRITE !,"Manual for discharges effective 4/1/2009, and the CRS CMS Report was included"

 +7        WRITE !,"in CRS Version 8.0."

 +8        WRITE !

 +9        WRITE !,"It is recommended this report NOT be used until it is updated.  OIT "

 +10       WRITE !,"anticipates this report will be updated with CRS Version 11.0."

 +11       WRITE !

 +12       WRITE !,"If you decide to use the information included in this report, because the"

 +13       WRITE !,"information may be inaccurate you will need to validate the information "

 +14       WRITE !,"reported against the current CMS Specifications Manual.  The URL for the "

 +15       WRITE !,"current manual is listed below."

 +16       WRITE !!,"http://www.qualitynet.org/dcs/ContentServer?c=Page&pagename=QnetPublic%2FPage%2FQnetTier2&cid=1141662756099"

 +17       WRITE !

 +18       SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue with this report"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +19       IF $DATA(DIRUT)

               DO XIT

               QUIT

 +20       IF 'Y

               DO XIT

               QUIT

 +21       SET BGPRPTYR=$ORDER(^BGPCTRL("B",2013,0))

 +22       SET X=0

FOR

               SET X=$ORDER(^BGPCTRL(BGPRPTYR,42,X))

               IF X'=+X

                   QUIT

               WRITE !,^BGPCTRL(BGPRPTYR,42,X,0)

 +23       DO PAUSE

GETLOC    ;

 +1        KILL DIC

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter the name of your Hospital: "

           SET DIC("B")=$PIECE(^DIC(4,DUZ(2),0),U)

           DO ^DIC

 +2        IF Y=-1

               DO XIT

               QUIT

 +3        SET BGPHOSP=+Y

SETIND    ;

 +1        KILL BGPIND

 +2        DO EP^BGP3CSI

 +3        IF '$DATA(BGPIND)

               WRITE !!,"No measures selected."

               DO PAUSE

               DO XIT

               QUIT

SETLIST   ;

 +1        KILL BGPPLST,BGPPLSTL

 +2        FOR BGPXX=0

FOR

                   SET BGPXX=$ORDER(BGPIND(BGPXX))

                   IF BGPXX=""

                       QUIT

                   Begin DoDot:1

 +3                    WRITE !!,"You will now be asked to select which patient lists you want"

 +4                    WRITE !,"within the ",$PIECE(^BGPCMSIB(BGPXX,0),U,3)," topic.",!

 +5                    DO PAUSE

 +6                    DO EN^BGP3CSII

 +7                    IF '$DATA(BGPPLSTL(BGPXX))

                           WRITE !!,"No lists selected for topic ",$PIECE(^BGPCMSIB(BGPXX,0),U,3),"."

                           DO PAUSE

                   End DoDot:1

 +8        IF '$DATA(BGPPLSTL)

               WRITE !!,"No patient lists selected."

               DO PAUSE

               DO XIT

               QUIT

 +9        DO TAXCHK^BGP3CTXC

TP1        SET (BGPBD,BGPED,BGPTP)=""

 +1        WRITE !

 +2        SET DIR(0)="S^1:1st Quarter January 1 - March 31;2:2nd Quarter April 1 - June 30;3:3rd Quarter July 1 - September 30;4:4th Quarter October 1 - December 31;5:User-Defined Report Period (enter beginning and ending date)"

 +3        SET DIR("A")="Enter the date range for your report"

 +4        KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               DO XIT

               QUIT

 +6        SET BGPQTR=Y

 +7        IF BGPQTR=5

               DO ENDDATE

 +8        IF BGPQTR'=5

               DO F

 +9        IF BGPPER=""

               WRITE !,"Year not entered.",!

               GOTO TP1

 +10       IF BGPQTR=1

               SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"

 +11       IF BGPQTR=2

               SET BGPBD=$EXTRACT(BGPPER,1,3)_"0401"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"

 +12       IF BGPQTR=3

               SET BGPBD=$EXTRACT(BGPPER,1,3)_"0701"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"

 +13       IF BGPQTR=4

               SET BGPBD=$EXTRACT(BGPPER,1,3)_"1001"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"

 +14       IF BGPQTR=5

               SET BGPBD=BGPUDBD

               SET BGPED=BGPPER

               SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"

 +15       IF BGPED>DT

               Begin DoDot:1

 +16               WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."

 +17               WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!

 +18               KILL DIR

                   SET BGPDO=0

                   SET DIR(0)="Y"

                   SET DIR("A")="Do you want to change your Current Report Dates"

                   SET DIR("B")="N"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +19               IF $DATA(DIRUT)

                       SET BGPDO=1

                       QUIT

 +20               IF Y

                       SET BGPDO=1

                       QUIT

 +21               QUIT

               End DoDot:1

               IF BGPDO=1

                   GOTO TP1

 +22       WRITE !!,"The date range for this report is: ",$$FMTE^XLFDT(BGPBD)," to ",$$FMTE^XLFDT(BGPED),!!

BEN       ;

 +1        SET BGPBEN=""

 +2        SET DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)"

           SET DIR("A")="Select Beneficiary Population to include in this report"

 +3        SET DIR("B")="3"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO TP1

 +5        SET BGPBEN=Y

TEXT      ;

 +1        SET BGPTEXD=""

 +2        WRITE !

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you want to have the explanatory/logic text printed with your report"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO BEN

 +5        SET BGPTEXD=Y

ZIS       ;call to XBDBQUE

 +1        KILL IOP,%ZIS

 +2        WRITE !!

           SET %ZIS="PQM"

           DO ^%ZIS

 +3        IF POP

               DO XIT

               QUIT

ZIS1      ;

 +1        IF $DATA(IO("Q"))

               GOTO TSKMN

DRIVER    ;

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        DO ^BGP3C1

 +3        USE IO

 +4        DO ^BGP3CP

 +5        DO ^%ZISC

 +6        DO XIT

 +7        QUIT

 +8       ;

TSKMN     ;EP ENTRY POINT FROM TASKMAN

 +1        SET ZTIO=$SELECT($DATA(ION):ION,1:IO)

           IF $DATA(IOST)#2

               IF IOST]""

                   SET ZTIO=ZTIO_";"_IOST

 +2        IF $GET(IO("DOC"))]""

               SET ZTIO=ZTIO_";"_$GET(IO("DOC"))

 +3        IF $DATA(IOM)#2

               IF IOM

                   SET ZTIO=ZTIO_";"_IOM

                   IF $DATA(IOSL)#2

                       IF IOSL

                           SET ZTIO=ZTIO_";"_IOSL

 +4        KILL ZTSAVE

           SET ZTSAVE("BGP*")=""

 +5        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="DRIVER^BGP3CL"

           SET ZTDTH=""

           SET ZTDESC="CRS 13 CMS REPORT"

           DO ^%ZTLOAD

           DO XIT

           QUIT

 +6        QUIT

 +7       ;

 +8       ;

XIT       ;

 +1        DO ^%ZISC

 +2        DO EN^XBVK("BGP")

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        KILL DIRUT,DUOUT,DIR,DOD

 +4        KILL DIADD,DLAYGO

 +5        DO KILL^AUPNPAT

 +6        KILL X,X1,X2,X3,X4,X5,X6

 +7        KILL A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 +8        KILL N,N1,N2,N3,N4,N5,N6

 +9        KILL BD,ED

 +10       DO KILL^AUPNPAT

 +11       DO ^XBFMK

 +12       QUIT

 +13      ;

PAUSE     ;EP - pause

 +1        KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +2        SET DIR("A")="Press Enter to Continue"

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

 +3        QUIT

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

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

 +2       ;----------

EOP       ;EP - End of page.

 +1        IF $EXTRACT(IOST)'="C"

               QUIT

 +2        IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))

               QUIT

 +3        NEW DIR

 +4        KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5        SET DIR(0)="E"

           DO ^DIR

           KILL DIR

 +6        QUIT

 +7       ;----------

USR()     ;EP - Return name of current user from ^VA(200.

 +1        QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 +2       ;----------

LOC()     ;EP - Return location name from file 4 based on DUZ(2).

 +1        QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 +2       ;----------

 +3       ;

ENDDATE   ;

 +1        WRITE !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2013)"

 +2        WRITE !,"will assume a year in the past, if you want to put in a future date,"

 +3        WRITE !,"remember to enter the full 4 digit year.  For example, if today is"

 +4        WRITE !,"January 4, 2013 and you type in 6/30/08 the system will assume the year"

 +5        WRITE !,"as 1908 since that is a date in the past.  You must type 6/30/2013 if you"

 +6        WRITE !,"want a date in the future."

 +7        SET (BGPPER,BGPVDT)=""

DATES     ;

 +1        SET BGPUDBD=""

           SET BGPUDED=""

 +2        KILL DIR

           WRITE !

           SET DIR(0)="DO^::EXP"

           SET DIR("A")="Enter Beginning Date"

 +3        DO ^DIR

           IF Y<1

               QUIT

           SET BGPUDBD=Y

 +4        KILL DIR

           SET DIR(0)="DO^:DT:EXP"

           SET DIR("A")="Enter Ending Date"

 +5        DO ^DIR

           IF Y<1

               QUIT

           SET (BGPPER,BGPVDT)=Y

 +6       ;

 +7        IF BGPVDT<BGPUDBD

               Begin DoDot:1

 +8                WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."

               End DoDot:1

               GOTO DATES

 +9       ;

 +10      ;

 +11       QUIT

F         ;calendar year

 +1        SET (BGPPER,BGPVDT)=""

 +2        WRITE !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2013"

 +3        SET DIR(0)="D^::EP"

 +4        SET DIR("A")="Enter Year"

 +5        SET DIR("?")="This report is compiled for a period.  Enter a valid date."

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               QUIT

 +8        IF $DATA(DUOUT)

               SET DIRUT=1

               QUIT

 +9        SET BGPVDT=Y

 +10       IF $EXTRACT(Y,4,7)'="0000"

               WRITE !!,"Please enter a year only!",!

               GOTO F

 +11       SET BGPPER=BGPVDT

 +12       QUIT

BGP3CL.m