source: IHS-VA_UTILITIES-XB/trunk/XBRSRCH2.m@ 1680

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

Modified directory structure; moved routines.

File size: 1.9 KB
Line 
1XBRSRCH2 ; IHS/ADC/GTH - SEARCH INPUT 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 INPUT TRANSFORMS that call routines.",!
8 S U="^",DIC="^DIC(",DIC(0)="AEMQ"
9 D ^DIC
10 I Y<0 D EOJ Q
11 S XBSINP("FILE")=+Y
12 KILL ^UTILITY("XBRSRCH",$J)
13 S XBSINP("MASTER")=""
14EN ;EP - Search for routines in Input Transforms.
15 S XBSINP("LAST FILE")=""
16 D SBTRACE
17 D:$D(XBSINP("MASTER")) LIST
18 D EOJ
19 Q
20 ;
21SBTRACE ; CHECK ALL SUB-FILES
22 KILL XBSINPFL
23 S XBSINP("CNT")=1,XBSINPFL(XBSINP("CNT"))=XBSINP("FILE")
24 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"))
25 Q
26 ;
27SBTRACE2 ;
28 S XBSINP("LCTL")=0
29 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")
30 Q
31 ;
32FILE ; CHECK ONE FILE OR SUB-FILE
33 S XBSINP("FIELD")=0
34 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
35 Q
36 ;
37FIELD ; Check Field's Input Transform.
38 S XBRSRCH("FOUND")=0,XBSINP("COUNT")=$L(X,U)
39 F XBSINP("I")=XBSINP("COUNT"):-1:2 S Y=$P(X,U,XBSINP("I")) D ^XBRSRCH1
40 D:XBRSRCH("FOUND") WRITE
41 Q
42 ;
43WRITE ;
44 I $D(XBRSRCH("NO DETAIL")) W "." Q
45 I XBSINP("FILE")'=XBSINP("LAST FILE") S XBSINP("LAST FILE")=XBSINP("FILE") W !
46 W !,XBSINP("FILE"),",",XBSINP("FIELD"),?20,$E(X,1,59)
47 F XBSINP("L")=0:0 S X=$E(X,60,999) Q:X="" W !?20,$E(X,1,59)
48 Q
49 ;
50LIST ; List Routine Names.
51 Q:'$D(^UTILITY("XBRSRCH",$J))
52 W !!,"Sorted list of routines found:",!
53 S X=""
54 F XBSINP("L")=0:0 S X=$O(^UTILITY("XBRSRCH",$J,X)) Q:X="" W !,"^",X
55 KILL ^UTILITY("XBRSRCH",$J)
56 W !
57 Q
58 ;
59EOJ ;
60 KILL DIC,X,X0,X1,X2,Y,YY
61 KILL:$D(XBSINP("MASTER")) XBRSRCH
62 KILL XBSINP,XBSINPFL
63 Q
64 ;
Note: See TracBrowser for help on using the repository browser.