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

KMPDUT4.m

Go to the documentation of this file.
  1. KMPDUT4 ;OAK/RAK; Multi-Lookup ;2/17/04 10:46
  1. ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1. ;
  1. SELECT(ARRAY,SORT,MAX,OPTION) ;select one or more entries
  1. ;--------------------------------------------------------------------
  1. ; this routine lets user select one or more entries from a file
  1. ;
  1. ; ARRAY - the array the data is to be stored in
  1. ; this may be a local or global array
  1. ; ARRAY(0) - will contain the number of entries selected
  1. ;
  1. ; SORT - determines how the array is set
  1. ; 0 - internal file number
  1. ; 1 - first piece of zero node
  1. ;
  1. ; if zero then ARRAY(internal_number)=external_format
  1. ; if one then ARRAY(external_format)=internal_number
  1. ;
  1. ; internal_number - the internal file number selected
  1. ; external_format - the first piece of the zero node or
  1. ; Y(0,0)
  1. ;
  1. ; MAX - if defined this represents the maximum number of entries
  1. ; to stuff into array
  1. ; - if '*' is selected and the number of file entries
  1. ; exceeds this number the array will be killed and
  1. ; ARRAY(0) will be equal to "*"
  1. ; - if while selecting one entry at a time the number
  1. ; of entries is equal to MAX the routine will quit with
  1. ; the entries stored as usual and ARRAY(0)=MAX
  1. ; this is to prevent partition store errors with local
  1. ; arrays or setting a global equal all the patients in
  1. ; the patient file
  1. ;
  1. ; OPTION - selected options
  1. ; S - suppress asterisk (*) ;'(* for All)' prompt
  1. ; W - allow selected wildcards
  1. ; example: A* - will select all entries beginning
  1. ; with the letter 'A'
  1. ; SMITH* - will select all entries beginning
  1. ; with 'SMITH'
  1. ;
  1. ; DIC - this variable must be defined in the normal fileman
  1. ; format
  1. ; DIC("A") - this variable should be defined
  1. ; the string " (* for All)" will be concatenated to the end
  1. ; DIC("S") - may be defined if necessary and will be honored
  1. ; DIC(0) - *** IMPORTANT ***
  1. ; this will be set to DIC(0)="EQZ" for the purposes of
  1. ; this routine
  1. ;
  1. ; example: S DIC=4,DIC("A")="Select Institution: "
  1. ; D SELECT^KMPDUT4("^TMP($J,")
  1. ; D SELECT^KMPDUT4("LOCAL",1,20)
  1. ; D SELECT^KMPDUT4("LOCAL($J)",1,0,"W")
  1. ;
  1. ; *** It is the programmers responsibility kill ***
  1. ; *** 'ARRAY' when finished with the data ***
  1. ;--------------------------------------------------------------------
  1. I $$CHECK^KMPDUT4A D FTR^KMPDUTL4("Press <RET> to continue") Q
  1. S OPTION=$$UP^XLFSTR($G(OPTION))
  1. S SORT=+$G(SORT),MAX=+$G(MAX) S:SORT'=1 SORT=0
  1. I MAX=1,(OPTION'["S") S OPTION=OPTION_"S"
  1. S DIC(0)="EMQZ",DTIME=$S($G(DTIME):DTIME,1:600)
  1. I $G(DIC("A"))'["(* for All): ",(OPTION'["S") D
  1. .S DIC("A")=$G(DIC("A"))_" (* for All): "
  1. K @ARRAY F D Q:X=""!(X="^")
  1. .I MAX,(+$G(@ARRAY@(0))=MAX) S X="" Q
  1. .W !
  1. .I '$D(@ARRAY) W DIC("A")
  1. .E W $J(" ",$L(DIC("A"))-12),"...another: "
  1. .R X:DTIME Q:X=""!(X="^")
  1. .I X="*",(MAX=1) D Q
  1. ..W *7,!!?7,"...you are allowed only one selection...",!
  1. .I X="*",(OPTION["S") D Q
  1. ..W *7,!!?7,"...'*' not allowed...",!
  1. .I X="*" D ALL^KMPDUT4B S X="" Q
  1. .I $E(X)="-" D MINUS^KMPDUT4C(X) Q
  1. .;-------------------------------------------------------------------
  1. .; wildcard selection
  1. .;-------------------------------------------------------------------
  1. .I $E(X,2,999)["*",(OPTION["W") D WILDCARD^KMPDUT4B(X) Q
  1. .I $E(X,1,2)="?D"!($E(X,1,2)="?d") D DISPLAY^KMPDUT4B Q
  1. .I X="?",(MAX'=1) D HELP^KMPDUT4C
  1. .D ^DIC I Y>0,('$D(@ARRAY@($S(SORT=1:Y(0,0),1:+Y)))) D
  1. ..I SORT=1 S @ARRAY@(Y(0,0))=+Y
  1. ..E S @ARRAY@(+Y)=Y(0,0)
  1. ..S @ARRAY@(0)=$G(@ARRAY@(0))+1
  1. EXIT ;
  1. K X,Y
  1. Q