Routine: AURSRCH5

AURSRCH5 ; SEARCH MISCELLANEOUS FOR ROUTINES [ 04/06/88  8:39 AM ]

 ; PREVIOUSLY NAMED AUSM

 W !!,"This routine searches a file for MISCELLANEOUS ^DD ENTRIES that call routines.",!

 S U="^"

 S DIC="^DIC(",DIC(0)="AEMQ" D ^DIC

 I Y<0 D EOJ Q

 S AUSM("FILE")=+Y

 K ^UTILITY("AURSRCH",$J)

 S AUSM("MASTER")=""

EN ; ENTRY POINT FOR CALLING ROUTINES

 S AUSM("LAST FILE")=""

 D FILE

 D:$D(AUSM("MASTER")) LIST

 D EOJ

FILE ; CHECK ONE FILE

 I $D(^DD(AUSM("FILE"),0,"ACT")) S X=^("ACT"),AUSM("GR")=$ZR D FILE2

 I $D(^DD(AUSM("FILE"),0,"SCR")) S X=^("SCR"),AUSM("GR")=$ZR D FILE2

 I $D(^DD(AUSM("FILE"),0,"ID")) S AUSM("FIELD")="" F AUSM("L")=0:0 S AUSM("FIELD")=$O(^DD(AUSM("FILE"),0,"ID",AUSM("FIELD"))) Q:AUSM("FIELD")=""  S X=^(AUSM("FIELD")),AUSM("GR")=$ZR D FILE2

 I $D(^DD(AUSM("FILE"),.01,7.5)) S X=^(7.5),AUSM("GR")=$ZR D FILE2

 I $D(^DD(AUSM("FILE"),.01,"DEL")) S AUSM("SUB")="DEL" D FIELD

 I $D(^DD(AUSM("FILE"),.01,"LAYGO")) S AUSM("SUB")="LAYGO" D FIELD

FIELD ; CHECK ONE FIELD

 S AUSM("FIELD")="" F AUSM("L")=0:0 S AUSM("FIELD")=$O(^DD(AUSM("FILE"),.01,AUSM("SUB"),AUSM("FIELD"))) Q:AUSM("FIELD")=""  D FIELD2

FIELD2 ;

 S AUSM("NODE")="" F AUSM("L")=0:0 S AUSM("NODE")=$O(^DD(AUSM("FILE"),.01,AUSM("SUB"),AUSM("FIELD"),AUSM("NODE"))) Q:AUSM("NODE")=""  S X=^(AUSM("NODE")),AUSM("GR")=$ZR D FILE2

FILE2 ;

 Q:X'[U

 S AURSRCH("FOUND")=0,AUSM("COUNT")=$L(X,U)

 F AUSM("I")=AUSM("COUNT"):-1:2 S Y=$P(X,U,AUSM("I")) D ^AURSRCH1

 D:AURSRCH("FOUND") WRITE

WRITE ;

 I $D(AURSRCH("NO DETAIL")) W "." Q

 I AUSM("FILE")'=AUSM("LAST FILE") S AUSM("LAST FILE")=AUSM("FILE") W !

 W !,AUSM("GR"),?30,$E(X,1,49)

 F AUSM("L")=0:0 S X=$E(X,50,999) Q:X=""  W !,?30,$E(X,1,49)

LIST ; LIST ROUTINE NAMES

 Q:'$D(^UTILITY("AURSRCH",$J))

 W !!,"Sorted list of routines found:",!

 S X="" F AUSM("L")=0:0 S X=$O(^UTILITY("AURSRCH",$J,X)) Q:X=""  W !,"^",X

 K ^UTILITY("AURSRCH",$J)

W !

EOJ ;

 K DIC

 K X,X0,X1,X2,Y,YY

 K:$D(AUSM("MASTER")) AURSRCH

 K AUSM,AUSMFL

AURSRCH5  ; SEARCH MISCELLANEOUS FOR ROUTINES [ 04/06/88  8:39 AM ]

 +1       ; PREVIOUSLY NAMED AUSM

 +2       ;

 +3        WRITE !!,"This routine searches a file for MISCELLANEOUS ^DD ENTRIES that call routines.",!

 +4        SET U="^"

 +5        SET DIC="^DIC("

           SET DIC(0)="AEMQ"

           DO ^DIC

 +6        IF Y<0

               DO EOJ

               QUIT

 +7        SET AUSM("FILE")=+Y

 +8        KILL ^UTILITY("AURSRCH",$JOB)

 +9        SET AUSM("MASTER")=""

