source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUT4.m@ 702

Last change on this file since 702 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.9 KB
Line 
1KMPDUT4 ;OAK/RAK; Multi-Lookup ;2/17/04 10:46
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4SELECT(ARRAY,SORT,MAX,OPTION) ;select one or more entries
5 ;--------------------------------------------------------------------
6 ; this routine lets user select one or more entries from a file
7 ;
8 ; ARRAY - the array the data is to be stored in
9 ; this may be a local or global array
10 ; ARRAY(0) - will contain the number of entries selected
11 ;
12 ; SORT - determines how the array is set
13 ; 0 - internal file number
14 ; 1 - first piece of zero node
15 ;
16 ; if zero then ARRAY(internal_number)=external_format
17 ; if one then ARRAY(external_format)=internal_number
18 ;
19 ; internal_number - the internal file number selected
20 ; external_format - the first piece of the zero node or
21 ; Y(0,0)
22 ;
23 ; MAX - if defined this represents the maximum number of entries
24 ; to stuff into array
25 ; - if '*' is selected and the number of file entries
26 ; exceeds this number the array will be killed and
27 ; ARRAY(0) will be equal to "*"
28 ; - if while selecting one entry at a time the number
29 ; of entries is equal to MAX the routine will quit with
30 ; the entries stored as usual and ARRAY(0)=MAX
31 ; this is to prevent partition store errors with local
32 ; arrays or setting a global equal all the patients in
33 ; the patient file
34 ;
35 ; OPTION - selected options
36 ; S - suppress asterisk (*) ;'(* for All)' prompt
37 ; W - allow selected wildcards
38 ; example: A* - will select all entries beginning
39 ; with the letter 'A'
40 ; SMITH* - will select all entries beginning
41 ; with 'SMITH'
42 ;
43 ; DIC - this variable must be defined in the normal fileman
44 ; format
45 ; DIC("A") - this variable should be defined
46 ; the string " (* for All)" will be concatenated to the end
47 ; DIC("S") - may be defined if necessary and will be honored
48 ; DIC(0) - *** IMPORTANT ***
49 ; this will be set to DIC(0)="EQZ" for the purposes of
50 ; this routine
51 ;
52 ; example: S DIC=4,DIC("A")="Select Institution: "
53 ; D SELECT^KMPDUT4("^TMP($J,")
54 ; D SELECT^KMPDUT4("LOCAL",1,20)
55 ; D SELECT^KMPDUT4("LOCAL($J)",1,0,"W")
56 ;
57 ; *** It is the programmers responsibility kill ***
58 ; *** 'ARRAY' when finished with the data ***
59 ;--------------------------------------------------------------------
60 I $$CHECK^KMPDUT4A D FTR^KMPDUTL4("Press <RET> to continue") Q
61 S OPTION=$$UP^XLFSTR($G(OPTION))
62 S SORT=+$G(SORT),MAX=+$G(MAX) S:SORT'=1 SORT=0
63 I MAX=1,(OPTION'["S") S OPTION=OPTION_"S"
64 S DIC(0)="EMQZ",DTIME=$S($G(DTIME):DTIME,1:600)
65 I $G(DIC("A"))'["(* for All): ",(OPTION'["S") D
66 .S DIC("A")=$G(DIC("A"))_" (* for All): "
67 K @ARRAY F D Q:X=""!(X="^")
68 .I MAX,(+$G(@ARRAY@(0))=MAX) S X="" Q
69 .W !
70 .I '$D(@ARRAY) W DIC("A")
71 .E W $J(" ",$L(DIC("A"))-12),"...another: "
72 .R X:DTIME Q:X=""!(X="^")
73 .I X="*",(MAX=1) D Q
74 ..W *7,!!?7,"...you are allowed only one selection...",!
75 .I X="*",(OPTION["S") D Q
76 ..W *7,!!?7,"...'*' not allowed...",!
77 .I X="*" D ALL^KMPDUT4B S X="" Q
78 .I $E(X)="-" D MINUS^KMPDUT4C(X) Q
79 .;-------------------------------------------------------------------
80 .; wildcard selection
81 .;-------------------------------------------------------------------
82 .I $E(X,2,999)["*",(OPTION["W") D WILDCARD^KMPDUT4B(X) Q
83 .I $E(X,1,2)="?D"!($E(X,1,2)="?d") D DISPLAY^KMPDUT4B Q
84 .I X="?",(MAX'=1) D HELP^KMPDUT4C
85 .D ^DIC I Y>0,('$D(@ARRAY@($S(SORT=1:Y(0,0),1:+Y)))) D
86 ..I SORT=1 S @ARRAY@(Y(0,0))=+Y
87 ..E S @ARRAY@(+Y)=Y(0,0)
88 ..S @ARRAY@(0)=$G(@ARRAY@(0))+1
89EXIT ;
90 K X,Y
91 Q
Note: See TracBrowser for help on using the repository browser.