BGP3DSI.m

BGP3DSI ; IHS/CMI/LAB - DISPLAY IND LISTS ;

 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 ;; ;

EP ;EP - CALLED FROM OPTION

 D EN

 Q

EOJ ;EP

 K BGPTIND,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX

 Q

 ;; ;

EN ;EP -- main entry point for APCH HMR DISPLAY

 D EN^VALM("BGP 13 INDICATOR SELECTION")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

HDR ; -- header code

 I BGPRTYPE'=1 S VALMHDR(1)="IHS Clinical Performance Measures"

 I BGPRTYPE=1 S VALMHDR(1)="IHS GPRA/GPRAMA Clinical Performance Measures (incl developmental measures)"

 S VALMHDR(2)="* indicates the performance measure has been selected"

 Q

 ;

INIT ; -- init variables and list array

 ;I BGPRTYPE=1,$G(BGPNPL) G INITPL

 K BGPTIND S BGPHIGH=""

 S (X,Y,Z,C)=0 F  S X=$O(^BGPINDH("AOI",X)) Q:X'=+X  S Y=0 F  S Y=$O(^BGPINDH("AOI",X,Y))  Q:Y'=+Y  D

 .I $G(BGPRTYPE)=1,$P(^BGPINDH(Y,0),U,7)'=1 Q

 .I $G(BGPRTYPE)=7,$P($G(^BGPINDH(Y,12)),U,1)'=1 Q

 .I $G(BGPRTYPE)=4,$P($G(^BGPINDH(Y,13)),U,1)=1 Q

 .I $G(BGPNPL),'$D(^BGPNPLH("AR",Y,$S(BGPRTYPE=1:"N",1:"O"))) Q

 .S C=C+1,BGPTIND(C,0)=C_")",$E(BGPTIND(C,0),5)=$P(^BGPINDH(Y,0),U,3),BGPTIND(C,C)=Y I $D(BGPIND(Y)) S BGPTIND(C,0)="*"_BGPTIND(C,0)

 .Q

 S (VALMCNT,BGPHIGH)=C

 Q

INITPL ;

 ;K BGPTIND S BGPHIGH=""

 ;get dev measures first and put (GPRA Dev.) on end

 ;S (X,Y,Z,C)=0 F  S X=$O(^BGPINDH("ADEVO",X)) Q:X'=+X  S Y=0 F  S Y=$O(^BGPINDH("ADEVO",X,Y)) Q:Y'=+Y  D

 ;.I $D(^BGPNPLH("AR",Y,"N")) Q

 ;.S C=C+1,BGPTIND(C,0)=C_")",$E(BGPTIND(C,0),5)=$P(^BGPINDH(Y,0),U,3)_" (GPRA Dev.)",BGPTIND(C,C)=Y I $D(BGPIND(Y)) S BGP

 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

 NEW BGPMCNT

 S BGPMCNT=0

 W !

 I $G(BGPYNPLT)=1 S DIR(0)="NO^1:"_BGPHIGH,DIR("A")="Select Only One Measure" G ADD1

 I $G(BGPRTYPE)'=1 S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which item(s)"

 I $G(BGPRTYPE)=1 S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which Measure Topic"

ADD1 ;

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 S BGPANS=Y,BGPC="" F BGPI=1:1 S BGPC=$P(BGPANS,",",BGPI) Q:BGPC=""  S BGPIND(BGPTIND(BGPC,BGPC))=""

 I BGPYRPTH="A" D   I BGPMCNT>15 W !!,"You can only select up to 15 Topics, please choose command 'S' again",!,"and reselect your topics." K BGPIND D PAUSE^BGP3DU

 .S X=0 F  S X=$O(BGPIND(X)) Q:X'=+X  S BGPMCNT=BGPMCNT+1

ADDX ;

 D BACK

 Q

ADDALL ;

 I $G(BGPYRPTH)="A" W !!,"Sorry, this option isn't available when running for ALL Communities." D PAUSE^BGP3DU,BACK Q

 F X=1:1:BGPHIGH S BGPIND(X)=""

 D BACK

 Q

 ;

REM ;

 W ! S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 S BGPANS=Y,BGPC="" F BGPI=1:1 S BGPC=$P(BGPANS,",",BGPI) Q:BGPC=""  K BGPIND(BGPTIND(BGPC,BGPC))

REMX ;

 D BACK

 Q

BGP3DSI   ; IHS/CMI/LAB - DISPLAY IND LISTS ;

 +1       ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 +2       ;; ;

EP        ;EP - CALLED FROM OPTION

 +1        DO EN

 +2        QUIT 

EOJ       ;EP

 +1        KILL BGPTIND,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX

 +2        QUIT 

 +3       ;; ;

EN        ;EP -- main entry point for APCH HMR DISPLAY

 +1        DO EN^VALM("BGP 13 INDICATOR SELECTION")

 +2        DO CLEAR^VALM1

 +3        DO FULL^VALM1

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        DO EOJ

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        IF BGPRTYPE'=1

               SET VALMHDR(1)="IHS Clinical Performance Measures"

 +2        IF BGPRTYPE=1

               SET VALMHDR(1)="IHS GPRA/GPRAMA Clinical Performance Measures (incl developmental measures)"

 +3        SET VALMHDR(2)="* indicates the performance measure has been selected"

 +4        QUIT 

 +5       ;

