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 ;