source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXILGU.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1LEXILGU ; ISL Save/Restore User Defaults ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 Q
4SD ; Save User Defaults from ^GMPT
5 Q:'$D(^GMPT(757.2))
6 K ^TMP("LEXDEF",757.01) N LEXDA,LEXN,LEXD,LEXTMP,LEXC,LEXQ
7 S (LEXTMP,LEXDA)=0 F S LEXDA=$O(^GMPT(757.2,LEXDA)) Q:+LEXDA=0 D
8 . Q:'$D(^GMPT(757.2,LEXDA,200)) S LEXQ="^GMPT(757.2,"_LEXDA_",200)",LEXC="^GMPT(757.2,"_LEXDA_",200"
9 . F S LEXQ=$Q(@LEXQ) Q:LEXQ'[LEXC D
10 . . S LEXTMP=LEXTMP+1
11 . . S LEXN=LEXQ,LEXD=@LEXQ
12 . . S LEXN=$$SW("^GMPT(","^LEXT(",LEXN),LEXN=$$SW("GMP","LEX",LEXN)
13 . . S LEXD=$$SW("^GMPTU","^LEXU",LEXD),LEXD=$$SW("^GMPT","^LEXT",LEXD),LEXD=$$SW("GMP","LEX",LEXD)
14 . . S ^TMP("LEXDEF",757.01,LEXTMP,0)=LEXN,^TMP("LEXDEF",757.01,LEXTMP,1)=LEXD
15 S LEXQ="^GMPT(757.2,""AUD"")",LEXC="^GMPT(757.2,""AUD"""
16 F S LEXQ=$Q(@LEXQ) Q:LEXQ'[LEXC D
17 . S LEXTMP=LEXTMP+1
18 . S LEXN=LEXQ,LEXD=@LEXQ
19 . S LEXN=$$SW("^GMPT(","^LEXT(",LEXN),LEXN=$$SW("GMP","LEX",LEXN)
20 . S LEXD=$$SW("^GMPTU","^LEXU",LEXD),LEXD=$$SW("^GMPT","^LEXT",LEXD),LEXD=$$SW("GMP","LEX",LEXD)
21 . S ^TMP("LEXDEF",757.01,LEXTMP,0)=LEXN,^TMP("LEXDEF",757.01,LEXTMP,1)=LEXD
22 Q
23RD ; Restore User Defaults into ^LEXT
24 Q:'$D(^TMP("LEXDEF",757.01)) N LEXN,LEXD,LEXC S LEXC=0
25 F S LEXC=$O(^TMP("LEXDEF",757.01,LEXC)) Q:+LEXC=0 D
26 . S LEXN=$G(^TMP("LEXDEF",757.01,LEXC,0)) Q:LEXN=""
27 . S LEXD=$G(^TMP("LEXDEF",757.01,LEXC,1)),@LEXN=LEXD
28 Q
29DF ; Delete user defaults in temporary storage - ^TMP("LEXDEF")
30 K ^TMP("LEXDEF",757.01) Q
31RI ; Re-index ^LEXT
32 Q:$D(^TMP("LEXIDX","STOP")) N DA S DA=999999999 Q:+($O(^LEXT(757.2,DA)))'=0
33 F S DA=$O(^LEXT(757.2,DA)) Q:DA=""!($D(^TMP("LEXIDX","STOP"))) K ^LEXT(757.2,DA)
34 N DA,LEXP3,LEXP4 S (LEXP3,LEXP4,DA)=0 F S DA=$O(^LEXT(757.2,DA)) Q:+DA=0!($D(^TMP("LEXIDX","STOP"))) S LEXP3=DA,LEXP4=LEXP4+1,(DIK,DIC)="^LEXT(757.2," D IX1^DIK
35 I LEXP3>0,LEXP4>0,$D(^LEXT(757.2,0)) S $P(^LEXT(757.2,0),"^",3)=LEXP3,$P(^LEXT(757.2,0),"^",4)=LEXP4
36 Q
37SW(LEXF,LEXT,LEXS) ; Switch "GMPT" with "LEX"
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
Note: See TracBrowser for help on using the repository browser.