| 1 | ARJTDDK2 ;PUG/TOAD-FileMan Search N Fields in 1 File ;7/8/02 10:43
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;
|
|---|
| 4 | ; Table of Contents:
|
|---|
| 5 | ; SEARCHN = search N fields in every entry in 1 file
|
|---|
| 6 | ;
|
|---|
| 7 | ; Calls:
|
|---|
| 8 | ; CHECK^ARJTDIM = to search each value (MUMPS code)
|
|---|
| 9 | ;
|
|---|
| 10 | SEARCHN(LIST,CONTAINS,FIND) ; search N fields in every entry in 1 file
|
|---|
| 11 | ;
|
|---|
| 12 | ; S.1. Build Get Code
|
|---|
| 13 | ;
|
|---|
| 14 | N FILE S FILE=$O(@LIST@(0)) ; ID file to search
|
|---|
| 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 IEN S ROOT=ROOT_"IEN(1)" ; top-level IEN
|
|---|
| 20 | N ADVANCE S ADVANCE(1)="S IEN(1)=$O("_ROOT_"))" ; build traverse code
|
|---|
| 21 | ;
|
|---|
| 22 | N COUNT S COUNT=0 ; how many fields will we be searching?
|
|---|
| 23 | N NODE ; list of nodes containing the fields
|
|---|
| 24 | N FIELD ; list of fields to search
|
|---|
| 25 | S FIELD=0 F S FIELD=$O(@LIST@(FILE,FIELD)) Q:'FIELD D
|
|---|
| 26 | . N FIELDEF S FIELDEF=$G(^DD(FILE,FIELD,0)) Q:FIELDEF="" ; field DD
|
|---|
| 27 | . Q:$P(FIELDEF,U,2) ; subfiles have subfile# in 2nd piece
|
|---|
| 28 | . S COUNT=COUNT+1 ; we'll definitely search this field
|
|---|
| 29 | . N HOME S HOME=$P(FIELDEF,U,4) ; node;place of field
|
|---|
| 30 | . S NODE=ROOT_","_+HOME_")" ; build root to fetch node
|
|---|
| 31 | . S NODE="$G("_NODE_")" ; protect against undefined errors
|
|---|
| 32 | . I '$D(NODE(+HOME)) D ; if we haven't already handled this node
|
|---|
| 33 | . . S NODE(+HOME,"GET")="S NODE("_+HOME_")="_NODE ; build get code
|
|---|
| 34 | . ;
|
|---|
| 35 | . N GET
|
|---|
| 36 | . N PLACE S PLACE=$P(HOME,";",2) ; place to fetch
|
|---|
| 37 | . I PLACE D ; $Piece fields have a numeric place
|
|---|
| 38 | . . S GET="S VALUE=$P(NODE("_+HOME_"),U,"_PLACE_")" ; build get code
|
|---|
| 39 | . E D ; $Extract fields have E#,#
|
|---|
| 40 | . . N FIRST S FIRST=+$P($P(PLACE,";"),"E",2) ; first position
|
|---|
| 41 | . . N LAST S LAST=$P(PLACE,",",2) ; last position
|
|---|
| 42 | . . S GET="S VALUE=$E(NODE("_+HOME_"),"_FIRST_","_LAST_")" ; get code
|
|---|
| 43 | . S FIELD(FIELD,"GET")=GET
|
|---|
| 44 | Q:'COUNT
|
|---|
| 45 | ;
|
|---|
| 46 | ;
|
|---|
| 47 | ; S.2. Traverse File
|
|---|
| 48 | ;
|
|---|
| 49 | N COUNT S COUNT=0 ; count of entries searched
|
|---|
| 50 | N VALUE ; the value of the field for each entry
|
|---|
| 51 | S IEN(1)=0 F X ADVANCE(1) Q:'IEN(1) D ; traverse file entries
|
|---|
| 52 | . ;
|
|---|
| 53 | . ; load needed nodes into locals
|
|---|
| 54 | . S NODE="" F S NODE=$O(NODE(NODE)) Q:NODE="" X NODE(NODE,"GET")
|
|---|
| 55 | . ;
|
|---|
| 56 | . S FIELD=0 F S FIELD=$O(FIELD(FIELD)) Q:'FIELD D
|
|---|
| 57 | . . S COUNT=COUNT+1 I '(COUNT#1000) W "."
|
|---|
| 58 | . . X FIELD(FIELD,"GET") ; fetch field value for each entry
|
|---|
| 59 | . . Q:VALUE'[CONTAINS ; skip those that clearly don't match
|
|---|
| 60 | . . ;
|
|---|
| 61 | . . N ZZDCOM ; clear array of commands & special elements found
|
|---|
| 62 | . . D CHECK^ARJTDIM(VALUE,FIND,.ZZDCOM) ; parse line
|
|---|
| 63 | . . Q:'ZZDCOM ; skip values that don't match
|
|---|
| 64 | . . ;
|
|---|
| 65 | . . ; display match
|
|---|
| 66 | . . W !,IEN(1)," " ; ID entry
|
|---|
| 67 | . . W ?20,FIELD," " ; ID field
|
|---|
| 68 | . . F Q:VALUE="" W ?30,$E(VALUE,1,50),! S $E(VALUE,1,50)="" ; wrap val
|
|---|
| 69 | ;
|
|---|
| 70 | QUIT ; end of SEARCHN
|
|---|
| 71 | ;
|
|---|
