SDUL2.m

SDUL2 ;ALB/MJK - List Manager Utilities; 4/22/92

 ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 ;

SEL ; -- select w/XQORNOD(0) defined

 D EN(XQORNOD(0)) Q

 ;

EN(SDULNOD) ; -- generic selector

 ; input passed: SDULNOD := var in XQORNOD(0) format

 K SDULY

 S BG=+$O(@SDULAR@("IDX",SDULBG,0))

 S LST=+$O(@SDULAR@("IDX",SDULST,0))

 I 'BG W !!,*7,"There are no '",SDUL("ENTITY"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR D OUT G ENQ

 S Y=$TR($P($P(SDULNOD,U,4),"=",2),"/\; .",",,,,,")

 I Y["-" S X=Y,Y="" F I=1:1 S J=$P(X,",",I) Q:J']""  I +J>(BG-1),+J<(LST+1) S:J'["-" Y=Y_J_"," I J["-",+J,+J<+$P(J,"-",2) F L=+J:1:+$P(J,"-",2) I L>(BG-1),L<(LST+1) S Y=Y_L_","

 I 'Y S DIR(0)="L^"_BG_":"_LST,DIR("A")="Select "_SDUL("ENTITY")_"(s)" D ^DIR K DIR I $D(DIRUT) D OUT G ENQ

 ;

 ; -- check was valid entries

 S SDERR=0 F I=1:1 S X=$P(Y,",",I) Q:'X  I X<BG!(X>LST) D

 .W:'SDERR ! W !,*7,"Selection '",X,"' is not a valid choice."

 .S SDERR=1

 I SDERR D PAUSE^SDUL1 G ENQ

 ;

 F I=1:1 S X=$P(Y,",",I) Q:'X  S SDULY(X)=""

ENQ K Y,X,BG,SDERR,LST,DIRUT,DTOUT,DUOUT,DIROUT Q

 ;

OUT ; -- set variables to quit

 S SDULBCK=$S(SDULCC:"",1:"R")

 Q

 ;

MENU ;

 N SDULX

 S SDULX=$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL"))) S:SDULX="" (SDULX,^(SDUL("PROTOCOL")))=1

 W ! S DIR(0)="Y",DIR("A")="Do you wish to turn auto-display "_$S(SDULX:"'OFF'",1:"'ON'")_" for this menu",DIR("B")="NO" D ^DIR K DIR

 I Y S (SDULMENU,^DISV($S($D(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL")))='SDULX

 D FINISH^SDUL4

 Q

SDUL2     ;ALB/MJK - List Manager Utilities; 4/22/92

 +1       ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 +2       ;

SEL       ; -- select w/XQORNOD(0) defined

 +1        DO EN(XQORNOD(0))

           QUIT 

 +2       ;

EN(SDULNOD) ; -- generic selector

 +1       ; input passed: SDULNOD := var in XQORNOD(0) format

 +2        KILL SDULY

 +3        SET BG=+$ORDER(@SDULAR@("IDX",SDULBG,0))

 +4        SET LST=+$ORDER(@SDULAR@("IDX",SDULST,0))

 +5        IF 'BG

               WRITE !!,*7,"There are no '",SDUL("ENTITY"),"s' to select.",!

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               DO OUT

               GOTO ENQ

 +6        SET Y=$TRANSLATE($PIECE($PIECE(SDULNOD,U,4),"=",2),"/\; .",",,,,,")

 +7        IF Y["-"

               SET X=Y

               SET Y=""

               FOR I=1:1

                   SET J=$PIECE(X,",",I)

                   IF J']""

                       QUIT 

                   IF +J>(BG-1)

                       IF +J<(LST+1)

                           IF J'["-"

                               SET Y=Y_J_","

                           IF J["-"

                               IF +J

                                   IF +J<+$PIECE(J,"-",2)

                                       FOR L=+J:1:+$PIECE(J,"-",2)

                                           IF L>(BG-1)

                                               IF L<(LST+1)

                                                   SET Y=Y_L_","

 +8        IF 'Y

               SET DIR(0)="L^"_BG_":"_LST

               SET DIR("A")="Select "_SDUL("ENTITY")_"(s)"

               DO ^DIR

               KILL DIR

               IF $DATA(DIRUT)

                   DO OUT

                   GOTO ENQ

 +9       ;

 +10      ; -- check was valid entries

 +11       SET SDERR=0

           FOR I=1:1

               SET X=$PIECE(Y,",",I)

               IF 'X

                   QUIT 

               IF X<BG!(X>LST)

                   Begin DoDot:1

 +12                   IF 'SDERR

                           WRITE !

                       WRITE !,*7,"Selection '",X,"' is not a valid choice."

 +13                   SET SDERR=1

                   End DoDot:1

 +14       IF SDERR

               DO PAUSE^SDUL1

               GOTO ENQ

 +15      ;

 +16       FOR I=1:1

               SET X=$PIECE(Y,",",I)

               IF 'X

                   QUIT 

               SET SDULY(X)=""

ENQ        KILL Y,X,BG,SDERR,LST,DIRUT,DTOUT,DUOUT,DIROUT

           QUIT 

 +1       ;

OUT       ; -- set variables to quit

 +1        SET SDULBCK=$SELECT(SDULCC:"",1:"R")

 +2        QUIT 

 +3       ;

MENU      ;

 +1        NEW SDULX

 +2        SET SDULX=$GET(^DISV($SELECT($DATA(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL")))

           IF SDULX=""

               SET (SDULX,^(SDUL("PROTOCOL")))=1

 +3        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to turn auto-display "_$SELECT(SDULX:"'OFF'",1:"'ON'")_" for this menu"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +4        IF Y

               SET (SDULMENU,^DISV($SELECT($DATA(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL")))='SDULX

 +5        DO FINISH^SDUL4

 +6        QUIT