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

Last change on this file since 1099 was 891, checked in by George Lilly, 14 years ago

update to RNF routines for eRx analysis

File size: 18.5 KB
RevLine 
[508]1C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
2 ;;1.0;C0C;;May 19, 2009;
[404]3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
[300]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 ;
[508]24FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
[300]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,!
[344]35 . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
[300]36 . . ;W "N: ",C0CFN,!
37 . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
38 . . I $D(@C0CFRTN@(C0CFN)) D ; IS THIS A DUPLICATE?
[718]39 . . . I $G(DEBUG) D ;
[431]40 . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
[300]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 ;
[674]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 ;
[891]78RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
79 ; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
80 ; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
81 ; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
82 ; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV
83 ; WITH RNF2CSV
84 ; (ZOUT) BOTH ARE PASSED BY NAME
85 ; RNF1 IS OF THE FORM:
86 ; @ZIN@("VAR1")=VAL1
87 ; @ZIN@("VAR2")=VAL2
88 ; RNF2 IS OF THE FORM:
89 ; @ZOUT@("F","VAR1")=""
90 ; @ZOUT@("F","VAR2")=""
91 ; @ZOUT@("V",n,"VAR1",1)=VAL1
92 ; @ZOUT@("V",n,"VAR2",1)=VAL2
93 ; WHERE n IS THE "ROW" OF THE ARRAY
94 N ZI S ZI=""
95 N ZN
96 I '$D(@ZOUT@("V",1)) S ZN=1
97 E S ZN=$O(@ZOUT@("V",""),-1)+1
98 F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
99 . S @ZOUT@("F",ZI)=""
100 . S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
101 Q
102 ;
[508]103GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
[301]104 ; GRTN IS PASSED BY NAME
[300]105 ;
106 N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
107 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
108 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
109 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
110 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
[343]111 D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
[300]112 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
[303]113 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
[300]114 S (C0CI,C0CJ)=""
115 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
116 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
117 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
118 . . ;W C0CJ," ",C0CI,!
119 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
120 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
121 . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
122 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
123 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
124 . S C0CI=""
125 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
126 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
127 Q
128 ;
[508]129GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
[345]130 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
131 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
132 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
133 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
134 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
135 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
136 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
137 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
138 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
139 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
140 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
141 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
142 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
143 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
144 ; GREF IS THE VALUE FOR THE INDEX
145 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
146 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
147 ;
148 ;
149 N GIEN,GF
150 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
[555]151 I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
[345]152 E D ; WE ARE USING AN INDEX
153 . ;N ZG
154 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
155 . I ZG'="" D ;
156 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
157 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
158 . . E S GIEN="" ; NOT FOUND IN INDEX
[404]159 . E S GIEN="" ;
[345]160 ;W "IEN: ",GIEN,!
161 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
162 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
163 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
164 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
165 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
166 K C0CTMP
167 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
168 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
169 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
170 S (C0CI,C0CJ)=""
171 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
172 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
173 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
174 . . ;W C0CJ," ",C0CI,!
175 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
176 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
177 . . I C0CVALUE["C0CTMP" D ; WP FIELD
178 . . . N ZT,ZWP S ZWP=0 ;ITERATOR
179 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
180 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
181 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
182 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
183 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
184 . . . . S C0CVALUE=C0CVALUE_ZT ;
185 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
186 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
187 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
188 . S C0CI=""
189 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
190 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
191 Q
192 ;
[508]193GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
[308]194 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
195 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
[301]196 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
197 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
198 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
199 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
200 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
201 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
202 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
203 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
204 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
[300]205 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
206 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
207 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
208 ; GREF IS THE VALUE FOR THE INDEX
209 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
210 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
211 ;
[301]212 ;
213 N GIEN,GF
214 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
[304]215 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
[300]216 E D ; WE ARE USING AN INDEX
[301]217 . ;N ZG
218 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
[345]219 . I ZG'="" D ;
220 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
221 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
222 . . E S GIEN="" ; NOT FOUND IN INDEX
[404]223 . E S GIEN="" ;
[345]224 ;W "IEN: ",GIEN,!
[340]225 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
[300]226 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
227 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
228 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
229 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
[308]230 K C0CTMP
[343]231 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
[300]232 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
[303]233 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
[300]234 S (C0CI,C0CJ)=""
235 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
236 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
237 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
238 . . ;W C0CJ," ",C0CI,!
239 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
[343]240 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
[308]241 . . I C0CVALUE["C0CTMP" D ; WP FIELD
242 . . . N ZT,ZWP S ZWP=0 ;ITERATOR
[309]243 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
244 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
[308]245 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
246 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
247 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
248 . . . . S C0CVALUE=C0CVALUE_ZT ;
[300]249 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
[343]250 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
[300]251 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
252 . S C0CI=""
253 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
254 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
255 Q
256 ;
[508]257GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
[301]258 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
[307]259 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
[301]260 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
[307]261 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
262 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
[301]263 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
[300]264 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
[301]265 ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
266 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
267 ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
[307]268 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
269 ; .. OF THE FILE WILL BE USED
[301]270 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
[300]271 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
[301]272 ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
[300]273 ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
274 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
275 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
[307]276 ;N GATMP,GAI,GAF
[300]277 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
[307]278 I '$D(GAIDX) S GAIDX="" ;DEFAULT
279 I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
280 I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
[300]281 W GAF,!
282 W $O(@GAF@(0)) ;
283 S GAI=0 ;ITERATOR
[307]284 F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;
285 . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
286 . N GAX S GAX=0
287 . F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS
288 . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
[300]289 Q
290 ;
[508]291ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
[307]292 ;
293 S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
294 S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
295 Q
296 ;
[508]297RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
[307]298 ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
299 ; RNSTY IS STYLE OF THE OUTPUT -
300 ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
301 ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
302 ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
303 N RNR,RNC ;ROW ROOT,COL ROOT
304 N RNI,RNJ,RNX
305 I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
306 I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
307 E D VN(RNRTN,RNIN) ;
308 Q
309 ;
[508]310NV(RNRTN,RNIN) ;
[307]311 S RNR=$NA(@RNIN@("F"))
312 S RNC=$NA(@RNIN@("V"))
313 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
314 S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
315 S RNI=""
316 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
317 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
318 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
[662]319 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
[307]320 S RNI=""
321 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
322 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
323 . S RNJ=""
324 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
325 . . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN
326 . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
327 . . E S RNX=RNX_"," ; NUL COLUMN
328 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
[662]329 . D PUSH^C0CXPATH(RNRTN,RNX)
[307]330 Q
331 ;
[508]332VN(RNRTN,RNIN) ;
[307]333 S RNR=$NA(@RNIN@("V"))
334 S RNC=$NA(@RNIN@("F"))
335 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
[891]336 S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
[307]337 S RNI=""
338 F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
339 . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
340 S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
[662]341 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
[307]342 S RNI=""
343 F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
344 . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
345 . S RNJ=""
346 . F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
347 . . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN
[891]348 . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
349 . . . S RNV=$TR(RNV,",","")
350 . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
[307]351 . . E S RNX=RNX_"," ; NUL COLUMN
352 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
[662]353 . D PUSH^C0CXPATH(RNRTN,RNX)
[307]354 Q
355 ;
[569]356READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
357 ;
358 Q $$FTG^%ZISH(PATH,NAME,GLB,1)
359 ;
[508]360FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
[307]361 ;
362 ;N G1,G2
363 I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
364 S G1=$NA(^TMP($J,"C0CCSV",1))
365 S G2=$NA(^TMP($J,"C0CCSV",2))
366 D GETN2(G1,FNUM) ; GET THE MATRIX
367 D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
368 K @G1
[308]369 D FILEOUT(G2,"FILE_"_FNUM_".csv")
[307]370 K @G2
371 Q
372 ;
[508]373FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
[308]374 ;
[891]375 W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))
[308]376 Q
377 ;
[508]378FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
[300]379 ;
[301]380 N C0CF
[300]381 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
382 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
[307]383 I C0CF["()" S C0CF=$P(C0CF,"()",1)
[300]384 Q C0CF
385 ;
[508]386SKIP ;
[308]387 N TXT,DIERR
388 S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
389 I $D(DIERR) D CLEAN^DILF Q
390 W " report_text:",! ;Progress Note Text
391 N LN S LN=0
392 F S LN=$O(TXT(LN)) Q:'LN D
393 . W " text"_LN_": "_TXT(LN),!
394 . Q
395 Q
396 ;
[662]397RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
398 ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
399 ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
400 ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES
[666]401 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
[662]402 N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
403 D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
404 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
405 . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
[666]406 . D PUSH^C0CXPATH(ZOUT,ZV)
[662]407 D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
[666]408 S ZI=""
[662]409 F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
410 . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
[666]411 . D PUSH^C0CXPATH(ZOUT,ZN)
[662]412 . S ZJ=0 ;RESET TO DO IT AGAIN
413 . F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
414 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
415 . . D PUSH^C0CXPATH(ZOUT,ZV)
416 . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
417 D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
418 Q
419 ;
420RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
421 ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
422 ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
423 ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES
[666]424 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
[662]425 N ZI,ZJ S ZI="" S ZJ=0
426 D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
427 F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
428 . S ZV="<td>"_ZI_"</td>"
429 . D PUSH^C0CXPATH(ZOUT,ZV) ; name
430 D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
431 S ZI="" ;RESET TO DO AGAIN
432 F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH ROW OF VARIABLES
433 . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
434 . F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
435 . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
436 . . D PUSH^C0CXPATH(ZOUT,ZV) ; value
437 . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
438 D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
439 Q
440 ;
[508]441ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
[300]442 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
443 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
444 I '$D(ZTAB) S ZTAB="C0CA"
445 Q $P(@ZTAB@(ZFN),"^",1)
[508]446ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
[300]447 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
448 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
449 I '$D(ZTAB) S ZTAB="C0CA"
450 Q $P(@ZTAB@(ZFN),"^",2)
[508]451ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
[300]452 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
453 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
454 I '$D(ZTAB) S ZTAB="C0CA"
[351]455 Q $P($G(@ZTAB@(ZFN)),"^",3)
[301]456 ;
[508]457ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
[343]458 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
459 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
460 I '$D(ZTAB) S ZTAB="C0CA"
[351]461 Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
[343]462 ;
Note: See TracBrowser for help on using the repository browser.