APCM24EA.m

APCM24EA ; IHS/CMI/LAB - IHS MU ;

 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

 ;

ET ;

 W ! S APCMZ=0 F  S APCMZ=$O(^APCM24OB(APCMY,N,APCMZ)) Q:APCMZ'=+APCMZ  W !,^APCM24OB(APCMY,N,APCMZ,0)

 W !

 Q

SS ;EP

 Q

SSH ;EP

 Q

IMMREG ;EP - ask additional exclusion questions for IMM REG

 S APCMQ=0

 S APCMY=$O(^APCM24OB("B",APCMX,0))

 Q:'$D(APCMIND(APCMY))  ;measure not being run

 ;display exclusion text/narrative

 I $O(^APCM24OB(APCMY,19,0)) S N=19 W !! D ET

 I APCMPLTY="SEL"!(APCMPLTY="TAX") D  G:APCMIND=1 IMMIND Q

 .W !!,"Do all selected providers included in this report meet this"

 .S DIR(0)="Y",DIR("A")="exclusion",DIR("B")="YES" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S APCMQ=1 Q

 .I 'Y S APCMIND=1 Q

 .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  S APCMATTE(APCMX,APCMP)="N/A"

IMMIND ;ask individually

 S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ)  D

 .S APCMZ=0 F  S APCMZ=$O(^APCM24OB(APCMY,24,APCMZ)) Q:APCMZ'=+APCMZ  W !,^APCM24OB(APCMY,24,APCMZ,0)

 .W ! S DIR(0)="Y",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_" meet this exclusion",DIR("B")="YES" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S APCMQ=1 Q

 .S APCMATTE(APCMX,APCMP)=$S(Y:"N/A",1:"")

IMM2 ;display exclusion text/narrative

 S APCMP=0,E=0,T=0 F  S APCMP=$O(APCMATTE(APCMX,APCMP)) Q:APCMP=""!(APCMQ)  D

 .S T=T+1

 .I APCMATTE(APCMX,APCMP)="N/A" S E=E+1 ;excluded so don't ask

 I E=T Q  ;all excluded

 I $O(^APCM24OB(APCMY,31,0)) S N=31 W !! D ET

 ;

IMMIND2 ;ask individually

 S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ)  D

 .Q:APCMATTE(APCMX,APCMP)="N/A"  ;excluded

 .W ! S DIR(0)="Y",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_" attest to this",DIR("B")="YES" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S APCMQ=1 Q

 .S APCMATTE(APCMX,APCMP)=$S(Y:"Yes",1:"No")

 Q

SPECREG ;EP

 Q

IMMREGH ;EP - ask additional exclusion questions for IMM REG

 S APCMQ=0

 S APCMY=$O(^APCM24OB("B",APCMX,0))

 Q:'$D(APCMIND(APCMY))  ;measure not being run

 ;display exclusion text/narrative

 I $O(^APCM24OB(APCMY,19,0)) S N=19 W !! D ET

 ;ask individually

 S APCMP=APCMFAC  D

 .S APCMZ=0 F  S APCMZ=$O(^APCM24OB(APCMY,24,APCMZ)) Q:APCMZ'=+APCMZ  W !,^APCM24OB(APCMY,24,APCMZ,0)

 .W ! S DIR(0)="Y",DIR("A")="Does "_$E($P(^DIC(4,APCMP,0),U,1),1,25)_" meet this exclusion"

 .S DIR("B")="YES"

 .I $P(^APCM24OB(APCMY,0),U,1)="S2.025.H.1" S DIR("B")="NO"

 .KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S APCMQ=1 Q

 .S APCMATTE(APCMX,APCMP)=$S(Y:"N/A",1:"")

IMMH2 ;display exclusion text/narrative

 S APCMP=0,E=0,T=0 F  S APCMP=$O(APCMATTE(APCMX,APCMP)) Q:APCMP=""!(APCMQ)  D

 .S T=T+1

 .I APCMATTE(APCMX,APCMP)="N/A" S E=E+1 ;excluded so don't ask

 I E=T Q  ;all excluded

 I $O(^APCM24OB(APCMY,31,0)) S N=31 W !! D ET

 ;

