132 lines
6.4 KiB
Mathematica
132 lines
6.4 KiB
Mathematica
|
XBCDIC2 ; IHS/ADC/GTH - CHECK DICTIONARY NAMES AND DATA GLOBALS ; [ 02/07/97 3:02 PM ]
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
;
|
||
|
|
; Part of XBCDIC
|
||
|
|
;
|
||
|
|
START ;
|
||
|
|
S (Y,XBCDUCI)=""
|
||
|
|
X:$D(^%ZOSF("UCI"))#2 ^("UCI")
|
||
|
|
I Y'="" S XBCDUCI="["""_$P(Y,",",1)_""""_$S($P(Y,",",2)'="":","""_$P(Y,",",2)_"""",1:"")_"]"
|
||
|
|
KILL Y
|
||
|
|
W !!,"Now checking dictionary names and data globals."
|
||
|
|
S XBCDFILE=""
|
||
|
|
F XBCDL=0:0 S XBCDFILE=$O(^UTILITY("XBDSET",$J,XBCDFILE)) Q:XBCDFILE="" W !?5,"Checking ",XBCDFILE D XBCDNC
|
||
|
|
KILL XBCDFILE,XBCDANS,XBCDC,XBCDG,XBCDGG,XBCDGNM,XBCDGNR,XBCDNDD,XBCDNDIC,XBCDNTBL,XBCDX,XBCDY,XBCDL,XBCDY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
XBCDNC ;
|
||
|
|
S XBCDNDIC=$G(^DIC(XBCDFILE,0)),XBCDNDIC=$P(XBCDNDIC,U,1)
|
||
|
|
D GCHK
|
||
|
|
I XBCDNDIC]"",$D(^DD(XBCDFILE,0,"NM",XBCDNDIC))#2 KILL ^DD(XBCDFILE,0,"NM") S ^DD(XBCDFILE,0,"NM",XBCDNDIC)=""
|
||
|
|
S XBCDNDD=$O(^DD(XBCDFILE,0,"NM",""))
|
||
|
|
I XBCDNDIC=XBCDNDD,XBCDNDIC=XBCDGNM,XBCDFILE=XBCDGNR Q
|
||
|
|
I XBCDNDIC]"",XBCDNDIC=XBCDNDD G GNMCHK
|
||
|
|
I XBCDNDIC]"",XBCDNDD="" W !?10,"No name in ^DD. Using name in ^DIC." S XBCDNDD=XBCDNDIC,^DD(XBCDFILE,0,"NM",XBCDNDIC)="" G GNMCHK
|
||
|
|
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
|
||
|
|
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
|
||
|
|
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
|
||
|
|
W !?10,"Unable to deduce name. Searching DIC(""B"")."
|
||
|
|
D DICB
|
||
|
|
G:XBCDNDIC]"" GNMCHK
|
||
|
|
D READNAME
|
||
|
|
G GNMCHK
|
||
|
|
;
|
||
|
|
READNAME ;
|
||
|
|
W !?10,"Unable to deduce name. Enter File Name or ""^"": ",XBCDX
|
||
|
|
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
|
||
|
|
I XBCDX'="^" W *7," ??" G READNAME
|
||
|
|
S ^UTILITY("XBDSET",$J,XBCDFILE,"ERR",1)="File "_XBCDFILE_" has no name."
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GCHK ; CHECK DATA GLOBAL
|
||
|
|
S (XBCDGNM,XBCDGNR)="",XBCDGG=0,XBCDG=$G(^DIC(XBCDFILE,0,"GL"))
|
||
|
|
S:XBCDG?1"^"1U.UN1"(".UNP!(XBCDG?1"^"1"%"1U.UN1"(".UNP) XBCDGG=1
|
||
|
|
I XBCDG="" W !?10,"File ",XBCDFILE," has no data global specified in ^DIC." D READGBL G:XBCDG]"" GCHK Q
|
||
|
|
I 'XBCDGG W !?10,"File ",XBCDFILE," data global=",XBCDG," is invalid." D READGBL G:XBCDG]"" GCHK Q
|
||
|
|
S XBCDG="^"_XBCDUCI_$E(XBCDG,2,99),^UTILITY("XBDSET",$J,XBCDFILE)=XBCDG
|
||
|
|
Q:XBCDG["%"
|
||
|
|
S XBCDX=$E(XBCDG,1,$L(XBCDG)-1)_$S($E(XBCDG,$L(XBCDG))=",":")",1:""),XBCDX=$D(@XBCDX)
|
||
|
|
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)")
|
||
|
|
I 'XBCDX W !?10,"Data global ",XBCDG," does not exist. Creating 0th node!" S @XBCDY="CREATED BY XBCD"_U_XBCDFILE Q
|
||
|
|
S XBCDX=$D(@XBCDY)
|
||
|
|
I XBCDX S XBCDGNM=@XBCDY,XBCDGNR=+$P(XBCDGNM,U,2),XBCDGNM=$P(XBCDGNM,U,1) S:'XBCDGNR XBCDGNR="" G GCHK2
|
||
|
|
W !?10,"File ",XBCDFILE," data global exists but has no 0th node.",!?12,"Creating 0th node. Piece 3 and 4 must be set!"
|
||
|
|
S @XBCDY="CREATED BY XBCD"_U_XBCDFILE
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GCHK2 ; CHECK 3RD AND 4TH PIECE
|
||
|
|
S XBCDX=$P(@XBCDY,U,3,4),XBCDX1=$P(XBCDX,U,2),XBCDX=+XBCDX
|
||
|
|
S XBCDX2=$O(@XBCDY)
|
||
|
|
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
|
||
|
|
I XBCDX2,'XBCDX!('XBCDX1) W !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix." G GCHK3
|
||
|
|
I XBCDX,'$D(@(XBCDG_XBCDX_")")) W !?10,"Data global 0th node inconsistent with data. Run ^XBCOUNT to fix." G GCHK3
|
||
|
|
GCHK3 ; CHECK FILE NUMBER IN DATA GLOBAL
|
||
|
|
KILL XBCDX1,XBCDX2
|
||
|
|
Q:XBCDGNR=XBCDFILE
|
||
|
|
W !?10,"Data global has different number than ^DIC. ",$P(@XBCDY,U,1,2)
|
||
|
|
G2R1 ;
|
||
|
|
R !?12,"Change number in data global? (Y/N) ",XBCDX:$G(DTIME,999)
|
||
|
|
I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G G2R1
|
||
|
|
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
|
||
|
|
D READGBL
|
||
|
|
I XBCDG="" W !?10,"Removing ^DIC(",XBCDFILE,",""0"",""GL"") node." KILL ^DIC(XBCDFILE,0,"GL")
|
||
|
|
G GCHK
|
||
|
|
;
|
||
|
|
READGBL ;
|
||
|
|
R !!,"Enter Data Global or ""^"": ",XBCDG:$G(DTIME,999)
|
||
|
|
I XBCDG="^" S XBCDG="",^UTILITY("XBDSET",$J,XBCDFILE,"ERR",2)="File "_XBCDFILE_" data global missing or invalid." Q
|
||
|
|
I XBCDG'?1"^"1U.UN1"(".UNP,XBCDG'?1"^"1"%"1U.UN1"(".UNP W *7," ??" G READGBL
|
||
|
|
S ^DIC(XBCDFILE,0,"GL")=XBCDG
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DICB ; CHECK DIC("B"
|
||
|
|
KILL XBCDNTBL
|
||
|
|
S (XBCDX,XBCDC)=0
|
||
|
|
F XBCDL=0:0 S XBCDX=$O(^DIC("B",XBCDX)) Q:XBCDX="" I $D(^(XBCDX,XBCDFILE)) S XBCDC=XBCDC+1,XBCDNTBL(XBCDC)=XBCDX
|
||
|
|
Q:'XBCDC
|
||
|
|
I XBCDC=1 S XBCDANS=1 D NAMESET KILL XBCDNTBL Q
|
||
|
|
W !?12,"Multiple entries were found in ^DIC(""B""). Select one name or enter ""^""",!?12," All unselected names will be removed."
|
||
|
|
D PICKNAME
|
||
|
|
I XBCDANS'="^" D NAMESET KILL XBCDNTBL(XBCDANS) W !
|
||
|
|
S XBCDX=""
|
||
|
|
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)
|
||
|
|
W !
|
||
|
|
KILL XBCDNTBL
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PICKNAME ;
|
||
|
|
F XBCDX=1:1:XBCDC W !?14,XBCDNTBL(XBCDX)
|
||
|
|
P1 ;
|
||
|
|
R !!?14,"Which one: ",XBCDANS:$G(DTIME,999)
|
||
|
|
Q:XBCDANS="^"
|
||
|
|
S:XBCDANS="" XBCDANS="?"
|
||
|
|
I '$D(XBCDNTBL(XBCDANS)) W *7," ??" G P1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
NAMESET ;
|
||
|
|
W !?12,"Setting names to '",XBCDNTBL(XBCDANS),"'"
|
||
|
|
S (XBCDNDIC,XBCDNDD)=XBCDNTBL(XBCDANS),$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)=""
|
||
|
|
KILL ^DD(XBCDFILE,0,"NM")
|
||
|
|
S ^DD(XBCDFILE,0,"NM",XBCDNDD)=""
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GNMCHK ; CHECK DATA GLOBAL NAME AGAINST ^DIC
|
||
|
|
Q:'XBCDGG
|
||
|
|
I XBCDGNM]""!(XBCDGNR),XBCDNDIC'=XBCDGNM W !?10,"Data global name does not match ^DIC.",!?12,"Data global: ",XBCDGNM,!?12," ^DIC: ",XBCDNDIC D GNMFIX
|
||
|
|
S XBCDX=XBCDG_"0)"
|
||
|
|
I XBCDGNM="",XBCDGNR="",$D(@XBCDX)#2 S $P(@XBCDX,U,1)=XBCDNDIC
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GNMFIX ;
|
||
|
|
R !?12,"Change name in data global? (Y/N) ",XBCDX:$G(DTIME,999)
|
||
|
|
I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G GNMFIX
|
||
|
|
I XBCDX="Y" S XBCDX=XBCDG_"0)",$P(@XBCDX,U,1)=XBCDNDIC,XBCDGNM=XBCDNDIC Q
|
||
|
|
GNMR1 ;
|
||
|
|
R !?12,"Change names in ^DIC and ^DD to name in data global? (Y/N) ",XBCDX:$G(DTIME,999)
|
||
|
|
I XBCDX'="Y"&(XBCDX'="N") W *7," ??" G GNMR1
|
||
|
|
I XBCDX'="Y" S ^UTILITY("XBDSET",$J,XBCDFILE,"ERR",3)="File "_XBCDFILE_" data global name does not match ^DIC name." Q
|
||
|
|
KILL ^DIC("B",XBCDNDIC,XBCDFILE),^DD(XBCDFILE,0,"NM")
|
||
|
|
S (XBCDNDIC,XBCDNDD)=XBCDGNM,$P(^DIC(XBCDFILE,0),U,1)=XBCDNDIC,^DIC("B",XBCDNDIC,XBCDFILE)="",^DD(XBCDFILE,0,"NM",XBCDNDD)=""
|
||
|
|
Q
|
||
|
|
;
|