| 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 | 
|---|