| 1 | DIU1 ;SFISC/GFT-REINDEX A FILE ;3:08 PM  18 Jun 2001
 | 
|---|
| 2 |  ;;22.0;VA FileMan;**41**;Mar 30, 1999
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 | 4 ;
 | 
|---|
| 5 |  N DIUCNT,DIUTYPE
 | 
|---|
| 6 |  W !! K ^UTILITY("DIK",$J),X S DIK=DIU,X=0 D DD^DIK S DW=0,DIUF=DI K DU,DV
 | 
|---|
| 7 | DW S DW=$O(^UTILITY("DIK",$J,DW)),DV=0 S:DW="" DW=-1
 | 
|---|
| 8 |  I DW>0 S DU=0 F  S DV=$O(^UTILITY("DIK",$J,DW,DV)),DH=0 G DW:DV="" S Y=0 F  S DH=$O(^UTILITY("DIK",$J,DW,DV,DH)) Q:DH=""  S Y=^(DH),X=X+1,X(X)=Y,X(X,0)=DW_U_DV S:$P(Y,U,3)=""&'Y&$D(^(DH,0)) X(X)=^(0)
 | 
|---|
| 9 |  D GETXR^DIKCUTL2(DI,.DIUCNT,"M")
 | 
|---|
| 10 |  K ^UTILITY("DIK",$J) G DD:'(X+DIUCNT),ONE:(X+DIUCNT)>1
 | 
|---|
| 11 | ALL W "OK, ARE YOU SURE YOU WANT TO KILL OFF THE EXISTING "
 | 
|---|
| 12 |  I X=0,DIUCNT=1 W "'"_$P(DIUCNT($O(DIUCNT(""))),U,3)_"' INDEX"
 | 
|---|
| 13 |  E  I X=1,DIUCNT=0 W $P(^DD(+X(1,0),$P(X(1,0),U,2),0),U,1)_" INDEX"
 | 
|---|
| 14 |  E  W X+DIUCNT_" INDICES"
 | 
|---|
| 15 |  S %=2 D YN^DICN G:%-1 NO:%,Q W !,"DO YOU THEN WANT TO 'RE-CROSS-REFERENCE'" D YN^DICN G NO:%<1 S N=%=1 D WAIT^DICD
 | 
|---|
| 16 |  F X=X:-1:1 S %=$P(X(X),U,2) I %]"",+X(X)=DI K @(DIK_"%)") K:$P(X(X),U,3)'="MUMPS" X(X)
 | 
|---|
| 17 |  S DIK(0)="AB" I $O(X(0))'="" S X=2,(DA,DCNT)=0 D DD^DIK,CNT^DIK1
 | 
|---|
| 18 |  D:DIUCNT INDEX^DIKC(DIUF,"","","","KR")
 | 
|---|
| 19 |  K X I N W !,$C(7),"FILE WILL NOW BE 'RE-CROSS-REFERENCED'..." H 5 D DD S DIK=^DIC(DIUF,0,"GL") D IXALL^DIK
 | 
|---|
| 20 |  K DIK,DIC Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | DD S DIK="^DD(DI,",DA(1)=DI K ^DD(DI,"B"),^("GL"),^("IX"),^("RQ"),^("GR"),^("SB")
 | 
|---|
| 23 |  W "." D IXALL^DIK:$D(^(0))#2 S DI=$O(^DD(DI)) S:DI="" DI=-1 I DI>0,DI<$O(^DIC(DIUF)) G DD
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 | ONE S %=2 W "THERE ARE "_(X+DIUCNT)_" INDICES WITHIN THIS FILE",!,"DO YOU WISH TO RE-CROSS-REFERENCE ONE PARTICULAR INDEX" D YN^DICN W ! I %-1 G ALL:%=2,NO:%,Q
 | 
|---|
| 27 |  S DIUTYPE=$S('$G(DIUCNT):1,'$G(X):2,1:$$TYPE^DIKCUTL2)
 | 
|---|
| 28 |  G NO:DIUTYPE=""
 | 
|---|
| 29 |  I DIUTYPE=2 K DIUCNT D ONEXR(DI) Q
 | 
