55 lines
2.0 KiB
Mathematica
55 lines
2.0 KiB
Mathematica
ARJTDDK1 ;PUG/TOAD-FileMan Search 1 Field in 1 File ;7/8/02 10:42
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;
|
|
; Table of Contents:
|
|
; SEARCH1 = search 1 field in every entry in 1 file
|
|
;
|
|
; Calls:
|
|
; CHECK^ARJTDIM = to search each value (MUMPS code)
|
|
;
|
|
;
|
|
SEARCH1(FILE,FIELD) ; search 1 field in every entry in 1 file
|
|
;
|
|
; S.1. Build Get Code
|
|
;
|
|
N ROOT S ROOT=$G(^DIC(FILE,0,"GL")) Q:ROOT="" ; file root
|
|
W !,"Now searching the ",$O(^DD(FILE,0,"NM",""))," file "
|
|
W "(",$P(@(ROOT_"0)"),U,4)," entries)..."
|
|
;
|
|
N ENTRY S ROOT=ROOT_"ENTRY(1)" ; top-level IEN
|
|
N ADVANCE S ADVANCE(1)="S ENTRY(1)=$O("_ROOT_"))" ; build traverse code
|
|
;
|
|
N FIELDEF S FIELDEF=$G(^DD(FILE,FIELD,0)) Q:FIELDEF="" ; field DD
|
|
Q:$P(FIELDEF,U,2) ; subfiles have subfile# in 2nd piece
|
|
N HOME S HOME=$P(FIELDEF,U,4) ; node;place of field
|
|
N NODE S NODE=ROOT_","_+HOME_")" ; build root to fetch node
|
|
S NODE="$G("_NODE_")" ; protect against undefined errors
|
|
N PLACE S PLACE=$P(HOME,";",2) ; place to fetch
|
|
;
|
|
; N GET ; array of get commands
|
|
I PLACE D ; $Piece fields have a numeric place
|
|
. S GET(1)="S VALUE=$P("_NODE_",U,"_PLACE_")" ; build get code
|
|
E D ; $Extract fields have E#,#
|
|
. N FIRST S FIRST=+$P($P(PLACE,";"),"E",2) ; first position
|
|
. N LAST S LAST=$P(PLACE,",",2) ; last position
|
|
. S GET(1)="S VALUE=$E("_NODE_","_FIRST_","_LAST_")" ; build get code
|
|
;
|
|
; S.2. Traverse File
|
|
;
|
|
N COUNT S COUNT=0 ; count of entries searched
|
|
N VALUE ; the value of the field for each entry
|
|
S ENTRY(1)=0 F X ADVANCE(1) Q:'ENTRY(1) D ; traverse file entries
|
|
. S COUNT=COUNT+1 I '(COUNT#1000) W "."
|
|
. X GET(1) ; fetch field value for each entry
|
|
. Q:VALUE'["?" ; skip those that clearly lack pattern match
|
|
. ;
|
|
. N ZZDCOM ; clear array of commands & special elements found
|
|
. D CHECK^ARJTDIM(VALUE,"?",.ZZDCOM) ; parse line
|
|
. Q:'ZZDCOM ; skip values that lack pattern match
|
|
. ;
|
|
. W !,ENTRY(1)," ",?15 ; display match (IEN value wrapped)
|
|
. N LINE F W $E(VALUE,1,65) S $E(VALUE,1,65)="" Q:VALUE="" W !?15
|
|
;
|
|
QUIT ; end of SEARCH1
|
|
;
|