DGPTLMU3.m

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       ;