| 1 | XBDINUM ; IHS/ADC/GTH - CONVERTS NON-DINUM FILE TO DINUM FILE ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | START ;
|
|---|
| 5 | S U="^"
|
|---|
| 6 | W !!,"This program sets the DFNs of a DINUM file appropriately.",!
|
|---|
| 7 | S DIC="^DIC(",DIC(0)="QAZEM"
|
|---|
| 8 | D ^DIC
|
|---|
| 9 | Q:Y<0
|
|---|
| 10 | S DIC=+Y
|
|---|
| 11 | I '$D(^DIC(DIC,0,"GL")) W !!,"Corrupted ^DIC!",!,"No ""GL"" node in zeroth node of file ",DIC,"." Q
|
|---|
| 12 | S XBDIGBL=^DIC(DIC,0,"GL")
|
|---|
| 13 | X "S XBDIX=$D("_XBDIGBL_"0))"
|
|---|
| 14 | I 'XBDIX W !!,XBDIGBL,"0) does not exist." Q
|
|---|
| 15 | I '$P(@(XBDIGBL_"0)"),U,4) W !!,"File ",DIC," has no entries." Q
|
|---|
| 16 | I '$D(^DD(DIC,.01,0)) W !!,"Corrupted ^DD!" Q
|
|---|
| 17 | I ^DD(DIC,.01,0)'["DINUM=X" W !!,"File ",DIC," is not a DINUM file." Q
|
|---|
| 18 | KILL ^UTILITY("XBDINUM",$J),^UTILITY("XBDIDUP",$J)
|
|---|
| 19 | S (XBDI3,XBDI4,XBDIDFN)=0
|
|---|
| 20 | X "S ^UTILITY(""XBDINUM"",$J,0)="_XBDIGBL_"0)"
|
|---|
| 21 | F XBDIL=0:0 X "S XBDIDFN=$O("_XBDIGBL_XBDIDFN_"))" Q:XBDIDFN'=+XBDIDFN D X1
|
|---|
| 22 | S XBDIX=^UTILITY("XBDINUM",$J,0),$P(XBDIX,U,3)=XBDI3,$P(XBDIX,U,4)=XBDI4,^(0)=XBDIX
|
|---|
| 23 | W !!,"Global ",$E(XBDIGBL,1,$L(XBDIGBL)-1)," now renumbered and stored in ^UTILITY(""XBDINUM"",",$J,!," High DFN=",XBDI3," Number of entries=",XBDI4
|
|---|
| 24 | I $D(^UTILITY("XBDIDUP",$J)) W !!,"Duplicate entries found. Stored in ^UTILITY(""XBDIDUP"",",$J,!," Eliminate duplicates and rerun this job!" G EOJ
|
|---|
| 25 | S XBDIX=$S($E(XBDIGBL,$L(XBDIGBL))="(":$E(XBDIGBL,1,$L(XBDIGBL)-1),1:$E(XBDIGBL,1,$L(XBDIGBL)-1)_")")
|
|---|
| 26 | KILL @(XBDIX)
|
|---|
| 27 | W !!,XBDIX," has been killed! Now being recreated."
|
|---|
| 28 | S TO=XBDIGBL,FROM="^UTILITY(""XBDINUM"",$J,",TALK=1
|
|---|
| 29 | D ^XBGXFR
|
|---|
| 30 | W !!,"File now being RE-INDEXED!",!
|
|---|
| 31 | S DIK=XBDIGBL,XBDIX=0
|
|---|
| 32 | F XBDIL=0:0 X "S XBDIX=$O("_XBDIGBL_XBDIX_"))" Q:XBDIX'=+XBDIX W "." S DA=XBDIX D IX1^DIK
|
|---|
| 33 | D EOJ
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | X1 ;
|
|---|
| 37 | S FROM=XBDIGBL_XBDIDFN_","
|
|---|
| 38 | X "S TO=+"_XBDIGBL_XBDIDFN_",0)"
|
|---|
| 39 | S:TO>XBDI3 XBDI3=TO
|
|---|
| 40 | S TO=$S('$D(^UTILITY("XBDINUM",$J,TO)):"^UTILITY(""XBDINUM"",$J,"_TO_",",1:"^UTILITY(""XBDIDUP"",$J,"_TO_",")
|
|---|
| 41 | S:TO'["XBDIDUP" XBDI4=XBDI4+1
|
|---|
| 42 | S TALK=1
|
|---|
| 43 | D ^XBGXFR
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | EOJ ;
|
|---|
| 47 | KILL ^UTILITY("XBDINUM",$J),XBDIGBL,XBDIX,XBDI3,XBDI4,XBDIDFN,XBDIL
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
