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
