source: IHS-VA_UTILITIES-XB/trunk/XBRSRCH3.m@ 667

Last change on this file since 667 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.9 KB
Line 
1XBRSRCH3 ; IHS/ADC/GTH - SEARCH OUTPUT TRANSFORM FOR ROUTINES ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Part of XBRSRCH
5 ;
6START ;
7 W !!,"This routine searches a file for OUTPUT TRANSFORMS that call routines.",!
8 S U="^",DIC="^DIC(",DIC(0)="AEMQ"
9 D ^DIC
10 I Y<0 D EOJ Q
11 S XBSOUT("FILE")=+Y
12 KILL ^UTILITY("XBRSRCH",$J)
13 S XBSOUT("MASTER")=""
14EN ;EP - ENTRY POINT FOR CALLING ROUTINES
15 S XBSOUT("LAST FILE")=""
16 D SBTRACE
17 D:$D(XBSOUT("MASTER")) LIST
18 D EOJ
19 Q
20 ;
21SBTRACE ; CHECK ALL SUB-FILES
22 KILL XBSOUTFL
23 S XBSOUT("CNT")=1,XBSOUTFL(XBSOUT("CNT"))=XBSOUT("FILE")
24 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"))
25 Q
26 ;
27SBTRACE2 ;
28 S XBSOUT("LCTL")=0
29 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")
30 Q
31 ;
32FILE ; CHECK ONE FILE OR SUB-FILE
33 S XBSOUT("FIELD")=0
34 F XBSOUT("L")=0:0 S XBSOUT("FIELD")=$O(^DD(XBSOUT("FILE"),XBSOUT("FIELD"))) Q:XBSOUT("FIELD")'=+XBSOUT("FIELD") D FIELD
35 Q
36 ;
37FIELD ; CHECK FIELD'S INPUT TRANSFORM
38 Q:'$D(^DD(XBSOUT("FILE"),XBSOUT("FIELD"),2)) S X=^(2)
39 Q:X'[U
40 S XBRSRCH("FOUND")=0,XBSOUT("COUNT")=$L(X,U)
41 F XBSOUT("I")=XBSOUT("COUNT"):-1:2 S Y=$P(X,U,XBSOUT("I")) D ^XBRSRCH1
42 D:XBRSRCH("FOUND") WRITE
43 Q
44 ;
45WRITE ;
46 I $D(XBRSRCH("NO DETAIL")) W "." Q
47 I XBSOUT("FILE")'=XBSOUT("LAST FILE") S XBSOUT("LAST FILE")=XBSOUT("FILE") W !
48 W !,XBSOUT("FILE"),",",XBSOUT("FIELD"),?20,$E(X,1,59)
49 F XBSOUT("L")=0:0 S X=$E(X,60,999) Q:X="" W !?20,$E(X,1,59)
50 Q
51 ;
52LIST ; LIST ROUTINE NAMES
53 Q:'$D(^UTILITY("XBRSRCH",$J))
54 W !!,"Sorted list of routines found:",!
55 S X=""
56 F XBSOUT("L")=0:0 S X=$O(^UTILITY("XBRSRCH",$J,X)) Q:X="" W !,"^",X
57 KILL ^UTILITY("XBRSRCH",$J)
58 W !
59 Q
60 ;
61EOJ ;
62 KILL DIC,X,X0,X1,X2,Y,YY
63 K:$D(XBSOUT("MASTER")) XBRSRCH
64 KILL XBSOUT,XBSOUTFL
65 Q
66 ;
Note: See TracBrowser for help on using the repository browser.