source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDDTF.m@ 623

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1LEXDDTF ; ISL Display Defaults - Filter ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4SC ; Filter by Semantic Classifications
5 ; Required LEXDICS in the format I $$SC^LEXU...
6 N LEXTC,LEXTCTR,LEXTI,LEXTIC,LEXTIE,LEXTSTR
7 Q:'$L($G(LEXDICS)) Q:LEXDICS'["$$SC^LEXU"
8 S LEX=$TR($P($P(LEXDICS,"Y,",2),")",1),"""","")
9 S LEXTCTR=0,LEX("I")=$P(LEX,";",1)
10 S LEX("E")=$P(LEX,";",2),LEX("L")=$P(LEX,";",3)
11 S LEX("I","H")="Include expressions which relate to",LEXTCTR=0
12 N LEXTIC,LEXTIE,LEXTI F LEXTI=1:1:$L(LEX("I"),"/") D
13 . S LEXTIC=$P(LEX("I"),"/",LEXTI) Q:LEXTIC="UNK"
14 . S LEXTCTR=LEXTCTR+1,LEX("I",LEXTCTR)=$$SN(LEXTIC)
15 S LEX("I",0)=LEXTCTR
16 S LEX("E","H")="Exclude expressions which relate to",LEXTCTR=0
17 F LEXTI=1:1:$L(LEX("E"),"/") D
18 . S LEXTIC=$P(LEX("E"),"/",LEXTI) Q:LEXTIC="UNK"
19 . S LEXTCTR=LEXTCTR+1,LEX("E",LEXTCTR)=$$SN(LEXTIC)
20 S LEX("E",0)=LEXTCTR
21 S LEX("L","H")="Also include expressions which are linked to"
22 S LEX("L","T")="coding system",LEXTCTR=0
23 F LEXTI=1:1:$L(LEX("L"),"/") D
24 . S LEXTIC=$P(LEX("L"),"/",LEXTI) Q:LEXTIC="UND" S LEXTCTR=LEXTCTR+1,LEX("L",LEXTCTR)=$$CN(LEXTIC)
25 S:LEXTCTR>1 LEX("L","T")=LEX("L","T")_"s"
26 S LEX("L","T")=LEX("L","T")_"."
27 S LEX("L",0)=LEXTCTR
28 S:'$D(LEXSTLN) LEXSTLN=56 K LEX("T") S LEXTCTR=0 N LEXT,LEXTSTR
29 D:$G(LEX("I",0)) INC
30 D:$G(LEX("E",0)) EXC
31 D:$G(LEX("L",0)) LNK
32 D EOC^LEXDDT2
33 Q
34SO ; Filter by Sources
35 ; Required LEXDICS in the format I $$SO^LEXU...
36 N LEXTC,LEXTCTR,LEXTI,LEXTIC,LEXTIE,LEXTSTR
37 Q:'$L($G(LEXDICS)) Q:LEXDICS'["$$SO^LEXU"
38 S LEX=$TR($P($P(LEXDICS,"Y,",2),")",1),"""","")
39 S LEXTCTR=0,LEX("L")=LEX
40 S LEX("L","H")="Include expressions which are linked to"
41 S LEX("L","T")="coding system",LEXTCTR=0
42 F LEXTI=1:1:$L(LEX("L"),"/") D
43 . S LEXTIC=$P(LEX("L"),"/",LEXTI) Q:LEXTIC="UND" S LEXTCTR=LEXTCTR+1,LEX("L",LEXTCTR)=$$CN(LEXTIC)
44 S:LEXTCTR>1 LEX("L","T")=LEX("L","T")_"s"
45 S LEX("L","T")=LEX("L","T")_"."
46 S LEX("L",0)=LEXTCTR
47 S:'$D(LEXSTLN) LEXSTLN=56 K LEX("T") S LEXTCTR=0 N LEXT,LEXTSTR
48 S LEXTSTR="" D:$G(LEX("L",0)) LNK
49 D EOC^LEXDDT2
50 Q
51INC ; Inclusion Data Elements
52 S LEXTSTR="",LEXT="I",LEXTCTR=0 D CONCAT^LEXDDT2 K LEX("I")
53 Q
54EXC ; Exclusion Data Elements
55 S LEXT="E",LEXTCTR=+($G(LEX(0)))
56 I $D(LEXTSTR) D
57 . S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
58 . I $L(LEXTSTR)'>(LEXSTLN+2) S LEXTSTR=LEXTSTR_" " Q
59 . D SET^LEXDDT2
60 . S LEXTSTR=""
61 D CONCAT^LEXDDT2 K LEX("E")
62 Q
63LNK ; Linked Sources Data Elements
64 S LEXT="L",LEXTCTR=+($G(LEX(0)))
65 I $D(LEXTSTR) D
66 . S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
67 . I $L(LEXTSTR)'>(LEXSTLN+2) S LEXTSTR=LEXTSTR_" " Q
68 . D SET^LEXDDT2
69 . S LEXTSTR=""
70 D CONCAT^LEXDDT2 K LEX("L")
71 Q
72SN(LEXSTR) ; Get Semantic Data Element Name
73 N LEXTEMP S LEXTEMP=LEXSTR I LEXTEMP?3U D
74 . S LEXSTR=$O(^LEX(757.11,"B",LEXTEMP,0)) S:+LEXSTR=0 LEXSTR=""
75 . S:+LEXSTR>0 LEXSTR=$P($G(^LEX(757.11,+LEXSTR,0)),"^",2)
76 I LEXTEMP?1N.N D
77 . S LEXSTR=+LEXTEMP
78 . S LEXSTR=$S($D(^LEX(757.12,LEXSTR,0)):$P($G(^LEX(757.12,LEXSTR,0)),"^",2),1:"")
79 Q LEXSTR
80CN(LEXSTR) ; Get Classification System Data Element Name
81 N LEXTEMP,LEXTC S LEXTC=LEXSTR,LEXTEMP=$E(LEXSTR,1,2)_$C($A($E(LEXSTR,3))-1)_"~"
82 S LEXSTR=""
83 F S LEXTEMP=$O(^LEX(757.03,"B",LEXTEMP)) Q:LEXTEMP=""!(LEXSTR'="") D Q:LEXTEMP=""!(LEXSTR'="")
84 . I LEXTEMP[LEXTC S LEXSTR=$O(^LEX(757.03,"B",LEXTEMP,0))
85 S LEXSTR=+LEXSTR S:LEXSTR=0 LEXSTR=""
86 I +LEXSTR>0,$D(^LEX(757.03,+LEXSTR)) S LEXSTR=$P($G(^LEX(757.03,+LEXSTR,0)),"^",2)
87 Q LEXSTR
Note: See TracBrowser for help on using the repository browser.