BGPMUDSI.m

BGPMUDSI ; IHS/MSC/MMT - DISPLAY MEASURE LISTS ;02-Mar-2011 16:50;MGH

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;; ;

EP ;EP - CALLED FROM OPTION

 D EN

 Q

EOJ ;EP

 K BGPMUMEA,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX,BGPLSEL

 Q

 ;; ;

EN ;EP -- main entry point

 S BGPLSEL="A"

 D EN^VALM("BGPMU 11 MEASURE SELECTION")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

ENH ;EP -- main entry point for Hospital measures

 S BGPLSEL="H"

 D EN^VALM("BGPMU 11 HOSPITAL MEASURE SEL")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

ENM ;EP -- main entry point for Menu Set measure selection

 S BGPLSEL="M"

 D EN^VALM("BGPMU 11 EP MENU MEASURE SEL")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="IHS Meaningful Use Clinical Quality Measures"

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

 Q

 ;

INIT ; ALL EP Measures -- init variables and list array

 N X,Y,X,C

 K BGPMUMEA S BGPHIGH=""

 S (X,Y,Z,C)=0 F  S X=$O(^BGPMUIND(BGPMUYF,"ADO",X)) Q:X'=+X  S Y=0 F  S Y=$O(^BGPMUIND(BGPMUYF,"ADO",X,Y))  Q:Y'=+Y  I $D(^BGPMUIND(BGPMUYF,Y)),$P($G(^BGPMUIND(BGPMUYF,Y,0)),U,4)'="H" D

 .S BGPMUDAT=^BGPMUIND(BGPMUYF,Y,0),C=C+1,BGPMUMEA(C,0)=C_")",$E(BGPMUMEA(C,0),5)="("_$P(BGPMUDAT,U,4)_") "_$P(BGPMUDAT,U,3),BGPMUMEA(C,C)=Y I $D(BGPIND(Y)) S BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)

 .Q

 S (VALMCNT,BGPHIGH)=C

 Q

INITM ;EP - Only Menu Set Measures -- init variables and list array

 K BGPMUMEA S BGPHIGH=""

 N X,Y,Z,C

 S (X,Y,Z,C)=0 F  S X=$O(^BGPMUIND(BGPMUYF,"ADO",X)) Q:X'=+X  S Y=0 F  S Y=$O(^BGPMUIND(BGPMUYF,"ADO",X,Y))  Q:Y'=+Y  I $D(^BGPMUIND(BGPMUYF,"AMS","M",Y)) D

 .S C=C+1,BGPMUMEA(C,0)=C_")",$E(BGPMUMEA(C,0),5)=$P(^BGPMUIND(BGPMUYF,Y,0),U,3),BGPMUMEA(C,C)=Y I $D(BGPIND(Y)) S BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)

 .Q

 S (VALMCNT,BGPHIGH)=C

 Q

INITH ;EP - ALL Hospital Measures -- init variables and list array

 K BGPMUMEA S BGPHIGH=""

 N X,Y,Z,C

 S (X,Y,Z,C)=0 F  S X=$O(^BGPMUIND(BGPMUYF,"ADO",X)) Q:X'=+X  S Y=0 F  S Y=$O(^BGPMUIND(BGPMUYF,"ADO",X,Y))  Q:Y'=+Y  I $D(^BGPMUIND(BGPMUYF,Y)),$P($G(^BGPMUIND(BGPMUYF,Y,0)),U,4)="H" D

 .S C=C+1,BGPMUMEA(C,0)=C_")",$E(BGPMUMEA(C,0),5)=$P(^BGPMUIND(BGPMUYF,Y,0),U,3),BGPMUMEA(C,C)=Y I $D(BGPIND(Y)) S BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)

 .Q

 S (VALMCNT,BGPHIGH)=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"

 I BGPLSEL="A" D INIT

 I BGPLSEL="M" D INITM

 I BGPLSEL="H" D INITH

 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:"_BGPHIGH,DIR("A")="Which item(s)"

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(BGPMUMEA(BGPC,BGPC))=""

ADDX ;

 D BACK

 Q

ADDALL ;

 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(BGPMUMEA(BGPC,BGPC))

REMX ;

 D BACK

 Q

BGPMUDSI  ; IHS/MSC/MMT - DISPLAY MEASURE LISTS ;02-Mar-2011 16:50;MGH

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 +2       ;; ;

EP        ;EP - CALLED FROM OPTION

 +1        DO EN

 +2        QUIT 

EOJ       ;EP

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

 +2        QUIT 

 +3       ;; ;

EN        ;EP -- main entry point

 +1        SET BGPLSEL="A"

 +2        DO EN^VALM("BGPMU 11 MEASURE SELECTION")

 +3        DO CLEAR^VALM1

 +4        DO FULL^VALM1

 +5        IF $DATA(IOF)

               WRITE @IOF

 +6        DO EOJ

 +7        QUIT 

 +8       ;

