67 lines
1.9 KiB
Mathematica
67 lines
1.9 KiB
Mathematica
XBRSRCH3 ; IHS/ADC/GTH - SEARCH OUTPUT TRANSFORM FOR ROUTINES ; [ 02/07/97 3:02 PM ]
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
|
;
|
|
; 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
|
|
;
|