source: FOIAVistA/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDU5.m@ 1008

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1KMPDU5 ;OAK/RAK - CM Tools Utilities ;8/25/04 08:56
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;**2**;Mar 22, 2002
3 ;
4FILEINQ(KMPDY,KMPDFN,KMPDIEN,KMPDGBL) ;-- file inquiry.
5 ;-----------------------------------------------------------------------
6 ; KMPDFN.... File number.
7 ; KMPDIEN... Ien for above file.
8 ; KMPDGBL... Global where data is stored.
9 ;-----------------------------------------------------------------------
10 ;
11 K KMPDY
12 ;
13 I '$G(KMPDFN) S KMPDY="[File Number not defined]" Q
14 I '$D(^DD(KMPDFN)) S KMPDY="[File #"_KMPDFN_" is not defined]" Q
15 ;
16 I '$G(KMPDIEN) S KMPDY="[IEN not defined]" Q
17 ;
18 I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
19 ;
20 N ARRAY,CNT,DATA,ERROR,FIELD,FILE,I,IEN,LN,TITLE
21 ;
22 ; kill global with check for ^tmp or ^utility.
23 D KILL^KMPDU(.DATA,KMPDGBL)
24 ; if error.
25 I $E(DATA)="[" S KMPDY=DATA Q
26 ;
27 S ARRAY=$NA(^TMP("KMPD FILE INQ",$J))
28 K @ARRAY
29 ;
30 S FIELD="**"
31 I KMPDFN=9.4 S FIELD="" D
32 .F I=0:0 S I=$O(^DD(KMPDFN,I)) Q:'I D
33 ..I $P($G(^DD(KMPDFN,I,0)),U,2)'["C"&($P($G(^(0)),U,2)'["M")&($E($G(^(0)))'="*")&($P($G(^(0)),U,3)'="") S FIELD=FIELD_I_";"
34 .S FIELD=FIELD_"3;" ;4;5;"
35 ;
36 D GETS^DIQ(KMPDFN,KMPDIEN,FIELD,"R",ARRAY,"ERROR")
37 ;
38 I $D(ERROR) S KMPDY="[Error occurred while getting info.]" Q
39 ;
40 I '$D(@ARRAY) S KMPDY="<No Data to Report>" Q
41 ;
42 S FILE="",LN=0
43 F S FILE=$O(@ARRAY@(FILE)) Q:FILE="" D
44 .S IEN=""
45 .F S IEN=$O(@ARRAY@(FILE,IEN)) Q:IEN="" D
46 ..S FIELD=""
47 ..F S FIELD=$O(@ARRAY@(FILE,IEN,FIELD)) Q:FIELD="" D
48 ...; if not a multiple.
49 ...I '$O(@ARRAY@(FILE,IEN,FIELD,0)) D Q
50 ....S @KMPDGBL@(LN)=FIELD,@KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$L(@KMPDGBL@(LN)))
51 ....S @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "_@ARRAY@(FILE,IEN,FIELD)
52 ....S LN=LN+1
53 ...;
54 ...; if multiple
55 ...S @KMPDGBL@(LN)=FIELD
56 ...S @KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(".",30-$L(@KMPDGBL@(LN)))
57 ...S @KMPDGBL@(LN)=@KMPDGBL@(LN)_": "
58 ...;S LN=LN+1
59 ...S CNT=1
60 ...F I=0:0 S I=$O(@ARRAY@(FILE,IEN,FIELD,I)) Q:'I D
61 ....;S @KMPDGBL@(LN)=FIELD,@KMPDGBL@(LN)=@KMPDGBL@(LN)_$$REPEAT^XLFSTR(" ",30-$L(@KMPDGBL@(LN)))
62 ....I CNT=1 S @KMPDGBL@(LN)=$G(@KMPDGBL@(LN))_@ARRAY@(FILE,IEN,FIELD,I)
63 ....E D
64 .....S @KMPDGBL@(LN)=$G(@KMPDGBL@(LN))_$$REPEAT^XLFSTR(" ",30-$L($G(@KMPDGBL@(LN))))
65 .....S @KMPDGBL@(LN)=@KMPDGBL@(LN)_" "_@ARRAY@(FILE,IEN,FIELD,I)
66 ....S LN=LN+1,CNT=CNT+1
67 ;
68 S KMPDY=$NA(@KMPDGBL)
69 S:'$D(@KMPDGBL) KMPDY="<No Data To Report>"
70 ;
71 Q
72 ;
73FILESRC(KMPDY,KMPDFN,KMPDFLD,KMPDSRC,KMPDGBL) ;-- file search.
74 ;-----------------------------------------------------------------------
75 ; KMPDFN... File Number.
76 ; KMPDFLD.. Fields to be returned, seperated by commas.
77 ; Example: ".01,.04,1" would return fields .01, .04 and 1.
78 ; KMPDSRC.. (optional). Search text. This will search the .01 field for
79 ; a match. If KMPDSRC="*" or is null then all entries will be
80 ; returned.
81 ; KMPDGBL... Global where data is stored.
82 ;-----------------------------------------------------------------------
83 ;
84 K KMPDY
85 ;
86 S KMPDFN=+$G(KMPDFN),KMPDFLD=$G(KMPDFLD)
87 S KMPDSRC=$$UP^XLFSTR($G(KMPDSRC)),KMPDGBL=$G(KMPDGBL)
88 ;
89 I 'KMPDFN S KMPDY="[File Number not defined]" Q
90 ;
91 I KMPDFLD="" S KMPDY="[No fields have been requested]" Q
92 ;
93 I KMPDGBL="" S KMPDY="[Global for storage is not defined]" Q
94 ;
95 N DATA,GLOBAL,I,IEN,LN,NAME,NODE,PIECE
96 ;
97 ; kill global with check for ^tmp or ^utility.
98 D KILL^KMPDU(.DATA,KMPDGBL)
99 ; if error.
100 I $E(DATA)="[" S KMPDY=DATA Q
101 ;
102 S GLOBAL=$G(^DIC(KMPDFN,0,"GL"))
103 I GLOBAL="" S KMPDY="[File #"_KMPDFN_" is not defined]" Q
104 ; make sure global name is closed () for use with subscript indirection.
105 S:$E(GLOBAL,$L(GLOBAL))="," $E(GLOBAL,$L(GLOBAL))=")"
106 ;
107 ; set zero node to field titles.
108 S $P(@KMPDGBL@(0),U)="IEN"
109 F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA="" D
110 .; try title first.
111 .S TITLE=$G(^DD(KMPDFN,DATA,.1))
112 .; if no title use name.
113 .S:TITLE="" TITLE=$P($G(^DD(KMPDFN,DATA,0)),U)
114 .S $P(@KMPDGBL@(0),U,(I+1))=TITLE
115 ;
116 S:KMPDSRC="*" KMPDSRC=""
117 ; remove '*' if last character
118 S:$E($RE(KMPDSRC))="*" $E(KMPDSRC,$L(KMPDSRC))=""
119 S LN=1,NAME=KMPDSRC
120 ; if exact match.
121 I NAME]"" S IEN=$O(@GLOBAL@("B",NAME,0)) I IEN D
122 .Q:'$D(@GLOBAL@(IEN,0)) S DATA=^(0)
123 .; ien.
124 .S $P(@KMPDGBL@(LN),U)=IEN
125 .; user defined data.
126 .F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA="" D
127 ..S $P(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
128 .S LN=LN+1
129 ;
130 F S NAME=$O(@GLOBAL@("B",NAME)) Q:NAME=""!($E(NAME,1,$L(KMPDSRC))'=KMPDSRC) D
131 .F IEN=0:0 S IEN=$O(@GLOBAL@("B",NAME,IEN)) Q:'IEN D
132 ..Q:'$D(@GLOBAL@(IEN,0)) S DATA=^(0)
133 ..; ien.
134 ..S $P(@KMPDGBL@(LN),U)=IEN
135 ..; user defined data.
136 ..F I=1:1 S DATA=$P(KMPDFLD,",",I) Q:DATA="" D
137 ...S $P(@KMPDGBL@(LN),U,(I+1))=$$GET1^DIQ(KMPDFN,IEN,DATA)
138 ..S LN=LN+1
139 ;
140 S KMPDY=$NA(@KMPDGBL)
141 S:'$O(@KMPDGBL@(0)) @KMPDGBL@(1)="<No Data To Report>"
142 ;
143 Q
144 ;
145ENV(KMPDRES) ;-- get uci/volume set
146 ;-----------------------------------------------------------------------
147 ; KMPDRES(0)="uci,volumeset"
148 ; KMPDRES(1)="facilityinfo" as returned by $$SITE^VASITE
149 ;-----------------------------------------------------------------------
150 ;
151 K KMPDRES
152 N Y X ^%ZOSF("UCI")
153 S KMPDRES(0)=Y
154 ;S KMPDRES(1)=$$SITE^VASITE
155 ;
156 Q
157 ;
158VERSION(KMPDY) ;-- version^patch info
159 ; cm tools version^patch
160 S KMPDY(0)=$P($G(^KMPD(8973,1,0)),U,2)
161 ; operating system version
162 S KMPDY(1)=$P($G(^%ZOSF("OS")),U) ;$ZV
163 ;
164 Q
Note: See TracBrowser for help on using the repository browser.