SDUL2 ;ALB/MJK - List Manager Utilities; 4/22/92
;;5.3;Scheduling;;Aug 13, 1993
;
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
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDUL2 1515 printed Nov 22, 2024@18:11:38 Page 2
SDUL2 ;ALB/MJK - List Manager Utilities; 4/22/92
+1 ;;5.3;Scheduling;;Aug 13, 1993
+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 ;
+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
