Routine: APCM24EP

APCM24EP ; IHS/CMI/LAB - IHS MU ;

 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

PRINT ;EP

 K ^TMP($J)

 S APCMIOSL=$S($G(APCMGUI):55,1:IOSL)

 S APCMQUIT=""

 S ^TMP($J,"APCMDEL",0)=0

 I APCMROT="D" G DEL

 S APCMPTYP="P"

 D ^APCM24EH

 S APCMGPG=0

 S APCMQUIT=""

 D SUM

 D W^APCM24EH(" ",0,2,APCMPTYP)

 D LIST^APCM24NP

 D W^APCM24EH(" ",0,2,APCMPTYP)

 K ^TMP($J)

 I APCMROT="P" K ^XTMP("APCM1D",APCMJ,APCMH) D EOP Q

DEL ;create delimited output file

 D ^%ZISC

 K ^TMP($J)

 S ^TMP($J,"APCMDEL",0)=0

 S APCMPTYP="D"

 D ^APCM24EH

 S APCMQUIT=""

 D SUM

 Q:APCMQUIT

 D LIST^APCM24NP

 Q:APCMQUIT

 D SAVEDEL^APCM24EQ

 K ^XTMP("APCM1D",APCMJ,APCMH)

 K ^TMP($J)

 D EOP

WP ;

 K ^UTILITY($J,"W")

 S APCMZ=0,APCMLCNT=0

 S DIWL=1,DIWR=APCMCOL,DIWF="",APCMZ=0 F  S APCMZ=$O(^APCM24OB(APCMIC,APCMNODE,APCMY,1,APCMZ)) Q:APCMZ'=+APCMZ  D

 .S APCMLCNT=APCMLCNT+1

 .S X=^APCM24OB(APCMIC,APCMNODE,APCMY,1,APCMZ,0) S:APCMLCNT=1 X=" - "_X D ^DIWP

.Q

WPS ;

 S Z=0 F  S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z  D

 .I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT

 .D W^APCM24EH(^UTILITY($J,"W",DIWL,Z,0),0,1,APCMPTYP)

 K DIWL,DIWR,DIWF,Z

 K ^UTILITY($J,"W"),X

EOP ;EP - End of page.

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

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

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR("A")="End of Report.  Press Enter",DIR(0)="E" D ^DIR

SCREEN ;

 S X=0 F  S X=$O(^TMP($J,"APCMDEL",X)) Q:X'=+X  W !,^TMP($J,"APCMDEL",X)

EXIT ;

 I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO",DIR("A")="End of report.  Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

CALC(N,O) ;ENTRY POINT

 NEW Z

 S Z=N-O,Z=$FN(Z,"+,",1)

Q Z

SB(X) ;EP - Strip

 NEW %

 X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)

Q X

C(X,X2,X3) ;

 I X'?.N Q $$RBLK^APCLUTL(X,10)

 D COMMA^%DTC

Q X

HEADER ;EP

 G:'APCMGPG HEADER1

 K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCMQUIT=1 Q

HEADER1 ;

 I APCMPTYP="P" W:$D(IOF) @IOF S APCMGPG=APCMGPG+1

 I APCMPTYP="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_APCMGPG D W^APCM24EH(X,0,1,APCMPTYP)

 I APCMRPTT=1 D W^APCM24EH("** IHS 2014/2015 Stage 2 Meaningful Use Performance Measure Report for EPs **",1,2,APCMPTYP)

 I APCMRPTT=2 D W^APCM24EH("** IHS 2014/2015 Stage 2 MU Performance Report for Eligible Hospitals/CAHs **",1,2,APCMPTYP)

 I $G(APCMPROV),APCMRPTT=1 S X="Provider Name: "_$$SN^APCM24EH($P(^VA(200,APCMPROV,0),U,1)) D W^APCM24EH(X,1,1,APCMPTYP)

 I $G(APCMPROV),APCMRPTT=2 S X="Facility Name: "_$P(^DIC(4,APCMPROV,0),U,1) D W^APCM24EH(X,1,1,APCMPTYP)

 I $G(APCMTOT) S X="Aggregate Report for all Selected Providers" D W^APCM24EH(X,1,1,APCMPTYP)

 I APCMRPTT=1 S X="Facility Name: "_$P(^DIC(4,DUZ(2),0),U,1) D W^APCM24EH(X,1,1,APCMPTYP)

 S X="Report Period:  "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED) D W^APCM24EH(X,1,1,APCMPTYP)

 S X=$$REPEAT^XLFSTR("-",80) D W^APCM24EH(X,0,1,APCMPTYP)

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

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

 ;----------

 ;----------

USR() ;EP - Return name .

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

 ;----------

