source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/ARJTDDKM.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: 3.2 KB
RevLine 
[613]1ARJTDDKM ;PUG/TOAD-FileMan Search All MUMPS Fields ;7/8/02 10:23
2 ;;22.0;VA FileMan;;Mar 30, 1999;
3 ;
4 ; table of contents:
5 ; MUMPS - search all MUMPS-type fields
6 ; FEEDBACK - report finds & allow escape
7 ; TEST - test MUMPS with alternation in pattern match
8 ;
9 ; calls:
10 ; SEARCHNS^ARJTDDK3 = search N fields in 1 file or subfile
11 ;
12 ; input:
13 ; .CONTAINS(string)="" to search any line containing the string
14 ; FIND = optional. special search, e.g., "DSM"
15 ;
16 ; output:
17 ; .EXIT = 1 if search interrupted
18 ; report to current device
19 ;
20 ;
21MUMPS(CONTAINS,FIND,EXIT) ; search all MUMPS-type fields
22 ;
23 ; calls:
24 ; FEEDBACK - report finds & allow escape
25 ; SEARCHNS^ARJTDDK3 - search N fields in 1 file or subfile
26 ;
27 ; MUMPS.1. BUILD MASTER LIST OF MUMPS-TYPE FIELDS
28 ;
29 W !!,"Building list of files and fields to search..."
30 K ^TMP("DIDUF",$J) ; clear master list array
31 S EXIT=0 ; not interrupted yet
32 N SEARCHED S SEARCHED=0
33 N FOUND S FOUND=0
34 N FILE S FILE=0 F S FILE=$O(^DD(FILE)) Q:'FILE D Q:EXIT
35 . N FIELD S FIELD=0 F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D Q:EXIT
36 . . S SEARCHED=SEARCHED+1
37 . . S NODE=$G(^DD(FILE,FIELD,0))
38 . . Q:$E($P(NODE,U,2))'="K"
39 . . S FOUND=FOUND+1
40 . . S ^TMP("DIDUF",$J,FILE,FIELD)=""
41 . . D FEEDBACK(FILE,FIELD,$P(NODE,U),.EXIT)
42 N FENTITY S FENTITY="MUMPS field"
43 D RESULTS^ARJTDDKU(EXIT,SEARCHED,FOUND,"Build","field","checked",FENTITY)
44 I EXIT K ^TMP("DIDUF",$J)
45 ;
46 ; MUMPS.2. TRAVERSE LIST OF FILES & SUBFILES, RUNNING A SEARCH ON EACH
47 ;
48 ; This is not the most efficient way to do this, since I'm retraversing
49 ; files to handle different subfiles within them, but it's an efficient
50 ; use of my time, since it will get me my answers sooner.
51 ;
52 W !!,"Now searching the data in those MUMPS fields..."
53 N ARJTLIST ; list of fields within each file or subfile/report
54 S (SEARCHED,FOUND)=0 ; reset counters for the search
55 N FILE S FILE=0 F S FILE=$O(^TMP("DIDUF",$J,FILE)) Q:'FILE D Q:EXIT
56 . K ARJTLIST M ARJTLIST(FILE)=^TMP("DIDUF",$J,FILE)
57 . ; run report on each DD #
58 . D SEARCHNS^ARJTDDK3("ARJTLIST",.CONTAINS,FIND,.SEARCHED,.FOUND,.EXIT)
59 K ^TMP("DIDUF",$J)
60 D RESULTS^ARJTDDKU(EXIT,SEARCHED,FOUND,"Search","value","checked")
61 W !!!,"End of report. Have a nice day."
62 Q
63 ;
64FEEDBACK(FILE,FIELD,FLDNAME,EXIT) ; subroutine: report finds & allow escape
65 ;
66 ; input:
67 ; FILE = file #
68 ; FIELD = field #
69 ; FLDNAME = name of field
70 ; output: .EXIT = 1 if interrupted
71 ; called by: MUMPS
72 ;
73 N FILENAME S FILENAME=$O(^DD(FILE,0,"NM",""))
74 I FILENAME="" S FILENAME=$P($G(^DIC(FILE,0)),U) ; for Function file (.7)
75 W !,FILE," ",?10,FILENAME," "
76 W ?40,FIELD," ",?50,FLDNAME
77 N READ R READ:0 S EXIT=READ=U
78 QUIT ; end of FEEDBACK
79 ;
80 ;
81TEST ; test MUMPS with alternation in pattern match
82 ;
83 ; calls:
84 ; ^%ZOSF("PRIINQ") - return current process priority
85 ; MUMPS - search all MUMPS fields
86 ; ^%ZOSF("PRIORITY") - lower & raise priority
87 ;
88 W !!,"Testing MUMPS^ARJTDDKM with alternation in pattern match."
89 W !!,"Lowering priority for duration of search.",!
90 N ARJTPRI,Y X ^%ZOSF("PRIINQ") S ARJTPRI=Y
91 N X S X=1 X ^%ZOSF("PRIORITY")
92 N EXIT S EXIT=0
93 D MUMPS("D","D")
94 S X=ARJTPRI X ^%ZOSF("PRIORITY")
95 W !!,"Priority restored."
96 QUIT ; end of TEST
97 ;
Note: See TracBrowser for help on using the repository browser.