APCM2AE6.m

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