- APCM14EH ; IHS/CMI/LAB - IHS MU ;
- ;;1.0;IHS MU PERFORMANCE REPORTS;**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("Indian Health Service RPMS Suite (BCER) v2.0",1,2,APCMPTYP)
- I APCMRPTT=1 D W("*** IHS 2014/2015 Stage 1 Meaningful Use Performance Measure Report for EPs ***",1,1,APCMPTYP)
- I APCMRPTT=2 D W("** IHS 2014/2015 Stage 1 MU Performance Report for Eligible Hospitals/CAHs **",1,1,APCMPTYP)
- D W("Report Generated by: "_$$USR,1,1,APCMPTYP)
- I APCMRPTT=2 S X="Method: "_$S(APCMMETH="E":"All Emergency Department",1:"Observation") D W^APCM14EH(X,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 APCMHPG'=1 D W^APCM14EH(" ",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^APCM14EH(Y,0,1,APCMPTYP) S Y=""
- I Y]"" D W^APCM14EH(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
- APCM14EH ; IHS/CMI/LAB - IHS MU ;
- +1 ;;1.0;IHS MU PERFORMANCE REPORTS;**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 ;S APCMNODE=$S(APCMRPTT=1:13,1:16)
- +9 ;S APCMX=0 F S APCMX=$O(^APCMMUCN(APCMRPTC,APCMNODE,APCMX)) Q:APCMX'=+APCMX!(APCMQUIT) D
- +10 ;.I APCMPTYP="P",$Y>(APCMIOSL-2) D HDR Q:APCMQUIT
- +11 ;.D W(^APCMMUCN(APCMRPTC,APCMNODE,APCMX,0),0,1,APCMPTYP)
- +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("Indian Health Service RPMS Suite (BCER) v2.0",1,2,APCMPTYP)
- +6 IF APCMRPTT=1
- DO W("*** IHS 2014/2015 Stage 1 Meaningful Use Performance Measure Report for EPs ***",1,1,APCMPTYP)
- +7 IF APCMRPTT=2
- DO W("** IHS 2014/2015 Stage 1 MU Performance Report for Eligible Hospitals/CAHs **",1,1,APCMPTYP)
- +8 DO W("Report Generated by: "_$$USR,1,1,APCMPTYP)
- +9 IF APCMRPTT=2
- SET X="Method: "_$SELECT(APCMMETH="E":"All Emergency Department",1:"Observation")
- DO W^APCM14EH(X,1,1,APCMPTYP)
- +10 DO W("Facility Name: "_$PIECE(^DIC(4,$SELECT(APCMRPTT=2:APCMFAC,1:DUZ(2)),0),U),1,1,APCMPTYP)
- +11 SET X="Report Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED)
- DO W(X,1,1,APCMPTYP)
- +12 IF APCMHPG'=1
- DO W^APCM14EH(" ",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^APCM14EH(Y,0,1,APCMPTYP)
- SET Y=""
- End DoDot:1
- +21 IF Y]""
- DO W^APCM14EH(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
