source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDDSP.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1LEXDDSP ; ISL Display Defaults - Single User Parse ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996
3 ;
4 ;
5DISP ; Display single user defaults
6 S:$D(ZTQUEUED) ZTREQ="@"
7 G:+($G(LEXAP))=0 EXIT S LEXAP=+LEXAP G:'$L($G(^LEXT(757.2,LEXAP,0))) EXIT
8 G:$P($G(^LEXT(757.2,LEXAP,5)),U,3)'=1 EXIT K LEX
9 D NAME,VOC,DIS,FIL,CTX,DSPLY^LEXDDSD
10EXIT ; Cleanup/quit
11 K LEX,LEXV,LEXN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LEX,^TMP("LEXDIC",$J) Q
12 ;
13NAME ; Name
14 N LEXV,LEXN S LEXV=$P(^VA(200,DUZ,0),"^",1),LEXN=""
15 I LEXV["," S LEXN=$P(LEXV,",",2),LEXV=$P(LEXV,",",1)
16 S:LEXN'="" LEXN=$$MIXED(LEXN) S:LEXV'="" LEXV=$$MIXED(LEXV)
17 D NAME^LEXDDSS((LEXN_" "_LEXV)) Q
18 ;
19VOC ; Vocabulary
20 N LEXV,LEXN S LEXV=$G(^LEXT(757.2,LEXAP,200,DUZ,3)) S:LEXV="" LEXV="WRD"
21 S:$D(^LEXT(757.2,"AA",LEXV)) LEXN=$P(^LEXT(757.2,+($O(^LEXT(757.2,"AA",LEXV,0))),0),"^",1)
22 D VOC^LEXDDSS(LEXN)
23 Q
24 ;
25DIS ; Display Format
26 D LEXSHOW^LEXDDSD Q
27 ;
28FIL ; Filter
29 N LEXV D DICS($G(^LEXT(757.2,LEXAP,200,DUZ,1)))
30 K ^TMP("LEXDIC",$J) W:IOST["C-" @IOF S:$D(ZTQUEUED) ZTREQ="@"
31 Q
32 ;
33DICS(LEXV) ; Translate filter
34 Q:'$D(LEXV) N LEXS,LEXSHOW,LEXIN,LEXEX
35 I $G(LEXV)="" D FIL^LEXDDSS("No search filter defined") Q
36 S LEXS=LEXV D PARSE S:LEXV["SO^" LEXSHOW=LEXS
37 D FIL^LEXDDSS($G(^LEXT(757.2,LEXAP,200,DUZ,1.5)))
38 I $G(LEXS)=""!(LEXV="I 1") D
39 . N LEXDA S LEXDA=0
40 . F S LEXDA=$O(^LEX(757.11,LEXDA)) Q:+LEXDA=0 D
41 . . S LEXS=LEXS_"/"_$P(^LEX(757.11,LEXDA,0),U,1)
42 . S:$E(LEXS,1)="/" LEXS=$E(LEXS,2,$L(LEXS)) S LEXS=LEXS_";"
43 I LEXV["SC^"!(LEXV="I 1") D
44 . S:$L(LEXS,";")=3 LEXSHOW=$P(LEXS,";",3)
45 . D LB^LEXDDSS(" Look-up filter will: ")
46 . D INCEXC,DICS^LEXDDSD
47 I $G(LEXSHOW)'="" D
48 . I LEXV["SC^" D BLB^LEXDDSS(" Look-up filter will also include terms linked to:")
49 . I LEXV["SO^" D LB^LEXDDSS(" Look-up filter will include terms linked to: ")
50 . D CODES^LEXDDSD(LEXSHOW)
51 K ^TMP("LEXDIC",$J) Q
52PARSE ; Parse DIS("S") string into INCLUDE;EXCLUDE;LEXSHOW
53 S (LEXIN,LEXEX)="" S:LEXS["," LEXS=$P(LEXS,",",2)
54 S LEXS=$TR(LEXS,"()",""),LEXS=$TR(LEXS,"""","") Q
55INCEXC ; Include/Exclude Components
56 S LEXIN=$P(LEXS,";",1),LEXEX=$P(LEXS,";",2) K ^TMP("LEXDIC",$J)
57 I $D(LEXIN),LEXIN'="",LEXIN["/" D
58 . N LEXI F LEXI=1:1:$L(LEXIN,"/") D
59 . . I +($P(LEXIN,"/",LEXI))=0 D
60 . . . S ^TMP("LEXDIC",$J,"INC","CLASS",$P(LEXIN,"/",LEXI))=""
61 . . I +($P(LEXIN,"/",LEXI))'=0 D
62 . . . S ^TMP("LEXDIC",$J,"INC","TYPE",$P(LEXIN,"/",LEXI))=""
63 I $D(LEXIN),LEXIN'="",LEXIN'["/" D
64 . I +LEXIN=0 S ^TMP("LEXDIC",$J,"INC","CLASS",LEXIN)="" Q
65 . S ^TMP("LEXDIC",$J,"INC","TYPE",LEXIN)=""
66 I $D(LEXEX),LEXEX'="",LEXEX["/" D
67 . N LEXI F LEXI=1:1:$L(LEXEX,"/") D
68 . . I +($P(LEXEX,"/",LEXI))=0 D
69 . . . S ^TMP("LEXDIC",$J,"EXC","CLASS",$P(LEXEX,"/",LEXI))=""
70 . . I +($P(LEXEX,"/",LEXI))'=0 D
71 . . . S ^TMP("LEXDIC",$J,"EXC","TYPE",$P(LEXEX,"/",LEXI))=""
72 I $D(LEXEX),LEXEX'="",LEXEX'["/" D
73 . I +LEXEX=0 S ^TMP("LEXDIC",$J,"EXC","CLASS",LEXEX)="" Q
74 . S ^TMP("LEXDIC",$J,"EXC","TYPE",LEXEX)=""
75 S LEXN="" F S LEXN=$O(^LEX(757.11,"B",LEXN)) Q:LEXN="" D
76 . Q:LEXIN[LEXN N LEXTT,LEXTI S LEXTI=1,LEXT=0
77 . F S LEXT=$O(^LEX(757.12,"C",LEXN,LEXT)) Q:+LEXT=0!(+LEXTI=0) D
78 . . I LEXIN[LEXT S LEXTI=0
79 . I LEXTI S ^TMP("LEXDIC",$J,"EXC","CLASS",LEXN)=""
80 Q
81 ;
82CTX ; Shortcut Context
83 N LEXV S LEXV=$G(^LEXT(757.2,LEXAP,200,DUZ,4.5)) I LEXV="" D
84 . N LEXN S LEXN=+($G(^LEXT(757.2,LEXAP,200,DUZ,4.5)))
85 . Q:+LEXN'>0 Q:'$D(^LEX(757.41,+LEXN))
86 . S LEXV=$P(^LEX(757.41,+LEXN,0),U,1)
87 D CON^LEXDDSS(LEXV)
88 Q
89MIXED(LEXV) ; Convert UPPERCASE to Mixed case
90 S LEXV=$E(LEXV,1)_$$LOW^XLFSTR($E(LEXV,2,$L(LEXV)))
91 Q LEXV
Note: See TracBrowser for help on using the repository browser.