| [613] | 1 | ARJTDDK1 ;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 | ;
|
|---|
| 11 | SEARCH1(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 | ;
|
|---|
