source: IHS-VA_UTILITIES-XB/XBCDIC2.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 6.4 KB
Line 
1XBCDIC2 ; IHS/ADC/GTH - CHECK DICTIONARY NAMES AND DATA GLOBALS ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Part of XBCDIC
5 ;
6START ;
7 S (Y,XBCDUCI)=""
8 X:$D(^%ZOSF("UCI"))#2 ^("UCI")
9 I Y'="" S XBCDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]"
10 KILL Y
11 W !!,"Now checking dictionary names and data globals."
12 S XBCDFILE=""
13 F XBCDL=0:0 S XBCDFILE=$O(^UTILITY("XBDSET",$J,XBCDFILE)) Q:XBCDFILE="" W !?5,"Checking ",XBCDFILE D XBCDNC
14 KILL XBCDFILE,XBCDANS,XBCDC,XBCDG,XBCDGG,XBCDGNM,XBCDGNR,XBCDNDD,XBCDNDIC,XBCDNTBL,XBCDX,XBCDY,XBCDL,XBCDY
15 Q
16 ;
17XBCDNC ;
18 S XBCDNDIC=$G(^DIC(XBCDFILE,0)),XBCDNDIC=$P(XBCDNDIC,U,1)
19 D GCHK
20 I XBCDNDIC]"",$D(^DD(XBCDFILE,0,"NM",XBCDNDIC))#2 KILL ^DD(XBCDFILE,0,"NM") S ^DD(XBCDFILE,0,"NM",XBCDNDIC)=""
21 S XBCDNDD=$O(^DD(XBCDFILE,0,"NM",""))
22 I XBCDNDIC=XBCDNDD,XBCDNDIC=XBCDGNM,XBCDFILE=XBCDGNR Q
23 I XBCDNDIC]"",XBCDNDIC=XBCDNDD G GNMCHK
24 I XBCDNDIC]"",XBCDNDD="" W !?10,"No name in ^DD. Using name in ^DIC." S XBCDNDD=XBCDNDIC,^DD(XBCDFILE,0,"NM",XBCDNDIC)="" G GNMCHK
25 I XBCDNDIC="",XBCDNDD]"" W !?10,"No name in ^DIC. Using name in ^DD." S XBCDNDIC=XBCDNDD,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="" G GNMCHK
26 I XBCDNDIC="",XBCDNDD="",XBCDGNM]"",XBCDFILE=XBCDGNR W !?10,"No name in ^DIC or ^DD. Using name in data global." S (XBCDNDIC,XBCDNDD)=XBCDGNM,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="",^DD(XBCDFILE,0,"NM",XBCDNDD)="" Q
27 I XBCDNDIC]"",XBCDNDD]"",XBCDNDIC'=XBCDNDD W !?10,"Name in ^DIC and ^DD differ. Using name in ^DIC." KILL ^DD(XBCDFILE,0,"NM") S XBCDNDD=XBCDNDIC,^DD(XBCDFILE,0,"NM",XBCDNDD)="" G GNMCHK
28 W !?10,"Unable to deduce name. Searching DIC(""B"")."
29 D DICB
30 G:XBCDNDIC]"" GNMCHK
31 D READNAME
32 G GNMCHK
33 ;
34READNAME ;
35 W !?10,"Unable to deduce name. Enter File Name or ""^"": ",XBCDX
36 I $L(XBCDX)>2,$L(XBCDX)<31,XBCDX?.ANP S (XBCDNDIC,XBCDNDD)=XBCDX,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="",^DD(XBCDFILE,0,"NM",XBCDNDD)="" Q
37 I XBCDX'="^" W *7," ??" G READNAME
38 S ^UTILITY("XBDSET",$J,XBCDFILE,"ERR",1)="File "_XBCDFILE_" has no name."
39 Q
40 ;
41GCHK ; CHECK DATA GLOBAL
42 S (XBCDGNM,XBCDGNR)="",XBCDGG=0,XBCDG=$G(^DIC(XBCDFILE,0,"GL"))
43 S:XBCDG?1"^"1U.UN1"(".UNP!(XBCDG?1"^"1"%"1U.UN1"(".UNP) XBCDGG=1
44 I XBCDG="" W !?10,"File ",XBCDFILE," has no data global specified in ^DIC." D READGBL G:XBCDG]"" GCHK Q
45 I 'XBCDGG W !?10,"File ",XBCDFILE," data global=",XBCDG," is invalid." D READGBL G:XBCDG]"" GCHK Q
46 S XBCDG="^"_XBCDUCI_$E(XBCDG,2,99),^UTILITY("XBDSET",$J,XBCDFILE)=XBCDG
47 Q:XBCDG["%"
48 S XBCDX=$E(XBCDG,1,$L(XBCDG)-1)_$S($E(XBCDG,$L(XBCDG))=",":")",1:""),XBCDX=$D(@XBCDX)
49 S XBCDY=$L(XBCDG),XBCDY=$E(XBCDG,1,XBCDY-1)_$E(")",$E(XBCDG,XBCDY)=","),XBCDY=$S(XBCDY[")":$E(XBCDY,1,$L(XBCDY)-1)_",0)",1:XBCDY_"(0)")
50 I 'XBCDX W !?10,"Data global ",XBCDG," does not exist. Creating 0th node!" S @XBCDY="CREATED BY XBCD"_U_XBCDFILE Q
51 S XBCDX=$D(@XBCDY)
52 I XBCDX S XBCDGNM=@XBCDY,XBCDGNR=+$P(XBCDGNM,U,2),XBCDGNM=$P(XBCDGNM,U,1) S:'XBCDGNR XBCDGNR="" G GCHK2
53 W !?10,"File ",XBCDFILE," data global exists but has no 0th node.",!?12,"Creating 0th node. Piece 3 and 4 must be set!"
54 S @XBCDY="CREATED BY XBCD"_U_XBCDFILE
55 Q
56 ;
57GCHK2 ; CHECK 3RD AND 4TH PIECE
58 S XBCDX=$P(@XBCDY,U,3,4),XBCDX1=$P(XBCDX,U,2),XBCDX=+XBCDX
59 S XBCDX2=$O(@XBCDY)
60 I 'XBCDX2,XBCDX!(XBCDX1) W !?10,"Data global 0th node inconsistent with data. Fixing." S $P(@XBCDY,U,3)=0,$P(@XBCDY,U,4)=0 G GCHK3
61 I XBCDX2,'XBCDX!('XBCDX1) W !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix." G GCHK3
62 I XBCDX,'$D(@(XBCDG_XBCDX_")")) W !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix." G GCHK3
63GCHK3 ; CHECK FILE NUMBER IN DATA GLOBAL
64 KILL XBCDX1,XBCDX2
65 Q:XBCDGNR=XBCDFILE
66 W !?10,"Data global has different number than ^DIC. ",$P(@XBCDY,U,1,2)
67G2R1 ;
68 R !?12,"Change number in data global? (Y/N) ",XBCDX:$G(DTIME,999)
69 I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G G2R1
70 I XBCDX="Y" S XBCDX=@XBCDY,XBCDX1=$P(XBCDX,U,2),XBCDX2=+XBCDX1,XBCDX3=$P(XBCDX1,XBCDX2,2),$P(XBCDX,U,2)=XBCDFILE_XBCDX3,@XBCDY=XBCDX,XBCDGNR=XBCDFILE KILL XBCDX1,XBCDX2,XBCDX3 KILL XBCDX3 Q
71 D READGBL
72 I XBCDG="" W !?10,"Removing ^DIC(",XBCDFILE,",""0"",""GL"") node." KILL ^DIC(XBCDFILE,0,"GL")
73 G GCHK
74 ;
75READGBL ;
76 R !!,"Enter Data Global or ""^"": ",XBCDG:$G(DTIME,999)
77 I XBCDG="^" S XBCDG="",^UTILITY("XBDSET",$J,XBCDFILE,"ERR",2)="File "_XBCDFILE_" data global missing or invalid." Q
78 I XBCDG'?1"^"1U.UN1"(".UNP,XBCDG'?1"^"1"%"1U.UN1"(".UNP W *7," ??" G READGBL
79 S ^DIC(XBCDFILE,0,"GL")=XBCDG
80 Q
81 ;
82DICB ; CHECK DIC("B"
83 KILL XBCDNTBL
84 S (XBCDX,XBCDC)=0
85 F XBCDL=0:0 S XBCDX=$O(^DIC("B",XBCDX)) Q:XBCDX="" I $D(^(XBCDX,XBCDFILE)) S XBCDC=XBCDC+1,XBCDNTBL(XBCDC)=XBCDX
86 Q:'XBCDC
87 I XBCDC=1 S XBCDANS=1 D NAMESET KILL XBCDNTBL Q
88 W !?12,"Multiple entries were found in ^DIC(""B""). Select one name or enter ""^""",!?12," All unselected names will be removed."
89 D PICKNAME
90 I XBCDANS'="^" D NAMESET KILL XBCDNTBL(XBCDANS) W !
91 S XBCDX=""
92 F XBCDL=0:0 S XBCDX=$O(XBCDNTBL(XBCDX)) Q:XBCDX="" W !?12,"Deleting ^DIC(""B"",""",XBCDNTBL(XBCDX),""",",XBCDFILE,")" KILL ^DIC("B",XBCDNTBL(XBCDX),XBCDFILE)
93 W !
94 KILL XBCDNTBL
95 Q
96 ;
97PICKNAME ;
98 F XBCDX=1:1:XBCDC W !?14,XBCDNTBL(XBCDX)
99P1 ;
100 R !!?14,"Which one: ",XBCDANS:$G(DTIME,999)
101 Q:XBCDANS="^"
102 S:XBCDANS="" XBCDANS="?"
103 I '$D(XBCDNTBL(XBCDANS)) W *7," ??" G P1
104 Q
105 ;
106NAMESET ;
107 W !?12,"Setting names to '",XBCDNTBL(XBCDANS),"'"
108 S (XBCDNDIC,XBCDNDD)=XBCDNTBL(XBCDANS),$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)=""
109 KILL ^DD(XBCDFILE,0,"NM")
110 S ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
111 Q
112 ;
113GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
114 Q:'XBCDGG
115 I XBCDGNM]""!(XBCDGNR),XBCDNDIC'=XBCDGNM W !?10,"Data global name does not match ^DIC.",!?12,"Data global: ",XBCDGNM,!?12," ^DIC: ",XBCDNDIC D GNMFIX
116 S XBCDX=XBCDG_"0)"
117 I XBCDGNM="",XBCDGNR="",$D(@XBCDX)#2 S $P(@XBCDX,U,1)=XBCDNDIC
118 Q
119 ;
120GNMFIX ;
121 R !?12,"Change name in data global? (Y/N) ",XBCDX:$G(DTIME,999)
122 I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G GNMFIX
123 I XBCDX="Y" S XBCDX=XBCDG_"0)",$P(@XBCDX,U,1)=XBCDNDIC,XBCDGNM=XBCDNDIC Q
124GNMR1 ;
125 R !?12,"Change names in ^DIC and ^DD to name in data global? (Y/N) ",XBCDX:$G(DTIME,999)
126 I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G GNMR1
127 I XBCDX'="Y" S ^UTILITY("XBDSET",$J,XBCDFILE,"ERR",3)="File "_XBCDFILE_" data global name does not match ^DIC name." Q
128 KILL ^DIC("B",XBCDNDIC,XBCDFILE),^DD(XBCDFILE,0,"NM")
129 S (XBCDNDIC,XBCDNDD)=XBCDGNM,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="",^DD(XBCDFILE,0,"NM",XBCDNDD)=""
130 Q
131 ;
Note: See TracBrowser for help on using the repository browser.