- DGPTLMU3 ;ALB/MTC - PTF ARCHIVE/PURGE LIST MAN UTILITIES CONT ; 9-23-92
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- 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
- ;
- DGPTLMU3 ;ALB/MTC - PTF ARCHIVE/PURGE LIST MAN UTILITIES CONT ; 9-23-92
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +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 ;
