source: IHS-VA_UTILITIES-XB/trunk/XBDINUM.m@ 1745

Last change on this file since 1745 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.9 KB
Line 
1XBDINUM ; 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 ;
4START ;
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 ;
36X1 ;
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 ;
46EOJ ;
47 KILL ^UTILITY("XBDINUM",$J),XBDIGBL,XBDIX,XBDI3,XBDI4,XBDIDFN,XBDIL
48 Q
49 ;
Note: See TracBrowser for help on using the repository browser.