Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPDUT4C

KMPDUT4C.m

Go to the documentation of this file.
  1. KMPDUT4C ;OAK/RAK; Multi-Lookup cont. ;2/17/04 10:48
  1. ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1. ;
  1. HELP ;--help text
  1. N OUT
  1. W !!?7,"Enter '?D' to display entries selected so far."
  1. I $G(OPTION)'["S" W !!?7,"Select '*' for all entries or"
  1. W !
  1. G:$G(OPTION)'["W" HELPM
  1. W !?7,"Select entries by typing one or more characters and then the '*'"
  1. W !
  1. W !?7," Example: 'A*' - will select all entries begging with"
  1. W !?7," the letter 'A'"
  1. W !?7," 'SMITH*' - will select all entries begging with"
  1. W !?7," 'SMITH'"
  1. W !!!
  1. D FTR^KMPDUTL4("Press <RET> to continue, '^' to exit Help",.OUT)
  1. I 'OUT W !!! Q
  1. W !!!
  1. HELPM ;help text for minus sign
  1. W !?7,"You may remove entries that have been selected so far by"
  1. W !?7,"entering a minus sign (-) before the entry to be removed"
  1. W !
  1. W !?7," Example: '-JONES,JANE' - will remove the entry 'JONES,JANE'"
  1. W !?7," from the array"
  1. W !?7," '-SMITH*' - will remove all entries beginning with"
  1. W !?7," 'SMITH' from the array"
  1. W !
  1. W !?7," ************************************************"
  1. W !?7," *** It is important to note that using the ***"
  1. W !?7," *** minus sign (-) only removes entries from ***"
  1. W !?7," *** the array storing the selected entries, ***"
  1. W !?7," *** it DOES NOT remove any entries from the ***"
  1. W !?7," *** look-up file ***"
  1. W !?7," ************************************************"
  1. W !!!
  1. D FTR^KMPDUTL4("Press <RET> to continue: ")
  1. W !!!
  1. Q
  1. MINUS(X) ;de-select entries
  1. ;--------------------------------------------------------------------
  1. ;--------------------------------------------------------------------
  1. Q:'$D(@ARRAY) S X=$G(X) Q:$E(X)'="-" S X=$E(X,2,$L(X))
  1. I X="*" K @ARRAY Q
  1. I X["*" S STR=$E(X,1,($F(X,"*")-2))
  1. E S STR=X
  1. Q:STR']"" S STR1=STR
  1. ;--------------------------------------------------------------------
  1. ; if exact match on STR1
  1. ;--------------------------------------------------------------------
  1. I SORT=1,($D(@ARRAY@(STR1))) D Q
  1. .K @ARRAY@(STR1) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
  1. ;--------------------------------------------------------------------
  1. ; if wildcard
  1. ;--------------------------------------------------------------------
  1. I SORT=1,(X["*") D Q
  1. .F S STR1=$O(@ARRAY@(STR1)) Q:$E(STR1,1,$L(STR))'=STR D
  1. ..K @ARRAY@(STR1) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
  1. Q:SORT
  1. I X'["*" S ASKI=0 D Q
  1. .F S ASKI=$O(@ARRAY@(ASKI)) Q:'ASKI I @ARRAY@(ASKI)=STR1 D
  1. ..K @ARRAY@(ASKI) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
  1. I X["*" S ASKI=0 D Q
  1. .F S ASKI=$O(@ARRAY@(ASKI)) Q:'ASKI I $E(@ARRAY@(ASKI),1,$L(STR))=STR D
  1. ..K @ARRAY@(ASKI) S @ARRAY@(0)=$G(@ARRAY@(0))-1 W:$X>73 !?7 W "."
  1. Q