source: IHS-VA_UTILITIES-XB/trunk/XBRXREF2.m@ 1562

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

Modified directory structure; moved routines.

File size: 3.5 KB
Line 
1XBRXREF2 ; IHS/ADC/GTH - INITIALIZATION ROUTINES FOR DRIVER ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Part of XBRXREF
5 ;
6START ;
7 W !!,"Invalid entry point!",!
8 S XBRXREF("QFLG")=99
9 Q
10 ;
11INIT ;EP - INITIALIZATION
12 S U="^"
13 W !!,"RE-INDEX selected cross-references.",!
14 S XBRXREF("QFLG")=0
15 KILL ^TMP("XBRXREF",$J)
16 Q
17 ;
18GETFILE ;EP - GET FILE TO BE RE-XREFED
19 S DIC="^DIC(",DIC(0)="AEMQ"
20 D ^DIC
21 KILL DIC
22 I Y<0 S XBRXREF("QFLG")=1 Q
23 S XBRXREF("FILE")=+Y
24 S XBRXREF("GBL")=^DIC(XBRXREF("FILE"),0,"GL")
25 Q
26 ;
27BLDXRT ;EP - BUILD XREF TABLE
28 F XBRXREF("L")=0:0 D GETFIELD Q:XBRXREF("FIELD")=""
29 S:'$O(^TMP("XBRXREF",$J,"")) XBRXREF("QFLG")=1
30 Q
31 ;
32GETFIELD ; GET FIELD TO XREF
33 W !
34 S XBRXREF("FIELD")=""
35 S DIC="^DD("_XBRXREF("FILE")_",",DIC(0)="AEMQ"
36 D ^DIC
37 KILL DIC
38 Q:Y<0
39 S XBRXREF("FIELD")=+Y
40 S X=$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),0),U,4)
41 S XBRXREF("NODE")=$P(X,";",1)
42 S XBRXREF("PIECE")=$P(X,";",2)
43 I XBRXREF("PIECE")=0 D GFRCR Q
44 I XBRXREF("NODE")=" " W !!,"Computed fields do not have xrefs." Q
45 I $D(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1)),$O(^(1,0)) D XREFS Q
46 W !!,"This field has no xrefs!"
47 Q
48 ;
49GFRCR ; GET FIELD RECURSION
50 S XBRXREF("SAVE FILE")=XBRXREF("FILE"),XBRXREF("SAVE FIELD")=XBRXREF("FIELD")
51 F Y="XBRXREF" S %RCR(Y)=""
52 S XBRXREF("FILE")=+$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),0),U,2)
53 S %RCR="RECURSE^XBRXREF2"
54 D STORLIST^%RCR
55 S XBRXREF("FILE")=XBRXREF("SAVE FILE"),XBRXREF("FIELD")=XBRXREF("SAVE FIELD")
56 Q
57 ;
58RECURSE ;
59 F XBRXREF("L")=0:0 D GETFIELD Q:XBRXREF("FIELD")=""
60 Q
61 ;
62XREFS ; DISPLAY XREFS FOR FIELD
63 W !,"This field has the following xrefs. Select by number:"
64 S XBRXREF("XREF")=0
65 F XBRXREF("L")=0:0 S XBRXREF("XREF")=$O(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"))) Q:XBRXREF("XREF")="" D XREFS2
66 F XBRXREF("L")=0:0 D GETXREF Q:XBRXREF("XREF")=""
67 Q
68 ;
69XREFS2 ; DISPLAY XREFS
70 S X=$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),0),U,2)
71 S Y=""
72 S:X="" Y="TRIGGER"
73 I Y="",'$F(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),1),"("""_X_"""") S Y="SUB-FILE LEVEL"
74 W !,XBRXREF("XREF"),?10,X,?20,Y
75 Q
76 ;
77GETXREF ; GET XREFS FROM FIELD
78 W !
79 S XBRXREF("XREF")=""
80 S DIC="^DD("_XBRXREF("FILE")_","_XBRXREF("FIELD")_",1,",DIC(0)="AEMQ"
81 D ^DIC
82 Q:Y<0
83 S XBRXREF("XREF")=+Y
84 D INFOSAVE
85 Q
86 ;
87INFOSAVE ; GET XREF/NODE/PIECE INFO AND SAVE
88 S X=$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),0),U,2)
89 I X="" W !!,*7,"Sorry, I don't do TRIGGERS!" Q
90 I '$F(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),1),"("""_X_"""") W !!,*7,"Sorry, I only do xrefs at the file level!" Q
91 S ^TMP("XBRXREF",$J,XBRXREF("FILE"),XBRXREF("FIELD"),XBRXREF("XREF"))=X
92 Q
93 ;
94CONFIRM ;EP - GET USER CONFIRMATION
95 W !!,"The ",$P(^DIC(XBRXREF("FILE"),0),U,1)," file contains ",$P(@(XBRXREF("GBL")_"0)"),U,4)," entries. The following xrefs will be",!,"killed and reset by the specified file or sub-file, and field:",!
96 S XBRXREF("FILE")=""
97 F XBRXREF("L")=0:0 S XBRXREF("FILE")=$O(^TMP("XBRXREF",$J,XBRXREF("FILE"))) Q:XBRXREF("FILE")="" D CONFIRM2
98 R !!,"Do you want to continue (Y/N) Y//",X:$G(DTIME,999)
99 S:"Yy"'[$E(X) XBRXREF("QFLG")=1
100 Q
101 ;
102CONFIRM2 ;
103 S XBRXREF("FIELD")=""
104 F XBRXREF("L")=0:0 S XBRXREF("FIELD")=$O(^TMP("XBRXREF",$J,XBRXREF("FILE"),XBRXREF("FIELD"))) Q:XBRXREF("FIELD")="" D CONFIRM3
105 Q
106 ;
107CONFIRM3 ;
108 S XBRXREF("XREF")=""
109 F XBRXREF("L")=0:0 S XBRXREF("XREF")=$O(^TMP("XBRXREF",$J,XBRXREF("FILE"),XBRXREF("FIELD"),XBRXREF("XREF"))) Q:XBRXREF("XREF")="" W !,XBRXREF("FILE"),?15,XBRXREF("FIELD"),?25,^(XBRXREF("XREF"))
110 Q
111 ;
Note: See TracBrowser for help on using the repository browser.