|---|
| 30 |  K X S X="CW" D DI^DIU G NO:Y<0 S (DA,DL)=+Y,DICD="RE-CROSS-REFERENCE" D CHIX^DICD G NO:'DICD
 | 
|---|
| 31 |  S X=$P(I,U,2)
 | 
|---|
| 32 |  W !,"ARE YOU SURE YOU WANT TO DELETE AND RE-CROSS-REFERENCE "_$S(X]"":"THE '"_X_"' INDEX",1:"THIS TRIGGER") S %=2 D YN^DICN G NO:%-1
 | 
|---|
| 33 |  G IND:X="" F %=0:0 S %=$O(^DD(+I,0,"IX",X,%)) Q:%=""  F %Y=0:0 S %Y=$O(^DD(+I,0,"IX",X,%,%Y)) Q:%Y=""  I %Y-DA!(%-DI) G IND
 | 
|---|
| 34 |  I +I=DIUF,$P(I,U,3)="",X]"" K @(DIK_"X)") G REDO
 | 
|---|
| 35 | IND I $P(I,U,3)="",X]"" D KWREG(DIU,0,.I,.J) G REDO
 | 
|---|
| 36 |  S X=^DD(J(N),DA,1,DICD,2) D DD^DICD:"Q"'[X S DIU=^DIC(DIUF,0,"GL")
 | 
|---|
| 37 | REDO S X=^DD(J(N),DL,1,DICD,1) D DD^DICD:"Q"'[X W $C(7),"    ...DONE!" Q
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 | Q F I=1:1:X W !,"FIELD " S %=X(I,0),J=$P(%,U,2) W J_" ('"_$P(^DD(+%,J,0),U,1)_"'" W:%-DI ", "_$O(^DD(+%,0,"NM",0))_" SUBFILE" W ") IS ",$S(X(I):"'"_$P(X(I),U,2)_"' INDEX",1:$P(X(I),U,3)) D UP
 | 
|---|
| 40 |  W !! D LIST^DIKCUTL2(.DIUCNT,"INDEX FILE CROSS-REFERENCES:")
 | 
|---|
| 41 |  G 4
 | 
|---|
| 42 | UP I X(I),X(I)-DI S %=$D(^DD(+X(I),0,"UP")) W " OF "_$O(^("NM",0))_" "_$P("SUB",U,%>0)_"FILE" Q
 | 
|---|
| 43 |  S %=+$P(X(I),U,4),(%F,Y)=+$P(X(I),U,5) I %,$D(^DD(%,Y,0)) W:$X>44 ! W " OF " D WR^DIDH
 | 
|---|
| 44 |  Q
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 | NO W !?7,$C(7),"<NO ACTION TAKEN>" K DICD,X,DH
 | 
|---|
| 47 |  Q
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 | KWREG(ROOT,LEV,I,J) ;Kill entire regular index
 | 
|---|
| 50 |  ;In:
 | 
|---|
| 51 |  ; ROOT = open root of file or subfile
 | 
|---|
| 52 |  ; LEV = level # of ROOT
 | 