SETN ;EP - set numerator fields

 S APCMCYN=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT) ;SPDX

 S APCMPRN=$$V(2,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT) ;SPDX

 I APCMCYN="" S APCMCYN=0

 I APCMPRN="" S APCMPRN=0

 Q:$P(^APCM24OB(APCMIC,0),U,6)="A"  ;no % on attestation measures

 S APCMCYP=$S(APCMCYD:((APCMCYN/APCMCYD)*100),1:"")

 S APCMPRP=$S(APCMPRD:((APCMPRN/APCMPRD)*100),1:"")

V(T,R,N,P,PROV,K,RT) ;EP ;SPDX

 NEW X,Y,Z,I,J

 I RT=1 S I=PROV_";VA(200,"

 I RT=2 S I=PROV_";AUTTLOC("

 I K="T" S I="TOTAL"

 I T=1 D  Q X

 .S J=$O(^APCMM24C(R,$S(K="I":11,1:12),"B",I,0))

 .I 'J S X=0 Q

 .S X=$P($G(^APCMM24C(R,$S(K="I":11,1:12),J,N)),U,P)

 Q ""

SUM ;summary sheet for each provider

 D SUM^APCM24ER

APCM24EP  ; IHS/CMI/LAB - IHS MU ;

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

 +2       ;

 +3       ;

PRINT     ;EP

 +1        KILL ^TMP($JOB)

 +2        SET APCMIOSL=$SELECT($GET(APCMGUI):55,1:IOSL)

 +3        SET APCMQUIT=""

 +4        SET ^TMP($JOB,"APCMDEL",0)=0

 +5        IF APCMROT="D"

               GOTO DEL

 +6        SET APCMPTYP="P"

 +7        DO ^APCM24EH

 +8        SET APCMGPG=0

 +9        SET APCMQUIT=""

 +10       DO SUM

 +11       DO W^APCM24EH(" ",0,2,APCMPTYP)

 +12       DO LIST^APCM24NP

 +13       DO W^APCM24EH(" ",0,2,APCMPTYP)

 +14       KILL ^TMP($JOB)

 +15       IF APCMROT="P"

               KILL ^XTMP("APCM1D",APCMJ,APCMH)

               DO EOP

               QUIT

 +16      ;

DEL       ;create delimited output file

 +1        DO ^%ZISC

 +2        KILL ^TMP($JOB)

 +3        SET ^TMP($JOB,"APCMDEL",0)=0

 +4        SET APCMPTYP="D"

 +5        DO ^APCM24EH

 +6        SET APCMQUIT=""

 +7        DO SUM

 +8        IF APCMQUIT

               QUIT

 +9        DO LIST^APCM24NP

 +10       IF APCMQUIT

               QUIT

 +11       DO SAVEDEL^APCM24EQ

 +12       KILL ^XTMP("APCM1D",APCMJ,APCMH)

 +13       KILL ^TMP($JOB)

 +14       DO EOP

 +15       QUIT

WP        ;

 +1        KILL ^UTILITY($JOB,"W")

 +2        SET APCMZ=0

           SET APCMLCNT=0

 +3        SET DIWL=1

           SET DIWR=APCMCOL

           SET DIWF=""

           SET APCMZ=0

FOR

               SET APCMZ=$ORDER(^APCM24OB(APCMIC,APCMNODE,APCMY,1,APCMZ))

               IF APCMZ'=+APCMZ

                   QUIT

               Begin DoDot:1

 +4                SET APCMLCNT=APCMLCNT+1

 +5                SET X=^APCM24OB(APCMIC,APCMNODE,APCMY,1,APCMZ,0)

                   IF APCMLCNT=1

                       SET X=" - "_X

                   DO ^DIWP

 +6                QUIT

               End DoDot:1

WPS       ;

 +1        SET Z=0

FOR

               SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))

               IF Z'=+Z

                   QUIT

               Begin DoDot:1

 +2                IF APCMPTYP="P"

                       IF $Y>(APCMIOSL-3)

                           DO HEADER

                           IF APCMQUIT

                               QUIT

 +3                DO W^APCM24EH(^UTILITY($JOB,"W",DIWL,Z,0),0,1,APCMPTYP)

               End DoDot:1

 +4        KILL DIWL,DIWR,DIWF,Z

 +5        KILL ^UTILITY($JOB,"W"),X

 +6        QUIT

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 DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5        SET DIR("A")="End of Report.  Press Enter"

           SET DIR(0)="E"

           DO ^DIR

 +6        QUIT

 +7       ;

 +8       ;

 +9       ;

SCREEN    ;

 +1        SET X=0

FOR

               SET X=$ORDER(^TMP($JOB,"APCMDEL",X))

               IF X'=+X

                   QUIT

               WRITE !,^TMP($JOB,"APCMDEL",X)

 +2        QUIT

EXIT      ;

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

               IF IO=IO(0)

                   IF '$DATA(ZTQUEUED)

                       WRITE !

                       SET DIR(0)="EO"

                       SET DIR("A")="End of report.  Press ENTER"

                       DO ^DIR

                       KILL DIR

                       IF $DATA(DUOUT)

                           SET DIRUT=1

 +2        QUIT

 +3       ;

