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