source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDUL2.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1SDUL2 ;ALB/MJK - List Manager Utilities; 4/22/92
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4SEL ; -- select w/XQORNOD(0) defined
5 D EN(XQORNOD(0)) Q
6 ;
7EN(SDULNOD) ; -- generic selector
8 ; input passed: SDULNOD := var in XQORNOD(0) format
9 K SDULY
10 S BG=+$O(@SDULAR@("IDX",SDULBG,0))
11 S LST=+$O(@SDULAR@("IDX",SDULST,0))
12 I 'BG W !!,*7,"There are no '",SDUL("ENTITY"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR D OUT G ENQ
13 S Y=$TR($P($P(SDULNOD,U,4),"=",2),"/\; .",",,,,,")
14 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_","
15 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
16 ;
17 ; -- check was valid entries
18 S SDERR=0 F I=1:1 S X=$P(Y,",",I) Q:'X I X<BG!(X>LST) D
19 .W:'SDERR ! W !,*7,"Selection '",X,"' is not a valid choice."
20 .S SDERR=1
21 I SDERR D PAUSE^SDUL1 G ENQ
22 ;
23 F I=1:1 S X=$P(Y,",",I) Q:'X S SDULY(X)=""
24ENQ K Y,X,BG,SDERR,LST,DIRUT,DTOUT,DUOUT,DIROUT Q
25 ;
26OUT ; -- set variables to quit
27 S SDULBCK=$S(SDULCC:"",1:"R")
28 Q
29 ;
30MENU ;
31 N SDULX
32 S SDULX=$G(^DISV($S($D(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL"))) S:SDULX="" (SDULX,^(SDUL("PROTOCOL")))=1
33 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
34 I Y S (SDULMENU,^DISV($S($D(DUZ)#2:DUZ,1:0),"SDULMENU",SDUL("PROTOCOL")))='SDULX
35 D FINISH^SDUL4
36 Q
Note: See TracBrowser for help on using the repository browser.