AURXREF2.m

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