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

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1ARJTDDK4 ;PUG/TOAD-FileMan Search DD ;7/8/02 10:45
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;
4 ; Table of Contents:
5 ; SEARCHDD = search entire DD
6 ; CHECK = check 1 value (MUMPS code)
7 ; UNQUOTE = unquote the contents of a string
8 ; CONTAINS = function: does code contain what we're looking for
9 ; TEST = test SEARCHDD with alternation in pattern match
10 ;
11 ; input:
12 ; .CONTAINS(string)="" to search any line containing the string
13 ; FIND = optional. special search, e.g., "DSM"
14 ;
15 ; output:
16 ; .EXIT = returns 1 if interrupted.
17 ; report to current device
18 ;
19 ; Calls:
20 ; CHECK^ARJTDIM = to search each value (MUMPS code)
21 ;
22SEARCHDD(CONTAINS,FIND,EXIT) ; search entire DD
23 ;
24 S EXIT=0 ; not interrupted yet
25 N FILE,FIELD,HOOK,VALUE,ID,IX,NODE,OF,MESSAGE
26 N COUNT S COUNT=0
27 N MATCHES S MATCHES=0
28 N FILENAME,FLDNAME
29 ; check the File-level attributes
30 S FILE=-1 F S FILE=$O(^DD(FILE)) Q:FILE'=0&'FILE D Q:EXIT
31 . S FILENAME=$O(^DD(FILE,0,"NM",""))
32 . ;
33 . S FIELD=0
34 . S VALUE=$G(^DD(FILE,0,"ACT")) I VALUE'="" D Q:EXIT
35 . . D CHECK(VALUE,"Post-Action")
36 . ;
37 . I $D(^DD(FILE,0,"ID")) D
38 . . S ID=0 F S ID=$O(^DD(FILE,0,"ID",ID)) Q:ID="" D Q:EXIT
39 . . . S VALUE=$G(^DD(FILE,0,"ID",ID)) I VALUE'="" D CHECK(VALUE,"ID")
40 . ;
41 . S VALUE=$G(^DD(FILE,0,"SCR")) I VALUE'="" D Q:EXIT
42 . . D CHECK(VALUE,"Whole-File Screen")
43 . ;
44 . S FIELD=0 F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D Q:EXIT
45 . . S FLDNAME=$P($G(^DD(FILE,FIELD,0)),U)
46 . . ;
47 . . S VALUE=$P($G(^DD(FILE,FIELD,0)),U,5,9999) I VALUE'="" D Q:EXIT
48 . . . D CHECK(VALUE,"Input Transform")
49 . . ;
50 . . I $D(^DD(FILE,FIELD,1)) D Q:EXIT
51 . . . S IX=0 F S IX=$O(^DD(FILE,FIELD,1,IX)) Q:'IX D Q:EXIT
52 . . . . S NODE=0 F D Q:'NODE!EXIT
53 . . . . . S NODE=$O(^DD(FILE,FIELD,1,IX,NODE)) Q:'NODE
54 . . . . . Q:NODE=3 ; No Deletion Message
55 . . . . . S VALUE=$G(^DD(FILE,FIELD,1,IX,NODE)) Q:VALUE=""
56 . . . . . I NODE=1 S MESSAGE=" Set Logic"
57 . . . . . E I NODE=2 S MESSAGE=" Kill Logic"
58 . . . . . E S MESSAGE=" Overflow Logic"
59 . . . . . D CHECK(VALUE,"Cross-Reference "_IX_MESSAGE)
60 . . ;
61 . . S VALUE=$G(^DD(FILE,FIELD,2)) I VALUE'="" D Q:EXIT
62 . . . D CHECK(VALUE,"Output Transform")
63 . . ;
64 . . S VALUE=$G(^DD(FILE,FIELD,4)) I VALUE'="" D Q:EXIT
65 . . . D CHECK(VALUE,"Executable Help")
66 . . ;
67 . . S VALUE=$G(^DD(FILE,FIELD,7.5)) I VALUE'="" D Q:EXIT
68 . . . D CHECK(VALUE,"Pre-Lookup Transform")
69 . . ;
70 . . F OF=9.2:.1:9.9 S VALUE=$G(^DD(FILE,FIELD,OF)) I VALUE'="" D Q:EXIT
71 . . . D CHECK(VALUE,"Overflow Code Node "_OF)
72 . . ;
73 . . S VALUE=$G(^DD(FILE,FIELD,12.1)) I VALUE'="" D Q:EXIT
74 . . . D CHECK(VALUE,"Pointer or Set-of-Codes Screen") Q:EXIT
75 . . . N SCREEN S SCREEN=$P(VALUE,"S DIC(""S"")=",2)
76 . . . Q:$E(SCREEN)'="""" Q:$E(SCREEN,$L(SCREEN))'=""""
77 . . . S SCREEN=$$UNQUOTE(SCREEN)
78 . . . D CHECK(SCREEN,"Pointer or Set-of-Codes Screen")
79 . . ;
80 . . S VALUE=$G(^DD(FILE,FIELD,"AX")) I VALUE'="" D Q:EXIT
81 . . . D CHECK(VALUE,"Audit Condition")
82 . . ;
83 . . I $D(^DD(FILE,FIELD,"DEL")) D
84 . . . S NODE=0 F S NODE=$O(^DD(FILE,FIELD,"DEL",NODE)) Q:'NODE D Q:EXIT
85 . . . . S VALUE=$G(^DD(FILE,FIELD,"DEL",NODE,0)) Q:VALUE=""
86 . . . . D CHECK(VALUE,"Delete Condition "_NODE)
87 . . ;
88 . . I $D(^DD(FILE,FIELD,"LAYGO")) D Q:EXIT
89 . . . S NODE=0 F S NODE=$O(^DD(FILE,FIELD,"LAYGO",NODE)) Q:'NODE D Q:EXIT
90 . . . . S VALUE=$G(^DD(FILE,FIELD,"LAYGO",NODE,0)) Q:VALUE=""
91 . . . . D CHECK(VALUE,"LAYGO Condition "_NODE)
92 N SENTITY S SENTITY="DD attribute value"
93 D RESULTS^ARJTDDKU(EXIT,COUNT,MATCHES,"Search",SENTITY,"checked")
94 W !!!,"End of report. Have a nice day."
95 Q
96 ;
97 ;
98CHECK(VALUE,HOOK) ; Check out this value
99 S COUNT=COUNT+1
100 I '(COUNT#1000) D Q:EXIT
101 . W "."
102 . I '(COUNT#10000) D
103 . . W !,$FN(COUNT,",")," DD attributes searched. "
104 . N READ R READ:0 S EXIT=READ=U Q:EXIT
105 Q:'$$CONTAINS(VALUE,.CONTAINS) ; skip those that clearly don't match
106 ;
107 N ZZDCOM ; clear array of commands & special elements found
108 D CHECK^ARJTDIM(VALUE,FIND,.ZZDCOM) ; parse line
109 Q:'ZZDCOM ; skip lines that don't match
110 S MATCHES=MATCHES+1 ; this is a match
111 ; S COUNT=0 ; reset count to postpone printing a dot
112 ;
113 ; display match
114 ; match #, file/subfile path, field
115 W !!,MATCHES_". "_FILENAME_" ("_FILE_") file, "
116 I FIELD W FLDNAME_" ("_FIELD_") field, " ; if a field attribute
117 W HOOK ; which attribute contained the match
118 ; field value
119 F Q:VALUE="" W !?10,$E(VALUE,1,70) S $E(VALUE,1,70)="" ; value
120 N READ R READ:0 S EXIT=READ=U
121 ;
122 QUIT ; end of CHECK
123 ;
124 ;
125UNQUOTE(STRING) ; unquote the contents of a string
126 ;
127 S $E(STRING)="",$E(STRING,$L(STRING))="" ; remove bracketing "s
128 N CHAR F CHAR=1:1:$L(STRING)-1 I $E(STRING,CHAR,CHAR+1)="""""" D
129 . S $E(STRING,CHAR)="" ; remove one of the doubled quotes
130 Q STRING
131 ;
132 ;
133CONTAINS(CODE,CONTAINS) ; function: does code contain what we're looking for
134 N DOES I $D(CONTAINS)#2 S DOES=CODE[CONTAINS Q DOES
135 I $D(CONTAINS)>9 D Q DOES
136 . N SUB S SUB=""
137 . F S SUB=$O(CONTAINS(SUB)) Q:SUB="" S DOES=CODE[SUB Q:DOES
138 Q 0
139 ;
140 ;
141TEST ; test SEARCHDD with alternation in pattern match
142 W !!,"Testing SEARCHDD^ARJTDDK4 with alternation in pattern match."
143 W !!,"Lowering priority for duration of search.",!
144 N ARJTPRI,Y X ^%ZOSF("PRIINQ") S ARJTPRI=Y
145 N X S X=1 X ^%ZOSF("PRIORITY")
146 D SEARCHDD("?","?(")
147 S X=ARJTPRI X ^%ZOSF("PRIORITY")
148 W !!,"Priority restored."
149 QUIT ; end of TEST
150 ;
Note: See TracBrowser for help on using the repository browser.