Changeset 1330 for ccr/branches/ohum/p/C0CRNF.m
- Timestamp:
- Jan 3, 2012, 11:45:29 PM (12 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CRNF.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CRNF.m
r1329 r1330 1 C0CRNF 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 FIELDS(C0CFRTN,C0CF) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 TESTRNF 47 48 49 50 51 52 53 54 55 56 57 58 RNF1TO2(ZOUT,ZIN) 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 RNF1TO2B(ZOUT,ZIN) 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 GETNOLD(GRTN,GFILE,GIEN,GNN) 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 GETN(GRTN,GFILE,GREF,GNDX,GNN) 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 GETN1(GRTN,GFILE,GREF,GNDX,GNN) 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 ADDNV(GNV,GNVN,GNVF,GNVV) 292 293 294 295 296 297 RNF2CSV(RNRTN,RNIN,RNSTY) 298 299 300 301 302 303 304 305 306 307 308 309 310 NV(RNRTN,RNIN) 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 VN(RNRTN,RNIN) 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 READCSV(PATH,NAME,GLB) 357 358 359 360 FILE2CSV(FNUM,FVN) 361 362 363 364 365 366 367 368 369 370 371 372 373 FILEOUT(FOARY,FONAM) 374 375 376 377 378 FILEREF(FNUM) 379 380 381 382 383 384 385 386 SKIP 387 388 389 390 391 392 393 394 395 396 397 RNF2HNV(ZOUT,ZIN) 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 RNF2HVN(ZOUT,ZIN) 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 ZFILE(ZFN,ZTAB) 442 443 444 445 446 ZFIELD(ZFN,ZTAB) 447 448 449 450 451 ZVALUE(ZFN,ZTAB) 452 453 454 455 456 457 ZVALUEI(ZFN,ZTAB) 458 459 460 461 462 1 C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08 2 ;;1.0;C0C;;May 19, 2009;Build 1 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 ; 24 FIELDS(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 $G(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 ; 46 TESTRNF ; 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 ; 58 RNF1TO2(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 ; 78 RNF1TO2B(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 ; 103 GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME 104 ; GRTN IS PASSED BY NAME 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 111 D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP") 112 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 113 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE 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 ; 129 GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP 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 151 I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 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 159 . E S GIEN="" ; 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 ; 193 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP 194 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 195 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 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 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 ; 212 ; 213 N GIEN,GF 214 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE 215 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 216 E D ; WE ARE USING AN INDEX 217 . ;N ZG 218 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 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 223 . E S GIEN="" ; 224 ;W "IEN: ",GIEN,! 225 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 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 230 K C0CTMP 231 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP") 232 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 233 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 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 240 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ; 241 . . I C0CVALUE["C0CTMP" D ; WP FIELD 242 . . . N ZT,ZWP S ZWP=0 ;ITERATOR 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 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 ; 249 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 250 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I")) 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 ; 257 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES 258 ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 259 ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#" 260 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 261 ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE 262 ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES 263 ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 264 ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 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 268 ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN 269 ; .. OF THE FILE WILL BE USED 270 ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE 271 ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED 272 ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE 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 276 ;N GATMP,GAI,GAF 277 S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE 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 281 W GAF,! 282 W $O(@GAF@(0)) ; 283 S GAI=0 ;ITERATOR 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 289 Q 290 ; 291 ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX 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 ; 297 RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT 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 ; 310 NV(RNRTN,RNIN) ; 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 319 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 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 329 . D PUSH^C0CXPATH(RNRTN,RNX) 330 Q 331 ; 332 VN(RNRTN,RNIN) ; 333 S RNR=$NA(@RNIN@("V")) 334 S RNC=$NA(@RNIN@("F")) 335 ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER 336 S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW" 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 341 D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS 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 348 . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","") 349 . . . S RNV=$TR(RNV,",","") 350 . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA 351 . . E S RNX=RNX_"," ; NUL COLUMN 352 . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA 353 . D PUSH^C0CXPATH(RNRTN,RNX) 354 Q 355 ; 356 READCSV(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 ; 360 FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV 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 369 D FILEOUT(G2,"FILE_"_FNUM_".csv") 370 K @G2 371 Q 372 ; 373 FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE 374 ; 375 W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR")) 376 Q 377 ; 378 FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM 379 ; 380 N C0CF 381 S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE 382 S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT 383 I C0CF["()" S C0CF=$P(C0CF,"()",1) 384 Q C0CF 385 ; 386 SKIP ; 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 ; 397 RNF2HNV(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 401 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">") 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 406 . D PUSH^C0CXPATH(ZOUT,ZV) 407 D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row 408 S ZI="" 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 411 . D PUSH^C0CXPATH(ZOUT,ZN) 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 ; 420 RNF2HVN(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 424 D PUSH^C0CXPATH(ZOUT,"<table border=""1"">") 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 ; 441 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 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) 446 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 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) 451 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 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" 455 Q $P($G(@ZTAB@(ZFN)),"^",3) 456 ; 457 ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED 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" 461 Q $P($G(@ZTAB@(ZFN,"I")),"^",3) 462 ;
Note:
See TracChangeset
for help on using the changeset viewer.
