VistA-WorldVistAEHR/r/VA_FILEMAN-ARJT-DI-DD-DM-DT.../ARJTDDKU.m

134 lines
4.0 KiB
Mathematica

ARJTDDKU ;PUG/TOAD-FileMan Search Utilities ;7/10/02 16:14
;;22.0;VA FileMan;;Mar 30, 1999
;
; this routine was used for experimenting with search criteria
;
; table of contents:
; EXTRACT - find non-MUMPS $EXTRACT fields
; LIKELY - flag likely fields
; RESULTS - report results of report
; RTEST - test RSE^ARJTDDKR with alternation in pattern match
; RDSM - test RSE^ARJTDDKR with DSM-specific code
;
; calls: nothing
; called by: nothing
;
EXTRACT ; subroutine: find "free text" MUMPS fields
;
; calls: LIKELY - flag likely fields
;
W !!,"Building list of non-MUMPS $EXTRACT fields..."
K ^TMP("DIDUF",$J) ; clear master list array
N SEARCHED S SEARCHED=0
N FOUND S FOUND=0
N FILE S FILE=0 F S FILE=$O(^DD(FILE)) Q:'FILE D
. N FIELD S FIELD=0 F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D
. . S SEARCHED=SEARCHED+1
. . N NODE S NODE=$G(^DD(FILE,FIELD,0))
. . N POS S POS=$P(NODE,U,4)
. . Q:$E($P(POS,";",2))'="E" ; $extract, not $piece
. . N FLDNAME S FLDNAME=$P(NODE,U)
. . N TYPE S TYPE=$E($P(NODE,U,2))
. . I TYPE="R" S TYPE=$E($P(NODE,U,2),2) ; R = required
. . Q:TYPE'="F"&(TYPE'="M") ; only want free text or "M"
. . ; M is not a real field type, but several fields use it to mean MUMPS
. . Q:'$$LIKELY(FLDNAME,FILE,FIELD)
. . S FOUND=FOUND+1
. . S ^TMP("DIDUF",$J,FILE,FIELD)=""
. . W !,FILE," ",?10,$O(^DD(FILE,0,"NM",""))," "
. . W ?40,FIELD," ",?50,FLDNAME,?79,TYPE
K ^TMP("DIDUF",$J) ; clear master list array
W !!,SEARCHED," non-MUMPS fields examined."
W !,FOUND," of them may contain MUMPS code."
QUIT ; end of EXTRACT
;
;
LIKELY(NAME,FILE,FIELD) ; function: flag likely fields
;
; input:
; NAME - name of field
; FILE - file DD #
; FIELD - field DD #
; called by: EXTRACT
;
I NAME["CODE" Q 1
I NAME["ACTION" Q 1
I NAME["LOGIC" Q 1
I NAME["DIR(0)" Q 1
I NAME["DIR(?)" Q 1
I NAME["DIR(??)" Q 1
I NAME["DR {DIE}" Q 1
I $G(^DD(FILE,FIELD,3))["MUMPS" Q 1 ; 'Help'-Prompt attribute (3)
I $G(^DD(FILE,FIELD,21,1,0))["MUMPS" Q 1 ; Description attribute (21)
Q 0
;
;
RESULTS(EXIT,COUNT,FOUND,STEP,SENTITY,SVERB,FENTITY) ;
;
; input:
; EXIT = 1 if search was interrupted
; COUNT = # of routines searched
; FOUND = # of instances found
; STEP = verb-name of step ended (e.g., "Search")
; SENTITY = kind of entity being searched/checked (e.g., "routine")
; SVERB = action being performed (e.g., "searched")
; FENTITY = kind of entity being found (e.g., "instance")
; called by: ^ARJTDDK*
;
S SVERB=$G(SVERB,"searched")
S FENTITY=$G(FENTITY,"instance")
W !!,STEP," ",$S(EXIT:"interrupted",1:"completed"),"."
W !,$FN(COUNT,",")," ",SENTITY,$E("s",COUNT'=1)," ",SVERB,"."
W !,$FN(FOUND,",")," ",FENTITY,$E("s",FOUND'=1)," found."
QUIT ; end of RESULTS
;
;
RTEST ; test RSE^ARJTDDKR with alternation in pattern match
;
; calls:
; ^%ZOSF("PRIINQ") - return current process priority
; RSE - search selected routines
; ^%ZOSF("PRIORITY") - lower & raise priority
;
W !!,"Testing RSE^ARJTDDKR with alternation in pattern match."
W !!,"Lowering priority for duration of search.",!
N ARJTPRI,Y X ^%ZOSF("PRIINQ") S ARJTPRI=Y
N X S X=1 X ^%ZOSF("PRIORITY")
K ^XTMP("DSMROUTINES")
D RSE^ARJTDDKR("?","?(")
S X=ARJTPRI X ^%ZOSF("PRIORITY")
W !!,"Priority restored."
QUIT ; end of TEST
;
;
RDSM ; test RSE^ARJTDDKR with DSM-specific code
;
; calls:
; ^%ZOSF("PRIINQ") - return current process priority
; RSE - search selected routines
; ^%ZOSF("PRIORITY") - lower & raise priority
;
W !!,"Testing RSE^ARJTDDKR with DSM-specific code."
I '$D(TOAD) N ARJTPRI D
. W !!,"Lowering priority for duration of search.",!
. N Y X ^%ZOSF("PRIINQ") S ARJTPRI=Y
. N X S X=1 X ^%ZOSF("PRIORITY")
K ^XTMP("DSMROUTINES")
N CONTAINS
S CONTAINS("Z")=""
S CONTAINS("&")=""
S CONTAINS("^%")=""
S CONTAINS("(%")=""
S CONTAINS("U ")=""
S CONTAINS("U:")=""
S CONTAINS("O ")=""
S CONTAINS("O:")=""
S CONTAINS("C ")=""
S CONTAINS("C:")=""
D RSE^ARJTDDKR(.CONTAINS,"DSM")
I '$D(TOAD) D
. S X=ARJTPRI X ^%ZOSF("PRIORITY")
. W !!,"Priority restored."
QUIT ; end of DSM
;