APCM2AE6 ;IHS/CMI/LAB - IHS MU REPORT;
;;1.0;MU PERFORMANCE REPORTS;**7,8**;MAR 26, 2012;Build 22
;
;
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) ;SPDX
Q:$P(^APCM25OB(M,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
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 ""
W ;EP
I $P(^APCM25OB(APCMIC,0),U,1)="S2.014.EP" D PHI Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.010.EP" D CDS Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.001.EP" D CPOEM Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.001.1EP" D CPOEL Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.001.2EP" D CPOER Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.003.EP" D EPRES Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.023.EP" D SC Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.021.EP" D PTED Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.022.EP" D MEDREC^APCM2AE0 Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.020.EP" D PEA^APCM2AE0 Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.026.EP" D SEM^APCM2AE0 Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.024.EP" D IMM^APCM2AE0 Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.025.EP" D SYN^APCM2AE0 Q
I $P(^APCM25OB(APCMIC,0),U,1)="S2.030.EP" D SR^APCM2AE0 Q
;
Q
SETND ;
S APCMDF=$P(^APCM25OB(M,0),U,8)
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(M,0),U,6)="A" S (APCMPRN,APCMCYN)="" Q
S APCMNF=$P(^APCM25OB(M,0),U,9) ;numerator field
S APCMNP=$P(^DD(9001304.0311,APCMNF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
D SETN
Q
PHI ;
I APCMPTYP="P" D Q
.D W^APCM2AEH(" 1. Protect e-Health Info+",0,2,APCMPTYP)
.;
.S T=$S($E(APCMPER,1,3)=315:1,$E(APCMPER,1,3)=316:2,$E(APCMPER,1,3)=317:3,1:1)
.D W^APCM2AEH($P($G(^APCM25OB(APCMIC,12)),U,T),0,0,APCMPTYP,,35)
.;
.S M=APCMIC
.D SETND
.D WRATE
.;
.D WNUMDEN
.;
.D W^APCM2AEH("N/A",0,0,APCMPTYP,,71)
.;
.D W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.S APCMX=$P(^APCM25OB(APCMIC,0),U,14)_$S($P(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
.;
.S T=$S($E(APCMPER,1,3)=315:1,$E(APCMPER,1,3)=316:2,$E(APCMPER,1,3)=317:3,1:1)
.S $P(APCMX,U,2)=$P($G(^APCM25OB(APCMIC,12)),U,T)
.;
.S M=APCMIC
.D SETND
.D WRATE
.;
.D WNUMDEN
.;
.S $P(APCMX,U,6)="N/A"
.S $P(APCMX,U,7)="N/A"
.D W^APCM25EH(APCMX,0,2,APCMPTYP,1)
Q
CDS ;
I APCMPTYP="P" D Q
.D W^APCM2AEH(" 2. Clin Decision Support+",0,2,APCMPTYP)
.D
..S M=$O(^APCM25OB("B","S2.010.EP.1",0))
..D W^APCM2AEH(" Imp 5 CDS 2016+",0,1,APCMPTYP)
..S T=$S($E(APCMPER,1,3)=315:1,$E(APCMPER,1,3)=316:2,$E(APCMPER,1,3)=317:3,1:1)
..D W^APCM2AEH($P($G(^APCM25OB(M,12)),U,T),0,0,APCMPTYP,,35)
..D SETND
..D WRATE
..D WNUMDEN
..D W^APCM2AEH("N/A",0,0,APCMPTYP,,71)
..D W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
.D W^APCM2AEH(" Drug Interaction Check+",0,1,APCMPTYP)
.S M=$O(^APCM25OB("B","S2.010.EP.2",0))
.S T=$S($E(APCMPER,1,3)=315:1,$E(APCMPER,1,3)=316:2,$E(APCMPER,1,3)=317:3,1:1)
.D W^APCM2AEH($P($G(^APCM25OB(M,12)),U,T),0,0,APCMPTYP,,35)
.D SETND
.D WRATE
.D WNUMDEN
.D WEXCL
.D W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.S APCMX="Clin Decision Support+" D W^APCM25EH(APCMX,0,2,APCMPTYP,1)
.D
..S M=$O(^APCM25OB("B","S2.010.EP.1",0))
..S APCMX=" Imp 5 CDS 2016+"
..S T=$S($E(APCMPER,1,3)=315:1,$E(APCMPER,1,3)=316:2,$E(APCMPER,1,3)=317:3,1:1)
..S $P(APCMX,U,2)=$P($G(^APCM25OB(M,12)),U,T)
..D SETND
..D WRATE
..D WNUMDEN
..S $P(APCMX,U,6)="N/A"
..S $P(APCMX,U,7)="N/A"
..D W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
.S APCMX=" Drug Interaction Check+"
.S M=$O(^APCM25OB("B","S2.010.EP.2",0))
.S T=$S($E(APCMPER,1,3)=315:1,$E(APCMPER,1,3)=316:2,$E(APCMPER,1,3)=317:3,1:1)
.S $P(APCMX,U,2)=$P($G(^APCM25OB(M,12)),U,T)
.D SETND
.D WRATE
.D WNUMDEN
.D WEXCL
.S $P(APCMX,U,7)="N/A"
.D W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
Q
CPOEM ;
I APCMPTYP="P" D
.D
..S M=APCMIC
..D W^APCM2AEH(" 3. CPOE Medications 2016",0,2,APCMPTYP)
..S T=">60%"
..D W^APCM2AEH(T,0,0,APCMPTYP,,35)
..D SETND
..D WRATE
..D WNUMDEN
..D WEXCL
..D W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.D
..S M=APCMIC
..S APCMX="CPOE Medications 2016"
..S T=">60%"
..S $P(APCMX,U,2)=T
..D SETND
..D WRATE
..D WNUMDEN
..D WEXCL
..S $P(APCMX,U,7)="N/A"
..D W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
Q
CPOEL ;
I APCMPTYP="P" D
.S M=APCMIC
.D W^APCM2AEH(" CPOE Laboratory",0,1,APCMPTYP)
.S T=">30%"
.D W^APCM2AEH(T,0,0,APCMPTYP,,35)
.D SETND
.D WRATE
.D WNUMDEN
.D WEXCL
.S I=$P(^APCM25OB(APCMIC,0),U,1)
.D W^APCM2AEH($G(APCMATTE(I,APCMPROV)),0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.S M=APCMIC
.S APCMX="CPOE Laboratory"
.S T=">30%"
.S $P(APCMX,U,2)=T
.D SETND
.D WRATE
.D WNUMDEN
.D WEXCL
.S I=$P(^APCM25OB(APCMIC,0),U,1)
.S $P(APCMX,U,7)=$G(APCMATTE(I,APCMPROV))
.D W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
Q
CPOER ;
I APCMPTYP="P" D
.S M=APCMIC
.D W^APCM2AEH(" CPOE Radiology",0,1,APCMPTYP)
.S T=">30%"
.D W^APCM2AEH(T,0,0,APCMPTYP,,35)
.D SETND
.D WRATE
.D WNUMDEN
.D WEXCL
.S I=$P(^APCM25OB(APCMIC,0),U,1)
.D W^APCM2AEH($G(APCMATTE(I,APCMPROV)),0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.S M=APCMIC
.S APCMX="CPOE Radiology"
.S T=">30%"
.S $P(APCMX,U,2)=T
.D SETND
.D WRATE
.D WNUMDEN
.D WEXCL
.S I=$P(^APCM25OB(APCMIC,0),U,1)
.S $P(APCMX,U,7)=$G(APCMATTE(I,APCMPROV))
.D W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
Q
EPRES ;
I APCMPTYP="P" D
.D
..S M=APCMIC
..D W^APCM2AEH(" 4. e-Prescribe (e-Rx) 2016",0,2,APCMPTYP)
..S T=">50%"
..D W^APCM2AEH(T,0,0,APCMPTYP,,35)
..D SETND
..D WRATE
..D WNUMDEN
..D WEXCL
..D W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.D
..S M=APCMIC
..S APCMX="e-Prescribe (e-Rx) 2016"
..S T=">50%"
..S $P(APCMX,U,2)=T
..D SETND
..D WRATE
..D WNUMDEN
..D WEXCL
..S $P(APCMX,U,7)="N/A"
..D W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
Q
SC ;summary of care
I APCMPTYP="P" D
.D
..S M=APCMIC
..D W^APCM2AEH(" 5. Sum of Care (HIE) 2016",0,2,APCMPTYP)
..S T=">10%"
..D W^APCM2AEH(T,0,0,APCMPTYP,,35)
..D SETND
..D WRATE
..D WNUMDEN
..D WEXCL
..S I=$P(^APCM25OB(APCMIC,0),U,1)
..D W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.D
..S M=APCMIC
..S APCMX="Sum of Care (HIE) 2016"
..S T=">10%"
..S $P(APCMX,U,2)=T
..D SETND
..D WRATE
..D WNUMDEN
..D WEXCL
..S I=$P(^APCM25OB(APCMIC,0),U,1)
..S $P(APCMX,U,7)="N/A"
..D W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
Q
PTED ;
I APCMPTYP="P" D
.D
..S M=APCMIC
..D W^APCM2AEH(" 6. Patient Education 2016",0,2,APCMPTYP)
..;
..S T=">10%"
..D W^APCM2AEH(T,0,0,APCMPTYP,,35)
..;
..D SETND
..D WRATE
..;
..D WNUMDEN
..;
..D WEXCL
..;
..S I=$P(^APCM25OB(APCMIC,0),U,1)
..D W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
I APCMPTYP="D" D
.D
..S M=APCMIC
..S APCMX="Patient Education 2016"
..;
..S T=">10%"
..S $P(APCMX,U,2)=T
..;
..D SETND
..D WRATE
..;
..D WNUMDEN
..;
..D WEXCL
..;
..S I=$P(^APCM25OB(APCMIC,0),U,1)
..S $P(APCMX,U,7)="N/A"
..D W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
Q
WEXCL ;
S APCMEF=$P(^APCM25OB(M,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)
.I APCMPTYP="P" D W^APCM25EH($S(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No"),0,0,APCMPTYP,,71)
.I APCMPTYP="D" S $P(APCMX,U,6)=$S(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No")
I APCMEF="" D
.I APCMPTYP="P" D W^APCM25EH("N/A",0,0,APCMPTYP,,71)
.S $P(APCMX,U,6)="N/A"
Q
WRATE ;
I APCMPTYP="P" D Q
.I $P(^APCM25OB(M,0),U,6)="A" D W^APCM2AEH($S(APCMCYD]"":$$LBLK^APCLUTL(APCMCYD,8),1:$$LBLK^APCLUTL("N/A",8)),0,0,APCMPTYP,,40)
.I $P(^APCM25OB(M,0),U,6)'="A" D W^APCM2AEH($J(APCMCYP,8,2)_"%",0,0,APCMPTYP,,40)
I $P(^APCM25OB(M,0),U,6)="A" S $P(APCMX,U,3)=$S(APCMCYD]"":APCMCYD,1:"N/A")
I $P(^APCM25OB(M,0),U,6)'="A" S $P(APCMX,U,3)=$S($P(^APCM25OB(M,0),U,6)="A":"N/A",1:$J(APCMCYP,8,2)_"%")
Q
WNUMDEN ;
I APCMPTYP="P" D Q
.D W^APCM2AEH($S($P(^APCM25OB(M,0),U,6)="A":" N/A",APCMCYN'?.N:" N/A",1:$$C(APCMCYN,0,9)),0,0,APCMPTYP,,51)
.D W^APCM2AEH($S($P(^APCM25OB(M,0),U,6)="A":" N/A",APCMCYD'?.N:" N/A",1:$$C(APCMCYD,0,9)),0,0,APCMPTYP,,61)
S $P(APCMX,U,4)=$S($P(^APCM25OB(M,0),U,6)="A":"N/A",1:+APCMCYN)
S $P(APCMX,U,5)=$S($P(^APCM25OB(M,0),U,6)="A":"N/A",1:+APCMCYD)
Q
APCM2AE6 ;IHS/CMI/LAB - IHS MU REPORT;
+1 ;;1.0;MU PERFORMANCE REPORTS;**7,8**;MAR 26, 2012;Build 22
+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 ;SPDX
SET APCMCYN=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+2 ;no % on attestation measures
IF $PIECE(^APCM25OB(M,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
+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 ""
W ;EP
+1 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.014.EP"
DO PHI
QUIT
+2 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.010.EP"
DO CDS
QUIT
+3 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.001.EP"
DO CPOEM
QUIT
+4 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.001.1EP"
DO CPOEL
QUIT
+5 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.001.2EP"
DO CPOER
QUIT
+6 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.003.EP"
DO EPRES
QUIT
+7 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.023.EP"
DO SC
QUIT
+8 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.021.EP"
DO PTED
QUIT
+9 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.022.EP"
DO MEDREC^APCM2AE0
QUIT
+10 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.020.EP"
DO PEA^APCM2AE0
QUIT
+11 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.026.EP"
DO SEM^APCM2AE0
QUIT
+12 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.024.EP"
DO IMM^APCM2AE0
QUIT
+13 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.025.EP"
DO SYN^APCM2AE0
QUIT
+14 IF $PIECE(^APCM25OB(APCMIC,0),U,1)="S2.030.EP"
DO SR^APCM2AE0
QUIT
+15 ;
+16 QUIT
SETND ;
+1 SET APCMDF=$PIECE(^APCM25OB(M,0),U,8)
+2 SET APCMNP=$PIECE(^DD(9001304.0311,APCMDF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+3 SET APCMCYD=$$V(1,APCMRPT,N,P,APCMPROV,$SELECT($GET(APCMTOT):"T",1:"I"),APCMRPTT)
+4 IF $PIECE(^APCM25OB(M,0),U,6)="A"
SET (APCMPRN,APCMCYN)=""
QUIT
+5 ;numerator field
SET APCMNF=$PIECE(^APCM25OB(M,0),U,9)
+6 SET APCMNP=$PIECE(^DD(9001304.0311,APCMNF,0),U,4)
SET N=$PIECE(APCMNP,";")
SET P=$PIECE(APCMNP,";",2)
+7 DO SETN
+8 QUIT
PHI ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 DO W^APCM2AEH(" 1. Protect e-Health Info+",0,2,APCMPTYP)
+3 ;
+4 SET T=$SELECT($EXTRACT(APCMPER,1,3)=315:1,$EXTRACT(APCMPER,1,3)=316:2,$EXTRACT(APCMPER,1,3)=317:3,1:1)
+5 DO W^APCM2AEH($PIECE($GET(^APCM25OB(APCMIC,12)),U,T),0,0,APCMPTYP,,35)
+6 ;
+7 SET M=APCMIC
+8 DO SETND
+9 DO WRATE
+10 ;
+11 DO WNUMDEN
+12 ;
+13 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,71)
+14 ;
+15 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
End DoDot:1
QUIT
+16 IF APCMPTYP="D"
Begin DoDot:1
+17 SET APCMX=$PIECE(^APCM25OB(APCMIC,0),U,14)_$SELECT($PIECE(^APCM25OB(APCMIC,0),U,6)="A":"+",1:"")
+18 ;
+19 SET T=$SELECT($EXTRACT(APCMPER,1,3)=315:1,$EXTRACT(APCMPER,1,3)=316:2,$EXTRACT(APCMPER,1,3)=317:3,1:1)
+20 SET $PIECE(APCMX,U,2)=$PIECE($GET(^APCM25OB(APCMIC,12)),U,T)
+21 ;
+22 SET M=APCMIC
+23 DO SETND
+24 DO WRATE
+25 ;
+26 DO WNUMDEN
+27 ;
+28 SET $PIECE(APCMX,U,6)="N/A"
+29 SET $PIECE(APCMX,U,7)="N/A"
+30 DO W^APCM25EH(APCMX,0,2,APCMPTYP,1)
End DoDot:1
+31 QUIT
CDS ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 DO W^APCM2AEH(" 2. Clin Decision Support+",0,2,APCMPTYP)
+3 Begin DoDot:2
+4 SET M=$ORDER(^APCM25OB("B","S2.010.EP.1",0))
+5 DO W^APCM2AEH(" Imp 5 CDS 2016+",0,1,APCMPTYP)
+6 SET T=$SELECT($EXTRACT(APCMPER,1,3)=315:1,$EXTRACT(APCMPER,1,3)=316:2,$EXTRACT(APCMPER,1,3)=317:3,1:1)
+7 DO W^APCM2AEH($PIECE($GET(^APCM25OB(M,12)),U,T),0,0,APCMPTYP,,35)
+8 DO SETND
+9 DO WRATE
+10 DO WNUMDEN
+11 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,71)
+12 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
End DoDot:2
+13 DO W^APCM2AEH(" Drug Interaction Check+",0,1,APCMPTYP)
+14 SET M=$ORDER(^APCM25OB("B","S2.010.EP.2",0))
+15 SET T=$SELECT($EXTRACT(APCMPER,1,3)=315:1,$EXTRACT(APCMPER,1,3)=316:2,$EXTRACT(APCMPER,1,3)=317:3,1:1)
+16 DO W^APCM2AEH($PIECE($GET(^APCM25OB(M,12)),U,T),0,0,APCMPTYP,,35)
+17 DO SETND
+18 DO WRATE
+19 DO WNUMDEN
+20 DO WEXCL
+21 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
End DoDot:1
QUIT
+22 IF APCMPTYP="D"
Begin DoDot:1
+23 SET APCMX="Clin Decision Support+"
DO W^APCM25EH(APCMX,0,2,APCMPTYP,1)
+24 Begin DoDot:2
+25 SET M=$ORDER(^APCM25OB("B","S2.010.EP.1",0))
+26 SET APCMX=" Imp 5 CDS 2016+"
+27 SET T=$SELECT($EXTRACT(APCMPER,1,3)=315:1,$EXTRACT(APCMPER,1,3)=316:2,$EXTRACT(APCMPER,1,3)=317:3,1:1)
+28 SET $PIECE(APCMX,U,2)=$PIECE($GET(^APCM25OB(M,12)),U,T)
+29 DO SETND
+30 DO WRATE
+31 DO WNUMDEN
+32 SET $PIECE(APCMX,U,6)="N/A"
+33 SET $PIECE(APCMX,U,7)="N/A"
+34 DO W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
End DoDot:2
+35 SET APCMX=" Drug Interaction Check+"
+36 SET M=$ORDER(^APCM25OB("B","S2.010.EP.2",0))
+37 SET T=$SELECT($EXTRACT(APCMPER,1,3)=315:1,$EXTRACT(APCMPER,1,3)=316:2,$EXTRACT(APCMPER,1,3)=317:3,1:1)
+38 SET $PIECE(APCMX,U,2)=$PIECE($GET(^APCM25OB(M,12)),U,T)
+39 DO SETND
+40 DO WRATE
+41 DO WNUMDEN
+42 DO WEXCL
+43 SET $PIECE(APCMX,U,7)="N/A"
+44 DO W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
End DoDot:1
+45 QUIT
CPOEM ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 Begin DoDot:2
+3 SET M=APCMIC
+4 DO W^APCM2AEH(" 3. CPOE Medications 2016",0,2,APCMPTYP)
+5 SET T=">60%"
+6 DO W^APCM2AEH(T,0,0,APCMPTYP,,35)
+7 DO SETND
+8 DO WRATE
+9 DO WNUMDEN
+10 DO WEXCL
+11 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
End DoDot:2
End DoDot:1
+12 IF APCMPTYP="D"
Begin DoDot:1
+13 Begin DoDot:2
+14 SET M=APCMIC
+15 SET APCMX="CPOE Medications 2016"
+16 SET T=">60%"
+17 SET $PIECE(APCMX,U,2)=T
+18 DO SETND
+19 DO WRATE
+20 DO WNUMDEN
+21 DO WEXCL
+22 SET $PIECE(APCMX,U,7)="N/A"
+23 DO W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
End DoDot:2
End DoDot:1
+24 QUIT
CPOEL ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 SET M=APCMIC
+3 DO W^APCM2AEH(" CPOE Laboratory",0,1,APCMPTYP)
+4 SET T=">30%"
+5 DO W^APCM2AEH(T,0,0,APCMPTYP,,35)
+6 DO SETND
+7 DO WRATE
+8 DO WNUMDEN
+9 DO WEXCL
+10 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+11 DO W^APCM2AEH($GET(APCMATTE(I,APCMPROV)),0,0,APCMPTYP,,77)
End DoDot:1
+12 IF APCMPTYP="D"
Begin DoDot:1
+13 SET M=APCMIC
+14 SET APCMX="CPOE Laboratory"
+15 SET T=">30%"
+16 SET $PIECE(APCMX,U,2)=T
+17 DO SETND
+18 DO WRATE
+19 DO WNUMDEN
+20 DO WEXCL
+21 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+22 SET $PIECE(APCMX,U,7)=$GET(APCMATTE(I,APCMPROV))
+23 DO W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
End DoDot:1
+24 QUIT
CPOER ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 SET M=APCMIC
+3 DO W^APCM2AEH(" CPOE Radiology",0,1,APCMPTYP)
+4 SET T=">30%"
+5 DO W^APCM2AEH(T,0,0,APCMPTYP,,35)
+6 DO SETND
+7 DO WRATE
+8 DO WNUMDEN
+9 DO WEXCL
+10 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+11 DO W^APCM2AEH($GET(APCMATTE(I,APCMPROV)),0,0,APCMPTYP,,77)
End DoDot:1
+12 IF APCMPTYP="D"
Begin DoDot:1
+13 SET M=APCMIC
+14 SET APCMX="CPOE Radiology"
+15 SET T=">30%"
+16 SET $PIECE(APCMX,U,2)=T
+17 DO SETND
+18 DO WRATE
+19 DO WNUMDEN
+20 DO WEXCL
+21 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+22 SET $PIECE(APCMX,U,7)=$GET(APCMATTE(I,APCMPROV))
+23 DO W^APCM2AEH(APCMX,0,1,APCMPTYP,1)
End DoDot:1
+24 QUIT
EPRES ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 Begin DoDot:2
+3 SET M=APCMIC
+4 DO W^APCM2AEH(" 4. e-Prescribe (e-Rx) 2016",0,2,APCMPTYP)
+5 SET T=">50%"
+6 DO W^APCM2AEH(T,0,0,APCMPTYP,,35)
+7 DO SETND
+8 DO WRATE
+9 DO WNUMDEN
+10 DO WEXCL
+11 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
End DoDot:2
End DoDot:1
+12 IF APCMPTYP="D"
Begin DoDot:1
+13 Begin DoDot:2
+14 SET M=APCMIC
+15 SET APCMX="e-Prescribe (e-Rx) 2016"
+16 SET T=">50%"
+17 SET $PIECE(APCMX,U,2)=T
+18 DO SETND
+19 DO WRATE
+20 DO WNUMDEN
+21 DO WEXCL
+22 SET $PIECE(APCMX,U,7)="N/A"
+23 DO W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
End DoDot:2
End DoDot:1
+24 QUIT
SC ;summary of care
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 Begin DoDot:2
+3 SET M=APCMIC
+4 DO W^APCM2AEH(" 5. Sum of Care (HIE) 2016",0,2,APCMPTYP)
+5 SET T=">10%"
+6 DO W^APCM2AEH(T,0,0,APCMPTYP,,35)
+7 DO SETND
+8 DO WRATE
+9 DO WNUMDEN
+10 DO WEXCL
+11 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+12 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
End DoDot:2
End DoDot:1
+13 IF APCMPTYP="D"
Begin DoDot:1
+14 Begin DoDot:2
+15 SET M=APCMIC
+16 SET APCMX="Sum of Care (HIE) 2016"
+17 SET T=">10%"
+18 SET $PIECE(APCMX,U,2)=T
+19 DO SETND
+20 DO WRATE
+21 DO WNUMDEN
+22 DO WEXCL
+23 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+24 SET $PIECE(APCMX,U,7)="N/A"
+25 DO W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
End DoDot:2
End DoDot:1
+26 QUIT
PTED ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 Begin DoDot:2
+3 SET M=APCMIC
+4 DO W^APCM2AEH(" 6. Patient Education 2016",0,2,APCMPTYP)
+5 ;
+6 SET T=">10%"
+7 DO W^APCM2AEH(T,0,0,APCMPTYP,,35)
+8 ;
+9 DO SETND
+10 DO WRATE
+11 ;
+12 DO WNUMDEN
+13 ;
+14 DO WEXCL
+15 ;
+16 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+17 DO W^APCM2AEH("N/A",0,0,APCMPTYP,,77)
End DoDot:2
End DoDot:1
+18 IF APCMPTYP="D"
Begin DoDot:1
+19 Begin DoDot:2
+20 SET M=APCMIC
+21 SET APCMX="Patient Education 2016"
+22 ;
+23 SET T=">10%"
+24 SET $PIECE(APCMX,U,2)=T
+25 ;
+26 DO SETND
+27 DO WRATE
+28 ;
+29 DO WNUMDEN
+30 ;
+31 DO WEXCL
+32 ;
+33 SET I=$PIECE(^APCM25OB(APCMIC,0),U,1)
+34 SET $PIECE(APCMX,U,7)="N/A"
+35 DO W^APCM2AEH(APCMX,0,2,APCMPTYP,1)
End DoDot:2
End DoDot:1
+36 QUIT
WEXCL ;
+1 SET APCMEF=$PIECE(^APCM25OB(M,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 IF APCMPTYP="P"
DO W^APCM25EH($SELECT(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No"),0,0,APCMPTYP,,71)
+6 IF APCMPTYP="D"
SET $PIECE(APCMX,U,6)=$SELECT(APCMEV="N/A":"N/A",APCMEV]"":"Yes",1:"No")
End DoDot:1
+7 IF APCMEF=""
Begin DoDot:1
+8 IF APCMPTYP="P"
DO W^APCM25EH("N/A",0,0,APCMPTYP,,71)
+9 SET $PIECE(APCMX,U,6)="N/A"
End DoDot:1
+10 QUIT
WRATE ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 IF $PIECE(^APCM25OB(M,0),U,6)="A"
DO W^APCM2AEH($SELECT(APCMCYD]"":$$LBLK^APCLUTL(APCMCYD,8),1:$$LBLK^APCLUTL("N/A",8)),0,0,APCMPTYP,,40)
+3 IF $PIECE(^APCM25OB(M,0),U,6)'="A"
DO W^APCM2AEH($JUSTIFY(APCMCYP,8,2)_"%",0,0,APCMPTYP,,40)
End DoDot:1
QUIT
+4 IF $PIECE(^APCM25OB(M,0),U,6)="A"
SET $PIECE(APCMX,U,3)=$SELECT(APCMCYD]"":APCMCYD,1:"N/A")
+5 IF $PIECE(^APCM25OB(M,0),U,6)'="A"
SET $PIECE(APCMX,U,3)=$SELECT($PIECE(^APCM25OB(M,0),U,6)="A":"N/A",1:$JUSTIFY(APCMCYP,8,2)_"%")
+6 QUIT
WNUMDEN ;
+1 IF APCMPTYP="P"
Begin DoDot:1
+2 DO W^APCM2AEH($SELECT($PIECE(^APCM25OB(M,0),U,6)="A":" N/A",APCMCYN'?.N:" N/A",1:$$C(APCMCYN,0,9)),0,0,APCMPTYP,,51)
+3 DO W^APCM2AEH($SELECT($PIECE(^APCM25OB(M,0),U,6)="A":" N/A",APCMCYD'?.N:" N/A",1:$$C(APCMCYD,0,9)),0,0,APCMPTYP,,61)
End DoDot:1
QUIT
+4 SET $PIECE(APCMX,U,4)=$SELECT($PIECE(^APCM25OB(M,0),U,6)="A":"N/A",1:+APCMCYN)
+5 SET $PIECE(APCMX,U,5)=$SELECT($PIECE(^APCM25OB(M,0),U,6)="A":"N/A",1:+APCMCYD)
+6 QUIT
