source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDDTV.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1LEXDDTV ; ISL Display Defaults - Vocabulary ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4SUB ; Select between Logical and Physical Subsets
5 ; Required LEXSUB Optional LEXDICS
6 N LEXTCTR,LEXTD,LEXTI,LEXTIC,LEXTL,LEXTN,LEXTSTR,LEXT,LEXTV
7 K LEX S:'$L($G(LEXSUB)) LEX="WRD"
8 S:$L($G(LEXSUB)) LEX=LEXSUB
9 S:'$D(LEXSTLN) LEXSTLN=56
10 S LEXTI=0,(LEXTIC,LEXTN,LEXTV,LEXTD)="" D INT
11 K:LEXSTLN=56 LEXSTLN Q
12INT ; Interpret string
13 ; LEXSUB is an Application Subset "AB"
14 I $D(^LEXT(757.2,"AB",LEX)) D
15 . S LEXTIC=$O(^LEXT(757.2,"AB",LEX,0))
16 . S LEXTN=$P($G(^LEXT(757.2,+LEXTIC,0)),"^",1)
17 . I +LEXTIC'=1 S LEXTN=LEXTN_" Subset"
18 ; LEXSUB is a Compiled Subset "AA"
19 I $D(^LEXT(757.2,"AA",LEX)) D
20 . S LEXTIC=$O(^LEXT(757.2,"AA",LEX,0))
21 . S LEXTN=$P($G(^LEXT(757.2,+LEXTIC,0)),"^",1)
22 . I +LEXTIC'=1 S LEXTN=LEXTN_" Subset"
23 ; View of a Subset - DIC("S") with LEXSUB
24 I $L($G(LEXDICS)) D
25 . S LEXTD=""
26 . F S LEXTD=$O(^LEXT(757.2,"AB",LEXTD)) Q:LEXTD=""!(LEXTV'="") D
27 . . S LEXTL=$O(^LEXT(757.2,"AB",LEXTD,0)) Q:+LEXTL'>0
28 . . I $G(^LEXT(757.2,+LEXTL,6))=LEXDICS D
29 . . . S LEXTV=$P($G(^LEXT(757.2,+LEXTL,0)),"^",1)
30 ; Build temporary phrase
31 I LEXTV'="",LEXTN'="" S LEX("V",1)=LEXTV_" view of the "_LEXTN
32 I LEXTV="",LEXTN'="" K LEX("V")
33 ; Process phrase
34 I $D(LEX("V",1)) D
35 . S LEX("V",0)=1,LEXT="V",LEXTCTR=0,LEXTSTR=""
36 . D CONCAT^LEXDDT2 K LEX("V")
37 . I $E(LEXTSTR,$L(LEXTSTR))?1P S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
38 . I $E(LEXTSTR,$L(LEXTSTR))?1P S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
39 . D EOC^LEXDDT2
40 Q
Note: See TracBrowser for help on using the repository browser.