AURXREF2 ; INITIALIZATION ROUTINES FOR DRIVER [ 10/27/87 8:34 AM ]
; EDE/10-12-87
;
W !!,"Invalid entry point!",! S AURXREF("QFLG")=99
Q
;
INIT ; INITIALIZATION
S U="^"
W !!,"RE-INDEX selected cross-references.",!
S AURXREF("QFLG")=0
K ^UTILITY("AURXREF",$J)
Q
;
GETFILE ; GET FILE TO BE RE-XREFED
S DIC="^DIC(",DIC(0)="AEMQ" D ^DIC K DIC
I Y<0 S AURXREF("QFLG")=1 Q
S AURXREF("FILE")=+Y
S AURXREF("GBL")=^DIC(AURXREF("FILE"),0,"GL")
Q
;
BLDXRT ; BUILD XREF TABLE
F AURXREF("L")=0:0 D GETFIELD Q:AURXREF("FIELD")=""
S:'$O(^UTILITY("AURXREF",$J,"")) AURXREF("QFLG")=1
Q
;
GETFIELD ; GET FIELD TO XREF
W !
S AURXREF("FIELD")=""
S DIC="^DD("_AURXREF("FILE")_",",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S AURXREF("FIELD")=+Y
S X=$P(^DD(AURXREF("FILE"),AURXREF("FIELD"),0),U,4)
S AURXREF("NODE")=$P(X,";",1)
S AURXREF("PIECE")=$P(X,";",2)
I AURXREF("PIECE")=0 D GFRCR Q
I AURXREF("NODE")=" " W !!,"Computed fields do not have xrefs." Q
I $D(^DD(AURXREF("FILE"),AURXREF("FIELD"),1)),$O(^(1,0)) D XREFS Q
W !!,"This field has no xrefs!"
Q
;
GFRCR ; GET FIELD RECURSION
S AURXREF("SAVE FILE")=AURXREF("FILE"),AURXREF("SAVE FIELD")=AURXREF("FIELD")
F Y="AURXREF" S %RCR(Y)=""
S AURXREF("FILE")=+$P(^DD(AURXREF("FILE"),AURXREF("FIELD"),0),U,2)
S %RCR="RECURSE^AURXREF2" D STORLIST^%RCR
S AURXREF("FILE")=AURXREF("SAVE FILE"),AURXREF("FIELD")=AURXREF("SAVE FIELD")
;ZW AURXREF
Q
;
RECURSE ;
F AURXREF("L")=0:0 D GETFIELD Q:AURXREF("FIELD")=""
Q
;
XREFS ; DISPLAY XREFS FOR FIELD
W !,"This field has the following xrefs. Select by number:"
S AURXREF("XREF")=0 F AURXREF("L")=0:0 S AURXREF("XREF")=$O(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"))) Q:AURXREF("XREF")="" D XREFS2
F AURXREF("L")=0:0 D GETXREF Q:AURXREF("XREF")=""
Q
;
XREFS2 ; DISPLAY XREFS
S X=$P(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),0),U,2)
S Y=""
S:X="" Y="TRIGGER"
I Y="",'$F(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),1),"("""_X_"""") S Y="SUB-FILE LEVEL"
W !,AURXREF("XREF"),?10,X,?20,Y
Q
;
GETXREF ; GET XREFS FROM FIELD
W !
S AURXREF("XREF")=""
S DIC="^DD("_AURXREF("FILE")_","_AURXREF("FIELD")_",1,",DIC(0)="AEMQ" D ^DIC
Q:Y<0
S AURXREF("XREF")=+Y
D INFOSAVE
Q
;
INFOSAVE ; GET XREF/NODE/PIECE INFO AND SAVE
S X=$P(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),0),U,2)
I X="" W !!,*7,"Sorry, I don't do TRIGGERS!" Q
I '$F(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),1),"("""_X_"""") W !!,*7,"Sorry, I only do xrefs at the file level!" Q
S ^UTILITY("AURXREF",$J,AURXREF("FILE"),AURXREF("FIELD"),AURXREF("XREF"))=X
Q
;
CONFIRM ; GET USER CONFIRMATION
W !!,"The ",$P(^DIC(AURXREF("FILE"),0),U,1)," file contains ",$P(@(AURXREF("GBL")_"0)"),U,4)," entries. The following xrefs will be",!,"killed and reset by the specified file or sub-file, and field:",!
S AURXREF("FILE")="" F AURXREF("L")=0:0 S AURXREF("FILE")=$O(^UTILITY("AURXREF",$J,AURXREF("FILE"))) Q:AURXREF("FILE")="" D CONFIRM2
R !!,"Do you want to continue (Y/N) Y//",X
S:"Yy"'[$E(X) AURXREF("QFLG")=1
Q
CONFIRM2 ;
S AURXREF("FIELD")="" F AURXREF("L")=0:0 S AURXREF("FIELD")=$O(^UTILITY("AURXREF",$J,AURXREF("FILE"),AURXREF("FIELD"))) Q:AURXREF("FIELD")="" D CONFIRM3
Q
;
CONFIRM3 ;
S AURXREF("XREF")="" F AURXREF("L")=0:0 S AURXREF("XREF")=$O(^UTILITY("AURXREF",$J,AURXREF("FILE"),AURXREF("FIELD"),AURXREF("XREF"))) Q:AURXREF("XREF")="" D CONFIRM4
Q
;
CONFIRM4 ;
W !,AURXREF("FILE"),?15,AURXREF("FIELD"),?25,^(AURXREF("XREF"))
Q
AURXREF2 ; INITIALIZATION ROUTINES FOR DRIVER [ 10/27/87 8:34 AM ]
+1 ; EDE/10-12-87
+2 ;
+3 WRITE !!,"Invalid entry point!",!
SET AURXREF("QFLG")=99
+4 QUIT
+5 ;
INIT ; INITIALIZATION
+1 SET U="^"
+2 WRITE !!,"RE-INDEX selected cross-references.",!
+3 SET AURXREF("QFLG")=0
+4 KILL ^UTILITY("AURXREF",$JOB)
+5 QUIT
+6 ;
GETFILE ; GET FILE TO BE RE-XREFED
+1 SET DIC="^DIC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+2 IF Y<0
SET AURXREF("QFLG")=1
QUIT
+3 SET AURXREF("FILE")=+Y
+4 SET AURXREF("GBL")=^DIC(AURXREF("FILE"),0,"GL")
+5 QUIT
+6 ;
BLDXRT ; BUILD XREF TABLE
+1 FOR AURXREF("L")=0:0
DO GETFIELD
IF AURXREF("FIELD")=""
QUIT
+2 IF '$ORDER(^UTILITY("AURXREF",$JOB,""))
SET AURXREF("QFLG")=1
+3 QUIT
+4 ;
GETFIELD ; GET FIELD TO XREF
+1 WRITE !
+2 SET AURXREF("FIELD")=""
+3 SET DIC="^DD("_AURXREF("FILE")_","
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF Y<0
QUIT
+5 SET AURXREF("FIELD")=+Y
+6 SET X=$PIECE(^DD(AURXREF("FILE"),AURXREF("FIELD"),0),U,4)
+7 SET AURXREF("NODE")=$PIECE(X,";",1)
+8 SET AURXREF("PIECE")=$PIECE(X,";",2)
+9 IF AURXREF("PIECE")=0
DO GFRCR
QUIT
+10 IF AURXREF("NODE")=" "
WRITE !!,"Computed fields do not have xrefs."
QUIT
+11 IF $DATA(^DD(AURXREF("FILE"),AURXREF("FIELD"),1))
IF $ORDER(^(1,0))
DO XREFS
QUIT
+12 WRITE !!,"This field has no xrefs!"
+13 QUIT
+14 ;
GFRCR ; GET FIELD RECURSION
+1 SET AURXREF("SAVE FILE")=AURXREF("FILE")
SET AURXREF("SAVE FIELD")=AURXREF("FIELD")
+2 FOR Y="AURXREF"
SET %RCR(Y)=""
+3 SET AURXREF("FILE")=+$PIECE(^DD(AURXREF("FILE"),AURXREF("FIELD"),0),U,2)
+4 SET %RCR="RECURSE^AURXREF2"
DO STORLIST^%RCR
+5 SET AURXREF("FILE")=AURXREF("SAVE FILE")
SET AURXREF("FIELD")=AURXREF("SAVE FIELD")
+6 ;ZW AURXREF
+7 QUIT
+8 ;
RECURSE ;
+1 FOR AURXREF("L")=0:0
DO GETFIELD
IF AURXREF("FIELD")=""
QUIT
+2 QUIT
+3 ;
XREFS ; DISPLAY XREFS FOR FIELD
+1 WRITE !,"This field has the following xrefs. Select by number:"
+2 SET AURXREF("XREF")=0
FOR AURXREF("L")=0:0
SET AURXREF("XREF")=$ORDER(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF")))
IF AURXREF("XREF")=""
QUIT
DO XREFS2
+3 FOR AURXREF("L")=0:0
DO GETXREF
IF AURXREF("XREF")=""
QUIT
+4 QUIT
+5 ;
XREFS2 ; DISPLAY XREFS
+1 SET X=$PIECE(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),0),U,2)
+2 SET Y=""
+3 IF X=""
SET Y="TRIGGER"
+4 IF Y=""
IF '$FIND(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),1),"("""_X_"""")
SET Y="SUB-FILE LEVEL"
+5 WRITE !,AURXREF("XREF"),?10,X,?20,Y
+6 QUIT
+7 ;
GETXREF ; GET XREFS FROM FIELD
+1 WRITE !
+2 SET AURXREF("XREF")=""
+3 SET DIC="^DD("_AURXREF("FILE")_","_AURXREF("FIELD")_",1,"
SET DIC(0)="AEMQ"
DO ^DIC
+4 IF Y<0
QUIT
+5 SET AURXREF("XREF")=+Y
+6 DO INFOSAVE
+7 QUIT
+8 ;
INFOSAVE ; GET XREF/NODE/PIECE INFO AND SAVE
+1 SET X=$PIECE(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),0),U,2)
+2 IF X=""
WRITE !!,*7,"Sorry, I don't do TRIGGERS!"
QUIT
+3 IF '$FIND(^DD(AURXREF("FILE"),AURXREF("FIELD"),1,AURXREF("XREF"),1),"("""_X_"""")
WRITE !!,*7,"Sorry, I only do xrefs at the file level!"
QUIT
+4 SET ^UTILITY("AURXREF",$JOB,AURXREF("FILE"),AURXREF("FIELD"),AURXREF("XREF"))=X
+5 QUIT
+6 ;
CONFIRM ; GET USER CONFIRMATION
+1 WRITE !!,"The ",$PIECE(^DIC(AURXREF("FILE"),0),U,1)," file contains ",$PIECE(@(AURXREF("GBL")_"0)"),U,4)," entries. The following xrefs will be",!,"killed and reset by the specified file or sub-file, and field:",!
+2 SET AURXREF("FILE")=""
FOR AURXREF("L")=0:0
SET AURXREF("FILE")=$ORDER(^UTILITY("AURXREF",$JOB,AURXREF("FILE")))
IF AURXREF("FILE")=""
QUIT
DO CONFIRM2
+3 READ !!,"Do you want to continue (Y/N) Y//",X
+4 IF "Yy"'[$EXTRACT(X)
SET AURXREF("QFLG")=1
+5 QUIT
CONFIRM2 ;
+1 SET AURXREF("FIELD")=""
FOR AURXREF("L")=0:0
SET AURXREF("FIELD")=$ORDER(^UTILITY("AURXREF",$JOB,AURXREF("FILE"),AURXREF("FIELD")))
IF AURXREF("FIELD")=""
QUIT
DO CONFIRM3
+2 QUIT
+3 ;
CONFIRM3 ;
+1 SET AURXREF("XREF")=""
FOR AURXREF("L")=0:0
SET AURXREF("XREF")=$ORDER(^UTILITY("AURXREF",$JOB,AURXREF("FILE"),AURXREF("FIELD"),AURXREF("XREF")))
IF AURXREF("XREF")=""
QUIT
DO CONFIRM4
+2 QUIT
+3 ;
CONFIRM4 ;
+1 WRITE !,AURXREF("FILE"),?15,AURXREF("FIELD"),?25,^(AURXREF("XREF"))
+2 QUIT
