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

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1ARJTDDK2 ;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 ;
10SEARCHN(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 ;
Note: See TracBrowser for help on using the repository browser.