XBRSRCH5.m

XBRSRCH5 ; IHS/ADC/GTH - SEARCH MISCELLANEOUS FOR ROUTINES ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; Part of XBRSRCH

 ;

START ;

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

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

 D ^DIC

 I Y<0 D EOJ Q

 S XBSM("FILE")=+Y

 KILL ^UTILITY("XBRSRCH",$J)

 S XBSM("MASTER")=""

EN ;EP - ENTRY POINT FOR CALLING ROUTINES

 S XBSM("LAST FILE")=""

 D FILE

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

 D EOJ

 Q

 ;

FILE ; CHECK ONE FILE

 I $D(^DD(XBSM("FILE"),0,"ACT")) S X=^("ACT"),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2

 I $D(^DD(XBSM("FILE"),0,"SCR")) S X=^("SCR"),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2

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

 I $D(^DD(XBSM("FILE"),.01,7.5)) S X=^(7.5),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2

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

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

 Q

 ;

FIELD ; CHECK ONE FIELD

 S XBSM("FIELD")=""

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

 Q

 ;

FIELD2 ;

 S XBSM("NODE")=""

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

 Q

 ;

FILE2 ;

 Q:X'[U

 S XBRSRCH("FOUND")=0,XBSM("COUNT")=$L(X,U)

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

 D:XBRSRCH("FOUND") WRITE

 Q

 ;

WRITE ;

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

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

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

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

 Q

 ;

LIST ; LIST ROUTINE NAMES

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

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

 S X=""

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

 KILL ^UTILITY("XBRSRCH",$J)

 W !

 Q

 ;

EOJ ;

 KILL DIC

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

 KILL:$D(XBSM("MASTER")) XBRSRCH

 KILL XBSM,XBSMFL

 Q

 ;

XBRSRCH5  ; IHS/ADC/GTH - SEARCH MISCELLANEOUS FOR ROUTINES ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; Part of XBRSRCH

 +4       ;

START     ;

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

 +2        SET U="^"

           SET DIC="^DIC("

           SET DIC(0)="AEMQ"

 +3        DO ^DIC

 +4        IF Y<0

               DO EOJ

               QUIT 

 +5        SET XBSM("FILE")=+Y

 +6        KILL ^UTILITY("XBRSRCH",$JOB)

 +7        SET XBSM("MASTER")=""

EN        ;EP - ENTRY POINT FOR CALLING ROUTINES

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

 +2        DO FILE

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

               DO LIST

 +4        DO EOJ

 +5        QUIT 

 +6       ;

FILE      ; CHECK ONE FILE

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

               SET X=^("ACT")

               SET XBSM("GR")=$$MSMZR^ZIBNSSV

               DO FILE2

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

               SET X=^("SCR")

               SET XBSM("GR")=$$MSMZR^ZIBNSSV

               DO FILE2

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

               SET XBSM("FIELD")=""

               FOR XBSM("L")=0:0

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

                   IF XBSM("FIELD")=""

                       QUIT 

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

                   SET XBSM("GR")=$$MSMZR^ZIBNSSV

                   DO FILE2

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

               SET X=^(7.5)

               SET XBSM("GR")=$$MSMZR^ZIBNSSV

               DO FILE2

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

               SET XBSM("SUB")="DEL"

               DO FIELD

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

               SET XBSM("SUB")="LAYGO"

               DO FIELD

 +7        QUIT 

 +8       ;

FIELD     ; CHECK ONE FIELD

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

 +2        FOR XBSM("L")=0:0

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

               IF XBSM("FIELD")=""

                   QUIT 

               DO FIELD2

 +3        QUIT 

 +4       ;

FIELD2    ;

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

 +2        FOR XBSM("L")=0:0

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

               IF XBSM("NODE")=""

                   QUIT 

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

               SET XBSM("GR")=$$MSMZR^ZIBNSSV

               DO FILE2

 +3        QUIT 

 +4       ;

FILE2     ;

 +1        IF X'[U

               QUIT 

 +2        SET XBRSRCH("FOUND")=0

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

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

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

               DO ^XBRSRCH1

 +4        IF XBRSRCH("FOUND")

               DO WRITE

 +5        QUIT 

 +6       ;

WRITE     ;

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

               WRITE "."

               QUIT 

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

               SET XBSM("LAST FILE")=XBSM("FILE")

               WRITE !

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

 +4        FOR XBSM("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("XBRSRCH",$JOB))

               QUIT 

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

 +3        SET X=""

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

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

               IF X=""

                   QUIT 

               WRITE !,"^",X

 +5        KILL ^UTILITY("XBRSRCH",$JOB)

 +6        WRITE !

 +7        QUIT 

 +8       ;

EOJ       ;

 +1        KILL DIC

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

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

               KILL XBRSRCH

 +4        KILL XBSM,XBSMFL

 +5        QUIT 

 +6       ;