[613] | 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
|
---|