BGP6CL.m

BGP6CL ; IHS/CMI/LAB - IHS GPRA 05 CMS REPORT DRIVER ;

 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 ;

 ;

 W:$D(IOF) @IOF

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

INTRO ;

 D XIT

 W !,"This will produce a Performance Measure Report for one or more measures for a",!,"period you specify.  You will be asked to provide: 1) the"

 W !,"reporting period and 2) which CMS measures to list.",!!

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^BGP6CSI

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

 D TAXCHK^BGP6CTXC

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

 S DIR(0)="S^1:January 1 - December 31;2:April 1 - March 31;3:July 1 - June 30;4:October 1 - September 30;5:User-Defined Report Period (enter beginning and ending date)",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)_"1231"

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

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

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

 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),!!

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 ;

 D ^BGP6C1

 U IO

 D ^BGP6CP

 D ^%ZISC

 D XIT

 Q

 ;

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^BGP6CL",ZTDTH="",ZTDESC="CRS 05 CMS REPORT" D ^%ZTLOAD D XIT Q

 Q

 ;

 ;

XIT ;

 D ^%ZISC

 D EN^XBVK("BGP")

 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

 Q

 ;

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

 Q

 ;----------

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

 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, 2006 and you type in 6/30/05 the system will assume the year"

 W !,"as 1905 since that is a date in the past.  You must type 6/30/2006 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."

 ;

 ;

 Q

F ;calendar year

 S (BGPPER,BGPVDT)=""

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

 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

 Q

BGP6CL    ; IHS/CMI/LAB - IHS GPRA 05 CMS REPORT DRIVER ;

 +1       ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

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

INTRO     ;

 +1        DO XIT

 +2        WRITE !,"This will produce a Performance Measure Report for one or more measures for a",!,"period you specify.  You will be asked to provide: 1) the"

 +3        WRITE !,"reporting period and 2) which CMS measures to list.",!!

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^BGP6CSI

 +3        IF '$DATA(BGPIND)

               WRITE !!,"No measures selected."

               DO XIT

               QUIT 

 +4        DO TAXCHK^BGP6CTXC

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

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

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

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               DO XIT

               QUIT 

 +3        SET BGPQTR=Y

 +4        IF BGPQTR=5

               DO ENDDATE

 +5        IF BGPQTR'=5

               DO F

 +6        IF BGPPER=""

               WRITE !,"Year not entered.",!

               GOTO TP1

 +7        IF BGPQTR=1

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

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

 +8        IF BGPQTR=2

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

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

 +9        IF BGPQTR=3

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

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

 +10       IF BGPQTR=4

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

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

 +11       IF BGPQTR=5

               SET BGPBD=BGPUDBD

               SET BGPED=BGPPER

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

 +12       IF BGPED>DT

               Begin DoDot:1

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

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

 +15               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

 +16               IF $DATA(DIRUT)

                       SET BGPDO=1

                       QUIT 

 +17               IF Y

                       SET BGPDO=1

                       QUIT 

 +18               QUIT 

               End DoDot:1

               IF BGPDO=1

                   GOTO TP1

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

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        DO ^BGP6C1

 +2        USE IO

 +3        DO ^BGP6CP

 +4        DO ^%ZISC

 +5        DO XIT

 +6        QUIT 

 +7       ;

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^BGP6CL"

           SET ZTDTH=""

           SET ZTDESC="CRS 05 CMS REPORT"

           DO ^%ZTLOAD

           DO XIT

           QUIT 

 +6        QUIT 

 +7       ;

 +8       ;

XIT       ;

 +1        DO ^%ZISC

 +2        DO EN^XBVK("BGP")

 +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      ;

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

 +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, 2006 and you type in 6/30/05 the system will assume the year"

 +5        WRITE !,"as 1905 since that is a date in the past.  You must type 6/30/2006 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. 2005"

 +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