XBRSRCH3.m

XBRSRCH3 ; IHS/ADC/GTH - SEARCH OUTPUT TRANSFORM 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 OUTPUT TRANSFORMS that call routines.",!

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

 D ^DIC

 I Y<0 D EOJ Q

 S XBSOUT("FILE")=+Y

 KILL ^UTILITY("XBRSRCH",$J)

 S XBSOUT("MASTER")=""

EN ;EP - ENTRY POINT FOR CALLING ROUTINES

 S XBSOUT("LAST FILE")=""

 D SBTRACE

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

 D EOJ

 Q

 ;

SBTRACE ; CHECK ALL SUB-FILES

 KILL XBSOUTFL

 S XBSOUT("CNT")=1,XBSOUTFL(XBSOUT("CNT"))=XBSOUT("FILE")

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

 Q

 ;

SBTRACE2 ;

 S XBSOUT("LCTL")=0

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

 Q

 ;

FILE ; CHECK ONE FILE OR SUB-FILE

 S XBSOUT("FIELD")=0

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

 Q

 ;

FIELD ; CHECK FIELD'S INPUT TRANSFORM

 Q:'$D(^DD(XBSOUT("FILE"),XBSOUT("FIELD"),2))  S X=^(2)

 Q:X'[U

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

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

 D:XBRSRCH("FOUND") WRITE

 Q

 ;

WRITE ;

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

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

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

 F XBSOUT("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 XBSOUT("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(XBSOUT("MASTER")) XBRSRCH

 KILL XBSOUT,XBSOUTFL

 Q

 ;

XBRSRCH3  ; IHS/ADC/GTH - SEARCH OUTPUT TRANSFORM 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 OUTPUT TRANSFORMS 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 XBSOUT("FILE")=+Y

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

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

EN        ;EP - ENTRY POINT FOR CALLING ROUTINES

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

 +2        DO SBTRACE

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

               DO LIST

 +4        DO EOJ

 +5        QUIT 

 +6       ;

SBTRACE   ; CHECK ALL SUB-FILES

 +1        KILL XBSOUTFL

 +2        SET XBSOUT("CNT")=1

           SET XBSOUTFL(XBSOUT("CNT"))=XBSOUT("FILE")

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

               SET XBSOUT("LCTL")=$ORDER(XBSOUTFL(""))

               IF XBSOUT("LCTL")=""

                   QUIT 

               SET XBSOUT("FILE")=XBSOUTFL(XBSOUT("LCTL"))

               DO SBTRACE2

               SET XBSOUT("LCTL")=$ORDER(XBSOUTFL(""))

               DO FILE

               KILL XBSOUTFL(XBSOUT("LCTL"))

 +4        QUIT 

 +5       ;

SBTRACE2  ;

 +1        SET XBSOUT("LCTL")=0

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

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

               IF XBSOUT("LCTL")=""

                   QUIT 

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

               SET XBSOUTFL(XBSOUT("CNT"))=XBSOUT("LCTL")

 +3        QUIT 

 +4       ;

FILE      ; CHECK ONE FILE OR SUB-FILE

 +1        SET XBSOUT("FIELD")=0

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

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

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

                   QUIT 

               DO FIELD

 +3        QUIT 

 +4       ;

FIELD     ; CHECK FIELD'S INPUT TRANSFORM

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

               QUIT 

           SET X=^(2)

 +2        IF X'[U

               QUIT 

 +3        SET XBRSRCH("FOUND")=0

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

 +4        FOR XBSOUT("I")=XBSOUT("COUNT"):-1:2

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

               DO ^XBRSRCH1

 +5        IF XBRSRCH("FOUND")

               DO WRITE

 +6        QUIT 

 +7       ;

WRITE     ;

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

               WRITE "."

               QUIT 

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

               SET XBSOUT("LAST FILE")=XBSOUT("FILE")

               WRITE !

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

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

               KILL XBRSRCH

 +3        KILL XBSOUT,XBSOUTFL

 +4        QUIT 

 +5       ;