Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCM24EH

APCM24EH.m

Go to the documentation of this file.
APCM24EH ; 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 2 Meaningful Use Performance Measure Report for EPs ***",1,1,APCMPTYP)
 I APCMRPTT=2 D W("** IHS 2014/2015 Stage 2 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^APCM24EH(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^APCM24EH(" ",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^APCM24EH(Y,0,1,APCMPTYP) S Y=""
 I Y]"" D W^APCM24EH(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