IMMINDH2 ;ask individually

 S APCMP=APCMFAC  D

 .Q:APCMATTE(APCMX,APCMP)="N/A"  ;excluded

 .W ! S DIR(0)="Y",DIR("A")="Does "_$E($P(^DIC(4,APCMP,0),U,1),1,25)_" attest to this",DIR("B")="YES" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S APCMQ=1 Q

 .S APCMATTE(APCMX,APCMP)=$S(Y:"Yes",1:"No")

 Q

APCM24EA  ; IHS/CMI/LAB - IHS MU ;

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

 +2       ;

ET        ;

 +1        WRITE !

           SET APCMZ=0

           FOR 

               SET APCMZ=$ORDER(^APCM24OB(APCMY,N,APCMZ))

               IF APCMZ'=+APCMZ

                   QUIT 

               WRITE !,^APCM24OB(APCMY,N,APCMZ,0)

 +2        WRITE !

 +3        QUIT 

SS        ;EP

 +1        QUIT 

SSH       ;EP

 +1        QUIT 

IMMREG    ;EP - ask additional exclusion questions for IMM REG

 +1        SET APCMQ=0

 +2        SET APCMY=$ORDER(^APCM24OB("B",APCMX,0))

 +3       ;measure not being run

           IF '$DATA(APCMIND(APCMY))

               QUIT 

 +4       ;display exclusion text/narrative

 +5        IF $ORDER(^APCM24OB(APCMY,19,0))

               SET N=19

               WRITE !!

               DO ET

 +6        IF APCMPLTY="SEL"!(APCMPLTY="TAX")

               Begin DoDot:1

 +7                WRITE !!,"Do all selected providers included in this report meet this"

 +8                SET DIR(0)="Y"

                   SET DIR("A")="exclusion"

                   SET DIR("B")="YES"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +9                IF $DATA(DIRUT)

                       SET APCMQ=1

                       QUIT 

 +10               IF 'Y

                       SET APCMIND=1

                       QUIT 

 +11               SET APCMP=0

                   FOR 

                       SET APCMP=$ORDER(APCMPRV(APCMP))

                       IF APCMP'=+APCMP

                           QUIT 

                       SET APCMATTE(APCMX,APCMP)="N/A"

               End DoDot:1

               IF APCMIND=1

                   GOTO IMMIND

               QUIT 

IMMIND    ;ask individually

 +1        SET APCMP=0

           FOR 

               SET APCMP=$ORDER(APCMPRV(APCMP))

               IF APCMP'=+APCMP!(APCMQ)

                   QUIT 

               Begin DoDot:1

 +2                SET APCMZ=0

                   FOR 

                       SET APCMZ=$ORDER(^APCM24OB(APCMY,24,APCMZ))

                       IF APCMZ'=+APCMZ

                           QUIT 

                       WRITE !,^APCM24OB(APCMY,24,APCMZ,0)

 +3                WRITE !

                   SET DIR(0)="Y"

                   SET DIR("A")="Does "_$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_" meet this exclusion"

                   SET DIR("B")="YES"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +4                IF $DATA(DIRUT)

                       SET APCMQ=1

                       QUIT 

 +5                SET APCMATTE(APCMX,APCMP)=$SELECT(Y:"N/A",1:"")

               End DoDot:1

IMM2      ;display exclusion text/narrative

 +1        SET APCMP=0

           SET E=0

           SET T=0

           FOR 

               SET APCMP=$ORDER(APCMATTE(APCMX,APCMP))

               IF APCMP=""!(APCMQ)

                   QUIT 

               Begin DoDot:1

 +2                SET T=T+1

 +3       ;excluded so don't ask

                   IF APCMATTE(APCMX,APCMP)="N/A"

                       SET E=E+1

               End DoDot:1

 +4       ;all excluded

           IF E=T

               QUIT 

 +5        IF $ORDER(^APCM24OB(APCMY,31,0))

               SET N=31

               WRITE !!

               DO ET

 +6       ;

