source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDU1.m@ 1000

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1KMPDU1 ;SF/RAK - CM Developer Tools Utilities ;2/17/04 09:49
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3GBLCHK(KMPDY,KMPDGBL) ;-- check global name.
4 ;----------------------------------------------------------------------
5 ; KMPDGBL... Global name.
6 ;
7 ; Check to make sure global name is in format for subscript indirection.
8 ;----------------------------------------------------------------------
9 ;
10 K KMPDY
11 ;
12 I $G(KMPDGBL)="" S KMPDY(0)="[Global name not defined]" Q
13 ;
14 I $E(KMPDGBL)["?" D Q
15 .S KMPDY(0)="['"_KMPDGBL_" is an incorrect global name]"
16 ;
17 I KMPDGBL["*" S KMPDY(0)="['"_KMPDGBL_" is an incorrect global name]" Q
18 ;
19 N GLOBAL
20 ;
21 S GLOBAL=KMPDGBL
22 ; make sure begins with up-arrow (^).
23 I $E(GLOBAL)'="^" S GLOBAL="^"_GLOBAL
24 ; make sure contains a '('.
25 I GLOBAL'["(" S GLOBAL=GLOBAL_"("
26 ; if ends with comma (,) then remove comma.
27 I $E(GLOBAL,($L(GLOBAL)))="," S $E(GLOBAL,($L(GLOBAL)))=""
28 ; make sure ends with a ')'.
29 I $E(GLOBAL,$L(GLOBAL))'=")" S GLOBAL=GLOBAL_")"
30 ; if ends with comma (,) then remove comma.
31 I $E(GLOBAL,($L(GLOBAL)-1))="," S $E(GLOBAL,($L(GLOBAL)-1))=""
32 ; if global contains () then change to ("").
33 I $E(GLOBAL,($L(GLOBAL)-1),$L(GLOBAL))="()" D
34 .S $E(GLOBAL,$L(GLOBAL))=""""")"
35 ;
36 S KMPDY(0)=GLOBAL
37 ;
38 Q
39 ;
40GBLLIST(KMPDY,KMPDGBL,KMPDST,KMPDLN) ;-- get global data
41 ;----------------------------------------------------------------------
42 ; KMPDGBL... Global name.
43 ; KMPDST... Starting global node. If this is a continuation then use
44 ; this entry as starting point. If original time through
45 ; this should be set to null ("").
46 ; KMPDLN... Number of lines to fill before quitting.
47 ;----------------------------------------------------------------------
48 ;
49 K KMPDY
50 ;
51 S KMPDGBL=$G(KMPDGBL),KMPDST=$G(KMPDST),KMPDLN=+$G(KMPDLN)
52 ;
53 I 'KMPDLN S KMPDY(0)="[Number of lines not defined]" Q
54 ;
55 N GBL,GLOBAL,LAST,LEN,LN
56 ;
57 D GBLCHK(.KMPDY,KMPDGBL)
58 ; if error.
59 I $E($G(KMPDY(0)))="[" Q
60 ;
61 S GLOBAL=$G(KMPDY(0))
62 I GLOBAL="" S KMPDY(0)="[Unable to process]" Q
63 I $Q(@GLOBAL)="" S KMPDY(0)="<No Data to Report>" Q
64 ;
65 S GBL=$E(GLOBAL,1,$L(GLOBAL)-1)
66 ; if GLOBAL("") then just use GLOBAL.
67 S:$E(GBL,$L(GBL))="""" GBL=$P(GBL,"(")
68 S LEN=80,LN=1
69 ;
70 ; if data in GLOBAL.
71 I KMPDST=""&(GLOBAL'["("""")") I $D(@GLOBAL)#2 D
72 .S KMPDY(LN)=GLOBAL_" = "_@GLOBAL,LN=LN+1
73 ;
74 S:KMPDST]"" GLOBAL=KMPDST
75 ;
76 F S GLOBAL=$Q(@GLOBAL) Q:GLOBAL=""!($E(GLOBAL,1,$L(GBL))'=GBL) D Q:LN>KMPDLN
77 .S LAST=GLOBAL
78 .S KMPDY(LN)=GLOBAL_" = "
79 .; if fits within LEN.
80 .I $L(@GLOBAL)'>LEN S KMPDY(LN)=KMPDY(LN)_@GLOBAL,LN=LN+1 Q
81 .; parse data to fit on line.
82 .D PARSE(LEN)
83 ;
84 S KMPDY(0)=GLOBAL
85 ; if no more subscripts.
86 ;($E(GLOBAL,1,$L(GBL))'=GBL)
87 I GLOBAL="" S KMPDY(0)="***end of list***"
88 E I $E($Q(@GLOBAL),1,$L(GBL))'=GBL S KMPDY(0)="***end of list***"
89 ;
90 Q
91 ;
92PARSE(LEN) ;
93 ; if length of data is greater than current position to the end
94 ; of the screen the data must be broken down and printed on
95 ; separate lines so that $Y will continue to be updated
96 ;
97 S LEN=+$G(LEN) Q:'LEN N C
98 F C=0:1 Q:$E(@GLOBAL,(LEN*C),(LEN*(C+1)-1))']"" D
99 .S:$G(KMPDY(LN))="" KMPDY(LN)=" "
100 .S KMPDY(LN)=$G(KMPDY(LN))_$E(@GLOBAL,(LEN*C),(LEN*(C+1)-1))
101 .S LN=LN+1
102 ;
103 Q
Note: See TracBrowser for help on using the repository browser.