source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTLMU3.m@ 1259

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1DGPTLMU3 ;ALB/MTC - PTF ARCHIVE/PURGE LIST MAN UTILITIES CONT ; 9-23-92
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4SEL ; -- 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 ;
12ASK ;--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 ;
15VAL ;-- 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)=""
31ENQ K Y,X,BG,SDERR,LST,DIRUT,DTOUT,DUOUT,DIROUT Q
32 ;
Note: See TracBrowser for help on using the repository browser.