112 lines
3.5 KiB
Mathematica
112 lines
3.5 KiB
Mathematica
|
XBRXREF2 ; IHS/ADC/GTH - INITIALIZATION ROUTINES FOR DRIVER ; [ 02/07/97 3:02 PM ]
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
;
|
||
|
|
; Part of XBRXREF
|
||
|
|
;
|
||
|
|
START ;
|
||
|
|
W !!,"Invalid entry point!",!
|
||
|
|
S XBRXREF("QFLG")=99
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
INIT ;EP - INITIALIZATION
|
||
|
|
S U="^"
|
||
|
|
W !!,"RE-INDEX selected cross-references.",!
|
||
|
|
S XBRXREF("QFLG")=0
|
||
|
|
KILL ^TMP("XBRXREF",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GETFILE ;EP - GET FILE TO BE RE-XREFED
|
||
|
|
S DIC="^DIC(",DIC(0)="AEMQ"
|
||
|
|
D ^DIC
|
||
|
|
KILL DIC
|
||
|
|
I Y<0 S XBRXREF("QFLG")=1 Q
|
||
|
|
S XBRXREF("FILE")=+Y
|
||
|
|
S XBRXREF("GBL")=^DIC(XBRXREF("FILE"),0,"GL")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
BLDXRT ;EP - BUILD XREF TABLE
|
||
|
|
F XBRXREF("L")=0:0 D GETFIELD Q:XBRXREF("FIELD")=""
|
||
|
|
S:'$O(^TMP("XBRXREF",$J,"")) XBRXREF("QFLG")=1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GETFIELD ; GET FIELD TO XREF
|
||
|
|
W !
|
||
|
|
S XBRXREF("FIELD")=""
|
||
|
|
S DIC="^DD("_XBRXREF("FILE")_",",DIC(0)="AEMQ"
|
||
|
|
D ^DIC
|
||
|
|
KILL DIC
|
||
|
|
Q:Y<0
|
||
|
|
S XBRXREF("FIELD")=+Y
|
||
|
|
S X=$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),0),U,4)
|
||
|
|
S XBRXREF("NODE")=$P(X,";",1)
|
||
|
|
S XBRXREF("PIECE")=$P(X,";",2)
|
||
|
|
I XBRXREF("PIECE")=0 D GFRCR Q
|
||
|
|
I XBRXREF("NODE")=" " W !!,"Computed fields do not have xrefs." Q
|
||
|
|
I $D(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1)),$O(^(1,0)) D XREFS Q
|
||
|
|
W !!,"This field has no xrefs!"
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GFRCR ; GET FIELD RECURSION
|
||
|
|
S XBRXREF("SAVE FILE")=XBRXREF("FILE"),XBRXREF("SAVE FIELD")=XBRXREF("FIELD")
|
||
|
|
F Y="XBRXREF" S %RCR(Y)=""
|
||
|
|
S XBRXREF("FILE")=+$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),0),U,2)
|
||
|
|
S %RCR="RECURSE^XBRXREF2"
|
||
|
|
D STORLIST^%RCR
|
||
|
|
S XBRXREF("FILE")=XBRXREF("SAVE FILE"),XBRXREF("FIELD")=XBRXREF("SAVE FIELD")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
RECURSE ;
|
||
|
|
F XBRXREF("L")=0:0 D GETFIELD Q:XBRXREF("FIELD")=""
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
XREFS ; DISPLAY XREFS FOR FIELD
|
||
|
|
W !,"This field has the following xrefs. Select by number:"
|
||
|
|
S XBRXREF("XREF")=0
|
||
|
|
F XBRXREF("L")=0:0 S XBRXREF("XREF")=$O(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"))) Q:XBRXREF("XREF")="" D XREFS2
|
||
|
|
F XBRXREF("L")=0:0 D GETXREF Q:XBRXREF("XREF")=""
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
XREFS2 ; DISPLAY XREFS
|
||
|
|
S X=$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),0),U,2)
|
||
|
|
S Y=""
|
||
|
|
S:X="" Y="TRIGGER"
|
||
|
|
I Y="",'$F(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),1),"("""_X_"""") S Y="SUB-FILE LEVEL"
|
||
|
|
W !,XBRXREF("XREF"),?10,X,?20,Y
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GETXREF ; GET XREFS FROM FIELD
|
||
|
|
W !
|
||
|
|
S XBRXREF("XREF")=""
|
||
|
|
S DIC="^DD("_XBRXREF("FILE")_","_XBRXREF("FIELD")_",1,",DIC(0)="AEMQ"
|
||
|
|
D ^DIC
|
||
|
|
Q:Y<0
|
||
|
|
S XBRXREF("XREF")=+Y
|
||
|
|
D INFOSAVE
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
INFOSAVE ; GET XREF/NODE/PIECE INFO AND SAVE
|
||
|
|
S X=$P(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),0),U,2)
|
||
|
|
I X="" W !!,*7,"Sorry, I don't do TRIGGERS!" Q
|
||
|
|
I '$F(^DD(XBRXREF("FILE"),XBRXREF("FIELD"),1,XBRXREF("XREF"),1),"("""_X_"""") W !!,*7,"Sorry, I only do xrefs at the file level!" Q
|
||
|
|
S ^TMP("XBRXREF",$J,XBRXREF("FILE"),XBRXREF("FIELD"),XBRXREF("XREF"))=X
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CONFIRM ;EP - GET USER CONFIRMATION
|
||
|
|
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:",!
|
||
|
|
S XBRXREF("FILE")=""
|
||
|
|
F XBRXREF("L")=0:0 S XBRXREF("FILE")=$O(^TMP("XBRXREF",$J,XBRXREF("FILE"))) Q:XBRXREF("FILE")="" D CONFIRM2
|
||
|
|
R !!,"Do you want to continue (Y/N) Y//",X:$G(DTIME,999)
|
||
|
|
S:"Yy"'[$E(X) XBRXREF("QFLG")=1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CONFIRM2 ;
|
||
|
|
S XBRXREF("FIELD")=""
|
||
|
|
F XBRXREF("L")=0:0 S XBRXREF("FIELD")=$O(^TMP("XBRXREF",$J,XBRXREF("FILE"),XBRXREF("FIELD"))) Q:XBRXREF("FIELD")="" D CONFIRM3
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CONFIRM3 ;
|
||
|
|
S XBRXREF("XREF")=""
|
||
|
|
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"))
|
||
|
|
Q
|
||
|
|
;
|