| 1 | KMPDUT4C ;OAK/RAK; Multi-Lookup cont. ;2/17/04 10:48
|
|---|
| 2 | ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
|
|---|
| 3 | ;
|
|---|
| 4 | HELP ;--help text
|
|---|
| 5 | N OUT
|
|---|
| 6 | W !!?7,"Enter '?D' to display entries selected so far."
|
|---|
| 7 | I $G(OPTION)'["S" W !!?7,"Select '*' for all entries or"
|
|---|
| 8 | W !
|
|---|
| 9 | G:$G(OPTION)'["W" HELPM
|
|---|
| 10 | W !?7,"Select entries by typing one or more characters and then the '*'"
|
|---|
| 11 | W !
|
|---|
| 12 | W !?7," Example: 'A*' - will select all entries begging with"
|
|---|
| 13 | W !?7," the letter 'A'"
|
|---|
| 14 | W !?7," 'SMITH*' - will select all entries begging with"
|
|---|
| 15 | W !?7," 'SMITH'"
|
|---|
| 16 | W !!!
|
|---|
| 17 | D FTR^KMPDUTL4("Press <RET> to continue, '^' to exit Help",.OUT)
|
|---|
| 18 | I 'OUT W !!! Q
|
|---|
| 19 | W !!!
|
|---|
| 20 | HELPM ;help text for minus sign
|
|---|
| 21 | W !?7,"You may remove entries that have been selected so far by"
|
|---|
| 22 | W !?7,"entering a minus sign (-) before the entry to be removed"
|
|---|
| 23 | W !
|
|---|
| 24 | W !?7," Example: '-JONES,JANE' - will remove the entry 'JONES,JANE'"
|
|---|
| 25 | W !?7," from the array"
|
|---|
| 26 | W !?7," '-SMITH*' - will remove all entries beginning with"
|
|---|
| 27 | W !?7," 'SMITH' from the array"
|
|---|
| 28 | W !
|
|---|
| 29 | W !?7," ************************************************"
|
|---|
| 30 | W !?7," *** It is important to note that using the ***"
|
|---|
| 31 | W !?7," *** minus sign (-) only removes entries from ***"
|
|---|
| 32 | W !?7," *** the array storing the selected entries, ***"
|
|---|
| 33 | W !?7," *** it DOES NOT remove any entries from the ***"
|
|---|
| 34 | W !?7," *** look-up file ***"
|
|---|
| 35 | W !?7," ************************************************"
|
|---|
| 36 | W !!!
|
|---|
| 37 | D FTR^KMPDUTL4("Press <RET> to continue: ")
|
|---|
| 38 | W !!!
|
|---|
| 39 | Q
|
|---|
| 40 | MINUS(X) ;de-select entries
|
|---|
| 41 | ;--------------------------------------------------------------------
|
|---|
| 42 | ;--------------------------------------------------------------------
|
|---|
| 43 | Q:'$D(@ARRAY) S X=$G(X) Q:$E(X)'="-" S X=$E(X,2,$L(X))
|
|---|
| 44 | I X="*" K @ARRAY Q
|
|---|
| 45 | I X["*" S STR=$E(X,1,($F(X,"*")-2))
|
|---|
| 46 | E S STR=X
|
|---|
| 47 | Q:STR']"" S STR1=STR
|
|---|
| 48 | ;--------------------------------------------------------------------
|
|---|
| 49 | ; if exact match on STR1
|
|---|
| 50 | ;--------------------------------------------------------------------
|
|---|
| 51 | I SORT=1,($D(@ARRAY@(STR1))) D Q
|
|---|
| 52 | .K @ARRAY@(STR1) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
|
|---|
| 53 | ;--------------------------------------------------------------------
|
|---|
| 54 | ; if wildcard
|
|---|
| 55 | ;--------------------------------------------------------------------
|
|---|
| 56 | I SORT=1,(X["*") D Q
|
|---|
| 57 | .F S STR1=$O(@ARRAY@(STR1)) Q:$E(STR1,1,$L(STR))'=STR D
|
|---|
| 58 | ..K @ARRAY@(STR1) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
|
|---|
| 59 | Q:SORT
|
|---|
| 60 | I X'["*" S ASKI=0 D Q
|
|---|
| 61 | .F S ASKI=$O(@ARRAY@(ASKI)) Q:'ASKI I @ARRAY@(ASKI)=STR1 D
|
|---|
| 62 | ..K @ARRAY@(ASKI) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
|
|---|
| 63 | I X["*" S ASKI=0 D Q
|
|---|
| 64 | .F S ASKI=$O(@ARRAY@(ASKI)) Q:'ASKI I $E(@ARRAY@(ASKI),1,$L(STR))=STR D
|
|---|
| 65 | ..K @ARRAY@(ASKI) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
|
|---|
| 66 | Q
|
|---|
