APCM25ER ;IHS/CMI/LAB - IHS MU REPORT;
;;1.0;MU PERFORMANCE REPORTS;**7,8,10**;MAR 26, 2012;Build 31
;
;
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) ;
S X3=""
I X'?.N Q $$LBLK^APCLUTL(X,7)
D COMMA^%DTC
S X=$$STRIP^XLFSTR(X," ")
Q $$LBLK^APCLUTL(X,7)
;
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" D ^DIR
Q
;----------
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)
Q:$P(^APCM25OB(APCMIC,0),U,6)="A" ;no % on attestation measures
S APCMCYP=$S(APCMCYD:((APCMCYN/APCMCYD)*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 T=1 D Q X
.S J=$O(^APCMM25C(R,11,"B",I,0))
.I 'J S X=0 Q
.S X=$P($G(^APCMM25C(R,11,J,N)),U,P)
Q ""
SUM ;EP - summary sheet PER PROV
K APCMTOT
K APCMPROV
S APCMGPG=0
S APCMQUIT=""
I APCMRPTT=2 G SUMHOS
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S APCMPROV($P(^VA(200,X,0),U),X)=""
S APCMPNAM="" F S APCMPNAM=$O(APCMPROV(APCMPNAM)) Q:APCMPNAM=""!(APCMQUIT) D
.S APCMPROV=0 F S APCMPROV=$O(APCMPROV(APCMPNAM,APCMPROV)) Q:APCMPROV=""!(APCMQUIT) D SUM1,W^APCM25EH(" ",0,0,APCMPTYP) D
..D W^APCM25EH("* Indicates Public Health Performance Measure.",0,1,APCMPTYP) ; At least one must be",0,1,APCMPTYP),W^APCM25EH("selected in the Menu Set options.",0,1,APCMPTYP),W^APCM25EH(" ",0,1,APCMPTYP),W^APCM25EH(" ",0,1,APCMPTYP)
..D W^APCM25EH("+ Indicates Yes/No Attestation Measure. The Yes or No displayed in the",0,1,APCMPTYP)
..D W^APCM25EH(" Current Rate Column is based on user input when generating the report.",0,1,APCMPTYP)
Q
SUMHOS ;
S APCMPNAM=$P(^DIC(4,APCMFAC,0),U,1)
S APCMPROV=APCMFAC
D SUM1
D W^APCM25EH("* Indicates Public Health Performance Measure.",0,1,APCMPTYP)
D W^APCM25EH("+ Indicates Yes/No Attestation Measure. The Yes or No displayed in the",0,1,APCMPTYP)
D W^APCM25EH(" Current Rate Column is based on user input when generating the report.",0,1,APCMPTYP)
Q
;
SUM1 ;
K APCMINDO
S X=0 F S X=$O(APCMIND(X)) Q:X'=+X D
.S C="A"
.S O=$P(^APCM25OB(X,0),U,10)
.I O="" Q ;not on summary sheet
.S APCMINDO(C,O,X)=""
S APCMCM="" I APCMPTYP="P" D SUMH
I APCMPTYP="D" D
.D W^APCM25EH("Indian Health Service RPMS Suite (BCER) v2.0",0,2,APCMPTYP)
.S X="MODIFIED STAGE 2 "_$S(APCMRPTT=1:"EP ",1:"HOSPITAL ")_"MEANINGFUL USE PERFORMANCE REPORT SUMMARY" D W^APCM25EH(X,0,1,APCMPTYP)
.S X="Summary Report for "_APCMPNAM D W^APCM25EH(X,0,2,APCMPTYP)
.S X="Performance Measure^Target^Current Rate^Num^Den^Excl Met" D W^APCM25EH(X,0,2,APCMPTYP)
S APCMCM="" F S APCMCM=$O(APCMINDO(APCMCM)) Q:APCMCM=""!(APCMQUIT) D
.I APCMCM="M" D
..I APCMPTYP="P" D SUMH
..I APCMPTYP="D" D
.S APCMMO=0 F S APCMMO=$O(APCMINDO(APCMCM,APCMMO)) Q:APCMMO=""!(APCMQUIT) D
..S APCMIC=0 F S APCMIC=$O(APCMINDO(APCMCM,APCMMO,APCMIC)) Q:APCMIC=""!(APCMQUIT) D SUM2
D W^APCM25EH(" ",0,1,APCMPTYP)
Q
SUM2 ;
I APCMPTYP="P",APCMGPG=0 D SUMH Q:APCMQUIT
I APCMPTYP="P",$Y>(APCMIOSL-4) D SUMH Q:APCMQUIT
I $P(^APCM25OB(APCMIC,0),U,1)="S2.026.EP" D SEM^APCM25EA Q ;special printing for sem
;SHOULD THIS LINE BE ALL N/As?
S F=$P(^APCM25OB(APCMIC,0),U,18)
I F]"" D I APCME="X" Q
.S APCMNP=$P(^DD(9001304.0311,F,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
.S APCME=$$V^APCM25ER(1,APCMRPT,N,P,APCMPROV,"I",APCMRPTT)
.Q:APCME'="X"
SUM21 .;
.I APCMPTYP="P" D
..I APCMMO["." D W^APCM25EH(" "_$E($P(^APCM25OB(APCMIC,0),U,14),1,28)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP) I 1
..E D W^APCM25EH($S($L(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$E($P(^APCM25OB(APCMIC,0),U,14),1,28)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP)
..D W^APCM25EH("N/A",0,0,APCMPTYP,,36)
..D W^APCM25EH($$LBLK^APCLUTL("N/A",8),0,0,APCMPTYP,,43)
..D W^APCM25EH($$LBLK^APCLUTL("N/A",7),0,0,APCMPTYP,,55)
..D W^APCM25EH($$LBLK^APCLUTL("N/A",7),0,0,APCMPTYP,,65)
..;D W^APCM25EH("N/A",0,0,APCMPTYP,,76)
..S APCMEF=$P(^APCM25OB(APCMIC,0),U,11)
..I APCMEF]"" D
...S APCMNP=$P(^DD(9001304.0311,APCMEF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
...S APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
...D W^APCM25EH($S(APCMEV]"":APCMEV,1:"N/A"),0,0,APCMPTYP,,76)
..I APCMEF="" D W^APCM25EH("N/A",0,0,APCMPTYP,,76)
.I APCMPTYP="D" D
..I APCMMO["." S APCMX=" "_$P(^APCM25OB(APCMIC,0),U,14)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"") I 1
..E S APCMX=$P(^APCM25OB(APCMIC,0),U,14)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
..S APCMX=APCMX_U_"N/A"_U_"N/A"_U_"N/A"_U_"N/A"
..S APCMEF=$P(^APCM25OB(APCMIC,0),U,11)
..I APCMEF]"" D
...S APCMNP=$P(^DD(9001304.0311,APCMEF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
...S APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
...S APCMX=APCMX_U_$S(APCMEV]"":APCMEV,1:"N/A")
..I APCMEF="" S APCMX=APCMX_U_"N/A"
..D W^APCM25EH(APCMX,0,2,APCMPTYP,1)
I $P(^APCM25OB(APCMIC,0),U,19)]"" G WSUM
S APCMDF=$P(^APCM25OB(APCMIC,0),U,8)
;get DENOMINATOR value
S APCMNP=$P(^DD(9001304.0311,APCMDF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
S APCMCYD=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
I $P(^APCM25OB(APCMIC,0),U,6)="A" S (APCMPRN,APCMCYN)="" G WSUM
S APCMNF=$P(^APCM25OB(APCMIC,0),U,9)
;numerator field
S APCMNP=$P(^DD(9001304.0311,APCMNF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
D SETN
WSUM ;write out line
I APCMPTYP="P",$Y>(APCMIOSL-2) D SUMH Q:APCMQUIT
I APCMPTYP="P" D
.;LABEL
.I APCMMO["." D W^APCM25EH(" "_$E($P(^APCM25OB(APCMIC,0),U,14),1,28)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP) I 1
.E D
..I $P($G(^APCM25OB(APCMIC,12)),U,6)]"" D
...D W^APCM25EH($S($L(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$E($P(^APCM25OB(APCMIC,12),U,6),1,28),0,2,APCMPTYP)
...D W^APCM25EH(" "_$E($P(^APCM25OB(APCMIC,0),U,14),1,28)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP)
..I $P($G(^APCM25OB(APCMIC,12)),U,6)="",$P(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP" D W^APCM25EH($S($L(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$E($P(^APCM25OB(APCMIC,0),U,14),1,28)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,2,APCMPTYP)
..I $P($G(^APCM25OB(APCMIC,12)),U,6)="",$P(^APCM25OB(APCMIC,0),U,1)="S2.026.EP" D W^APCM25EH($S($L(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$E($P(^APCM25OB(APCMIC,0),U,14),1,28),0,2,APCMPTYP)
.;if summary category then skip rest
.Q:$P(^APCM25OB(APCMIC,0),U,19)]""
.I $P($G(^APCM25OB(APCMIC,12)),U,4) D Q
..I $E(APCMPER,1,3)=315 D W^APCM25EH($P($G(^APCM25OB(APCMIC,12)),U,1),0,0,APCMPTYP,,35) D NUMRATE
..I $P(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP" D
...I $E(APCMPER,1,3)=316 D W^APCM25EH($P($G(^APCM25OB(APCMIC,12)),U,2),0,0,APCMPTYP,,35) D NUMRATE
...I $E(APCMPER,1,3)>316 D W^APCM25EH($P($G(^APCM25OB(APCMIC,12)),U,3),0,0,APCMPTYP,,35) D RATE
.;TARGET
.S T=$S($E(APCMPER,1,3)=315:1,$E(APCMPER,1,3)=316:2,$E(APCMPER,1,3)>316:3,1:1)
.D W^APCM25EH($P($G(^APCM25OB(APCMIC,12)),U,T),0,0,APCMPTYP,,35)
RATE .;RATE
.I $P(^APCM25OB(APCMIC,0),U,6)="A" D W^APCM25EH($S(APCMCYD]"":$$LBLK^APCLUTL(APCMCYD,8),1:$$LBLK^APCLUTL("N/A",8)),0,0,APCMPTYP,,42)
.I $P(^APCM25OB(APCMIC,0),U,6)'="A" D W^APCM25EH($J(APCMCYP,8,2)_"%",0,0,APCMPTYP,,42)
.;NUMERATOR/DENOMINATOR
.D W^APCM25EH($S($P(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYN'?.N:" N/A",1:$$C(APCMCYN,0,9)),0,0,APCMPTYP,,55)
.D W^APCM25EH($S($P(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYD'?.N:" N/A",1:$$C(APCMCYD,0,9)),0,0,APCMPTYP,,65)
.;EXCL MET?
.S APCMEF=$P(^APCM25OB(APCMIC,0),U,11)
.I APCMEF]"" D
..S APCMNP=$P(^DD(9001304.0311,APCMEF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
..S APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
..D W^APCM25EH($S(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No"),0,0,APCMPTYP,,76)
.I APCMEF="" D W^APCM25EH("N/A",0,0,APCMPTYP,,76)
.I $P(^APCM25OB(APCMIC,0),U,1)="S2.020.EP.1"!($P(^APCM25OB(APCMIC,0),U,1)="S2.025.H.1"),$P(APCMVDTE,U,1)=1 D
..D W^APCM25EH("Note: PHR Server access failed during report generation "_$P(APCMSEME,U,2)_" which may",0,1,APCMPTYP,,0)
..D W^APCM25EH("have affected the numerator results for this measure. Contact your IT staff to",0,1,APCMPTYP,,0)
..D W^APCM25EH("resolve the error and then regenerate the report again to obtain accurate",0,1,APCMPTYP,,0)
..D W^APCM25EH("results.",0,1,APCMPTYP,,0)
D I APCMPTYP="D" D
.K R
.I APCMMO["." S APCMX=" "_$P(^APCM25OB(APCMIC,0),U,14)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"") I 1
.E D
..I $P($G(^APCM25OB(APCMIC,12)),U,6)]"" D
...S APCMX="" S $P(APCMX,U,1)=$P(^APCM25OB(APCMIC,12),U,6) D W^APCM25EH(APCMX,0,2,APCMPTYP,1)
...I $P(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP" S APCMX=" "_$P(^APCM25OB(APCMIC,0),U,14)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
...I $P(^APCM25OB(APCMIC,0),U,1)="S2.026.EP" S APCMX=" "_$P(^APCM25OB(APCMIC,0),U,14)
..I $P($G(^APCM25OB(APCMIC,12)),U,6)="",$P(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP" S APCMX=$P(^APCM25OB(APCMIC,0),U,14)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
..I $P($G(^APCM25OB(APCMIC,12)),U,6)="",$P(^APCM25OB(APCMIC,0),U,1)="S2.026.EP" S APCMX=$P(^APCM25OB(APCMIC,0),U,14)
.;if summary category then skip rest
.Q:$P(^APCM25OB(APCMIC,0),U,19)]""
.;TARGet
.I $P($G(^APCM25OB(APCMIC,12)),U,4) D Q
..;D W^APCM25EH(" ",0,1,APCMPTYP,1)
..I $E(APCMPER,1,3)=315 S APCMX=APCMX_U_$P($G(^APCM25OB(APCMIC,12)),U,1) S R=1 D NUMRATED
..I $P(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP" D
...I $E(APCMPER,1,3)=316 S APCMX=APCMX_U_$P($G(^APCM25OB(APCMIC,12)),U,2) S R=1 D NUMRATED
...I $E(APCMPER,1,3)=317 S APCMX=APCMX_U_$P($G(^APCM25OB(APCMIC,12)),U,3) S R=1 D RATED
...I $E(APCMPER,1,3)>317 S APCMX=APCMX_U_$P($G(^APCM25OB(APCMIC,12)),U,7) S R=1 D RATED
..I $P(^APCM25OB(APCMIC,0),U,1)="S2.026.EP" D
...S APCMX="" S $P(APCMX,U,1)=" 2016"_U_$P($G(^APCM25OB(APCMIC,12)),U,2) S R=1
...F I=3,4,5 S $P(APCMX,U,I)=0
...D EXD
...S APCMX="" S $P(APCMX,U,1)=" 2016"_U_$P($G(^APCM25OB(APCMIC,12)),U,2) S R=1
...F I=3,4,5 S $P(APCMX,U,I)=0
...D EXD
.S R=2
.S $P(APCMX,U,2)=$G(^APCM25OB(APCMIC,13,1,0))
RATED .;current rate
.I $P(^APCM25OB(APCMIC,0),U,6)="A" S $P(APCMX,U,3)=$S(APCMCYD]"":APCMCYD,1:"N/A")
.I $P(^APCM25OB(APCMIC,0),U,6)'="A" S $P(APCMX,U,3)=$$SB($J(APCMCYP,6,2))_"%"
.;numerator denominator
.S $P(APCMX,U,4)=$S($P(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYN)
.S $P(APCMX,U,5)=$S($P(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYD)
.S APCMEF=$P(^APCM25OB(APCMIC,0),U,11)
EXD .;EXCLUSION MET?
.I APCMEF]"" D
..S APCMNP=$P(^DD(9001304.0311,APCMEF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
..S APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
..S $P(APCMX,U,6)=$S(APCMEV="N/A":APCMEV,APCMEV]"":"Yes",1:"No") ;IHS/CMI/LAB - fix display
.I APCMEF="" S $P(APCMX,U,6)="N/A"
.D W^APCM25EH(APCMX,0,R,APCMPTYP,1)
.I $P(^APCM25OB(APCMIC,0),U,1)="S2.020.EP.1"!($P(^APCM25OB(APCMIC,0),U,1)="S2.025.H.1"),$P(APCMVDTE,U,1)=1 D
..D W^APCM25EH("Note: PHR Server access failed during report generation "_$P(APCMSEME,U,2)_" which may",0,1,APCMPTYP,1)
..D W^APCM25EH("have affected the numerator results for this measure. Contact your IT staff to",0,1,APCMPTYP,1)
..D W^APCM25EH("resolve the error and then regenerate the report again to obtain accurate results.",0,1,APCMPTYP,1)
Q
SUMH ;
G:'APCMGPG SUMH1
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
;
SUMH1 ;
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^APCM25EH(X,0,1,APCMPTYP)
D W^APCM25EH("Indian Health Service RPMS Suite (BCER) v2.0",1,2,APCMPTYP)
I $G(APCMPROV),APCMRPTT=1 S X="Provider Name: "_$$SN^APCM25EH($P(^VA(200,APCMPROV,0),U,1)) D W^APCM25EH(X,1,1,APCMPTYP)
I APCMRPTT=2 S X="Method: "_$S(APCMMETH="E":"All Emergency Department",1:"Observation") D W^APCM25EH(X,1,1,APCMPTYP)
I $G(APCMPROV),APCMRPTT=2 S X="Facility: "_$P(^DIC(4,APCMPROV,0),U,1) D W^APCM25EH(X,1,1,APCMPTYP)
S X="Report Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED) D W^APCM25EH(X,1,1,APCMPTYP)
S X=$$REPEAT^XLFSTR("-",80) D W^APCM25EH(X,0,1,APCMPTYP)
D W^APCM25EH("MODIFIED STAGE 2 "_$S(APCMRPTT=1:"EP ",1:"EH ")_"MEANINGFUL USE PERFORMANCE REPORT SUMMARY",1,1,APCMPTYP)
S X=$$REPEAT^XLFSTR("-",80) D W^APCM25EH(X,0,1,APCMPTYP)
S X="",$E(X,45)="Current",$E(X,76)="Excl" D W^APCM25EH(X,0,1,APCMPTYP)
S X="",X="Performance Measures",$E(X,35)="Target",$E(X,45)="Rate",$E(X,59)="Num",$E(X,69)="Den",$E(X,76)="Met" D W^APCM25EH(X,0,1,APCMPTYP)
D W^APCM25EH($$REPEAT^XLFSTR("-",80),0,1,APCMPTYP)
Q
NUMRATE ;RATE
I $P(^APCM25OB(APCMIC,0),U,6)="A" D W^APCM25EH($S(APCMCYD]"":$$LBLK^APCLUTL(APCMCYD,8),1:$$LBLK^APCLUTL("N/A",8)),0,0,APCMPTYP,,42)
I $P(^APCM25OB(APCMIC,0),U,6)'="A" D W^APCM25EH($$C(APCMCYN,0,9),0,0,APCMPTYP,,42)
;NUMERATOR/DENOMINATOR
D W^APCM25EH($S($P(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYN'?.N:" N/A",1:$$C(APCMCYN,0,9)),0,0,APCMPTYP,,55)
D W^APCM25EH($S($P(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYD'?.N:" N/A",1:$$C(APCMCYD,0,9)),0,0,APCMPTYP,,65)
EX ;EXCL MET?
S APCMEF=$P(^APCM25OB(APCMIC,0),U,11)
I APCMEF]"" D
.S APCMNP=$P(^DD(9001304.0311,APCMEF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
.S APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
.D W^APCM25EH($S(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No"),0,0,APCMPTYP,,76)
I APCMEF="" D W^APCM25EH("N/A",0,0,APCMPTYP,,76)
Q
NUMRATED ;current rate
D
.I $P(^APCM25OB(APCMIC,0),U,6)="A" S $P(APCMX,U,3)=$S(APCMCYD]"":APCMCYD,1:"N/A")
.I $P(^APCM25OB(APCMIC,0),U,6)'="A" S $P(APCMX,U,3)=$S($P(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYN)
.;numerator denominator
.S $P(APCMX,U,4)=$S($P(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYN)
.S $P(APCMX,U,5)=$S($P(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYD)
.S APCMEF=$P(^APCM25OB(APCMIC,0),U,11)
.;EXCLUSION MET?
.I APCMEF]"" D
..S APCMNP=$P(^DD(9001304.0311,APCMEF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
..S APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
..S $P(APCMX,U,6)=$S(APCMEV="N/A":APCMEV,APCMEV]"":"Yes",1:"No") ;IHS/CMI/LAB - fix display
.I APCMEF="" S $P(APCMX,U,6)="N/A"
.D W^APCM25EH(APCMX,0,R,APCMPTYP,1)
Q
APCM25ER ;IHS/CMI/LAB - IHS MU REPORT;
+1 ;;1.0;MU PERFORMANCE REPORTS;**7,8,10**;MAR 26, 2012;Build 31
+2 ;
+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 SET X3=""
+2 IF X'?.N
QUIT $$LBLK^APCLUTL(X,7)
+3 DO COMMA^%DTC
+4 SET X=$$STRIP^XLFSTR(X," ")
+5 QUIT $$LBLK^APCLUTL(X,7)
+6 ;
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"
DO ^DIR
+6 QUIT
+7 ;----------
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 ;
SETN ;EP - set numerator fields
+1 SET APCMCYN=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+2 ;no % on attestation measures
IF $PIECE(^APCM25OB(APCMIC,0),U,6)="A"
QUIT
+3 SET APCMCYP=$SELECT(APCMCYD:((APCMCYN/APCMCYD)*100),1:"")
+4 QUIT
+5 ;
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 T=1
Begin DoDot:1
+5 SET J=$ORDER(^APCMM25C(R,11,"B",I,0))
+6 IF 'J
SET X=0
QUIT
+7 SET X=$PIECE($GET(^APCMM25C(R,11,J,N)),U,P)
End DoDot:1
QUIT X
+8 QUIT ""
SUM ;EP - summary sheet PER PROV
+1 KILL APCMTOT
+2 KILL APCMPROV
+3 SET APCMGPG=0
+4 SET APCMQUIT=""
+5 IF APCMRPTT=2
GOTO SUMHOS
+6 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMPROV($PIECE(^VA(200,X,0),U),X)=""
+7 SET APCMPNAM=""
FOR
SET APCMPNAM=$ORDER(APCMPROV(APCMPNAM))
IF APCMPNAM=""!(APCMQUIT)
QUIT
Begin DoDot:1
+8 SET APCMPROV=0
FOR
SET APCMPROV=$ORDER(APCMPROV(APCMPNAM,APCMPROV))
IF APCMPROV=""!(APCMQUIT)
QUIT
DO SUM1
DO W^APCM25EH(" ",0,0,APCMPTYP)
Begin DoDot:2
+9 ; At least one must be",0,1,APCMPTYP),W^APCM25EH("selected in the Menu Set options.",0,1,APCMPTYP),W^APCM25EH(" ",0,1,APCMPTYP),W^APCM25EH(" ",0,1,APCMPTYP)
DO W^APCM25EH("* Indicates Public Health Performance Measure.",0,1,APCMPTYP)
+10 DO W^APCM25EH("+ Indicates Yes/No Attestation Measure. The Yes or No displayed in the",0,1,APCMPTYP)
+11 DO W^APCM25EH(" Current Rate Column is based on user input when generating the report.",0,1,APCMPTYP)
End DoDot:2
End DoDot:1
+12 QUIT
SUMHOS ;
+1 SET APCMPNAM=$PIECE(^DIC(4,APCMFAC,0),U,1)
+2 SET APCMPROV=APCMFAC
+3 DO SUM1
+4 DO W^APCM25EH("* Indicates Public Health Performance Measure.",0,1,APCMPTYP)
+5 DO W^APCM25EH("+ Indicates Yes/No Attestation Measure. The Yes or No displayed in the",0,1,APCMPTYP)
+6 DO W^APCM25EH(" Current Rate Column is based on user input when generating the report.",0,1,APCMPTYP)
+7 QUIT
+8 ;
SUM1 ;
+1 KILL APCMINDO
+2 SET X=0
FOR
SET X=$ORDER(APCMIND(X))
IF X'=+X
QUIT
Begin DoDot:1
+3 SET C="A"
+4 SET O=$PIECE(^APCM25OB(X,0),U,10)
+5 ;not on summary sheet
IF O=""
QUIT
+6 SET APCMINDO(C,O,X)=""
End DoDot:1
+7 SET APCMCM=""
IF APCMPTYP="P"
DO SUMH
+8 IF APCMPTYP="D"
Begin DoDot:1
+9 DO W^APCM25EH("Indian Health Service RPMS Suite (BCER) v2.0",0,2,APCMPTYP)
+10 SET X="MODIFIED STAGE 2 "_$SELECT(APCMRPTT=1:"EP ",1:"HOSPITAL ")_"MEANINGFUL USE PERFORMANCE REPORT SUMMARY"
DO W^APCM25EH(X,0,1,APCMPTYP)
+11 SET X="Summary Report for "_APCMPNAM
DO W^APCM25EH(X,0,2,APCMPTYP)
+12 SET X="Performance Measure^Target^Current Rate^Num^Den^Excl Met"
DO W^APCM25EH(X,0,2,APCMPTYP)
End DoDot:1
+13 SET APCMCM=""
FOR
SET APCMCM=$ORDER(APCMINDO(APCMCM))
IF APCMCM=""!(APCMQUIT)
QUIT
Begin DoDot:1
+14 IF APCMCM="M"
Begin DoDot:2
+15 IF APCMPTYP="P"
DO SUMH
+16 IF APCMPTYP="D"
Begin DoDot:3
End DoDot:3
End DoDot:2
+17 SET APCMMO=0
FOR
SET APCMMO=$ORDER(APCMINDO(APCMCM,APCMMO))
IF APCMMO=""!(APCMQUIT)
QUIT
Begin DoDot:2
+18 SET APCMIC=0
FOR
SET APCMIC=$ORDER(APCMINDO(APCMCM,APCMMO,APCMIC))
IF APCMIC=""!(APCMQUIT)
QUIT
DO SUM2
End DoDot:2
End DoDot:1
+19 DO W^APCM25EH(" ",0,1,APCMPTYP)
+20 QUIT
SUM2 ;
+1 IF APCMPTYP="P"
IF APCMGPG=0
DO SUMH
IF APCMQUIT
QUIT
+2 IF APCMPTYP="P"
IF $Y>(APCMIOSL-4)
DO SUMH
IF APCMQUIT
QUIT
+3 ;special printing for sem
IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.026.EP"
DO SEM^APCM25EA
QUIT
+4 ;SHOULD THIS LINE BE ALL N/As?
+5 SET F=$PIECE(^APCM25OB(APCMIC,0),U,18)
+6 IF F]""
Begin DoDot:1
+7 SET APCMNP=$PIECE(^DD(9001304.0311,F,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+8 SET APCME=$$V^APCM25ER(1,APCMRPT,N,P,APCMPROV,"I",APCMRPTT)
+9 IF APCME'="X"
QUIT
SUM21 ;
+1 IF APCMPTYP="P"
Begin DoDot:2
+2 IF APCMMO["."
DO W^APCM25EH(" "_$EXTRACT($PIECE(^APCM25OB(APCMIC,0),U,14),1,28)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP)
IF 1
+3 IF '$TEST
DO W^APCM25EH($SELECT($LENGTH(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$EXTRACT($PIECE(^APCM25OB(APCMIC,0),U,14),1,28)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP)
+4 DO W^APCM25EH("N/A",0,0,APCMPTYP,,36)
+5 DO W^APCM25EH($$LBLK^APCLUTL("N/A",8),0,0,APCMPTYP,,43)
+6 DO W^APCM25EH($$LBLK^APCLUTL("N/A",7),0,0,APCMPTYP,,55)
+7 DO W^APCM25EH($$LBLK^APCLUTL("N/A",7),0,0,APCMPTYP,,65)
+8 ;D W^APCM25EH("N/A",0,0,APCMPTYP,,76)
+9 SET APCMEF=$PIECE(^APCM25OB(APCMIC,0),U,11)
+10 IF APCMEF]""
Begin DoDot:3
+11 SET APCMNP=$PIECE(^DD(9001304.0311,APCMEF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+12 SET APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+13 DO W^APCM25EH($SELECT(APCMEV]"":APCMEV,1:"N/A"),0,0,APCMPTYP,,76)
End DoDot:3
+14 IF APCMEF=""
DO W^APCM25EH("N/A",0,0,APCMPTYP,,76)
End DoDot:2
+15 IF APCMPTYP="D"
Begin DoDot:2
+16 IF APCMMO["."
SET APCMX=" "_$PIECE(^APCM25OB(APCMIC,0),U,14)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
IF 1
+17 IF '$TEST
SET APCMX=$PIECE(^APCM25OB(APCMIC,0),U,14)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
+18 SET APCMX=APCMX_U_"N/A"_U_"N/A"_U_"N/A"_U_"N/A"
+19 SET APCMEF=$PIECE(^APCM25OB(APCMIC,0),U,11)
+20 IF APCMEF]""
Begin DoDot:3
+21 SET APCMNP=$PIECE(^DD(9001304.0311,APCMEF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+22 SET APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+23 SET APCMX=APCMX_U_$SELECT(APCMEV]"":APCMEV,1:"N/A")
End DoDot:3
+24 IF APCMEF=""
SET APCMX=APCMX_U_"N/A"
+25 DO W^APCM25EH(APCMX,0,2,APCMPTYP,1)
End DoDot:2
End DoDot:1
IF APCME="X"
QUIT
+26 IF $PIECE(^APCM25OB(APCMIC,0),U,19)]""
GOTO WSUM
+27 SET APCMDF=$PIECE(^APCM25OB(APCMIC,0),U,8)
+28 ;get DENOMINATOR value
+29 SET APCMNP=$PIECE(^DD(9001304.0311,APCMDF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+30 SET APCMCYD=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+31 IF $PIECE(^APCM25OB(APCMIC,0),U,6)="A"
SET (APCMPRN,APCMCYN)=""
GOTO WSUM
+32 SET APCMNF=$PIECE(^APCM25OB(APCMIC,0),U,9)
+33 ;numerator field
+34 SET APCMNP=$PIECE(^DD(9001304.0311,APCMNF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+35 DO SETN
WSUM ;write out line
+1 IF APCMPTYP="P"
IF $Y>(APCMIOSL-2)
DO SUMH
IF APCMQUIT
QUIT
+2 IF APCMPTYP="P"
Begin DoDot:1
+3 ;LABEL
+4 IF APCMMO["."
DO W^APCM25EH(" "_$EXTRACT($PIECE(^APCM25OB(APCMIC,0),U,14),1,28)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP)
IF 1
+5 IF '$TEST
Begin DoDot:2
+6 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,6)]""
Begin DoDot:3
+7 DO W^APCM25EH($SELECT($LENGTH(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$EXTRACT($PIECE(^APCM25OB(APCMIC,12),U,6),1,28),0,2,APCMPTYP)
+8 DO W^APCM25EH(" "_$EXTRACT($PIECE(^APCM25OB(APCMIC,0),U,14),1,28)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,1,APCMPTYP)
End DoDot:3
+9 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,6)=""
IF $PIECE(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP"
DO W^APCM25EH($SELECT($LENGTH(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$EXTRACT($PIECE(^APCM25OB(APCMIC,0),U,14),1,28)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:""),0,2,APCMPTYP)
+10 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,6)=""
IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.026.EP"
DO W^APCM25EH($SELECT($LENGTH(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$EXTRACT($PIECE(^APCM25OB(APCMIC,0),U,14),1,28),0,2,APCMPTYP)
End DoDot:2
+11 ;if summary category then skip rest
+12 IF $PIECE(^APCM25OB(APCMIC,0),U,19)]""
QUIT
+13 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,4)
Begin DoDot:2
+14 IF $EXTRACT(APCMPER,1,3)=315
DO W^APCM25EH($PIECE($GET(^APCM25OB(APCMIC,12)),U,1),0,0,APCMPTYP,,35)
DO NUMRATE
+15 IF $PIECE(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP"
Begin DoDot:3
+16 IF $EXTRACT(APCMPER,1,3)=316
DO W^APCM25EH($PIECE($GET(^APCM25OB(APCMIC,12)),U,2),0,0,APCMPTYP,,35)
DO NUMRATE
+17 IF $EXTRACT(APCMPER,1,3)>316
DO W^APCM25EH($PIECE($GET(^APCM25OB(APCMIC,12)),U,3),0,0,APCMPTYP,,35)
DO RATE
End DoDot:3
End DoDot:2
QUIT
+18 ;TARGET
+19 SET T=$SELECT($EXTRACT(APCMPER,1,3)=315:1,$EXTRACT(APCMPER,1,3)=316:2,$EXTRACT(APCMPER,1,3)>316:3,1:1)
+20 DO W^APCM25EH($PIECE($GET(^APCM25OB(APCMIC,12)),U,T),0,0,APCMPTYP,,35)
RATE ;RATE
+1 IF $PIECE(^APCM25OB(APCMIC,0),U,6)="A"
DO W^APCM25EH($SELECT(APCMCYD]"":$$LBLK^APCLUTL(APCMCYD,8),1:$$LBLK^APCLUTL("N/A",8)),0,0,APCMPTYP,,42)
+2 IF $PIECE(^APCM25OB(APCMIC,0),U,6)'="A"
DO W^APCM25EH($JUSTIFY(APCMCYP,8,2)_"%",0,0,APCMPTYP,,42)
+3 ;NUMERATOR/DENOMINATOR
+4 DO W^APCM25EH($SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYN'?.N:" N/A",1:$$C(APCMCYN,0,9)),0,0,APCMPTYP,,55)
+5 DO W^APCM25EH($SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYD'?.N:" N/A",1:$$C(APCMCYD,0,9)),0,0,APCMPTYP,,65)
+6 ;EXCL MET?
+7 SET APCMEF=$PIECE(^APCM25OB(APCMIC,0),U,11)
+8 IF APCMEF]""
Begin DoDot:2
+9 SET APCMNP=$PIECE(^DD(9001304.0311,APCMEF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+10 SET APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+11 DO W^APCM25EH($SELECT(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No"),0,0,APCMPTYP,,76)
End DoDot:2
+12 IF APCMEF=""
DO W^APCM25EH("N/A",0,0,APCMPTYP,,76)
+13 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.020.EP.1"!($PIECE(^APCM25OB(APCMIC,0),U,1)="S2.025.H.1")
IF $PIECE(APCMVDTE,U,1)=1
Begin DoDot:2
+14 DO W^APCM25EH("Note: PHR Server access failed during report generation "_$PIECE(APCMSEME,U,2)_" which may",0,1,APCMPTYP,,0)
+15 DO W^APCM25EH("have affected the numerator results for this measure. Contact your IT staff to",0,1,APCMPTYP,,0)
+16 DO W^APCM25EH("resolve the error and then regenerate the report again to obtain accurate",0,1,APCMPTYP,,0)
+17 DO W^APCM25EH("results.",0,1,APCMPTYP,,0)
End DoDot:2
End DoDot:1
D IF APCMPTYP="D"
Begin DoDot:1
+1 KILL R
+2 IF APCMMO["."
SET APCMX=" "_$PIECE(^APCM25OB(APCMIC,0),U,14)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
IF 1
+3 IF '$TEST
Begin DoDot:2
+4 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,6)]""
Begin DoDot:3
+5 SET APCMX=""
SET $PIECE(APCMX,U,1)=$PIECE(^APCM25OB(APCMIC,12),U,6)
DO W^APCM25EH(APCMX,0,2,APCMPTYP,1)
+6 IF $PIECE(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP"
SET APCMX=" "_$PIECE(^APCM25OB(APCMIC,0),U,14)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
+7 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.026.EP"
SET APCMX=" "_$PIECE(^APCM25OB(APCMIC,0),U,14)
End DoDot:3
+8 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,6)=""
IF $PIECE(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP"
SET APCMX=$PIECE(^APCM25OB(APCMIC,0),U,14)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
+9 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,6)=""
IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.026.EP"
SET APCMX=$PIECE(^APCM25OB(APCMIC,0),U,14)
End DoDot:2
+10 ;if summary category then skip rest
+11 IF $PIECE(^APCM25OB(APCMIC,0),U,19)]""
QUIT
+12 ;TARGet
+13 IF $PIECE($GET(^APCM25OB(APCMIC,12)),U,4)
Begin DoDot:2
+14 ;D W^APCM25EH(" ",0,1,APCMPTYP,1)
+15 IF $EXTRACT(APCMPER,1,3)=315
SET APCMX=APCMX_U_$PIECE($GET(^APCM25OB(APCMIC,12)),U,1)
SET R=1
DO NUMRATED
+16 IF $PIECE(^APCM25OB(APCMIC,0),U,1)'="S2.026.EP"
Begin DoDot:3
+17 IF $EXTRACT(APCMPER,1,3)=316
SET APCMX=APCMX_U_$PIECE($GET(^APCM25OB(APCMIC,12)),U,2)
SET R=1
DO NUMRATED
+18 IF $EXTRACT(APCMPER,1,3)=317
SET APCMX=APCMX_U_$PIECE($GET(^APCM25OB(APCMIC,12)),U,3)
SET R=1
DO RATED
+19 IF $EXTRACT(APCMPER,1,3)>317
SET APCMX=APCMX_U_$PIECE($GET(^APCM25OB(APCMIC,12)),U,7)
SET R=1
DO RATED
End DoDot:3
+20 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.026.EP"
Begin DoDot:3
+21 SET APCMX=""
SET $PIECE(APCMX,U,1)=" 2016"_U_$PIECE($GET(^APCM25OB(APCMIC,12)),U,2)
SET R=1
+22 FOR I=3,4,5
SET $PIECE(APCMX,U,I)=0
+23 DO EXD
+24 SET APCMX=""
SET $PIECE(APCMX,U,1)=" 2016"_U_$PIECE($GET(^APCM25OB(APCMIC,12)),U,2)
SET R=1
+25 FOR I=3,4,5
SET $PIECE(APCMX,U,I)=0
+26 DO EXD
End DoDot:3
End DoDot:2
QUIT
+27 SET R=2
+28 SET $PIECE(APCMX,U,2)=$GET(^APCM25OB(APCMIC,13,1,0))
RATED ;current rate
+1 IF $PIECE(^APCM25OB(APCMIC,0),U,6)="A"
SET $PIECE(APCMX,U,3)=$SELECT(APCMCYD]"":APCMCYD,1:"N/A")
+2 IF $PIECE(^APCM25OB(APCMIC,0),U,6)'="A"
SET $PIECE(APCMX,U,3)=$$SB($JUSTIFY(APCMCYP,6,2))_"%"
+3 ;numerator denominator
+4 SET $PIECE(APCMX,U,4)=$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYN)
+5 SET $PIECE(APCMX,U,5)=$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYD)
+6 SET APCMEF=$PIECE(^APCM25OB(APCMIC,0),U,11)
EXD ;EXCLUSION MET?
+1 IF APCMEF]""
Begin DoDot:2
+2 SET APCMNP=$PIECE(^DD(9001304.0311,APCMEF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+3 SET APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+4 ;IHS/CMI/LAB - fix display
SET $PIECE(APCMX,U,6)=$SELECT(APCMEV="N/A":APCMEV,APCMEV]"":"Yes",1:"No")
End DoDot:2
+5 IF APCMEF=""
SET $PIECE(APCMX,U,6)="N/A"
+6 DO W^APCM25EH(APCMX,0,R,APCMPTYP,1)
+7 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.020.EP.1"!($PIECE(^APCM25OB(APCMIC,0),U,1)="S2.025.H.1")
IF $PIECE(APCMVDTE,U,1)=1
Begin DoDot:2
+8 DO W^APCM25EH("Note: PHR Server access failed during report generation "_$PIECE(APCMSEME,U,2)_" which may",0,1,APCMPTYP,1)
+9 DO W^APCM25EH("have affected the numerator results for this measure. Contact your IT staff to",0,1,APCMPTYP,1)
+10 DO W^APCM25EH("resolve the error and then regenerate the report again to obtain accurate results.",0,1,APCMPTYP,1)
End DoDot:2
End DoDot:1
+11 QUIT
SUMH ;
+1 IF 'APCMGPG
GOTO SUMH1
+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 ;
SUMH1 ;
+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^APCM25EH(X,0,1,APCMPTYP)
+3 DO W^APCM25EH("Indian Health Service RPMS Suite (BCER) v2.0",1,2,APCMPTYP)
+4 IF $GET(APCMPROV)
IF APCMRPTT=1
SET X="Provider Name: "_$$SN^APCM25EH($PIECE(^VA(200,APCMPROV,0),U,1))
DO W^APCM25EH(X,1,1,APCMPTYP)
+5 IF APCMRPTT=2
SET X="Method: "_$SELECT(APCMMETH="E":"All Emergency Department",1:"Observation")
DO W^APCM25EH(X,1,1,APCMPTYP)
+6 IF $GET(APCMPROV)
IF APCMRPTT=2
SET X="Facility: "_$PIECE(^DIC(4,APCMPROV,0),U,1)
DO W^APCM25EH(X,1,1,APCMPTYP)
+7 SET X="Report Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED)
DO W^APCM25EH(X,1,1,APCMPTYP)
+8 SET X=$$REPEAT^XLFSTR("-",80)
DO W^APCM25EH(X,0,1,APCMPTYP)
+9 DO W^APCM25EH("MODIFIED STAGE 2 "_$SELECT(APCMRPTT=1:"EP ",1:"EH ")_"MEANINGFUL USE PERFORMANCE REPORT SUMMARY",1,1,APCMPTYP)
+10 SET X=$$REPEAT^XLFSTR("-",80)
DO W^APCM25EH(X,0,1,APCMPTYP)
+11 SET X=""
SET $EXTRACT(X,45)="Current"
SET $EXTRACT(X,76)="Excl"
DO W^APCM25EH(X,0,1,APCMPTYP)
+12 SET X=""
SET X="Performance Measures"
SET $EXTRACT(X,35)="Target"
SET $EXTRACT(X,45)="Rate"
SET $EXTRACT(X,59)="Num"
SET $EXTRACT(X,69)="Den"
SET $EXTRACT(X,76)="Met"
DO W^APCM25EH(X,0,1,APCMPTYP)
+13 DO W^APCM25EH($$REPEAT^XLFSTR("-",80),0,1,APCMPTYP)
+14 QUIT
NUMRATE ;RATE
+1 IF $PIECE(^APCM25OB(APCMIC,0),U,6)="A"
DO W^APCM25EH($SELECT(APCMCYD]"":$$LBLK^APCLUTL(APCMCYD,8),1:$$LBLK^APCLUTL("N/A",8)),0,0,APCMPTYP,,42)
+2 IF $PIECE(^APCM25OB(APCMIC,0),U,6)'="A"
DO W^APCM25EH($$C(APCMCYN,0,9),0,0,APCMPTYP,,42)
+3 ;NUMERATOR/DENOMINATOR
+4 DO W^APCM25EH($SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYN'?.N:" N/A",1:$$C(APCMCYN,0,9)),0,0,APCMPTYP,,55)
+5 DO W^APCM25EH($SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":" N/A",APCMCYD'?.N:" N/A",1:$$C(APCMCYD,0,9)),0,0,APCMPTYP,,65)
EX ;EXCL MET?
+1 SET APCMEF=$PIECE(^APCM25OB(APCMIC,0),U,11)
+2 IF APCMEF]""
Begin DoDot:1
+3 SET APCMNP=$PIECE(^DD(9001304.0311,APCMEF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+4 SET APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+5 DO W^APCM25EH($SELECT(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No"),0,0,APCMPTYP,,76)
End DoDot:1
+6 IF APCMEF=""
DO W^APCM25EH("N/A",0,0,APCMPTYP,,76)
+7 QUIT
NUMRATED ;current rate
+1 Begin DoDot:1
+2 IF $PIECE(^APCM25OB(APCMIC,0),U,6)="A"
SET $PIECE(APCMX,U,3)=$SELECT(APCMCYD]"":APCMCYD,1:"N/A")
+3 IF $PIECE(^APCM25OB(APCMIC,0),U,6)'="A"
SET $PIECE(APCMX,U,3)=$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYN)
+4 ;numerator denominator
+5 SET $PIECE(APCMX,U,4)=$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYN)
+6 SET $PIECE(APCMX,U,5)=$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYD)
+7 SET APCMEF=$PIECE(^APCM25OB(APCMIC,0),U,11)
+8 ;EXCLUSION MET?
+9 IF APCMEF]""
Begin DoDot:2
+10 SET APCMNP=$PIECE(^DD(9001304.0311,APCMEF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+11 SET APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+12 ;IHS/CMI/LAB - fix display
SET $PIECE(APCMX,U,6)=$SELECT(APCMEV="N/A":APCMEV,APCMEV]"":"Yes",1:"No")
End DoDot:2
+13 IF APCMEF=""
SET $PIECE(APCMX,U,6)="N/A"
+14 DO W^APCM25EH(APCMX,0,R,APCMPTYP,1)
End DoDot:1
+15 QUIT
