source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/ARJTDDK1.m@ 767

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1ARJTDDK1 ;PUG/TOAD-FileMan Search 1 Field in 1 File ;7/8/02 10:42
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;
4 ; Table of Contents:
5 ; SEARCH1 = search 1 field in every entry in 1 file
6 ;
7 ; Calls:
8 ; CHECK^ARJTDIM = to search each value (MUMPS code)
9 ;
10 ;
11SEARCH1(FILE,FIELD) ; search 1 field in every entry in 1 file
12 ;
13 ; S.1. Build Get Code
14 ;
15 N ROOT S ROOT=$G(^DIC(FILE,0,"GL")) Q:ROOT="" ; file root
16 W !,"Now searching the ",$O(^DD(FILE,0,"NM",""))," file "
17 W "(",$P(@(ROOT_"0)"),U,4)," entries)..."
18 ;
19 N ENTRY S ROOT=ROOT_"ENTRY(1)" ; top-level IEN
20 N ADVANCE S ADVANCE(1)="S ENTRY(1)=$O("_ROOT_"))" ; build traverse code
21 ;
22 N FIELDEF S FIELDEF=$G(^DD(FILE,FIELD,0)) Q:FIELDEF="" ; field DD
23 Q:$P(FIELDEF,U,2) ; subfiles have subfile# in 2nd piece
24 N HOME S HOME=$P(FIELDEF,U,4) ; node;place of field
25 N NODE S NODE=ROOT_","_+HOME_")" ; build root to fetch node
26 S NODE="$G("_NODE_")" ; protect against undefined errors
27 N PLACE S PLACE=$P(HOME,";",2) ; place to fetch
28 ;
29 ; N GET ; array of get commands
30 I PLACE D ; $Piece fields have a numeric place
31 . S GET(1)="S VALUE=$P("_NODE_",U,"_PLACE_")" ; build get code
32 E D ; $Extract fields have E#,#
33 . N FIRST S FIRST=+$P($P(PLACE,";"),"E",2) ; first position
34 . N LAST S LAST=$P(PLACE,",",2) ; last position
35 . S GET(1)="S VALUE=$E("_NODE_","_FIRST_","_LAST_")" ; build get code
36 ;
37 ; S.2. Traverse File
38 ;
39 N COUNT S COUNT=0 ; count of entries searched
40 N VALUE ; the value of the field for each entry
41 S ENTRY(1)=0 F X ADVANCE(1) Q:'ENTRY(1) D ; traverse file entries
42 . S COUNT=COUNT+1 I '(COUNT#1000) W "."
43 . X GET(1) ; fetch field value for each entry
44 . Q:VALUE'["?" ; skip those that clearly lack pattern match
45 . ;
46 . N ZZDCOM ; clear array of commands & special elements found
47 . D CHECK^ARJTDIM(VALUE,"?",.ZZDCOM) ; parse line
48 . Q:'ZZDCOM ; skip values that lack pattern match
49 . ;
50 . W !,ENTRY(1)," ",?15 ; display match (IEN value wrapped)
51 . N LINE F W $E(VALUE,1,65) S $E(VALUE,1,65)="" Q:VALUE="" W !?15
52 ;
53 QUIT ; end of SEARCH1
54 ;
Note: See TracBrowser for help on using the repository browser.