INIT      ; -- init variables and list array

 +1       ;I BGPRTYPE=1,$G(BGPNPL) G INITPL

 +2        KILL BGPTIND

           SET BGPHIGH=""

 +3        SET (X,Y,Z,C)=0

           FOR 

               SET X=$ORDER(^BGPINDH("AOI",X))

               IF X'=+X

                   QUIT 

               SET Y=0

               FOR 

                   SET Y=$ORDER(^BGPINDH("AOI",X,Y))

                   IF Y'=+Y

                       QUIT 

                   Begin DoDot:1

 +4                    IF $GET(BGPRTYPE)=1

                           IF $PIECE(^BGPINDH(Y,0),U,7)'=1

                               QUIT 

 +5                    IF $GET(BGPRTYPE)=7

                           IF $PIECE($GET(^BGPINDH(Y,12)),U,1)'=1

                               QUIT 

 +6                    IF $GET(BGPRTYPE)=4

                           IF $PIECE($GET(^BGPINDH(Y,13)),U,1)=1

                               QUIT 

 +7                    IF $GET(BGPNPL)

                           IF '$DATA(^BGPNPLH("AR",Y,$SELECT(BGPRTYPE=1:"N",1:"O")))

                               QUIT 

 +8                    SET C=C+1

                       SET BGPTIND(C,0)=C_")"

                       SET $EXTRACT(BGPTIND(C,0),5)=$PIECE(^BGPINDH(Y,0),U,3)

                       SET BGPTIND(C,C)=Y

                       IF $DATA(BGPIND(Y))

                           SET BGPTIND(C,0)="*"_BGPTIND(C,0)

 +9                    QUIT 

                   End DoDot:1

 +10       SET (VALMCNT,BGPHIGH)=C

 +11       QUIT 

INITPL    ;

 +1       ;K BGPTIND S BGPHIGH=""

 +2       ;get dev measures first and put (GPRA Dev.) on end

 +3       ;S (X,Y,Z,C)=0 F  S X=$O(^BGPINDH("ADEVO",X)) Q:X'=+X  S Y=0 F  S Y=$O(^BGPINDH("ADEVO",X,Y)) Q:Y'=+Y  D

 +4       ;.I $D(^BGPNPLH("AR",Y,"N")) Q

 +5       ;.S C=C+1,BGPTIND(C,0)=C_")",$E(BGPTIND(C,0),5)=$P(^BGPINDH(Y,0),U,3)_" (GPRA Dev.)",BGPTIND(C,C)=Y I $D(BGPIND(Y)) S BGP

 +6        QUIT 

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        NEW BGPMCNT

 +2        SET BGPMCNT=0

 +3        WRITE !

 +4        IF $GET(BGPYNPLT)=1

               SET DIR(0)="NO^1:"_BGPHIGH

               SET DIR("A")="Select Only One Measure"

               GOTO ADD1

 +5        IF $GET(BGPRTYPE)'=1

               SET DIR(0)="LO^1:"_BGPHIGH

               SET DIR("A")="Which item(s)"

 +6        IF $GET(BGPRTYPE)=1

               SET DIR(0)="LO^1:"_BGPHIGH

               SET DIR("A")="Which Measure Topic"

ADD1      ;

 +1        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        SET BGPANS=Y

           SET BGPC=""

           FOR BGPI=1:1

               SET BGPC=$PIECE(BGPANS,",",BGPI)

               IF BGPC=""

                   QUIT 

               SET BGPIND(BGPTIND(BGPC,BGPC))=""

 +6        IF BGPYRPTH="A"

               Begin DoDot:1

 +7                SET X=0

                   FOR 

                       SET X=$ORDER(BGPIND(X))

                       IF X'=+X

                           QUIT 

                       SET BGPMCNT=BGPMCNT+1

               End DoDot:1

               IF BGPMCNT>15

                   WRITE !!,"You can only select up to 15 Topics, please choose command 'S' again",!,"and reselect your topics."

                   KILL BGPIND

                   DO PAUSE^BGP3DU

ADDX      ;

 +1        DO BACK

 +2        QUIT 

ADDALL    ;

 +1        IF $GET(BGPYRPTH)="A"

               WRITE !!,"Sorry, this option isn't available when running for ALL Communities."

               DO PAUSE^BGP3DU

               DO BACK

               QUIT 

 +2        FOR X=1:1:BGPHIGH

               SET BGPIND(X)=""

 +3        DO BACK

 +4        QUIT 

 +5       ;

REM       ;

 +1        WRITE !

           SET DIR(0)="LO^1:"_BGPHIGH

           SET DIR("A")="Which item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        SET BGPANS=Y

           SET BGPC=""

           FOR BGPI=1:1

               SET BGPC=$PIECE(BGPANS,",",BGPI)

               IF BGPC=""

                   QUIT 

               KILL BGPIND(BGPTIND(BGPC,BGPC))

REMX      ;

 +1        DO BACK

 +2        QUIT