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

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

        ;