151 lines
5.2 KiB
Mathematica
151 lines
5.2 KiB
Mathematica
ARJTDDK4 ;PUG/TOAD-FileMan Search DD ;7/8/02 10:45
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;
|
|
; Table of Contents:
|
|
; SEARCHDD = search entire DD
|
|
; CHECK = check 1 value (MUMPS code)
|
|
; UNQUOTE = unquote the contents of a string
|
|
; CONTAINS = function: does code contain what we're looking for
|
|
; TEST = test SEARCHDD with alternation in pattern match
|
|
;
|
|
; input:
|
|
; .CONTAINS(string)="" to search any line containing the string
|
|
; FIND = optional. special search, e.g., "DSM"
|
|
;
|
|
; output:
|
|
; .EXIT = returns 1 if interrupted.
|
|
; report to current device
|
|
;
|
|
; Calls:
|
|
; CHECK^ARJTDIM = to search each value (MUMPS code)
|
|
;
|
|
SEARCHDD(CONTAINS,FIND,EXIT) ; search entire DD
|
|
;
|
|
S EXIT=0 ; not interrupted yet
|
|
N FILE,FIELD,HOOK,VALUE,ID,IX,NODE,OF,MESSAGE
|
|
N COUNT S COUNT=0
|
|
N MATCHES S MATCHES=0
|
|
N FILENAME,FLDNAME
|
|
; check the File-level attributes
|
|
S FILE=-1 F S FILE=$O(^DD(FILE)) Q:FILE'=0&'FILE D Q:EXIT
|
|
. S FILENAME=$O(^DD(FILE,0,"NM",""))
|
|
. ;
|
|
. S FIELD=0
|
|
. S VALUE=$G(^DD(FILE,0,"ACT")) I VALUE'="" D Q:EXIT
|
|
. . D CHECK(VALUE,"Post-Action")
|
|
. ;
|
|
. I $D(^DD(FILE,0,"ID")) D
|
|
. . S ID=0 F S ID=$O(^DD(FILE,0,"ID",ID)) Q:ID="" D Q:EXIT
|
|
. . . S VALUE=$G(^DD(FILE,0,"ID",ID)) I VALUE'="" D CHECK(VALUE,"ID")
|
|
. ;
|
|
. S VALUE=$G(^DD(FILE,0,"SCR")) I VALUE'="" D Q:EXIT
|
|
. . D CHECK(VALUE,"Whole-File Screen")
|
|
. ;
|
|
. S FIELD=0 F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D Q:EXIT
|
|
. . S FLDNAME=$P($G(^DD(FILE,FIELD,0)),U)
|
|
. . ;
|
|
. . S VALUE=$P($G(^DD(FILE,FIELD,0)),U,5,9999) I VALUE'="" D Q:EXIT
|
|
. . . D CHECK(VALUE,"Input Transform")
|
|
. . ;
|
|
. . I $D(^DD(FILE,FIELD,1)) D Q:EXIT
|
|
. . . S IX=0 F S IX=$O(^DD(FILE,FIELD,1,IX)) Q:'IX D Q:EXIT
|
|
. . . . S NODE=0 F D Q:'NODE!EXIT
|
|
. . . . . S NODE=$O(^DD(FILE,FIELD,1,IX,NODE)) Q:'NODE
|
|
. . . . . Q:NODE=3 ; No Deletion Message
|
|
. . . . . S VALUE=$G(^DD(FILE,FIELD,1,IX,NODE)) Q:VALUE=""
|
|
. . . . . I NODE=1 S MESSAGE=" Set Logic"
|
|
. . . . . E I NODE=2 S MESSAGE=" Kill Logic"
|
|
. . . . . E S MESSAGE=" Overflow Logic"
|
|
. . . . . D CHECK(VALUE,"Cross-Reference "_IX_MESSAGE)
|
|
. . ;
|
|
. . S VALUE=$G(^DD(FILE,FIELD,2)) I VALUE'="" D Q:EXIT
|
|
. . . D CHECK(VALUE,"Output Transform")
|
|
. . ;
|
|
. . S VALUE=$G(^DD(FILE,FIELD,4)) I VALUE'="" D Q:EXIT
|
|
. . . D CHECK(VALUE,"Executable Help")
|
|
. . ;
|
|
. . S VALUE=$G(^DD(FILE,FIELD,7.5)) I VALUE'="" D Q:EXIT
|
|
. . . D CHECK(VALUE,"Pre-Lookup Transform")
|
|
. . ;
|
|
. . F OF=9.2:.1:9.9 S VALUE=$G(^DD(FILE,FIELD,OF)) I VALUE'="" D Q:EXIT
|
|
. . . D CHECK(VALUE,"Overflow Code Node "_OF)
|
|
. . ;
|
|
. . S VALUE=$G(^DD(FILE,FIELD,12.1)) I VALUE'="" D Q:EXIT
|
|
. . . D CHECK(VALUE,"Pointer or Set-of-Codes Screen") Q:EXIT
|
|
. . . N SCREEN S SCREEN=$P(VALUE,"S DIC(""S"")=",2)
|
|
. . . Q:$E(SCREEN)'="""" Q:$E(SCREEN,$L(SCREEN))'=""""
|
|
. . . S SCREEN=$$UNQUOTE(SCREEN)
|
|
. . . D CHECK(SCREEN,"Pointer or Set-of-Codes Screen")
|
|
. . ;
|
|
. . S VALUE=$G(^DD(FILE,FIELD,"AX")) I VALUE'="" D Q:EXIT
|
|
. . . D CHECK(VALUE,"Audit Condition")
|
|
. . ;
|
|
. . I $D(^DD(FILE,FIELD,"DEL")) D
|
|
. . . S NODE=0 F S NODE=$O(^DD(FILE,FIELD,"DEL",NODE)) Q:'NODE D Q:EXIT
|
|
. . . . S VALUE=$G(^DD(FILE,FIELD,"DEL",NODE,0)) Q:VALUE=""
|
|
. . . . D CHECK(VALUE,"Delete Condition "_NODE)
|
|
. . ;
|
|
. . I $D(^DD(FILE,FIELD,"LAYGO")) D Q:EXIT
|
|
. . . S NODE=0 F S NODE=$O(^DD(FILE,FIELD,"LAYGO",NODE)) Q:'NODE D Q:EXIT
|
|
. . . . S VALUE=$G(^DD(FILE,FIELD,"LAYGO",NODE,0)) Q:VALUE=""
|
|
. . . . D CHECK(VALUE,"LAYGO Condition "_NODE)
|
|
N SENTITY S SENTITY="DD attribute value"
|
|
D RESULTS^ARJTDDKU(EXIT,COUNT,MATCHES,"Search",SENTITY,"checked")
|
|
W !!!,"End of report. Have a nice day."
|
|
Q
|
|
;
|
|
;
|
|
CHECK(VALUE,HOOK) ; Check out this value
|
|
S COUNT=COUNT+1
|
|
I '(COUNT#1000) D Q:EXIT
|
|
. W "."
|
|
. I '(COUNT#10000) D
|
|
. . W !,$FN(COUNT,",")," DD attributes searched. "
|
|
. N READ R READ:0 S EXIT=READ=U Q:EXIT
|
|
Q:'$$CONTAINS(VALUE,.CONTAINS) ; skip those that clearly don't match
|
|
;
|
|
N ZZDCOM ; clear array of commands & special elements found
|
|
D CHECK^ARJTDIM(VALUE,FIND,.ZZDCOM) ; parse line
|
|
Q:'ZZDCOM ; skip lines that don't match
|
|
S MATCHES=MATCHES+1 ; this is a match
|
|
; S COUNT=0 ; reset count to postpone printing a dot
|
|
;
|
|
; display match
|
|
; match #, file/subfile path, field
|
|
W !!,MATCHES_". "_FILENAME_" ("_FILE_") file, "
|
|
I FIELD W FLDNAME_" ("_FIELD_") field, " ; if a field attribute
|
|
W HOOK ; which attribute contained the match
|
|
; field value
|
|
F Q:VALUE="" W !?10,$E(VALUE,1,70) S $E(VALUE,1,70)="" ; value
|
|
N READ R READ:0 S EXIT=READ=U
|
|
;
|
|
QUIT ; end of CHECK
|
|
;
|
|
;
|
|
UNQUOTE(STRING) ; unquote the contents of a string
|
|
;
|
|
S $E(STRING)="",$E(STRING,$L(STRING))="" ; remove bracketing "s
|
|
N CHAR F CHAR=1:1:$L(STRING)-1 I $E(STRING,CHAR,CHAR+1)="""""" D
|
|
. S $E(STRING,CHAR)="" ; remove one of the doubled quotes
|
|
Q STRING
|
|
;
|
|
;
|
|
CONTAINS(CODE,CONTAINS) ; function: does code contain what we're looking for
|
|
N DOES I $D(CONTAINS)#2 S DOES=CODE[CONTAINS Q DOES
|
|
I $D(CONTAINS)>9 D Q DOES
|
|
. N SUB S SUB=""
|
|
. F S SUB=$O(CONTAINS(SUB)) Q:SUB="" S DOES=CODE[SUB Q:DOES
|
|
Q 0
|
|
;
|
|
;
|
|
TEST ; test SEARCHDD with alternation in pattern match
|
|
W !!,"Testing SEARCHDD^ARJTDDK4 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")
|
|
D SEARCHDD("?","?(")
|
|
S X=ARJTPRI X ^%ZOSF("PRIORITY")
|
|
W !!,"Priority restored."
|
|
QUIT ; end of TEST
|
|
;
|