CALC(N,O) ;ENTRY POINT

 +1        NEW Z

 +2        SET Z=N-O

           SET Z=$FNUMBER(Z,"+,",1)

 +3        QUIT Z

 +4       ;

SB(X)     ;EP - Strip

 +1        NEW %

 +2        XECUTE ^DD("FUNC",$ORDER(^DD("FUNC","B","STRIPBLANKS",0)),1)

 +3        QUIT X

 +4       ;

C(X,X2,X3) ;

 +1        IF X'?.N

               QUIT $$RBLK^APCLUTL(X,10)

 +2        DO COMMA^%DTC

 +3        QUIT X

 +4       ;

 +5       ;

 +6       ;

HEADER    ;EP

 +1        IF 'APCMGPG

               GOTO HEADER1

 +2        KILL DIR

           IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   IF '$DATA(ZTQUEUED)

                       WRITE !

                       SET DIR(0)="EO"

                       DO ^DIR

                       KILL DIR

                       IF Y=0!(Y="^")!($DATA(DTOUT))

                           SET APCMQUIT=1

                           QUIT

 +3       ;

HEADER1   ;

 +1        IF APCMPTYP="P"

               IF $DATA(IOF)

                   WRITE @IOF

               SET APCMGPG=APCMGPG+1

 +2        IF APCMPTYP="P"

               SET X=$PIECE(^VA(200,DUZ,0),U,2)

               SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)

               SET $EXTRACT(X,70)="Page "_APCMGPG

               DO W^APCM24EH(X,0,1,APCMPTYP)

 +3        IF APCMRPTT=1

               DO W^APCM24EH("** IHS 2014/2015 Stage 2 Meaningful Use Performance Measure Report for EPs **",1,2,APCMPTYP)

 +4        IF APCMRPTT=2

               DO W^APCM24EH("** IHS 2014/2015 Stage 2 MU Performance Report for Eligible Hospitals/CAHs **",1,2,APCMPTYP)

 +5        IF $GET(APCMPROV)

               IF APCMRPTT=1

                   SET X="Provider Name: "_$$SN^APCM24EH($PIECE(^VA(200,APCMPROV,0),U,1))

                   DO W^APCM24EH(X,1,1,APCMPTYP)

 +6        IF $GET(APCMPROV)

               IF APCMRPTT=2

                   SET X="Facility Name: "_$PIECE(^DIC(4,APCMPROV,0),U,1)

                   DO W^APCM24EH(X,1,1,APCMPTYP)

 +7        IF $GET(APCMTOT)

               SET X="Aggregate Report for all Selected Providers"

               DO W^APCM24EH(X,1,1,APCMPTYP)

 +8        IF APCMRPTT=1

               SET X="Facility Name: "_$PIECE(^DIC(4,DUZ(2),0),U,1)

               DO W^APCM24EH(X,1,1,APCMPTYP)

 +9        SET X="Report Period:  "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED)

           DO W^APCM24EH(X,1,1,APCMPTYP)

 +10       SET X=$$REPEAT^XLFSTR("-",80)

           DO W^APCM24EH(X,0,1,APCMPTYP)

 +11       QUIT

 +12      ;

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

 +3       ;----------

USR()     ;EP - Return name .

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

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

 +3       ;

SETN      ;EP - set numerator fields

 +1       ;SPDX

           SET APCMCYN=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)

 +2       ;SPDX

           SET APCMPRN=$$V(2,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)

 +3        IF APCMCYN=""

               SET APCMCYN=0

 +4        IF APCMPRN=""

               SET APCMPRN=0

 +5       ;no % on attestation measures

           IF $PIECE(^APCM24OB(APCMIC,0),U,6)="A"

               QUIT

 +6        SET APCMCYP=$SELECT(APCMCYD:((APCMCYN/APCMCYD)*100),1:"")

 +7        SET APCMPRP=$SELECT(APCMPRD:((APCMPRN/APCMPRD)*100),1:"")

 +8        QUIT

 +9       ;

V(T,R,N,P,PROV,K,RT) ;EP ;SPDX

 +1        NEW X,Y,Z,I,J

 +2        IF RT=1

               SET I=PROV_";VA(200,"

 +3        IF RT=2

               SET I=PROV_";AUTTLOC("

 +4        IF K="T"

               SET I="TOTAL"

 +5        IF T=1

               Begin DoDot:1

 +6                SET J=$ORDER(^APCMM24C(R,$SELECT(K="I":11,1:12),"B",I,0))

 +7                IF 'J

                       SET X=0

                       QUIT

 +8                SET X=$PIECE($GET(^APCMM24C(R,$SELECT(K="I":11,1:12),J,N)),U,P)

               End DoDot:1

               QUIT X

 +9        QUIT ""

SUM       ;summary sheet for each provider

 +1        DO SUM^APCM24ER

 +2        QUIT

APCM24EP.m