source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUT4A.m@ 1639

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1KMPDUT4A ;OAK/RAK; Multi-Lookup Global/Array Check ;2/17/04 10:47
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4CHECK() ;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
Note: See TracBrowser for help on using the repository browser.