source: ccr/trunk/p/C0CRNF.m@ 699

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

first version with Procedures

File size: 17.8 KB
Line 
1C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
2 ;;1.0;C0C;;May 19, 2009;
3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 W "This is the Reference Name Format (RNF) Utility Library ",!
21 W !
22 Q
23 ;
24FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
25 ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
26 ;
27 N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
28 N C0CFN ; FIELD NAME
29 S C0CFI=0 S C0CFJ=C0CF
30 K @C0CFRTN ; CLEAR THE RETURN ARRAY
31 F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
32 . ;W "1: "_C0CFJ," ",C0CFI,!
33 . F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD
34 . . ;W "2: "_C0CFJ," ",C0CFI,!
35 . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
36 . . ;W "N: ",C0CFN,!
37 . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
38 . . I $D(@C0CFRTN@(C0CFN)) D ; IS THIS A DUPLICATE?
39 . . . I DEBUG D ;
40 . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
41 . . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
42 . . E S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
43 . S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
44 Q
45 ;
46TESTRNF ; TEST THE RNF1TO2 ROUTINE
47 S G1("ONE")=1
48 S G1("TWO")=2
49 S G1("THREE")=3
50 D RNF1TO2("GPL","G1")
51 S G1("ONE")="NOT1"
52 S G1("TWO")="STILL2"
53 S G1("THREE")=3
54 D RNF1TO2("GPL","G1")
55 ZWR GPL
56 Q
57 ;
58RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
59 ; (ZOUT) BOTH ARE PASSED BY NAME
60 ; RNF1 IS OF THE FORM:
61 ; @ZIN@("VAR1")=VAL1
62 ; @ZIN@("VAR2")=VAL2
63 ; RNF2 IS OF THE FORM:
64 ; @ZOUT@("F","VAR1")=""
65 ; @ZOUT@("F","VAR2")=""
66 ; @ZOUT@("V",n,"VAR1")=VAL1
67 ; @ZOUT@("V",n,"VAR2")=VAL2
68 ; WHERE n IS THE "ROW" OF THE ARRAY
69 N ZI S ZI=""
70 N ZN
71 I '$D(@ZOUT@("V",1)) S ZN=1
72 E S ZN=$O(@ZOUT@("V",""),-1)+1
73 F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
74 . S @ZOUT@("F",ZI)=""
75 . S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
76 Q
77 ;
78GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
79 ; GRTN IS PASSED BY NAME
80 ;
81 N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
82 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
83 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
84 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
85 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
86 D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
87 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
88 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
89 S (C0CI,C0CJ)=""
90 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
91 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
92 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
93 . . ;W C0CJ," ",C0CI,!
94 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
95 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
96 . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
97 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
98 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
99 . S C0CI=""
100 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
101 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
102 Q
103 ;
104GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
105 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
106 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
107 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
108 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
109 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
110 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
111 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
112 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
113 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
114 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
115 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
116 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
117 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
118 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
119 ; GREF IS THE VALUE FOR THE INDEX
120 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
121 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
122 ;
123 ;
124 N GIEN,GF
125 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
126 I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
127 E D ; WE ARE USING AN INDEX
128 . ;N ZG
129 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
130 . I ZG'="" D ;
131 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
132 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
133 . . E S GIEN="" ; NOT FOUND IN INDEX
134 . E S GIEN="" ;
135 ;W "IEN: ",GIEN,!
136 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
137 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
138 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
139 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
140 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
141 K C0CTMP
142 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
143 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
144 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
145 S (C0CI,C0CJ)=""
146 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
147 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
148 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
149 . . ;W C0CJ," ",C0CI,!
150 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
151 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
152 . . I C0CVALUE["C0CTMP" D ; WP FIELD
153 . . . N ZT,ZWP S ZWP=0 ;ITERATOR
154 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
155 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
156 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
157 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
158 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
159 . . . . S C0CVALUE=C0CVALUE_ZT ;
160 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
161 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
162 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
163 . S C0CI=""
164 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
165 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
166 Q
167 ;
168GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
169 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
170 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
171 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
172 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
173 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
174 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
175 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
176 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
177 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
178 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
179 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
180 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
181 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
182 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
183 ; GREF IS THE VALUE FOR THE INDEX
184 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
185 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
186 ;
187 ;
188 N GIEN,GF
189 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
190 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
191 E D ; WE ARE USING AN INDEX
192 . ;N ZG
193 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
194 . I ZG'="" D ;
195 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
196 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
197 . . E S GIEN="" ; NOT FOUND IN INDEX
198 . E S GIEN="" ;
199 ;W "IEN: ",GIEN,!
200 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
201 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
202 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
203 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
204 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
205 K C0CTMP
206 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
207 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
208 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
209 S (C0CI,C0CJ)=""
210 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
211 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
212 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
213 . . ;W C0CJ," ",C0CI,!
214 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
215 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
216 . . I C0CVALUE["C0CTMP" D ; WP FIELD
217 . . . N ZT,ZWP S ZWP=0 ;ITERATOR
218 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
219 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
220 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
221 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
222 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
223 . . . . S C0CVALUE=C0CVALUE_ZT ;
224 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
225 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
226 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
227 . S C0CI=""
228 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
229 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
230 Q
231 ;
232GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
233 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
234 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
235 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
236 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
237 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
238 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
239 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
240 ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
241 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
242 ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
243 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
244 ; .. OF THE FILE WILL BE USED
245 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
246 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
247 ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
248 ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
249 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
250 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
251 ;N GATMP,GAI,GAF
252 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
253 I '$D(GAIDX) S GAIDX="" ;DEFAULT
254 I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
255 I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
256 W GAF,!
257 W $O(@GAF@(0)) ;
258 S GAI=0 ;ITERATOR
259 F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;
260 . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
261 . N GAX S GAX=0
262 . F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS
263 . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
264 Q
265 ;
266ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
267 ;
268 S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
269 S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
270 Q
271 ;
272RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
273 ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
274 ; RNSTY IS STYLE OF THE OUTPUT -
275 ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
276 ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
277 ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
278 N RNR,RNC ;ROW ROOT,COL ROOT
279 N RNI,RNJ,RNX
280 I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
281 I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
282 E D VN(RNRTN,RNIN) ;
283 Q
284 ;
285NV(RNRTN,RNIN) ;
286 S RNR=$NA(@RNIN@("F"))
287 S RNC=$NA(@RNIN@("V"))
288 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
289 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
290 S RNI=""
291 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
292 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
293 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
294 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
295 S RNI=""
296 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
297 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
298 . S RNJ=""
299 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
300 . . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN
301 . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
302 . . E S RNX=RNX_"," ; NUL COLUMN
303 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
304 . D PUSH^C0CXPATH(RNRTN,RNX)
305 Q
306 ;
307VN(RNRTN,RNIN) ;
308 S RNR=$NA(@RNIN@("V"))
309 S RNC=$NA(@RNIN@("F"))
310 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
311 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
312 S RNI=""
313 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
314 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
315 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
316 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
317 S RNI=""
318 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
319 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
320 . S RNJ=""
321 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
322 . . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN
323 . . . S RNX=RNX_""""_@RNR@(RNI,RNJ,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
324 . . E S RNX=RNX_"," ; NUL COLUMN
325 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
326 . D PUSH^C0CXPATH(RNRTN,RNX)
327 Q
328 ;
329READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
330 ;
331 Q $$FTG^%ZISH(PATH,NAME,GLB,1)
332 ;
333FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
334 ;
335 ;N G1,G2
336 I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
337 S G1=$NA(^TMP($J,"C0CCSV",1))
338 S G2=$NA(^TMP($J,"C0CCSV",2))
339 D GETN2(G1,FNUM) ; GET THE MATRIX
340 D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
341 K @G1
342 D FILEOUT(G2,"FILE_"_FNUM_".csv")
343 K @G2
344 Q
345 ;
346FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
347 ;
348 W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("GPLCCR","ODIR"))
349 Q
350 ;
351FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
352 ;
353 N C0CF
354 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
355 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
356 I C0CF["()" S C0CF=$P(C0CF,"()",1)
357 Q C0CF
358 ;
359SKIP ;
360 N TXT,DIERR
361 S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
362 I $D(DIERR) D CLEAN^DILF Q
363 W " report_text:",! ;Progress Note Text
364 N LN S LN=0
365 F S LN=$O(TXT(LN)) Q:'LN D
366 . W " text"_LN_": "_TXT(LN),!
367 . Q
368 Q
369 ;
370RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
371 ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
372 ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
373 ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES
374 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
375 N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
376 D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
377 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
378 . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
379 . D PUSH^C0CXPATH(ZOUT,ZV)
380 D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
381 S ZI=""
382 F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
383 . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
384 . D PUSH^C0CXPATH(ZOUT,ZN)
385 . S ZJ=0 ;RESET TO DO IT AGAIN
386 . F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
387 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
388 . . D PUSH^C0CXPATH(ZOUT,ZV)
389 . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
390 D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
391 Q
392 ;
393RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
394 ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
395 ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
396 ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES
397 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
398 N ZI,ZJ S ZI="" S ZJ=0
399 D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
400 F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
401 . S ZV="<td>"_ZI_"</td>"
402 . D PUSH^C0CXPATH(ZOUT,ZV) ; name
403 D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
404 S ZI="" ;RESET TO DO AGAIN
405 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH ROW OF VARIABLES
406 . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
407 . F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
408 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
409 . . D PUSH^C0CXPATH(ZOUT,ZV) ; value
410 . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
411 D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
412 Q
413 ;
414ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
415 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
416 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
417 I '$D(ZTAB) S ZTAB="C0CA"
418 Q $P(@ZTAB@(ZFN),"^",1)
419ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
420 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
421 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
422 I '$D(ZTAB) S ZTAB="C0CA"
423 Q $P(@ZTAB@(ZFN),"^",2)
424ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
425 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
426 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
427 I '$D(ZTAB) S ZTAB="C0CA"
428 Q $P($G(@ZTAB@(ZFN)),"^",3)
429 ;
430ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
431 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
432 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
433 I '$D(ZTAB) S ZTAB="C0CA"
434 Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
435 ;
Note: See TracBrowser for help on using the repository browser.