APCM13EH ; IHS/CMI/LAB - IHS MU ;
;;1.0;IHS MU PERFORMANCE REPORTS;**2,4,5,6**;MAR 26, 2012;Build 65
;
;
S APCMHPG=0,APCMQUIT=""
D HDR
D ENDTIME
D W(" ",0,1,APCMPTYP)
S APCMNODE=$S(APCMRPTT=1:13,1:16)
S APCMX=0 F S APCMX=$O(^APCMMUCN(APCMRPTC,APCMNODE,APCMX)) Q:APCMX'=+APCMX!(APCMQUIT) D
.I APCMPTYP="P",$Y>(APCMIOSL-2) D HDR Q:APCMQUIT
.D W(^APCMMUCN(APCMRPTC,APCMNODE,APCMX,0),0,1,APCMPTYP)
D W(" ",0,1,APCMPTYP)
K APCMX,APCMQUIT,APCMHPG
Q
HDR ;
G:APCMPTYP'="P" HDR1
G:'APCMHPG HDR1
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
;
HDR1 ;
I APCMHPG W:$D(IOF) @IOF
S APCMHPG=APCMHPG+1
D W("Cover Page",1,$S(APCMPTYP="P":0,1:1),APCMPTYP)
D W("Date Report Run: "_$$FMTE^XLFDT(DT),1,1,APCMPTYP)
D W^APCM13EH("Indian Health Service RPMS Suite (BCER) v1.0",1,2,APCMPTYP)
I APCMRPTT=1 D W("** IHS 2013 Stage 1 Meaningful Use Performance Measure Report for EPs **",1,1,APCMPTYP)
I APCMRPTT=2 D W("** IHS 2013 Stage 1 MU Performance Report for Eligible Hospitals/CAHs **",1,1,APCMPTYP)
D W("Report Generated by: "_$$USR,1,1,APCMPTYP)
D W("Facility Name: "_$P(^DIC(4,$S(APCMRPTT=2:APCMFAC,1:DUZ(2)),0),U),1,1,APCMPTYP)
S X="Report Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED) D W(X,1,1,APCMPTYP)
I $G(APCMWPP) S X="Previous Period: "_$$FMTE^XLFDT(APCMPBD)_" to "_$$FMTE^XLFDT(APCMPED) D W(X,1,1,APCMPTYP)
I APCMHPG'=1 D W^APCM13EH(" ",0,2,APCMPTYP) Q
Q:APCMRPTT=2
S X="Report for:" D W(X,0,2,APCMPTYP)
;S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X D W($P(^VA(200,X,0),U,1),0,1,APCMPTYP,,5)
K K S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S K($P(^VA(200,X,0),U,1))=""
S C=0,T=3,X="",Y=""
F S X=$O(K(X)) Q:X="" D
.I Y="" S $E(Y,3)=$$SN(X) Q
.I Y]"" S $E(Y,40)=$$SN(X) D W^APCM13EH(Y,0,1,APCMPTYP) S Y=""
I Y]"" D W^APCM13EH(Y,0,1,APCMPTYP)
Q
SN(N) ;EP
Q $P(N,",",1)_", "_$P(N,",",2)
ENDTIME ;
I $D(APCMET) S APCMTS=(86400*($P(APCMET,",")-$P(APCMBT,",")))+($P(APCMET,",",2)-$P(APCMBT,",",2)),APCMHR=$P(APCMTS/3600,".") S:APCMHR="" APCMHR=0 D
.S APCMTS=APCMTS-(APCMHR*3600),APCMM=$P(APCMTS/60,".") S:APCMM="" APCMM=0 S APCMTS=APCMTS-(APCMM*60),APCMS=APCMTS D W("RUN TIME (H.M.S): "_APCMHR_"."_APCMM_"."_APCMS,0,2,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
;----------
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(0)="E",DIR("A")="Press enter to continue" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P($P(^(0),U),",",1)_", "_$P($P(^(0),U,1),",",2),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
;;
W(V,C,F,M,P,T) ;EP
NEW X
I $G(F)="" S F=1
I $G(C)="" S C=0
I $G(P)="" S P=1
I $G(T)="" S T=0
I M="P" D Q
.;I $Y>(APCMIOSL-2) D HDR Q:APCMQUIT W:$D(IOF) @IOF
.NEW X
.F X=1:1:F W !
.I C W $$CTR(V,80)
.I 'C W ?T,V
;set up array
I '$G(F) S F=0
NEW %,Z
S Z=""
S %=$P(^TMP($J,"APCMDEL",0),U)
F Z=1:1:F S %=%+1 S ^TMP($J,"APCMDEL",%)=""
S $P(^TMP($J,"APCMDEL",0),U)=%
I '$D(^TMP($J,"APCMDEL",%)) S ^TMP($J,"APCMDEL",%)=""
S $P(^TMP($J,"APCMDEL",%),U,P)=V
Q
APCM13EH ; IHS/CMI/LAB - IHS MU ;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**2,4,5,6**;MAR 26, 2012;Build 65
+2 ;
+3 ;
+4 SET APCMHPG=0
SET APCMQUIT=""
+5 DO HDR
+6 DO ENDTIME
+7 DO W(" ",0,1,APCMPTYP)
+8 SET APCMNODE=$SELECT(APCMRPTT=1:13,1:16)
+9 SET APCMX=0
FOR
SET APCMX=$ORDER(^APCMMUCN(APCMRPTC,APCMNODE,APCMX))
IF APCMX'=+APCMX!(APCMQUIT)
QUIT
Begin DoDot:1
+10 IF APCMPTYP="P"
IF $Y>(APCMIOSL-2)
DO HDR
IF APCMQUIT
QUIT
+11 DO W(^APCMMUCN(APCMRPTC,APCMNODE,APCMX,0),0,1,APCMPTYP)
End DoDot:1
+12 DO W(" ",0,1,APCMPTYP)
+13 KILL APCMX,APCMQUIT,APCMHPG
+14 QUIT
HDR ;
+1 IF APCMPTYP'="P"
GOTO HDR1
+2 IF 'APCMHPG
GOTO HDR1
+3 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
+4 ;
HDR1 ;
+1 IF APCMHPG
IF $DATA(IOF)
WRITE @IOF
+2 SET APCMHPG=APCMHPG+1
+3 DO W("Cover Page",1,$SELECT(APCMPTYP="P":0,1:1),APCMPTYP)
+4 DO W("Date Report Run: "_$$FMTE^XLFDT(DT),1,1,APCMPTYP)
+5 DO W^APCM13EH("Indian Health Service RPMS Suite (BCER) v1.0",1,2,APCMPTYP)
+6 IF APCMRPTT=1
DO W("** IHS 2013 Stage 1 Meaningful Use Performance Measure Report for EPs **",1,1,APCMPTYP)
+7 IF APCMRPTT=2
DO W("** IHS 2013 Stage 1 MU Performance Report for Eligible Hospitals/CAHs **",1,1,APCMPTYP)
+8 DO W("Report Generated by: "_$$USR,1,1,APCMPTYP)
+9 DO W("Facility Name: "_$PIECE(^DIC(4,$SELECT(APCMRPTT=2:APCMFAC,1:DUZ(2)),0),U),1,1,APCMPTYP)
+10 SET X="Report Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED)
DO W(X,1,1,APCMPTYP)
+11 IF $GET(APCMWPP)
SET X="Previous Period: "_$$FMTE^XLFDT(APCMPBD)_" to "_$$FMTE^XLFDT(APCMPED)
DO W(X,1,1,APCMPTYP)
+12 IF APCMHPG'=1
DO W^APCM13EH(" ",0,2,APCMPTYP)
QUIT
+13 IF APCMRPTT=2
QUIT
+14 SET X="Report for:"
DO W(X,0,2,APCMPTYP)
+15 ;S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X D W($P(^VA(200,X,0),U,1),0,1,APCMPTYP,,5)
+16 KILL K
SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET K($PIECE(^VA(200,X,0),U,1))=""
+17 SET C=0
SET T=3
SET X=""
SET Y=""
+18 FOR
SET X=$ORDER(K(X))
IF X=""
QUIT
Begin DoDot:1
+19 IF Y=""
SET $EXTRACT(Y,3)=$$SN(X)
QUIT
+20 IF Y]""
SET $EXTRACT(Y,40)=$$SN(X)
DO W^APCM13EH(Y,0,1,APCMPTYP)
SET Y=""
End DoDot:1
+21 IF Y]""
DO W^APCM13EH(Y,0,1,APCMPTYP)
+22 QUIT
SN(N) ;EP
+1 QUIT $PIECE(N,",",1)_", "_$PIECE(N,",",2)
ENDTIME ;
+1 IF $DATA(APCMET)
SET APCMTS=(86400*($PIECE(APCMET,",")-$PIECE(APCMBT,",")))+($PIECE(APCMET,",",2)-$PIECE(APCMBT,",",2))
SET APCMHR=$PIECE(APCMTS/3600,".")
IF APCMHR=""
SET APCMHR=0
Begin DoDot:1
+2 SET APCMTS=APCMTS-(APCMHR*3600)
SET APCMM=$PIECE(APCMTS/60,".")
IF APCMM=""
SET APCMM=0
SET APCMTS=APCMTS-(APCMM*60)
SET APCMS=APCMTS
DO W("RUN TIME (H.M.S): "_APCMHR_"."_APCMM_"."_APCMS,0,2,APCMPTYP)
End DoDot:1
+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 DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^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($PIECE(^(0),U),",",1)_", "_$PIECE($PIECE(^(0),U,1),",",2),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
+3 ;;
W(V,C,F,M,P,T) ;EP
+1 NEW X
+2 IF $GET(F)=""
SET F=1
+3 IF $GET(C)=""
SET C=0
+4 IF $GET(P)=""
SET P=1
+5 IF $GET(T)=""
SET T=0
+6 IF M="P"
Begin DoDot:1
+7 ;I $Y>(APCMIOSL-2) D HDR Q:APCMQUIT W:$D(IOF) @IOF
+8 NEW X
+9 FOR X=1:1:F
WRITE !
+10 IF C
WRITE $$CTR(V,80)
+11 IF 'C
WRITE ?T,V
End DoDot:1
QUIT
+12 ;set up array
+13 IF '$GET(F)
SET F=0
+14 NEW %,Z
+15 SET Z=""
+16 SET %=$PIECE(^TMP($JOB,"APCMDEL",0),U)
+17 FOR Z=1:1:F
SET %=%+1
SET ^TMP($JOB,"APCMDEL",%)=""
+18 SET $PIECE(^TMP($JOB,"APCMDEL",0),U)=%
+19 IF '$DATA(^TMP($JOB,"APCMDEL",%))
SET ^TMP($JOB,"APCMDEL",%)=""
+20 SET $PIECE(^TMP($JOB,"APCMDEL",%),U,P)=V
+21 QUIT
