source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXILGP.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1LEXILGP ; ISL Save/Restore Pointers ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 Q
4SP ; 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
7ST ; 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
11PL ; 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
23PG ; 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
35DP ; Delete pointers in temporary storage - ^TMP("LEXPT")
36 K ^TMP("LEXPT",757.01) Q
37SW(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
41NM(X) S X=+($G(X)) Q:X=0 "" Q:'$D(^DD(X,0,"NM")) "" Q $O(^DD(X,0,"NM",""))
42RT(X) ; Get RT
43 S:'$D(U) U="^" S X=$C(68),X=U_X_X_$C(40) Q X
Note: See TracBrowser for help on using the repository browser.