APCM11SI ; IHS/CMI/LAB - IHS MU ;
;;1.0;IHS MU PERFORMANCE REPORTS;**1**;MAR 26, 2012
;; ;
EP ;EP - CALLED FROM OPTION
D EN
Q
EOJ ;EP
K APCMTIND,APCMHIGH,APCMANS,APCMC,APCMGANS,APCMGC,APCMGI,APCMI,APCMX
Q
;; ;
EN ;EP -- main entry point for SELECTION
D EN^VALM("APCM S1 INDICATOR SEL")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
HDR ; -- header code
S VALMHDR(1)="IHS MU PERFORMANCE MEASUREs"
S VALMHDR(2)="* indicates the Performance Measure has been selected"
Q
;
INIT ; -- init variables and list array
K APCMTIND S APCMHIGH=""
S APCMXREF=$S(APCMRPTT=1:"EOORDER",1:"AH")
S (X,Y,Z,C)=0 F S X=$O(^APCMMUM("EOORDER",X)) Q:X'=+X F S Y=$O(^APCMMUM(APCMXREF,X,Y)) Q:Y'=+Y D
.S C=C+1,APCMTIND(C,0)=C_")",$E(APCMTIND(C,0),5)="("_$P(^APCMMUM(Y,0),U,3)_") "_$P(^APCMMUM(Y,0),U,5),APCMTIND(C,C)=Y I $D(APCMIND(Y)) S APCMTIND(C,0)="*"_APCMTIND(C,0)
.Q
S (VALMCNT,APCMHIGH)=C
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
;
ADD ;EP - add an item to the selected list - called from a protocol
W !
S DIR(0)="LO^1:"_APCMHIGH,DIR("A")="Which Performance Measure(s)"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No Performance Measures selected." G ADDX
I $D(DIRUT) W !,"No Performance Measures selected." G ADDX
D FULL^VALM1 W:$D(IOF) @IOF
S APCMANS=Y,APCMC="" F APCMI=1:1 S APCMC=$P(APCMANS,",",APCMI) Q:APCMC="" S APCMIND(APCMTIND(APCMC,APCMC))=""
ADDX ;
D BACK
Q
ADDALL ;
F X=1:1:APCMHIGH S APCMIND(X)=""
D BACK
Q
;
MS ;
F X=1:1:APCMHIGH I $P(^APCMMUM(X,0),U,3)="M" S APCMIND(X)=""
D BACK
Q
;
CM ;
F X=1:1:APCMHIGH I $P(^APCMMUM(X,0),U,3)="C" S APCMIND(X)=""
D BACK
Q
;
REM ;
W ! S DIR(0)="LO^1:"_APCMHIGH,DIR("A")="Which Performance Measure(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No Performance Measures selected." G ADDX
I $D(DIRUT) W !,"No Performance Measures selected." G ADDX
D FULL^VALM1 W:$D(IOF) @IOF
S APCMANS=Y,APCMC="" F APCMI=1:1 S APCMC=$P(APCMANS,",",APCMI) Q:APCMC="" K APCMIND(APCMTIND(APCMC,APCMC))
REMX ;
D BACK
Q
APCM11SI ; IHS/CMI/LAB - IHS MU ;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**1**;MAR 26, 2012
+2 ;; ;
EP ;EP - CALLED FROM OPTION
+1 DO EN
+2 QUIT
EOJ ;EP
+1 KILL APCMTIND,APCMHIGH,APCMANS,APCMC,APCMGANS,APCMGC,APCMGI,APCMI,APCMX
+2 QUIT
+3 ;; ;
EN ;EP -- main entry point for SELECTION
+1 DO EN^VALM("APCM S1 INDICATOR SEL")
+2 DO CLEAR^VALM1
+3 DO FULL^VALM1
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EOJ
+6 QUIT
+7 ;
HDR ; -- header code
+1 SET VALMHDR(1)="IHS MU PERFORMANCE MEASUREs"
+2 SET VALMHDR(2)="* indicates the Performance Measure has been selected"
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 KILL APCMTIND
SET APCMHIGH=""
+2 SET APCMXREF=$SELECT(APCMRPTT=1:"EOORDER",1:"AH")
+3 SET (X,Y,Z,C)=0
FOR
SET X=$ORDER(^APCMMUM("EOORDER",X))
IF X'=+X
QUIT
FOR
SET Y=$ORDER(^APCMMUM(APCMXREF,X,Y))
IF Y'=+Y
QUIT
Begin DoDot:1
+4 SET C=C+1
SET APCMTIND(C,0)=C_")"
SET $EXTRACT(APCMTIND(C,0),5)="("_$PIECE(^APCMMUM(Y,0),U,3)_") "_$PIECE(^APCMMUM(Y,0),U,5)
SET APCMTIND(C,C)=Y
IF $DATA(APCMIND(Y))
SET APCMTIND(C,0)="*"_APCMTIND(C,0)
+5 QUIT
End DoDot:1
+6 SET (VALMCNT,APCMHIGH)=C
+7 QUIT
+8 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
+8 ;
ADD ;EP - add an item to the selected list - called from a protocol
+1 WRITE !
+2 SET DIR(0)="LO^1:"_APCMHIGH
SET DIR("A")="Which Performance Measure(s)"
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF Y=""
WRITE !,"No Performance Measures selected."
GOTO ADDX
+5 IF $DATA(DIRUT)
WRITE !,"No Performance Measures selected."
GOTO ADDX
+6 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+7 SET APCMANS=Y
SET APCMC=""
FOR APCMI=1:1
SET APCMC=$PIECE(APCMANS,",",APCMI)
IF APCMC=""
QUIT
SET APCMIND(APCMTIND(APCMC,APCMC))=""
ADDX ;
+1 DO BACK
+2 QUIT
ADDALL ;
+1 FOR X=1:1:APCMHIGH
SET APCMIND(X)=""
+2 DO BACK
+3 QUIT
+4 ;
MS ;
+1 FOR X=1:1:APCMHIGH
IF $PIECE(^APCMMUM(X,0),U,3)="M"
SET APCMIND(X)=""
+2 DO BACK
+3 QUIT
+4 ;
CM ;
+1 FOR X=1:1:APCMHIGH
IF $PIECE(^APCMMUM(X,0),U,3)="C"
SET APCMIND(X)=""
+2 DO BACK
+3 QUIT
+4 ;
REM ;
+1 WRITE !
SET DIR(0)="LO^1:"_APCMHIGH
SET DIR("A")="Which Performance Measure(s)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF Y=""
WRITE !,"No Performance Measures selected."
GOTO ADDX
+3 IF $DATA(DIRUT)
WRITE !,"No Performance Measures selected."
GOTO ADDX
+4 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+5 SET APCMANS=Y
SET APCMC=""
FOR APCMI=1:1
SET APCMC=$PIECE(APCMANS,",",APCMI)
IF APCMC=""
QUIT
KILL APCMIND(APCMTIND(APCMC,APCMC))
REMX ;
+1 DO BACK
+2 QUIT
