APCM2AEP ; IHS/CMI/LAB - IHS MU ;
;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
;
;
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 ^APCM2AEH
S APCMGPG=0
S APCMQUIT=""
D SUM
D W^APCM2AEH(" ",0,2,APCMPTYP)
D LIST^APCM2ANP
D W^APCM2AEH(" ",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 ^APCM2AEH
S APCMQUIT=""
D SUM
Q:APCMQUIT
D LIST^APCM2ANP
Q:APCMQUIT
D SAVEDEL^APCM2AEQ
K ^XTMP("APCM1D",APCMJ,APCMH)
K ^TMP($J)
D EOP
Q
WP ;
K ^UTILITY($J,"W")
S APCMZ=0,APCMLCNT=0
S DIWL=1,DIWR=APCMCOL,DIWF="",APCMZ=0 F S APCMZ=$O(^APCM25OB(APCMIC,APCMNODE,APCMY,1,APCMZ)) Q:APCMZ'=+APCMZ D
.S APCMLCNT=APCMLCNT+1
.S X=^APCM25OB(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^APCM2AEH(^UTILITY($J,"W",DIWL,Z,0),0,1,APCMPTYP)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),X
Q
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
Q
;
;
;
SCREEN ;
S X=0 F S X=$O(^TMP($J,"APCMDEL",X)) Q:X'=+X W !,^TMP($J,"APCMDEL",X)
Q
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
Q
;
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
;
;
;
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
;
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^APCM2AEH(X,0,1,APCMPTYP)
I APCMRPTT=1 D W^APCM2AEH("** IHS Modified Stage 2 Meaningful Use Performance Measure Report for EPs **",1,2,APCMPTYP)
I APCMRPTT=2 D W^APCM2AEH("** IHS Modified Stage 2 MU Performance Report for Eligible Hospitals/CAHs **",1,2,APCMPTYP)
I $G(APCMPROV),APCMRPTT=1 S X="Provider Name: "_$$SN^APCM2AEH($P(^VA(200,APCMPROV,0),U,1)) D W^APCM2AEH(X,1,1,APCMPTYP)
I $G(APCMPROV),APCMRPTT=2 S X="Facility Name: "_$P(^DIC(4,APCMPROV,0),U,1) D W^APCM2AEH(X,1,1,APCMPTYP)
I $G(APCMTOT) S X="Aggregate Report for all Selected Providers" D W^APCM2AEH(X,1,1,APCMPTYP)
I APCMRPTT=1 S X="Facility Name: "_$P(^DIC(4,DUZ(2),0),U,1) D W^APCM2AEH(X,1,1,APCMPTYP)
S X="Report Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED) D W^APCM2AEH(X,1,1,APCMPTYP)
S X=$$REPEAT^XLFSTR("-",80) D W^APCM2AEH(X,0,1,APCMPTYP)
Q
;
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(^APCM25OB(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:"")
Q
;
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(^APCMM25C(R,$S(K="I":11,1:12),"B",I,0))
.I 'J S X=0 Q
.S X=$P($G(^APCMM25C(R,$S(K="I":11,1:12),J,N)),U,P)
Q ""
SUM ;summary sheet for each provider
D SUM^APCM2AER
Q
APCM2AEP ; IHS/CMI/LAB - IHS MU ;
+1 ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
+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 ^APCM2AEH
+8 SET APCMGPG=0
+9 SET APCMQUIT=""
+10 DO SUM
+11 DO W^APCM2AEH(" ",0,2,APCMPTYP)
+12 DO LIST^APCM2ANP
+13 DO W^APCM2AEH(" ",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 ^APCM2AEH
+6 SET APCMQUIT=""
+7 DO SUM
+8 IF APCMQUIT
QUIT
+9 DO LIST^APCM2ANP
+10 IF APCMQUIT
QUIT
+11 DO SAVEDEL^APCM2AEQ
+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(^APCM25OB(APCMIC,APCMNODE,APCMY,1,APCMZ))
IF APCMZ'=+APCMZ
QUIT
Begin DoDot:1
+4 SET APCMLCNT=APCMLCNT+1
+5 SET X=^APCM25OB(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^APCM2AEH(^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 ;
+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 ;
+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^APCM2AEH(X,0,1,APCMPTYP)
+3 IF APCMRPTT=1
DO W^APCM2AEH("** IHS Modified Stage 2 Meaningful Use Performance Measure Report for EPs **",1,2,APCMPTYP)
+4 IF APCMRPTT=2
DO W^APCM2AEH("** IHS Modified Stage 2 MU Performance Report for Eligible Hospitals/CAHs **",1,2,APCMPTYP)
+5 IF $GET(APCMPROV)
IF APCMRPTT=1
SET X="Provider Name: "_$$SN^APCM2AEH($PIECE(^VA(200,APCMPROV,0),U,1))
DO W^APCM2AEH(X,1,1,APCMPTYP)
+6 IF $GET(APCMPROV)
IF APCMRPTT=2
SET X="Facility Name: "_$PIECE(^DIC(4,APCMPROV,0),U,1)
DO W^APCM2AEH(X,1,1,APCMPTYP)
+7 IF $GET(APCMTOT)
SET X="Aggregate Report for all Selected Providers"
DO W^APCM2AEH(X,1,1,APCMPTYP)
+8 IF APCMRPTT=1
SET X="Facility Name: "_$PIECE(^DIC(4,DUZ(2),0),U,1)
DO W^APCM2AEH(X,1,1,APCMPTYP)
+9 SET X="Report Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED)
DO W^APCM2AEH(X,1,1,APCMPTYP)
+10 SET X=$$REPEAT^XLFSTR("-",80)
DO W^APCM2AEH(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(^APCM25OB(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(^APCMM25C(R,$SELECT(K="I":11,1:12),"B",I,0))
+7 IF 'J
SET X=0
QUIT
+8 SET X=$PIECE($GET(^APCMM25C(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^APCM2AER
+2 QUIT