EN        ; ENTRY POINT FOR CALLING ROUTINES

 +1        SET AUSM("LAST FILE")=""

 +2        DO FILE

 +3        IF $DATA(AUSM("MASTER"))

               DO LIST

 +4        DO EOJ

 +5        QUIT

FILE      ; CHECK ONE FILE

 +1        IF $DATA(^DD(AUSM("FILE"),0,"ACT"))

               SET X=^("ACT")

               SET AUSM("GR")=$ZR

               DO FILE2

 +2        IF $DATA(^DD(AUSM("FILE"),0,"SCR"))

               SET X=^("SCR")

               SET AUSM("GR")=$ZR

               DO FILE2

 +3        IF $DATA(^DD(AUSM("FILE"),0,"ID"))

               SET AUSM("FIELD")=""

               FOR AUSM("L")=0:0

                   SET AUSM("FIELD")=$ORDER(^DD(AUSM("FILE"),0,"ID",AUSM("FIELD")))

                   IF AUSM("FIELD")=""

                       QUIT

                   SET X=^(AUSM("FIELD"))

                   SET AUSM("GR")=$ZR

                   DO FILE2

 +4        IF $DATA(^DD(AUSM("FILE"),.01,7.5))

               SET X=^(7.5)

               SET AUSM("GR")=$ZR

               DO FILE2

 +5        IF $DATA(^DD(AUSM("FILE"),.01,"DEL"))

               SET AUSM("SUB")="DEL"

               DO FIELD

 +6        IF $DATA(^DD(AUSM("FILE"),.01,"LAYGO"))

               SET AUSM("SUB")="LAYGO"

               DO FIELD

 +7        QUIT

 +8       ;

FIELD     ; CHECK ONE FIELD

 +1        SET AUSM("FIELD")=""

           FOR AUSM("L")=0:0

               SET AUSM("FIELD")=$ORDER(^DD(AUSM("FILE"),.01,AUSM("SUB"),AUSM("FIELD")))

               IF AUSM("FIELD")=""

                   QUIT

               DO FIELD2

 +2        QUIT

 +3       ;

FIELD2    ;

 +1        SET AUSM("NODE")=""

           FOR AUSM("L")=0:0

               SET AUSM("NODE")=$ORDER(^DD(AUSM("FILE"),.01,AUSM("SUB"),AUSM("FIELD"),AUSM("NODE")))

               IF AUSM("NODE")=""

                   QUIT

               SET X=^(AUSM("NODE"))

               SET AUSM("GR")=$ZR

               DO FILE2

 +2        QUIT

 +3       ;

FILE2     ;

 +1        IF X'[U

               QUIT

 +2        SET AURSRCH("FOUND")=0

           SET AUSM("COUNT")=$LENGTH(X,U)

 +3        FOR AUSM("I")=AUSM("COUNT"):-1:2

               SET Y=$PIECE(X,U,AUSM("I"))

               DO ^AURSRCH1

 +4        IF AURSRCH("FOUND")

               DO WRITE

 +5        QUIT

 +6       ;

WRITE     ;

 +1        IF $DATA(AURSRCH("NO DETAIL"))

               WRITE "."

               QUIT

 +2        IF AUSM("FILE")'=AUSM("LAST FILE")

               SET AUSM("LAST FILE")=AUSM("FILE")

               WRITE !

 +3        WRITE !,AUSM("GR"),?30,$EXTRACT(X,1,49)

 +4        FOR AUSM("L")=0:0

               SET X=$EXTRACT(X,50,999)

               IF X=""

                   QUIT

               WRITE !,?30,$EXTRACT(X,1,49)

 +5        QUIT

 +6       ;

LIST      ; LIST ROUTINE NAMES

 +1        IF '$DATA(^UTILITY("AURSRCH",$JOB))

               QUIT

 +2        WRITE !!,"Sorted list of routines found:",!

 +3        SET X=""

           FOR AUSM("L")=0:0

               SET X=$ORDER(^UTILITY("AURSRCH",$JOB,X))

               IF X=""

                   QUIT

               WRITE !,"^",X

 +4        KILL ^UTILITY("AURSRCH",$JOB)

 +5        WRITE !

 +6        QUIT

 +7       ;

EOJ       ;

 +1        KILL DIC

 +2        KILL X,X0,X1,X2,Y,YY

 +3        IF $DATA(AUSM("MASTER"))

               KILL AURSRCH

 +4        KILL AUSM,AUSMFL

 +5        QUIT

AURSRCH5.m