| [613] | 1 | DGPTLMU3 ;ALB/MTC - PTF ARCHIVE/PURGE LIST MAN UTILITIES CONT ; 9-23-92
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | SEL ; -- select routine for range of numbers not in continuous sequence
|
|---|
| 5 | K VALMY N DGX
|
|---|
| 6 | S BG=+$O(@VALMAR@("IDX",VALMBG,0))
|
|---|
| 7 | S LST=+$O(@VALMAR@("IDX",VALMLST,0))
|
|---|
| 8 | I 'BG W !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR G ENQ
|
|---|
| 9 | ;-- check for a selection passed in using XQORNOD(0), then validate
|
|---|
| 10 | S Y=$P(XQORNOD(0),"=",2) G:Y VAL
|
|---|
| 11 | ;
|
|---|
| 12 | ASK ;--ask for entries
|
|---|
| 13 | W !,"Select PTF Record(s): ("_BG_"-"_LST_"):" R Y:DTIME G:'$T!(Y["^") ENQ I 'Y D PAUSE^VALM1 G:'Y ENQ G ASK
|
|---|
| 14 | ;
|
|---|
| 15 | VAL ;-- check for valid range
|
|---|
| 16 | S SDERR=0
|
|---|
| 17 | I Y["-" F I=1:1 S J=$P(Y,",",I) Q:'J I J["-" D
|
|---|
| 18 | . I +J<BG!($P(J,"-",2)>LST) S SDERR=1 W !,!,*7,"Selection '",J,"' is not a valid range."
|
|---|
| 19 | ;-- check for valid entries
|
|---|
| 20 | F I=1:1 S J=$P(Y,",",I) Q:'J I J'["-" D
|
|---|
| 21 | . I +J<BG!(J>LST) S SDERR=1 W !,!,*7,"Selection '",J,"' is not a valid choice."
|
|---|
| 22 | I SDERR D PAUSE^VALM1 G:'Y ENQ G ASK
|
|---|
| 23 | ;
|
|---|
| 24 | ;-- build
|
|---|
| 25 | 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) S SDERR=1 D I SDERR D PAUSE^VALM1 G:'Y ENQ G ASK
|
|---|
| 26 | . F L=VALMBG:1:VALMLST S DGX=$O(@VALMAR@("IDX",L,0)) I DGX>(+J-1),DGX<(+$P(J,"-",2)+1) S Y=Y_DGX_",",SDERR=0
|
|---|
| 27 | . I SDERR W !,*7,"Selection '",J,"' is not a valid range." S SDERR=1
|
|---|
| 28 | ;
|
|---|
| 29 | ;-- load VALMY with entries
|
|---|
| 30 | F I=1:1 S X=$P(Y,",",I) Q:'X S VALMY(X)=""
|
|---|
| 31 | ENQ K Y,X,BG,SDERR,LST,DIRUT,DTOUT,DUOUT,DIROUT Q
|
|---|
| 32 | ;
|
|---|
