| [613] | 1 | ARJTDDKU ;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 | ;
|
|---|
| 16 | EXTRACT ; 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 | ;
|
|---|
| 46 | LIKELY(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 | ;
|
|---|
| 66 | RESULTS(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 | ;
|
|---|
| 86 | RTEST ; 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 | ;
|
|---|
| 104 | RDSM ; 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 | ;
|
|---|
