| 1 | LEXILGP ; ISL Save/Restore Pointers ; 09-23-96
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
|
|---|
| 3 | Q
|
|---|
| 4 | SP ; Save "Pointed to by"
|
|---|
| 5 | 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)=""
|
|---|
| 6 | Q
|
|---|
| 7 | ST ; Set "Pointed to by"
|
|---|
| 8 | N LEXPT S LEXPT="" F S LEXPT=$O(^TMP("LEXPT",757.01,LEXPT)) Q:LEXPT="" S @LEXPT=""
|
|---|
| 9 | K ^TMP("LEXPT",757.01)
|
|---|
| 10 | Q
|
|---|
| 11 | PL ; Point to LEX
|
|---|
| 12 | D:'$D(^TMP("LEXPT",757.01)) SP D:$D(^TMP("LEXPT",757.01)) ST N LEXFI,LEXNAM,LEXQ,LEXC,LEXD S LEXFI=""
|
|---|
| 13 | F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|---|
| 14 | . I '$D(^DD(LEXFI)) K ^DD(757.01,0,"PT",LEXFI) Q
|
|---|
| 15 | . Q:$E(LEXFI,1,3)["757" S LEXNAM=$$NM(LEXFI),LEXQ="^DD("_LEXFI_")",LEXC="^DD("_LEXFI_","
|
|---|
| 16 | . W:$L($G(LEXNAM)) !,?4,LEXNAM F S LEXQ=$Q(@LEXQ) Q:LEXQ'[LEXC D
|
|---|
| 17 | . . S LEXD=@LEXQ Q:LEXD'["GMP(757.01"&(LEXD'["^GMP^")
|
|---|
| 18 | . . S:LEXD["GMP(757.01" LEXD=$$SW("GMP(757.01","LEX(757.01",LEXD)
|
|---|
| 19 | . . S:LEXD["^GMP^" LEXD=$$SW("^GMP^","^LEX^",LEXD) S @LEXQ=LEXD
|
|---|
| 20 | S LEXFI=0 F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|---|
| 21 | . Q:$E(LEXFI,1,3)="757" K:'$D(^DD(LEXFI)) ^DD(757.01,0,"PT",LEXFI)
|
|---|
| 22 | Q
|
|---|
| 23 | PG ; Point to GMP
|
|---|
| 24 | D:'$D(^TMP("LEXPT",757.01)) SP D:$D(^TMP("LEXPT",757.01)) ST N LEXFI,LEXNAM,LEXQ,LEXC,LEXD S LEXFI=""
|
|---|
| 25 | F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|---|
| 26 | . I '$D(^DD(LEXFI)) K ^DD(757.01,0,"PT",LEXFI) Q
|
|---|
| 27 | . Q:$E(LEXFI,1,3)["757" S LEXNAM=$$NM(LEXFI),LEXQ="^DD("_LEXFI_")",LEXC="^DD("_LEXFI_","
|
|---|
| 28 | . W:$L($G(LEXNAM)) !,?4,LEXNAM F S LEXQ=$Q(@LEXQ) Q:LEXQ'[LEXC D
|
|---|
| 29 | . . S LEXD=@LEXQ Q:LEXD'["LEX(757.01"&(LEXD'["^LEX^")
|
|---|
| 30 | . . S:LEXD["LEX(757.01" LEXD=$$SW("LEX(757.01","GMP(757.01",LEXD)
|
|---|
| 31 | . . S:LEXD["^LEX^" LEXD=$$SW("^LEX^","^GMP^",LEXD) S @LEXQ=LEXD
|
|---|
| 32 | S LEXFI=0 F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 D
|
|---|
| 33 | . Q:$E(LEXFI,1,3)="757" K:'$D(^DD(LEXFI)) ^DD(757.01,0,"PT",LEXFI)
|
|---|
| 34 | Q
|
|---|
| 35 | DP ; Delete pointers in temporary storage - ^TMP("LEXPT")
|
|---|
| 36 | K ^TMP("LEXPT",757.01) Q
|
|---|
| 37 | SW(LEXF,LEXT,LEXS) ;
|
|---|
| 38 | Q:'$L($G(LEXF)) "" Q:'$L($G(LEXT)) "" Q:'$L($G(LEXS)) ""
|
|---|
| 39 | F Q:LEXS'[LEXF S LEXS=$P(LEXS,LEXF,1)_LEXT_$P(LEXS,LEXF,2)
|
|---|
| 40 | Q LEXS
|
|---|
| 41 | NM(X) S X=+($G(X)) Q:X=0 "" Q:'$D(^DD(X,0,"NM")) "" Q $O(^DD(X,0,"NM",""))
|
|---|
| 42 | RT(X) ; Get RT
|
|---|
| 43 | S:'$D(U) U="^" S X=$C(68),X=U_X_X_$C(40) Q X
|
|---|
