BGP9CSII.m

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

 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 ;; ;

EP ;EP - CALLED FROM OPTION

 D EN

 Q

EOJ ;EP

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

 Q

 ;; ;

EN ;EP -- main entry point for CMS PT LIST DISPLAY

 D EN^VALM("BGP 09 CMS MEASURE PT LISTS")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="CMS Clinical Performance Topics"

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

 Q

 ;

INIT ; -- init variables and list array

 K BGPPLST S BGPHIGH=""

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

 .S C=C+1,BGPPLST(C,0)=C_")",$E(BGPPLST(C,0),5)=$P(^BGPCMSMN(Y,0),U,3),BGPPLST(C,C)=Y I $D(BGPPLSTL(BGPXX,Y)) S BGPPLST(C,0)="*"_BGPPLST(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"

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

 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 BGPPLSTL(BGPXX,BGPPLST(BGPC,BGPC))=""

ADDX ;

 D BACK

 Q

ADDALL ;

 F X=1:1:BGPHIGH S BGPPLSTL(BGPXX,X)=""

 D BACK

 Q

 ;

REM ;

 W ! S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which Patient List(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 BGPPLSTL(BGPXX,BGPPLST(BGPC,BGPC))

REMX ;

 D BACK

 Q

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

 +1       ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 +2       ;; ;

EP        ;EP - CALLED FROM OPTION

 +1        DO EN

 +2        QUIT 

EOJ       ;EP

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

 +2        QUIT 

 +3       ;; ;

EN        ;EP -- main entry point for CMS PT LIST DISPLAY

 +1        DO EN^VALM("BGP 09 CMS MEASURE PT LISTS")

 +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)="CMS Clinical Performance Topics"

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

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        KILL BGPPLST

           SET BGPHIGH=""

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

           FOR 

               SET X=$ORDER(^BGPCMSMN("AO",BGPXX,X))

               IF X'=+X

                   QUIT 

               SET Y=$ORDER(^BGPCMSMN("AO",BGPXX,X,Y))

               IF Y'=+Y

                   QUIT 

               Begin DoDot:1

 +3                SET C=C+1

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

                   SET $EXTRACT(BGPPLST(C,0),5)=$PIECE(^BGPCMSMN(Y,0),U,3)

                   SET BGPPLST(C,C)=Y

                   IF $DATA(BGPPLSTL(BGPXX,Y))

                       SET BGPPLST(C,0)="*"_BGPPLST(C,0)

 +4                QUIT 

               End DoDot:1

 +5        SET (VALMCNT,BGPHIGH)=C

 +6        QUIT 

 +7       ;

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:"_BGPHIGH

           SET DIR("A")="Which Patient List"

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +5        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +6        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +7        SET BGPANS=Y

           SET BGPC=""

           FOR BGPI=1:1

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

               IF BGPC=""

                   QUIT 

               SET BGPPLSTL(BGPXX,BGPPLST(BGPC,BGPC))=""

ADDX      ;

 +1        DO BACK

 +2        QUIT 

ADDALL    ;

 +1        FOR X=1:1:BGPHIGH

               SET BGPPLSTL(BGPXX,X)=""

 +2        DO BACK

 +3        QUIT 

 +4       ;

REM       ;

 +1        WRITE !

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

           SET DIR("A")="Which Patient List(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 BGPPLSTL(BGPXX,BGPPLST(BGPC,BGPC))

REMX      ;

 +1        DO BACK

 +2        QUIT