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