source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXSET3.m@ 1351

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1LEXSET3 ; ISL Overwrite/Merge Appl/User Defaults ; 10-15-97
2 ;;2.0;LEXICON UTILITY;**6**;Sep 23, 1996;Build 1
3 ;
4OVER ;
5 N LEXT
6 S:LEXM=0&(LEXL=LEXS) LEXT="AP"
7 S:LEXM=0&(LEXL'=LEXS) LEXT="SS"
8 I LEXM>0 S:LEXM>0 LEXT="SS"
9 I $L($G(LEXD("AP","DEF"))),+($G(LEXD("AP","DEF")))=0 S LEXT="AP"
10 S:$L($G(LEXD(LEXT,"DIS"))) LEXD("DF","DIS")=LEXD(LEXT,"DIS")
11 S:$L($G(LEXD(LEXT,"DSP"))) LEXD("DF","DSP")=LEXD(LEXT,"DSP")
12 S:$L($G(LEXD(LEXT,"FIL"))) LEXD("DF","FIL")=LEXD(LEXT,"FIL")
13 S:$L($G(LEXD(LEXT,"GBL"))) LEXD("DF","GBL")=LEXD(LEXT,"GBL")
14 S:$L($G(LEXD(LEXT,"HLP"))) LEXD("DF","HLP")=LEXD(LEXT,"HLP")
15 S:$L($G(LEXD(LEXT,"IDX"))) LEXD("DF","IDX")=LEXD(LEXT,"IDX")
16 ; Modifiers PCH 6
17 S:$L($G(LEXD(LEXT,"MOD"))) LEXD("DF","MOD")=LEXD(LEXT,"MOD")
18 S:'$D(LEXD(LEXT,"IDX")) LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
19 I '$D(LEXD(LEXT,"GBL")) D
20 . I $D(^LEX(757.01,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.01," Q
21 . I $D(^LEX(757.21,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.21," Q
22 . S LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
23 S:$L($G(LEXD(LEXT,"NAM"))) LEXD("DF","NAM")=LEXD(LEXT,"NAM")
24 S LEXD("DF","SUB")=$E($G(LEXD(LEXT,"IDX")),2,$L($G(LEXD(LEXT,"IDX"))))
25 S LEXD("DF","FLN")=$P($P($G(LEXD(LEXT,"GBL")),"(",2),",",1)
26 I 'LEXD("DF","FLN") D
27 . S LEXD("DF","FLN")=757.01,LEXD("DF","GBL")="^LEX(757.01,"
28 . S LEXD("DF","IDX")="AWRD",LEXD("DF","SUB")="WRD"
29 S:$L($G(LEXD(LEXT,"SCT"))) LEXD("DF","SCT")=LEXD(LEXT,"SCT")
30 Q
31USER ;
32 N LEXT
33 S:LEXM=0&(LEXL=LEXS) LEXT="AP"
34 S:LEXM=0&(LEXL'=LEXS) LEXT="SS"
35 S:LEXM>0&(LEXM=LEXA) LEXT="AP"
36 S:LEXM>0&(LEXM'=LEXA) LEXT="SS"
37 S:$L($G(LEXD(LEXT,"DIS"))) LEXD("DF","DIS")=LEXD(LEXT,"DIS")
38 S:$L($G(LEXD(LEXT,"DSP"))) LEXD("DF","DSP")=LEXD(LEXT,"DSP")
39 S:$L($G(LEXD(LEXT,"FIL"))) LEXD("DF","FIL")=LEXD(LEXT,"FIL")
40 S:$L($G(LEXD(LEXT,"GBL"))) LEXD("DF","GBL")=LEXD(LEXT,"GBL")
41 S:$L($G(LEXD(LEXT,"HLP"))) LEXD("DF","HLP")=LEXD(LEXT,"HLP")
42 S:$L($G(LEXD(LEXT,"IDX"))) LEXD("DF","IDX")=LEXD(LEXT,"IDX")
43 ; Modifiers PCH 6
44 S:$L($G(LEXD(LEXT,"MOD"))) LEXD("DF","MOD")=LEXD(LEXT,"MOD")
45 S:'$D(LEXD(LEXT,"IDX")) LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
46 I '$D(LEXD(LEXT,"GBL")) D
47 . I $D(^LEX(757.01,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.01," Q
48 . I $D(^LEX(757.21,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.21," Q
49 . S LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
50 S:$L($G(LEXD(LEXT,"NAM"))) LEXD("DF","NAM")=LEXD(LEXT,"NAM")
51 S LEXD("DF","SUB")=$E($G(LEXD(LEXT,"IDX")),2,$L($G(LEXD(LEXT,"IDX"))))
52 S LEXD("DF","FLN")=$P($P($G(LEXD(LEXT,"GBL")),"(",2),",",1)
53 I LEXD("DF","FLN")="" D
54 . S LEXD("DF","FLN")=757.01,LEXD("DF","GBL")="^LEX(757.01,"
55 . S LEXD("DF","IDX")="AWRD",LEXD("DF","SUB")="WRD"
56 S:$L($G(LEXD("UD","DIS"))) LEXD("DF","DIS")=LEXD("UD","DIS")
57 S:$L($G(LEXD("UD","SCT"))) LEXD("DF","SCT")=LEXD("UD","SCT")
58 I LEXT="AP" D
59 . S:$L($G(LEXD("UD","FIL"))) LEXD("DF","FIL")=LEXD("UD","FIL")
60 . S:$L($G(LEXD("UD","DSP"))) LEXD("DF","DSP")=LEXD("UD","DSP")
61 . S:$L($G(LEXD("UD","HLP"))) LEXD("DF","HLP")=LEXD("UD","HLP")
62 . S:$L($G(LEXD("UD","IDX"))) LEXD("DF","IDX")=LEXD("UD","IDX")
63 . S:$L($G(LEXD("UD","SUB"))) LEXD("DF","SUB")=LEXD("UD","SUB")
64 I $L($G(LEXD("DF","IDX"))),$D(^LEX(757.01,LEXD("DF","IDX"))) S LEXD("DF","GBL")="^LEX(757.01,",LEXD("DF","FLN")="757.01"
65 I $L($G(LEXD("DF","IDX"))),$D(^LEX(757.21,LEXD("DF","IDX"))) S LEXD("DF","GBL")="^LEX(757.21,",LEXD("DF","FLN")="757.21"
66 Q
Note: See TracBrowser for help on using the repository browser.