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

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
        ;