XBRSRCH2.m

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

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

 D ^DIC

 I Y<0 D EOJ Q

 S XBSINP("FILE")=+Y

 KILL ^UTILITY("XBRSRCH",$J)

 S XBSINP("MASTER")=""

EN ;EP - Search for routines in Input Transforms.

 S XBSINP("LAST FILE")=""

 D SBTRACE

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

 D EOJ

 Q

 ;

SBTRACE ; CHECK ALL SUB-FILES

 KILL XBSINPFL

 S XBSINP("CNT")=1,XBSINPFL(XBSINP("CNT"))=XBSINP("FILE")

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

 Q

 ;

SBTRACE2 ;

 S XBSINP("LCTL")=0

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

 Q

 ;

FILE ; CHECK ONE FILE OR SUB-FILE

 S XBSINP("FIELD")=0

 F XBSINP("L")=0:0 S XBSINP("FIELD")=$O(^DD(XBSINP("FILE"),XBSINP("FIELD"))) Q:XBSINP("FIELD")'=+XBSINP("FIELD")  S X=$P(^(XBSINP("FIELD"),0),U,5,99) D:X[U FIELD

 Q

 ;

FIELD ; Check Field's Input Transform.

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

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

 D:XBRSRCH("FOUND") WRITE

 Q

 ;

WRITE ;

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

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

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

 F XBSINP("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 XBSINP("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

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

 KILL XBSINP,XBSINPFL

 Q

 ;

XBRSRCH2  ; IHS/ADC/GTH - SEARCH INPUT 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 INPUT 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 XBSINP("FILE")=+Y

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

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

EN        ;EP - Search for routines in Input Transforms.

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

 +2        DO SBTRACE

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

               DO LIST

 +4        DO EOJ

 +5        QUIT 

 +6       ;

SBTRACE   ; CHECK ALL SUB-FILES

 +1        KILL XBSINPFL

 +2        SET XBSINP("CNT")=1

           SET XBSINPFL(XBSINP("CNT"))=XBSINP("FILE")

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

               SET XBSINP("LCTL")=$ORDER(XBSINPFL(""))

               IF XBSINP("LCTL")=""

                   QUIT 

               SET XBSINP("FILE")=XBSINPFL(XBSINP("LCTL"))

               DO SBTRACE2

               SET XBSINP("LCTL")=$ORDER(XBSINPFL(""))

               DO FILE

               KILL XBSINPFL(XBSINP("LCTL"))

 +4        QUIT 

 +5       ;

SBTRACE2  ;

 +1        SET XBSINP("LCTL")=0

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

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

               IF XBSINP("LCTL")=""

                   QUIT 

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

               SET XBSINPFL(XBSINP("CNT"))=XBSINP("LCTL")

 +3        QUIT 

 +4       ;

FILE      ; CHECK ONE FILE OR SUB-FILE

 +1        SET XBSINP("FIELD")=0

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

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

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

                   QUIT 

               SET X=$PIECE(^(XBSINP("FIELD"),0),U,5,99)

               IF X[U

                   DO FIELD

 +3        QUIT 

 +4       ;

FIELD     ; Check Field's Input Transform.

 +1        SET XBRSRCH("FOUND")=0

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

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

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

               DO ^XBRSRCH1

 +3        IF XBRSRCH("FOUND")

               DO WRITE

 +4        QUIT 

 +5       ;

WRITE     ;

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

               WRITE "."

               QUIT 

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

               SET XBSINP("LAST FILE")=XBSINP("FILE")

               WRITE !

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

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

               KILL XBRSRCH

 +3        KILL XBSINP,XBSINPFL

 +4        QUIT 

 +5       ;