AURSRCH3.m

AURSRCH3 ; SEARCH OUTPUT TRANSFORM FOR ROUTINES [ 04/06/88  8:39 AM ]

 ; PREVIOUSLY NAMED AUSOUT

 ;

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

 S U="^"

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

 I Y<0 D EOJ Q

 S AUSOUT("FILE")=+Y

 K ^UTILITY("AURSRCH",$J)

 S AUSOUT("MASTER")=""

EN ; ENTRY POINT FOR CALLING ROUTINES

 S AUSOUT("LAST FILE")=""

 D SBTRACE

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

 D EOJ

 Q

SBTRACE ; CHECK ALL SUB-FILES

 K AUSOUTFL S AUSOUT("CNT")=1,AUSOUTFL(AUSOUT("CNT"))=AUSOUT("FILE")

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

 Q

SBTRACE2 ;

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

 Q

 ;

FILE ; CHECK ONE FILE OR SUB-FILE

 S AUSOUT("FIELD")=0

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

 Q

 ;

FIELD ; CHECK FIELD'S INPUT TRANSFORM

 Q:'$D(^DD(AUSOUT("FILE"),AUSOUT("FIELD"),2))

 S X=^(2)

 Q:X'[U

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

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

 D:AURSRCH("FOUND") WRITE

 Q

 ;

WRITE ;

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

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

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

 F AUSOUT("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 AUSOUT("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(AUSOUT("MASTER")) AURSRCH

 K AUSOUT,AUSOUTFL

 Q

AURSRCH3  ; SEARCH OUTPUT TRANSFORM FOR ROUTINES [ 04/06/88  8:39 AM ]

 +1       ; PREVIOUSLY NAMED AUSOUT

 +2       ;

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

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

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

EN        ; ENTRY POINT FOR CALLING ROUTINES

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

 +2        DO SBTRACE

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

               DO LIST

 +4        DO EOJ

 +5        QUIT 

SBTRACE   ; CHECK ALL SUB-FILES

 +1        KILL AUSOUTFL

           SET AUSOUT("CNT")=1

           SET AUSOUTFL(AUSOUT("CNT"))=AUSOUT("FILE")

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

               SET AUSOUT("LCTL")=$ORDER(AUSOUTFL(""))

               IF AUSOUT("LCTL")=""

                   QUIT 

               SET AUSOUT("FILE")=AUSOUTFL(AUSOUT("LCTL"))

               DO SBTRACE2

               SET AUSOUT("LCTL")=$ORDER(AUSOUTFL(""))

               DO FILE

               KILL AUSOUTFL(AUSOUT("LCTL"))

 +3        QUIT 

SBTRACE2  ;

 +1        SET AUSOUT("LCTL")=0

           FOR AUSOUT("L")=0:0

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

               IF AUSOUT("LCTL")=""

                   QUIT 

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

               SET AUSOUTFL(AUSOUT("CNT"))=AUSOUT("LCTL")

 +2        QUIT 

 +3       ;

FILE      ; CHECK ONE FILE OR SUB-FILE

 +1        SET AUSOUT("FIELD")=0

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

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

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

                   QUIT 

               DO FIELD

 +3        QUIT 

 +4       ;

FIELD     ; CHECK FIELD'S INPUT TRANSFORM

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

               QUIT 

 +2        SET X=^(2)

 +3        IF X'[U

               QUIT 

 +4        SET AURSRCH("FOUND")=0

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

 +5        FOR AUSOUT("I")=AUSOUT("COUNT"):-1:2

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

               DO ^AURSRCH1

 +6        IF AURSRCH("FOUND")

               DO WRITE

 +7        QUIT 

 +8       ;

WRITE     ;

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

               WRITE "."

               QUIT 

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

               SET AUSOUT("LAST FILE")=AUSOUT("FILE")

               WRITE !

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

 +4        FOR AUSOUT("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 AUSOUT("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(AUSOUT("MASTER"))

               KILL AURSRCH

 +4        KILL AUSOUT,AUSOUTFL

 +5        QUIT