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

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1ARJTDDKU ;PUG/TOAD-FileMan Search Utilities ;7/10/02 16:14
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;
4 ; this routine was used for experimenting with search criteria
5 ;
6 ; table of contents:
7 ; EXTRACT - find non-MUMPS $EXTRACT fields
8 ; LIKELY - flag likely fields
9 ; RESULTS - report results of report
10 ; RTEST - test RSE^ARJTDDKR with alternation in pattern match
11 ; RDSM - test RSE^ARJTDDKR with DSM-specific code
12 ;
13 ; calls: nothing
14 ; called by: nothing
15 ;
16EXTRACT ; subroutine: find "free text" MUMPS fields
17 ;
18 ; calls: LIKELY - flag likely fields
19 ;
20 W !!,"Building list of non-MUMPS $EXTRACT fields..."
21 K ^TMP("DIDUF",$J) ; clear master list array
22 N SEARCHED S SEARCHED=0
23 N FOUND S FOUND=0
24 N FILE S FILE=0 F S FILE=$O(^DD(FILE)) Q:'FILE D
25 . N FIELD S FIELD=0 F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D
26 . . S SEARCHED=SEARCHED+1
27 . . N NODE S NODE=$G(^DD(FILE,FIELD,0))
28 . . N POS S POS=$P(NODE,U,4)
29 . . Q:$E($P(POS,";",2))'="E" ; $extract, not $piece
30 . . N FLDNAME S FLDNAME=$P(NODE,U)
31 . . N TYPE S TYPE=$E($P(NODE,U,2))
32 . . I TYPE="R" S TYPE=$E($P(NODE,U,2),2) ; R = required
33 . . Q:TYPE'="F"&(TYPE'="M") ; only want free text or "M"
34 . . ; M is not a real field type, but several fields use it to mean MUMPS
35 . . Q:'$$LIKELY(FLDNAME,FILE,FIELD)
36 . . S FOUND=FOUND+1
37 . . S ^TMP("DIDUF",$J,FILE,FIELD)=""
38 . . W !,FILE," ",?10,$O(^DD(FILE,0,"NM",""))," "
39 . . W ?40,FIELD," ",?50,FLDNAME,?79,TYPE
40 K ^TMP("DIDUF",$J) ; clear master list array
41 W !!,SEARCHED," non-MUMPS fields examined."
42 W !,FOUND," of them may contain MUMPS code."
43 QUIT ; end of EXTRACT
44 ;
45 ;
46LIKELY(NAME,FILE,FIELD) ; function: flag likely fields
47 ;
48 ; input:
49 ; NAME - name of field
50 ; FILE - file DD #
51 ; FIELD - field DD #
52 ; called by: EXTRACT
53 ;
54 I NAME["CODE" Q 1
55 I NAME["ACTION" Q 1
56 I NAME["LOGIC" Q 1
57 I NAME["DIR(0)" Q 1
58 I NAME["DIR(?)" Q 1
59 I NAME["DIR(??)" Q 1
60 I NAME["DR {DIE}" Q 1
61 I $G(^DD(FILE,FIELD,3))["MUMPS" Q 1 ; 'Help'-Prompt attribute (3)
62 I $G(^DD(FILE,FIELD,21,1,0))["MUMPS" Q 1 ; Description attribute (21)
63 Q 0
64 ;
65 ;
66RESULTS(EXIT,COUNT,FOUND,STEP,SENTITY,SVERB,FENTITY) ;
67 ;
68 ; input:
69 ; EXIT = 1 if search was interrupted
70 ; COUNT = # of routines searched
71 ; FOUND = # of instances found
72 ; STEP = verb-name of step ended (e.g., "Search")
73 ; SENTITY = kind of entity being searched/checked (e.g., "routine")
74 ; SVERB = action being performed (e.g., "searched")
75 ; FENTITY = kind of entity being found (e.g., "instance")
76 ; called by: ^ARJTDDK*
77 ;
78 S SVERB=$G(SVERB,"searched")
79 S FENTITY=$G(FENTITY,"instance")
80 W !!,STEP," ",$S(EXIT:"interrupted",1:"completed"),"."
81 W !,$FN(COUNT,",")," ",SENTITY,$E("s",COUNT'=1)," ",SVERB,"."
82 W !,$FN(FOUND,",")," ",FENTITY,$E("s",FOUND'=1)," found."
83 QUIT ; end of RESULTS
84 ;
85 ;
86RTEST ; test RSE^ARJTDDKR with alternation in pattern match
87 ;
88 ; calls:
89 ; ^%ZOSF("PRIINQ") - return current process priority
90 ; RSE - search selected routines
91 ; ^%ZOSF("PRIORITY") - lower & raise priority
92 ;
93 W !!,"Testing RSE^ARJTDDKR with alternation in pattern match."
94 W !!,"Lowering priority for duration of search.",!
95 N ARJTPRI,Y X ^%ZOSF("PRIINQ") S ARJTPRI=Y
96 N X S X=1 X ^%ZOSF("PRIORITY")
97 K ^XTMP("DSMROUTINES")
98 D RSE^ARJTDDKR("?","?(")
99 S X=ARJTPRI X ^%ZOSF("PRIORITY")
100 W !!,"Priority restored."
101 QUIT ; end of TEST
102 ;
103 ;
104RDSM ; test RSE^ARJTDDKR with DSM-specific code
105 ;
106 ; calls:
107 ; ^%ZOSF("PRIINQ") - return current process priority
108 ; RSE - search selected routines
109 ; ^%ZOSF("PRIORITY") - lower & raise priority
110 ;
111 W !!,"Testing RSE^ARJTDDKR with DSM-specific code."
112 I '$D(TOAD) N ARJTPRI D
113 . W !!,"Lowering priority for duration of search.",!
114 . N Y X ^%ZOSF("PRIINQ") S ARJTPRI=Y
115 . N X S X=1 X ^%ZOSF("PRIORITY")
116 K ^XTMP("DSMROUTINES")
117 N CONTAINS
118 S CONTAINS("Z")=""
119 S CONTAINS("&")=""
120 S CONTAINS("^%")=""
121 S CONTAINS("(%")=""
122 S CONTAINS("U ")=""
123 S CONTAINS("U:")=""
124 S CONTAINS("O ")=""
125 S CONTAINS("O:")=""
126 S CONTAINS("C ")=""
127 S CONTAINS("C:")=""
128 D RSE^ARJTDDKR(.CONTAINS,"DSM")
129 I '$D(TOAD) D
130 . S X=ARJTPRI X ^%ZOSF("PRIORITY")
131 . W !!,"Priority restored."
132 QUIT ; end of DSM
133 ;
Note: See TracBrowser for help on using the repository browser.