XBRSRCH4.m

XBRSRCH4 ; IHS/ADC/GTH - SEARCH XREFS 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 XREFS that call routines.",!

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

 D ^DIC

 I Y<0 D EOJ Q

 S XBSXREF("FILE")=+Y

 KILL ^UTILITY("XBRSRCH",$J)

 S XBSXREF("MASTER")=""

EN ;EP - ENTRY POINT FOR CALLING ROUTINES

 S XBSXREF("LAST FILE")=""

 D SBTRACE

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

 D EOJ

 Q

 ;

SBTRACE ; CHECK ALL SUB-FILES

 KILL XBSXREFF

 S XBSXREF("CNT")=1,XBSXREFF(XBSXREF("CNT"))=XBSXREF("FILE")

 F XBSXREF("L")=0:0 S XBSXREF("LCTL")=$O(XBSXREFF("")) Q:XBSXREF("LCTL")=""  S XBSXREF("FILE")=XBSXREFF(XBSXREF("LCTL")) D SBTRACE2 S XBSXREF("LCTL")=$O(XBSXREFF("")) D FILE KILL XBSXREFF(XBSXREF("LCTL"))

 Q

 ;

SBTRACE2 ;

 S XBSXREF("LCTL")=0

 F XBSXREF("L")=0:0 S XBSXREF("LCTL")=$O(^DD(XBSXREF("FILE"),"SB",XBSXREF("LCTL"))) Q:XBSXREF("LCTL")=""  S XBSXREF("CNT")=XBSXREF("CNT")+1,XBSXREFF(XBSXREF("CNT"))=XBSXREF("LCTL")

 Q

 ;

FILE ; CHECK ONE FILE OR SUB-FILE

 S XBSXREF("FIELD")=0

 F XBSXREF("L")=0:0 S XBSXREF("FIELD")=$O(^DD(XBSXREF("FILE"),XBSXREF("FIELD"))) Q:XBSXREF("FIELD")'=+XBSXREF("FIELD")  D FIELD

 Q

 ;

FIELD ; CHECK FIELD'S XREFS

 Q:'$D(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1))

 S XBSXREF("XREF")=0

 F XBSXREF("L")=0:0 S XBSXREF("XREF")=$O(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"))) Q:XBSXREF("XREF")'=+XBSXREF("XREF")  D CHKXREF

 Q

 ;

CHKXREF ; CHECK ONE XREF

 S X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),1)

 D CHKSK

 S X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),2)

 D CHKSK

 Q

 ;

CHKSK ; CHECK XREF SET/KILL

 Q:X'[U

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

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

 D:XBRSRCH("FOUND") WRITE

 Q

 ;

WRITE ;

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

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

 W !,XBSXREF("FILE"),",",XBSXREF("FIELD"),?20,$E(X,1,59)

 F XBSXREF("L")=0:0 S X=$E(X,60,999) Q:X=""  W !?20,$E(X,1,59)

 Q

 ;

LIST ; LIST ROUTINE NAMES

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

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

 S X=""

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

 KILL ^UTILITY("XBRSRCH",$J)

 W !

 Q

 ;

EOJ ;

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

 K:$D(XBSXREF("MASTER")) XBRSRCH

 KILL XBSXREF,XBSXREFF

 Q

 ;

XBRSRCH4  ; IHS/ADC/GTH - SEARCH XREFS 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 XREFS 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 XBSXREF("FILE")=+Y

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

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

EN        ;EP - ENTRY POINT FOR CALLING ROUTINES

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

 +2        DO SBTRACE

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

               DO LIST

 +4        DO EOJ

 +5        QUIT 

 +6       ;

SBTRACE   ; CHECK ALL SUB-FILES

 +1        KILL XBSXREFF

 +2        SET XBSXREF("CNT")=1

           SET XBSXREFF(XBSXREF("CNT"))=XBSXREF("FILE")

 +3        FOR XBSXREF("L")=0:0

               SET XBSXREF("LCTL")=$ORDER(XBSXREFF(""))

               IF XBSXREF("LCTL")=""

                   QUIT 

               SET XBSXREF("FILE")=XBSXREFF(XBSXREF("LCTL"))

               DO SBTRACE2

               SET XBSXREF("LCTL")=$ORDER(XBSXREFF(""))

               DO FILE

               KILL XBSXREFF(XBSXREF("LCTL"))

 +4        QUIT 

 +5       ;

SBTRACE2  ;

 +1        SET XBSXREF("LCTL")=0

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

               SET XBSXREF("LCTL")=$ORDER(^DD(XBSXREF("FILE"),"SB",XBSXREF("LCTL")))

               IF XBSXREF("LCTL")=""

                   QUIT 

               SET XBSXREF("CNT")=XBSXREF("CNT")+1

               SET XBSXREFF(XBSXREF("CNT"))=XBSXREF("LCTL")

 +3        QUIT 

 +4       ;

FILE      ; CHECK ONE FILE OR SUB-FILE

 +1        SET XBSXREF("FIELD")=0

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

               SET XBSXREF("FIELD")=$ORDER(^DD(XBSXREF("FILE"),XBSXREF("FIELD")))

               IF XBSXREF("FIELD")'=+XBSXREF("FIELD")

                   QUIT 

               DO FIELD

 +3        QUIT 

 +4       ;

FIELD     ; CHECK FIELD'S XREFS

 +1        IF '$DATA(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1))

               QUIT 

 +2        SET XBSXREF("XREF")=0

 +3        FOR XBSXREF("L")=0:0

               SET XBSXREF("XREF")=$ORDER(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF")))

               IF XBSXREF("XREF")'=+XBSXREF("XREF")

                   QUIT 

               DO CHKXREF

 +4        QUIT 

 +5       ;

CHKXREF   ; CHECK ONE XREF

 +1        SET X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),1)

 +2        DO CHKSK

 +3        SET X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),2)

 +4        DO CHKSK

 +5        QUIT 

 +6       ;

CHKSK     ; CHECK XREF SET/KILL

 +1        IF X'[U

               QUIT 

 +2        SET XBRSRCH("FOUND")=0

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

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

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

               DO ^XBRSRCH1

 +4        IF XBRSRCH("FOUND")

               DO WRITE

 +5        QUIT 

 +6       ;

WRITE     ;

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

               WRITE "."

               QUIT 

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

               SET XBSXREF("LAST FILE")=XBSXREF("FILE")

               WRITE !

 +3        WRITE !,XBSXREF("FILE"),",",XBSXREF("FIELD"),?20,$EXTRACT(X,1,59)

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

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

               IF X=""

                   QUIT 

               WRITE !?20,$EXTRACT(X,1,59)

 +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 XBSXREF("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,X,X0,X1,X2,Y,YY

 +2        IF $DATA(XBSXREF("MASTER"))

               KILL XBRSRCH

 +3        KILL XBSXREF,XBSXREFF

 +4        QUIT 

 +5       ;