- APCM25SI ; IHS/CMI/LAB - IHS MU ;
- ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
- ;; ;
- 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 25 S2 INDICATOR SEL")
- D CLEAR^VALM1
- D FULL^VALM1
- W:$D(IOF) @IOF
- D EOJ
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)="IHS Modified Stage 2 MU Performance Reports"
- 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(^APCM25OB(APCMXREF,X)) Q:X'=+X F S Y=$O(^APCM25OB(APCMXREF,X,Y)) Q:Y'=+Y D
- .S C=C+1,APCMTIND(C,0)=C_")",$E(APCMTIND(C,0),5)=$P(^APCM25OB(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 ;
- S X=0 F S X=$O(APCMTIND(X)) Q:X'=+X S APCMIND(APCMTIND(X,X))=""
- D BACK
- Q
- ;
- MS ;
- S X=0 F S X=$O(APCMTIND(X)) Q:X'=+X S Y=APCMTIND(X,X) I $P(^APCM25OB(Y,0),U,3)="M" S APCMIND(APCMTIND(X,X))=""
- D BACK
- Q
- ;
- CM ;
- S X=0 F S X=$O(APCMTIND(X)) Q:X'=+X S Y=APCMTIND(X,X) I $P(^APCM25OB(Y,0),U,3)="C" S APCMIND(APCMTIND(X,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
- APCM25SI ; IHS/CMI/LAB - IHS MU ;
- +1 ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
- +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 25 S2 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 Modified Stage 2 MU Performance Reports"
- +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(^APCM25OB(APCMXREF,X))
- IF X'=+X
- QUIT
- FOR
- SET Y=$ORDER(^APCM25OB(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(^APCM25OB(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 SET X=0
- FOR
- SET X=$ORDER(APCMTIND(X))
- IF X'=+X
- QUIT
- SET APCMIND(APCMTIND(X,X))=""
- +2 DO BACK
- +3 QUIT
- +4 ;
- MS ;
- +1 SET X=0
- FOR
- SET X=$ORDER(APCMTIND(X))
- IF X'=+X
- QUIT
- SET Y=APCMTIND(X,X)
- IF $PIECE(^APCM25OB(Y,0),U,3)="M"
- SET APCMIND(APCMTIND(X,X))=""
- +2 DO BACK
- +3 QUIT
- +4 ;
- CM ;
- +1 SET X=0
- FOR
- SET X=$ORDER(APCMTIND(X))
- IF X'=+X
- QUIT
- SET Y=APCMTIND(X,X)
- IF $PIECE(^APCM25OB(Y,0),U,3)="C"
- SET APCMIND(APCMTIND(X,X))=""
- +2 DO BACK
- +3 QUIT
- 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