|---|
| 53 |  ; I = ^DD(file#,field#,1,xref#,0) [xref header node] = rfile#^name
 | 
|---|
| 54 |  ; I(N) = node on which multiple at level n resides (for N>0)
 | 
|---|
| 55 |  ; J(N) = level N subfile #
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 |  N CROOT
 | 
|---|
| 58 |  S CROOT=$$CREF^DILF(ROOT)
 | 
|---|
| 59 |  Q:'$D(@CROOT)
 | 
|---|
| 60 |  I J(LEV)=+I K @CROOT@($P(I,U,2)) Q
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 |  N DA
 | 
|---|
| 63 |  S DA=0
 | 
|---|
| 64 |  F  S DA=$O(@CROOT@(DA)) Q:'DA  D:$D(@CROOT@(DA,0))#2 KWREG(ROOT_DA_","_I(LEV+1)_",",LEV+1,.I,.J)
 | 
|---|
| 65 |  Q
 | 
|---|
| 66 |  ;
 | 
|---|
| 67 |  ;==============
 | 
|---|
| 68 |  ; ONEXR(file#)
 | 
|---|
| 69 |  ;==============
 | 
|---|
| 70 |  ;Prompt for file/subfile and Index; run kill/set logic for that Index
 | 
|---|
| 71 |  ;In:
 | 
|---|
| 72 |  ; DI = top level file #
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | ONEXR(DI) ;Re-index one cross reference
 | 
|---|
| 75 |  ;Prompt for subfile
 | 
|---|
| 76 |  N DIUCNT,DIUCTRL,DIUFILE,DIULOG,DIUXR
 | 
|---|
| 77 |  W !!?10,"File: "_$O(^DD(DI,0,"NM",""))_" (#"_DI_")"
 | 
|---|
| 78 |  S DIUFILE=$$SUB^DIKCU(DI) G:DIUFILE="" NO
 | 
|---|
| 79 |  ;
 | 
|---|
| 80 |  ;Prompt for xref
 | 
|---|
| 81 |  D GETXR^DIKCUTL2(DIUFILE,.DIUCNT)
 | 
|---|
| 82 |  W ! D LIST^DIKCUTL2(.DIUCNT)
 | 
|---|
| 83 |  S DIUXR=$$CHOOSE^DIKCUTL2(.DIUCNT,"re-cross-reference")
 | 
|---|
| 84 |  G:'DIUXR NO
 | 
|---|
| 85 |  ;
 | 
|---|
| 86 |  ;Run kill and/or set
 | 
|---|
| 87 |  S DIUCTRL=$$LOGIC($P(DIUCNT(DIUXR),U,3))
 | 
|---|
| 88 |  G:DIUCTRL="" NO
 | 
|---|
| 89 |  ;
 | 
|---|
| 90 |  S:DI'=DIUFILE DIUCTRL=DIUCTRL_"W"_DIUFILE
 | 
|---|
| 91 |  D INDEX^DIKC(DI,"","",DIUXR,DIUCTRL_"R")
 | 
|---|
| 92 |  W $C(7)_"  ...DONE!"
 | 
|---|
| 93 |  Q
 | 
|---|
| 94 |  ;
 | 
|---|
| 95 |  ;====================
 | 
|---|
| 96 |  ; $$LOGIC(indexName)
 | 
|---|
| 97 |  ;====================
 | 
|---|
| 98 |  ;Prompt for whether kill and/or set logic should be run.
 | 
|---|
| 99 |  ;In:
 | 
|---|
| 100 |  ; DIUNAME = name of xref (used in prompt)
 | 
|---|
| 101 |  ;Return value:
 | 
|---|
| 102 |  ; [ K : if kill logic should be run
 | 
|---|
| 103 |  ; [ S : if set logic should be run
 | 
|---|
| 104 |  ;
 | 
|---|
| 105 | LOGIC(DIUNAME) ;
 | 
|---|
| 106 |  N DIULOG,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 | 
|---|
| 107 |  S DIULOG=""
 | 
|---|
| 108 |  ;
 | 
|---|
| 109 |  ;Ask whether kill logic should be executed
 | 
|---|
| 110 |  S DIR(0)="Y"
 | 
|---|
| 111 |  S DIR("A")="Do you want to delete the existing '"_DIUNAME_"' cross-reference"
 | 
|---|
| 112 |  S DIR("?")="  Enter 'YES' if you want to run the kill logic for this cross-reference."
 | 
|---|
| 113 |  W ! D ^DIR K DIR Q:$D(DIRUT) ""
 | 
|---|
| 114 |  S:Y DIULOG="K"
 | 
|---|
| 115 |  ;
 | 
|---|
| 116 |  ;Ask whether set logic should be executed
 | 
|---|
| 117 |  S DIR(0)="Y"
 | 
|---|
| 118 |  S DIR("A")="Do you want to re-build the '"_DIUNAME_"' cross reference"
 | 
|---|
| 119 |  S DIR("?")="  Enter 'YES' if you want to run the set logic for this cross reference."
 | 
|---|
| 120 |  D ^DIR K DIR Q:$D(DIRUT) ""
 | 
|---|
| 121 |  S:Y DIULOG=DIULOG_"S"
 | 
|---|
| 122 |  Q DIULOG
 | 
|---|