Routine: BUDDDSI

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

 ;;11.0;IHS/RPMS UNIFORM DATA SYSTEM;;JAN 18, 2017;Build 66

 ;; ;

EP ;EP - CALLED FROM OPTION

 D EN

EOJ ;EP

 K BUDTIND,BUDHIGH,BUDANS,BUDD,BUDGANS,BUDGC,BUDGI,BUDI,BUDX

 ;; ;

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

 D EN^VALM("BUD 16 MEASURE SELECTION")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

HDR ; -- header code

 S VALMHDR(1)="UDS Lists for Table 6B"

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

INIT ; -- init variables and list array

 K BUDTIND S BUDHIGH=""

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

 .S C=C+1,BUDTIND(C,0)=C_")",$E(BUDTIND(C,0),5)=$P(^BUDDLST2(Y,0),U,1),BUDTIND(C,C)=Y I $D(BUDIND(Y)) S BUDTIND(C,0)="*"_BUDTIND(C,0)

.Q

 S (VALMCNT,BUDHIGH)=C

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ; -- exit code

EXPND ; -- expand code

BACK ;go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

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

 NEW BUDMCNT

 S BUDMCNT=0

W !

 S DIR(0)="LO^1:"_BUDHIGH,DIR("A")="Which List(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 BUDANS=Y,BUDD="" F BUDI=1:1 S BUDD=$P(BUDANS,",",BUDI) Q:BUDD=""  S BUDIND(BUDTIND(BUDD,BUDD))=""

ADDX ;

 D BACK

ADDALL ;

 F X=1:1:BUDHIGH S BUDIND(X)=""

 D BACK

REM ;

 W ! S DIR(0)="LO^1:"_BUDHIGH,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 BUDANS=Y,BUDD="" F BUDI=1:1 S BUDD=$P(BUDANS,",",BUDI) Q:BUDD=""  K BUDIND(BUDTIND(BUDD,BUDD))

REMX ;

 D BACK

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

 +1       ;;11.0;IHS/RPMS UNIFORM DATA SYSTEM;;JAN 18, 2017;Build 66

 +2       ;; ;

EP        ;EP - CALLED FROM OPTION

 +1        DO EN

 +2        QUIT

EOJ       ;EP

 +1        KILL BUDTIND,BUDHIGH,BUDANS,BUDD,BUDGANS,BUDGC,BUDGI,BUDI,BUDX

 +2        QUIT

 +3       ;; ;

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

 +1        DO EN^VALM("BUD 16 MEASURE 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        SET VALMHDR(1)="UDS Lists for Table 6B"

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

 +3        QUIT

 +4       ;

INIT      ; -- init variables and list array

 +1        KILL BUDTIND

           SET BUDHIGH=""

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

FOR

               SET X=$ORDER(^BUDDLST2("OR",X))

               IF X'=+X

                   QUIT

               SET Y=0

FOR

                   SET Y=$ORDER(^BUDDLST2("OR",X,Y))

                   IF Y'=+Y

                       QUIT

                   Begin DoDot:1

 +3                    SET C=C+1

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

                       SET $EXTRACT(BUDTIND(C,0),5)=$PIECE(^BUDDLST2(Y,0),U,1)

                       SET BUDTIND(C,C)=Y

                       IF $DATA(BUDIND(Y))

                           SET BUDTIND(C,0)="*"_BUDTIND(C,0)

 +4                    QUIT

                   End DoDot:1

 +5        SET (VALMCNT,BUDHIGH)=C

 +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 BUDMCNT

 +2        SET BUDMCNT=0

 +3        WRITE !

 +4        SET DIR(0)="LO^1:"_BUDHIGH

           SET DIR("A")="Which List(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 BUDANS=Y

           SET BUDD=""

           FOR BUDI=1:1

               SET BUDD=$PIECE(BUDANS,",",BUDI)

               IF BUDD=""

                   QUIT

               SET BUDIND(BUDTIND(BUDD,BUDD))=""

 +6       ;

ADDX      ;

 +1        DO BACK

 +2        QUIT

ADDALL    ;

 +1        FOR X=1:1:BUDHIGH

               SET BUDIND(X)=""

 +2        DO BACK

 +3        QUIT

 +4       ;

REM       ;

 +1        WRITE !

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

           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 BUDANS=Y

           SET BUDD=""

           FOR BUDI=1:1

               SET BUDD=$PIECE(BUDANS,",",BUDI)

               IF BUDD=""

                   QUIT

               KILL BUDIND(BUDTIND(BUDD,BUDD))

REMX      ;

 +1        DO BACK

 +2        QUIT

BUDDDSI.m