AURSRCH4.m

AURSRCH4 ; SEARCH XREFS FOR ROUTINES [ 04/06/88  8:39 AM ]

 ; PREVIOUSLY NAMED AUSXREF

 ;

 W !!,"This routine searches a file for XREFS that call routines.",!

 S U="^"

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

 I Y<0 D EOJ Q

 S AUSXREF("FILE")=+Y

 K ^UTILITY("AURSRCH",$J)

 S AUSXREF("MASTER")=""

EN ; ENTRY POINT FOR CALLING ROUTINES

 S AUSXREF("LAST FILE")=""

 D SBTRACE

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

 D EOJ

 Q

SBTRACE ; CHECK ALL SUB-FILES

 K AUSXREFF S AUSXREF("CNT")=1,AUSXREFF(AUSXREF("CNT"))=AUSXREF("FILE")

 F AUSXREF("L")=0:0 S AUSXREF("LCTL")=$O(AUSXREFF("")) Q:AUSXREF("LCTL")=""  S AUSXREF("FILE")=AUSXREFF(AUSXREF("LCTL")) D SBTRACE2 S AUSXREF("LCTL")=$O(AUSXREFF("")) D FILE K AUSXREFF(AUSXREF("LCTL"))

 Q

SBTRACE2 ;

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

 Q

 ;

FILE ; CHECK ONE FILE OR SUB-FILE

 S AUSXREF("FIELD")=0

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

 Q

 ;

FIELD ; CHECK FIELD'S XREFS

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

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

 Q

 ;

CHKXREF ; CHECK ONE XREF

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

 D CHKSK

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

 D CHKSK

 Q

 ;

CHKSK ; CHECK XREF SET/KILL

 Q:X'[U

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

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

 D:AURSRCH("FOUND") WRITE

 Q

 ;

WRITE ;

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

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

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

 F AUSXREF("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("AURSRCH",$J))

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

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

 K ^UTILITY("AURSRCH",$J)

 W !

 Q

 ;

EOJ ;

 K DIC

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

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

 K AUSXREF,AUSXREFF

 Q

AURSRCH4  ; SEARCH XREFS FOR ROUTINES [ 04/06/88  8:39 AM ]

 +1       ; PREVIOUSLY NAMED AUSXREF

 +2       ;

 +3        WRITE !!,"This routine searches a file for XREFS 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 AUSXREF("FILE")=+Y

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

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

EN        ; ENTRY POINT FOR CALLING ROUTINES

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

 +2        DO SBTRACE

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

               DO LIST

 +4        DO EOJ

 +5        QUIT 

SBTRACE   ; CHECK ALL SUB-FILES

 +1        KILL AUSXREFF

           SET AUSXREF("CNT")=1

           SET AUSXREFF(AUSXREF("CNT"))=AUSXREF("FILE")

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

               SET AUSXREF("LCTL")=$ORDER(AUSXREFF(""))

               IF AUSXREF("LCTL")=""

                   QUIT 

               SET AUSXREF("FILE")=AUSXREFF(AUSXREF("LCTL"))

               DO SBTRACE2

               SET AUSXREF("LCTL")=$ORDER(AUSXREFF(""))

               DO FILE

               KILL AUSXREFF(AUSXREF("LCTL"))

 +3        QUIT 

SBTRACE2  ;

 +1        SET AUSXREF("LCTL")=0

           FOR AUSXREF("L")=0:0

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

               IF AUSXREF("LCTL")=""

                   QUIT 

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

               SET AUSXREFF(AUSXREF("CNT"))=AUSXREF("LCTL")

 +2        QUIT 

 +3       ;

FILE      ; CHECK ONE FILE OR SUB-FILE

 +1        SET AUSXREF("FIELD")=0

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

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

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

                   QUIT 

               DO FIELD

 +3        QUIT 

 +4       ;

FIELD     ; CHECK FIELD'S XREFS

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

               QUIT 

 +2        SET AUSXREF("XREF")=0

           FOR AUSXREF("L")=0:0

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

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

                   QUIT 

               DO CHKXREF

 +3        QUIT 

 +4       ;

CHKXREF   ; CHECK ONE XREF

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

 +2        DO CHKSK

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

 +4        DO CHKSK

 +5        QUIT 

 +6       ;

CHKSK     ; CHECK XREF SET/KILL

 +1        IF X'[U

               QUIT 

 +2        SET AURSRCH("FOUND")=0

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

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

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

               DO ^AURSRCH1

 +4        IF AURSRCH("FOUND")

               DO WRITE

 +5        QUIT 

 +6       ;

WRITE     ;

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

               WRITE "."

               QUIT 

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

               SET AUSXREF("LAST FILE")=AUSXREF("FILE")

               WRITE !

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

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

               QUIT 

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

 +3        SET X=""

           FOR AUSXREF("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(AUSXREF("MASTER"))

               KILL AURSRCH

 +4        KILL AUSXREF,AUSXREFF

 +5        QUIT