DGPTLMU3 ;ALB/MTC - PTF ARCHIVE/PURGE LIST MAN UTILITIES CONT ; 9-23-92
;;5.3;Registration;;Aug 13, 1993
;
SEL ; -- select routine for range of numbers not in continuous sequence
K VALMY N DGX
S BG=+$O(@VALMAR@("IDX",VALMBG,0))
S LST=+$O(@VALMAR@("IDX",VALMLST,0))
I 'BG W !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR G ENQ
;-- check for a selection passed in using XQORNOD(0), then validate
S Y=$P(XQORNOD(0),"=",2) G:Y VAL
;
ASK ;--ask for entries
W !,"Select PTF Record(s): ("_BG_"-"_LST_"):" R Y:DTIME G:'$T!(Y["^") ENQ I 'Y D PAUSE^VALM1 G:'Y ENQ G ASK
;
VAL ;-- check for valid range
S SDERR=0
I Y["-" F I=1:1 S J=$P(Y,",",I) Q:'J I J["-" D
. I +J<BG!($P(J,"-",2)>LST) S SDERR=1 W !,!,*7,"Selection '",J,"' is not a valid range."
;-- check for valid entries
F I=1:1 S J=$P(Y,",",I) Q:'J I J'["-" D
. I +J<BG!(J>LST) S SDERR=1 W !,!,*7,"Selection '",J,"' is not a valid choice."
I SDERR D PAUSE^VALM1 G:'Y ENQ G ASK
;
;-- build
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
. 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
. I SDERR W !,*7,"Selection '",J,"' is not a valid range." S SDERR=1
;
;-- load VALMY with entries
F I=1:1 S X=$P(Y,",",I) Q:'X S VALMY(X)=""
ENQ K Y,X,BG,SDERR,LST,DIRUT,DTOUT,DUOUT,DIROUT Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTLMU3 1508 printed Dec 13, 2024@02:52:49 Page 2
DGPTLMU3 ;ALB/MTC - PTF ARCHIVE/PURGE LIST MAN UTILITIES CONT ; 9-23-92
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
SEL ; -- select routine for range of numbers not in continuous sequence
+1 KILL VALMY
NEW DGX
+2 SET BG=+$ORDER(@VALMAR@("IDX",VALMBG,0))
+3 SET LST=+$ORDER(@VALMAR@("IDX",VALMLST,0))
+4 IF 'BG
WRITE !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO ENQ
+5 ;-- check for a selection passed in using XQORNOD(0), then validate
+6 SET Y=$PIECE(XQORNOD(0),"=",2)
if Y
GOTO VAL
+7 ;
ASK ;--ask for entries
+1 WRITE !,"Select PTF Record(s): ("_BG_"-"_LST_"):"
READ Y:DTIME
if '$TEST!(Y["^")
GOTO ENQ
IF 'Y
DO PAUSE^VALM1
if 'Y
GOTO ENQ
GOTO ASK
+2 ;
VAL ;-- check for valid range
+1 SET SDERR=0
+2 IF Y["-"
FOR I=1:1
SET J=$PIECE(Y,",",I)
if 'J
QUIT
IF J["-"
Begin DoDot:1
+3 IF +J<BG!($PIECE(J,"-",2)>LST)
SET SDERR=1
WRITE !,!,*7,"Selection '",J,"' is not a valid range."
End DoDot:1
+4 ;-- check for valid entries
+5 FOR I=1:1
SET J=$PIECE(Y,",",I)
if 'J
QUIT
IF J'["-"
Begin DoDot:1
+6 IF +J<BG!(J>LST)
SET SDERR=1
WRITE !,!,*7,"Selection '",J,"' is not a valid choice."
End DoDot:1
+7 IF SDERR
DO PAUSE^VALM1
if 'Y
GOTO ENQ
GOTO ASK
+8 ;
+9 ;-- build
+10 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)
SET SDERR=1
Begin DoDot:1
+11 FOR L=VALMBG:1:VALMLST
SET DGX=$ORDER(@VALMAR@("IDX",L,0))
IF DGX>(+J-1)
IF DGX<(+$PIECE(J,"-",2)+1)
SET Y=Y_DGX_","
SET SDERR=0
+12 IF SDERR
WRITE !,*7,"Selection '",J,"' is not a valid range."
SET SDERR=1
End DoDot:1
IF SDERR
DO PAUSE^VALM1
if 'Y
GOTO ENQ
GOTO ASK
+13 ;
+14 ;-- load VALMY with entries
+15 FOR I=1:1
SET X=$PIECE(Y,",",I)
if 'X
QUIT
SET VALMY(X)=""
ENQ KILL Y,X,BG,SDERR,LST,DIRUT,DTOUT,DUOUT,DIROUT
QUIT
+1 ;
