source: IHS-VA_UTILITIES-XB/trunk/XBKD2.m@ 1278

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

Modified directory structure; moved routines.

File size: 4.5 KB
RevLine 
[641]1XBKD2 ; IHS/ADC/GTH - CHECK DICTIONARY NAMES AND DATA GLOBALS ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 ; Part of XBKD
6 ;
7START ;
8 S (Y,XBKDUCI)=""
9 X:$D(^%ZOSF("UCI"))#2 ^("UCI")
10 ;I Y'="" S XBKDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]" ;IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
11 I Y'="" S XBKDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'=""&($$VERSION^%ZOSV(1)'["Cache"):","""_$P(Y,",",2)_"""",1:"")_"]" ;IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
12 W !!,"Now checking dictionary names and data globals."
13 S XBKDFILE=""
14 F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" W !?5,"Checking ",XBKDFILE D XBKDNC
15 KILL XBKDANS,XBKDC,XBKDG,XBKDGG,XBKDGNM,XBKDGNR,XBKDNDD,XBKDNDIC,XBKDNTBL,XBKDX,XBKDY
16 Q
17 ;
18XBKDNC ;
19 I '$D(^DIC(XBKDFILE)),'$D(^DD(XBKDFILE)) W !,*7,?10,"Not in ^DIC or ^DD. Removing from ^UTILITY(""XBDSET"")." KILL ^UTILITY("XBDSET",$J,XBKDFILE) Q
20 S XBKDNDIC=$G(^DIC(XBKDFILE,0)),XBKDNDIC=$P(XBKDNDIC,U,1)
21 D GCHK
22 I XBKDG["%" W !,*7,?10,"Data global for ",XBKDFILE," is a % global. Removing from ^UTILITY(""XBDSET"")." KILL ^UTILITY("XBDSET",$J,XBKDFILE) Q
23 S XBKDNDD=$O(^DD(XBKDFILE,0,"NM",""))
24 I XBKDNDIC=XBKDNDD,XBKDNDIC=XBKDGNM,XBKDFILE=XBKDGNR Q
25 I XBKDNDIC]"",XBKDNDIC=XBKDNDD G GNMCHK
26 I XBKDNDIC]"",XBKDNDD="" W !?10,"No name in ^DD. Using name in ^DIC." S XBKDNDD=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)="" G GNMCHK
27 I XBKDNDIC="",XBKDNDD]"" W !?10,"No name in ^DIC. Using name in ^DD." S $P(^DIC(XBKDFILE,0),U,1)=XBKDNDD,XBKDNDIC=XBKDNDD G GNMCHK
28 I XBKDNDIC="",XBKDNDD="",XBKDGNM]"",XBKDFILE=XBKDGNR W !?10,"No name in ^DIC or ^DD. Using name in data global." S $P(^DIC(XBKDFILE,0),U,1)=XBKDGNM,^DD(XBKDFILE,0,"NM",XBKDGNM)="",(XBKDNDIC,XBKDNDD)=XBKDGNM Q
29 I XBKDNDIC]"",XBKDNDD]"",XBKDNDIC'=XBKDNDD W !?10,"Name in ^DIC and ^DD differ. Using name in ^DIC." KILL ^DD(XBKDFILE,0,"NM") S XBKDNDD=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)="" G GNMCHK
30 W !?10,"Unable to deduce name. Searching DIC(""B"")."
31 D DICB
32 G:XBKDNDIC]"" GNMCHK
33 W !?10,"Unable to deduce name. Setting to 'NO NAME'"
34 S (XBKDNDIC,XBKDNDD)="NO NAME",$P(^DIC(XBKDFILE,0),U,1)=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)=""
35 G GNMCHK
36 ;
37GCHK ; CHECK DATA GLOBAL
38 S (XBKDGNM,XBKDGNR)=""
39 S XBKDGG=0,XBKDG=$G(^DIC(XBKDFILE,0,"GL"))
40 S:XBKDG?1"^"1U.UN1"(".UNP XBKDGG=1
41 I XBKDG="" W !?10,"File ",XBKDFILE," has no data global specified in ^DIC." S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="?" Q
42 I 'XBKDGG W !?10,"File ",XBKDFILE," data global=",XBKDG," is invalid." S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="?" Q
43 S XBKDG="^"_XBKDUCI_$E(XBKDG,2,99),$P(^UTILITY("XBDSET",$J,XBKDFILE),U,3)=$E(XBKDG,2,99)
44 S XBKDX=$E(XBKDG,1,$L(XBKDG)-1)_$S($E(XBKDG,$L(XBKDG))=",":")",1:""),XBKDX=$D(@XBKDX)
45 I 'XBKDX W !?10,"Data global ",XBKDG," does not exist!" S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="?" Q
46 S XBKDY=$L(XBKDG),XBKDY=$E(XBKDG,1,XBKDY-1)_$E(")",$E(XBKDG,XBKDY)=","),XBKDY=$S(XBKDY[")":$E(XBKDY,1,$L(XBKDY)-1)_",0)",1:XBKDY_"(0)")
47 S XBKDX=$D(@XBKDY)
48 I XBKDX S XBKDGNM=@XBKDY,XBKDGNR=+$P(XBKDGNM,U,2),XBKDGNM=$P(XBKDGNM,U,1) S:'XBKDGNR XBKDGNR="" Q
49 I 'XBKDX W !?10,"File ",XBKDFILE," data global has entries but no 0th node.",!?12,"If global not being deleted, piece 3 and 4 must be reset!",!?12,"Creating 0th node." S @XBKDY="CREATED BY XBKD"_U_XBKDFILE
50 Q
51 ;
52DICB ; CHECK DIC("B"
53 KILL XBKDNTBL
54 S (XBKDX,XBKDC)=0
55 F XBKDL=0:0 S XBKDX=$O(^DIC("B",XBKDX)) Q:XBKDX="" I $D(^(XBKDX,XBKDFILE)) S XBKDC=XBKDC+1,XBKDNTBL(XBKDC)=XBKDX
56 Q:'XBKDC
57 I XBKDC=1 S XBKDANS=1 D NAMESET KILL XBKDNTBL Q
58 W !?12,"Multiple entries were found in ^DIC(""B""). Selecting first name",!?12," found. All other names will be removed."
59 W !
60 S XBKDANS=1
61 D NAMESET
62 KILL XBKDNTBL(XBKDANS)
63 W !
64 S XBKDX=""
65 F XBKDL=0:0 S XBKDX=$O(XBKDNTBL(XBKDX)) Q:XBKDX="" W !?12,"Deleting ^DIC(""B"",""",XBKDNTBL(XBKDX),""",",XBKDFILE,")" KILL ^DIC("B",XBKDNTBL(XBKDX),XBKDFILE)
66 W !
67 KILL XBKDNTBL
68 Q
69NAMESET ;
70 W !?12,"Setting names to '",XBKDNTBL(XBKDANS),"'"
71 KILL ^DD(XBKDFILE,0,"NM")
72 S (XBKDNDIC,XBKDNDD)=XBKDNTBL(XBKDANS),$P(^DIC(XBKDFILE,0),U,1)=XBKDNDIC,^DD(XBKDFILE,0,"NM",XBKDNDD)=""
73 Q
74 ;
75GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
76 Q:'XBKDGG
77 I XBKDGNM]""!(XBKDGNR),XBKDFILE'=XBKDGNR!(XBKDNDIC'=XBKDGNM) D GNMCHK2
78 S XBKDX=XBKDG_"0)"
79 I XBKDGNM="",XBKDGNR="",$D(@XBKDX)#2 S $P(@XBKDX,U,1)=XBKDNDIC
80 Q
81 ;
82GNMCHK2 ; DATA GLOBAL MISMATCH
83 W !?10,"Data global name and/or number do not match ^DIC. Data global will",!?12,"not be deleted!! "
84 S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="S",XBKDX=XBKDG_"0)="_@(XBKDG_"0)")
85 W $E(XBKDX,1,47)
86 Q
87 ;
Note: See TracBrowser for help on using the repository browser.