1 | KMPDUT4A ;OAK/RAK; Multi-Lookup Global/Array Check ;2/17/04 10:47
|
---|
2 | ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
|
---|
3 | ;
|
---|
4 | CHECK() ;extrinsic function
|
---|
5 | ;--------------------------------------------------------------------
|
---|
6 | ; return: 0 - if successful
|
---|
7 | ; 1 - if error found
|
---|
8 | ;
|
---|
9 | ; check variable 'ARRAY' for correct global or local array format
|
---|
10 | ;--------------------------------------------------------------------
|
---|
11 | I '$D(ARRAY) D Q 1
|
---|
12 | .W !?7,"...variable 'ARRAY' is undefined..."
|
---|
13 | I $G(DIC)']"" D Q 1
|
---|
14 | .W !?7,"...variable 'DIC' is undefined..."
|
---|
15 | .D FTR^KMPDUTL4("Press <RET> to continue")
|
---|
16 | I $E(ARRAY)="^",(ARRAY'["(")!(ARRAY["()")!($E(ARRAY,$F(ARRAY,"("))']"")!($E(ARRAY,$F(ARRAY,"("))=",") D Q 1
|
---|
17 | .W !?7,"...global must have a subscript (ex: '^TMP($J' )..."
|
---|
18 | ;
|
---|
19 | ;global array must be either ^TMP or ^UTILITY - just to be safe
|
---|
20 | I $E(ARRAY)="^" I $E(ARRAY,2,($F(ARRAY,"(")-2))'="TMP",($E(ARRAY,2,($F(ARRAY,"(")-2))'="UTILITY") D Q 1
|
---|
21 | .W !!?7,"...global names must be either '^TMP' or '^UTILITY'..."
|
---|
22 | ;
|
---|
23 | ;if local array
|
---|
24 | I $E(ARRAY)'="^" D
|
---|
25 | .;remove '()' from local array if no subscript
|
---|
26 | .I $E(ARRAY,$F(ARRAY,"("))=")"!($E(ARRAY,$F(ARRAY,"("))']"") D
|
---|
27 | ..S ARRAY=$TR(ARRAY,"(",""),ARRAY=$TR(ARRAY,")","")
|
---|
28 | ;
|
---|
29 | ;if subcript array add closing parenthesis and remove trailing comma
|
---|
30 | I ARRAY["("!($E(ARRAY)="^") D
|
---|
31 | .I $E(ARRAY,$L(ARRAY))'=")" S ARRAY=ARRAY_")"
|
---|
32 | .I $E(ARRAY,($L(ARRAY)-1))="," S ARRAY=$E(ARRAY,1,($L(ARRAY)-2))_")"
|
---|
33 | Q 0
|
---|