ENH       ;EP -- main entry point for Hospital measures

 +1        SET BGPLSEL="H"

 +2        DO EN^VALM("BGPMU 11 HOSPITAL MEASURE SEL")

 +3        DO CLEAR^VALM1

 +4        DO FULL^VALM1

 +5        IF $DATA(IOF)

               WRITE @IOF

 +6        DO EOJ

 +7        QUIT 

 +8       ;

ENM       ;EP -- main entry point for Menu Set measure selection

 +1        SET BGPLSEL="M"

 +2        DO EN^VALM("BGPMU 11 EP MENU MEASURE SEL")

 +3        DO CLEAR^VALM1

 +4        DO FULL^VALM1

 +5        IF $DATA(IOF)

               WRITE @IOF

 +6        DO EOJ

 +7        QUIT 

 +8       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="IHS Meaningful Use Clinical Quality Measures"

 +2        SET VALMHDR(2)="* indicates the clinical quality measure has been selected"

 +3        QUIT 

 +4       ;

INIT      ; ALL EP Measures -- init variables and list array

 +1        NEW X,Y,X,C

 +2        KILL BGPMUMEA

           SET BGPHIGH=""

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

           FOR 

               SET X=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X))

               IF X'=+X

                   QUIT 

               SET Y=0

               FOR 

                   SET Y=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X,Y))

                   IF Y'=+Y

                       QUIT 

                   IF $DATA(^BGPMUIND(BGPMUYF,Y))

                       IF $PIECE($GET(^BGPMUIND(BGPMUYF,Y,0)),U,4)'="H"

                           Begin DoDot:1

 +4                            SET BGPMUDAT=^BGPMUIND(BGPMUYF,Y,0)

                               SET C=C+1

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

                               SET $EXTRACT(BGPMUMEA(C,0),5)="("_$PIECE(BGPMUDAT,U,4)_") "_$PIECE(BGPMUDAT,U,3)

                               SET BGPMUMEA(C,C)=Y

                               IF $DATA(BGPIND(Y))

                                   SET BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)

 +5                            QUIT 

                           End DoDot:1

 +6        SET (VALMCNT,BGPHIGH)=C

 +7        QUIT 

INITM     ;EP - Only Menu Set Measures -- init variables and list array

 +1        KILL BGPMUMEA

           SET BGPHIGH=""

 +2        NEW X,Y,Z,C

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

           FOR 

               SET X=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X))

               IF X'=+X

                   QUIT 

               SET Y=0

               FOR 

                   SET Y=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X,Y))

                   IF Y'=+Y

                       QUIT 

                   IF $DATA(^BGPMUIND(BGPMUYF,"AMS","M",Y))

                       Begin DoDot:1

 +4                        SET C=C+1

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

                           SET $EXTRACT(BGPMUMEA(C,0),5)=$PIECE(^BGPMUIND(BGPMUYF,Y,0),U,3)

                           SET BGPMUMEA(C,C)=Y

                           IF $DATA(BGPIND(Y))

                               SET BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)

 +5                        QUIT 

                       End DoDot:1

 +6        SET (VALMCNT,BGPHIGH)=C

 +7        QUIT 

INITH     ;EP - ALL Hospital Measures -- init variables and list array

 +1        KILL BGPMUMEA

           SET BGPHIGH=""

 +2        NEW X,Y,Z,C

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

           FOR 

               SET X=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X))

               IF X'=+X

                   QUIT 

               SET Y=0

               FOR 

                   SET Y=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X,Y))

                   IF Y'=+Y

                       QUIT 

                   IF $DATA(^BGPMUIND(BGPMUYF,Y))

                       IF $PIECE($GET(^BGPMUIND(BGPMUYF,Y,0)),U,4)="H"

                           Begin DoDot:1

 +4                            SET C=C+1

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

                               SET $EXTRACT(BGPMUMEA(C,0),5)=$PIECE(^BGPMUIND(BGPMUYF,Y,0),U,3)

                               SET BGPMUMEA(C,C)=Y

                               IF $DATA(BGPIND(Y))

                                   SET BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)

 +5                            QUIT 

                           End DoDot:1

 +6        SET (VALMCNT,BGPHIGH)=C

 +7        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        IF BGPLSEL="A"

               DO INIT

 +4        IF BGPLSEL="M"

               DO INITM

 +5        IF BGPLSEL="H"

               DO INITH

 +6        DO HDR

 +7        KILL DIR

 +8        KILL X,Y,Z,I

 +9        QUIT 

 +10      ;

ADD       ;EP - add an item to the selected list - called from a protocol

 +1        WRITE !

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

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

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(BGPMUMEA(BGPC,BGPC))=""

ADDX      ;

 +1        DO BACK

 +2        QUIT 

ADDALL    ;

 +1        FOR X=1:1:BGPHIGH

               SET BGPIND(X)=""

 +2        DO BACK

 +3        QUIT 

 +4       ;

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(BGPMUMEA(BGPC,BGPC))

REMX      ;

 +1        DO BACK

 +2        QUIT