IMMIND2   ;ask individually

 +1        SET APCMP=0

           FOR 

               SET APCMP=$ORDER(APCMPRV(APCMP))

               IF APCMP'=+APCMP!(APCMQ)

                   QUIT 

               Begin DoDot:1

 +2       ;excluded

                   IF APCMATTE(APCMX,APCMP)="N/A"

                       QUIT 

 +3                WRITE !

                   SET DIR(0)="Y"

                   SET DIR("A")="Does "_$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_" attest to this"

                   SET DIR("B")="YES"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +4                IF $DATA(DIRUT)

                       SET APCMQ=1

                       QUIT 

 +5                SET APCMATTE(APCMX,APCMP)=$SELECT(Y:"Yes",1:"No")

               End DoDot:1

 +6        QUIT 

SPECREG   ;EP

 +1        QUIT 

IMMREGH   ;EP - ask additional exclusion questions for IMM REG

 +1        SET APCMQ=0

 +2        SET APCMY=$ORDER(^APCM24OB("B",APCMX,0))

 +3       ;measure not being run

           IF '$DATA(APCMIND(APCMY))

               QUIT 

 +4       ;display exclusion text/narrative

 +5        IF $ORDER(^APCM24OB(APCMY,19,0))

               SET N=19

               WRITE !!

               DO ET

 +6       ;ask individually

 +7        SET APCMP=APCMFAC

           Begin DoDot:1

 +8            SET APCMZ=0

               FOR 

                   SET APCMZ=$ORDER(^APCM24OB(APCMY,24,APCMZ))

                   IF APCMZ'=+APCMZ

                       QUIT 

                   WRITE !,^APCM24OB(APCMY,24,APCMZ,0)

 +9            WRITE !

               SET DIR(0)="Y"

               SET DIR("A")="Does "_$EXTRACT($PIECE(^DIC(4,APCMP,0),U,1),1,25)_" meet this exclusion"

 +10           SET DIR("B")="YES"

 +11           IF $PIECE(^APCM24OB(APCMY,0),U,1)="S2.025.H.1"

                   SET DIR("B")="NO"

 +12           KILL DA

               DO ^DIR

               KILL DIR

 +13           IF $DATA(DIRUT)

                   SET APCMQ=1

                   QUIT 

 +14           SET APCMATTE(APCMX,APCMP)=$SELECT(Y:"N/A",1:"")

           End DoDot:1

IMMH2     ;display exclusion text/narrative

 +1        SET APCMP=0

           SET E=0

           SET T=0

           FOR 

               SET APCMP=$ORDER(APCMATTE(APCMX,APCMP))

               IF APCMP=""!(APCMQ)

                   QUIT 

               Begin DoDot:1

 +2                SET T=T+1

 +3       ;excluded so don't ask

                   IF APCMATTE(APCMX,APCMP)="N/A"

                       SET E=E+1

               End DoDot:1

 +4       ;all excluded

           IF E=T

               QUIT 

 +5        IF $ORDER(^APCM24OB(APCMY,31,0))

               SET N=31

               WRITE !!

               DO ET

 +6       ;

IMMINDH2  ;ask individually

 +1        SET APCMP=APCMFAC

           Begin DoDot:1

 +2       ;excluded

               IF APCMATTE(APCMX,APCMP)="N/A"

                   QUIT 

 +3            WRITE !

               SET DIR(0)="Y"

               SET DIR("A")="Does "_$EXTRACT($PIECE(^DIC(4,APCMP,0),U,1),1,25)_" attest to this"

               SET DIR("B")="YES"

               KILL DA

               DO ^DIR

               KILL DIR

 +4            IF $DATA(DIRUT)

                   SET APCMQ=1

                   QUIT 

 +5            SET APCMATTE(APCMX,APCMP)=$SELECT(Y:"Yes",1:"No")

           End DoDot:1

 +6        QUIT