44 lines
2.1 KiB
Mathematica
44 lines
2.1 KiB
Mathematica
LEXILGP ; ISL Save/Restore Pointers ; 09-23-96
|
|
;;2.0;LEXICON UTILITY;;Sep 23, 1996
|
|
Q
|
|
SP ; Save "Pointed to by"
|
|
N LEXQ,LEXC S LEXQ="^DD(757.01,0,""PT"")",LEXC="^DD(757.01,0,""PT""," F S LEXQ=$Q(@LEXQ) Q:LEXQ'[LEXC S ^TMP("LEXPT",757.01,LEXQ)=""
|
|
Q
|
|
ST ; Set "Pointed to by"
|
|
N LEXPT S LEXPT="" F S LEXPT=$O(^TMP("LEXPT",757.01,LEXPT)) Q:LEXPT="" S @LEXPT=""
|
|
K ^TMP("LEXPT",757.01)
|
|
Q
|
|
PL ; Point to LEX
|
|
D:'$D(^TMP("LEXPT",757.01)) SP D:$D(^TMP("LEXPT",757.01)) ST N LEXFI,LEXNAM,LEXQ,LEXC,LEXD S LEXFI=""
|
|
F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|
. I '$D(^DD(LEXFI)) K ^DD(757.01,0,"PT",LEXFI) Q
|
|
. Q:$E(LEXFI,1,3)["757" S LEXNAM=$$NM(LEXFI),LEXQ="^DD("_LEXFI_")",LEXC="^DD("_LEXFI_","
|
|
. W:$L($G(LEXNAM)) !,?4,LEXNAM F S LEXQ=$Q(@LEXQ) Q:LEXQ'[LEXC D
|
|
. . S LEXD=@LEXQ Q:LEXD'["GMP(757.01"&(LEXD'["^GMP^")
|
|
. . S:LEXD["GMP(757.01" LEXD=$$SW("GMP(757.01","LEX(757.01",LEXD)
|
|
. . S:LEXD["^GMP^" LEXD=$$SW("^GMP^","^LEX^",LEXD) S @LEXQ=LEXD
|
|
S LEXFI=0 F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|
. Q:$E(LEXFI,1,3)="757" K:'$D(^DD(LEXFI)) ^DD(757.01,0,"PT",LEXFI)
|
|
Q
|
|
PG ; Point to GMP
|
|
D:'$D(^TMP("LEXPT",757.01)) SP D:$D(^TMP("LEXPT",757.01)) ST N LEXFI,LEXNAM,LEXQ,LEXC,LEXD S LEXFI=""
|
|
F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|
. I '$D(^DD(LEXFI)) K ^DD(757.01,0,"PT",LEXFI) Q
|
|
. Q:$E(LEXFI,1,3)["757" S LEXNAM=$$NM(LEXFI),LEXQ="^DD("_LEXFI_")",LEXC="^DD("_LEXFI_","
|
|
. W:$L($G(LEXNAM)) !,?4,LEXNAM F S LEXQ=$Q(@LEXQ) Q:LEXQ'[LEXC D
|
|
. . S LEXD=@LEXQ Q:LEXD'["LEX(757.01"&(LEXD'["^LEX^")
|
|
. . S:LEXD["LEX(757.01" LEXD=$$SW("LEX(757.01","GMP(757.01",LEXD)
|
|
. . S:LEXD["^LEX^" LEXD=$$SW("^LEX^","^GMP^",LEXD) S @LEXQ=LEXD
|
|
S LEXFI=0 F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|
. Q:$E(LEXFI,1,3)="757" K:'$D(^DD(LEXFI)) ^DD(757.01,0,"PT",LEXFI)
|
|
Q
|
|
DP ; Delete pointers in temporary storage - ^TMP("LEXPT")
|
|
K ^TMP("LEXPT",757.01) Q
|
|
SW(LEXF,LEXT,LEXS) ;
|
|
Q:'$L($G(LEXF)) "" Q:'$L($G(LEXT)) "" Q:'$L($G(LEXS)) ""
|
|
F Q:LEXS'[LEXF S LEXS=$P(LEXS,LEXF,1)_LEXT_$P(LEXS,LEXF,2)
|
|
Q LEXS
|
|
NM(X) S X=+($G(X)) Q:X=0 "" Q:'$D(^DD(X,0,"NM")) "" Q $O(^DD(X,0,"NM",""))
|
|
RT(X) ; Get RT
|
|
S:'$D(U) U="^" S X=$C(68),X=U_X_X_$C(40) Q X
|