source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXSET.m@ 1736

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1LEXSET ; ISL/KER Setup Appl/User Defaults for Look-up ; 05/14/2003
2 ;;2.0;LEXICON UTILITY;**25**;Sep 23, 1996;Build 1
3 ;
4 ; External References
5 ; DBIA 10103 $$DT^XLFDT
6 ; DBIA 10103 $$FMTE^XLFDT
7 ;
8EN ; Namespace/subset are not known
9 N DTOUT,DUOUT,LEXNS,LEXSS,LEXDS,LEXDW,LEXDR,LEXDP,LEXDA,LEXDB,LEXD0,LEXD,LEXDX
10 S LEXNS=$$NS^LEXSET4 Q:LEXNS[U!($D(DTOUT))!($D(DUOUT))
11 S LEXSS=$$SS^LEXSET4(LEXNS) Q:LEXSS[U!($D(DTOUT))!($D(DUOUT))
12 D CONFIG(LEXNS,LEXSS)
13 Q
14CONFIG(LEXNS,LEXSS,LEXVDT) ; Namespace/subset are known
15 K LEXD,LEXSUB,LEXAP,LEXSHOW,LEXSCT,LEXUN
16 S LEXVDT=$S(+($G(LEXVDT))>0:+($G(LEXVDT)),1:$$DT^XLFDT)
17 N LEXA,LEXL,LEXS,LEXM,LEXD S LEXNS=$G(LEXNS),LEXSS=$G(LEXSS)
18 S LEXQ=$S($D(LEXQ):+LEXQ,1:1) S:LEXNS="" LEXNS="LEX" S:LEXSS="" LEXSS="WRD"
19 S:'$D(^LEXT(757.2,"AN",LEXNS)) LEXNS=$$NS^LEXDFN2(LEXNS)
20 S:'$D(^LEXT(757.2,"AA",LEXSS))&('$D(^LEXT(757.2,"AB",LEXSS))) LEXSS=$$MD^LEXDFN2(LEXSS)
21 N LEXUS,LEXO,LEXT
22 S LEXA=$$NSIEN(LEXNS),LEXS=$$SSIEN(LEXSS)
23 S LEXM=$$MDIEN(LEXSS),LEXL=$$ASIEN(LEXA)
24 I +LEXA=0!(+LEXS=0) D DEF G SET
25 D APP^LEXSET2(LEXA)
26 I LEXM=0!(LEXM>0&(LEXM=LEXA)) D SUB^LEXSET2(LEXS)
27 I LEXM>0,LEXM'=LEXA D MOD^LEXSET2(LEXM)
28 D USR^LEXSET2(LEXA)
29 D GEN^LEXSET2
30 I +($G(LEXD("DF","OVR")))>0 D OVER^LEXSET3
31 I +($G(LEXD("DF","OVR")))=0 D USER^LEXSET3
32 S ^TMP("LEXSCH",$J,"VDT",0)=+($G(LEXVDT))
33 S ^TMP("LEXSCH",$J,"VDT",1)="Version Date Check"_$S(+($G(LEXVDT))>0:(": "_$$FMTE^XLFDT(+($G(LEXVDT)))),1:"")
34 D EN^LEXSET5 S:+($G(LEXQ))=1 ^TMP("LEXSCH",$J,"ADF",0)=1
35SET ; Quit Setting Defaults
36 Q
37DEF ; Defaults if LEXNS or LEXSS are invalid
38 S LEXD("DF","DIS")="ICD/CPT",LEXD("DF","DSP")="XTLK^LEXPRNT"
39 S LEXD("DF","FLN")=757.01,LEXD("DF","GBL")="^LEX(757.01,"
40 S LEXD("DF","LEXAP")=1,LEXD("DF","UNR")=0
41 S LEXD("DF","HLP")="D XTLK^LEXHLP",LEXD("DF","IDX")="AWRD"
42 S LEXD("DF","NAM")="Lexicon",LEXD("DF","OVR")=0
43 S LEXD("DF","SUB")="WRD"
44 Q
45ALTDEF ; Defaults if LEXNS or LEXSS are invalid
46 S (DIC,XTLKGBL,XTLKKSCH("GBL"))="^LEX(757.01,"
47 S XTLKKSCH("DSPLY")="XTLK^LEXPRNT",XTLKKSCH("INDEX")="AWRD",XTLKHLP="D XTLK^LEXHLP"
48 S XTLKSAY=1 S:'$L($G(DIC(0))) DIC(0)="EQM" S:'$L($G(X))&(DIC(0)'["A") DIC(0)="A"_DIC(0)
49 S:DIC(0)["L" DIC(0)=$P(DIC(0),"L",1)_$P(DIC(0),"L",2) S:DIC(0)["I" DIC(0)=$P(DIC(0),"I",1)_$P(DIC(0),"L",2)
50 S LEXAP=1,LEXLL=5,LEXUN=0,LEXSUB="WRD",LEXSHOW="ICD/CPT"
51 Q
52NSIEN(LEX) ; Get IEN for application based on namespace
53 Q:'$L($G(LEX)) 0 Q:$D(^LEXT(757.2,"AN",LEX)) $O(^LEXT(757.2,"AN",LEX,0)) Q 0
54SSIEN(LEX) ; Get IEN for subset based on subset
55 Q:'$L($G(LEX)) 0
56 Q:$D(^LEXT(757.2,"AA",LEX)) $O(^LEXT(757.2,"AA",LEX,0))
57 S:$D(^LEXT(757.2,"AB",LEX)) LEX=$O(^LEXT(757.2,"AB",LEX,0))
58 I +LEX>0,$D(^LEXT(757.2,LEX,5)) S LEX=$P(^LEXT(757.2,LEX,5),"^",2)
59 I LEX'="",$D(^LEXT(757.2,"AA",LEX)) Q $O(^LEXT(757.2,"AA",LEX,0))
60 Q 0
61MDIEN(LEX) ; Get IEN for mode based on subset
62 Q:'$L($G(LEX)) 0
63 I $D(^LEXT(757.2,"AB",LEX)) S LEX=$O(^LEXT(757.2,"AB",LEX,0)) S LEX=+LEX Q LEX
64 Q 0
65ASIEN(LEX) ; Get IEN for application
66 Q:+($G(LEX))=0 0
67 S LEX=+LEX Q:'$L($P($G(^LEXT(757.2,LEX,5)),"^",2))&('$L($P($G(^LEXT(757.2,LEX,0)),"^",2))) 0
68 S:$L($P($G(^LEXT(757.2,LEX,5)),"^",2)) LEX=$P($G(^LEXT(757.2,LEX,5)),"^",2)
69 S:$L($P($G(^LEXT(757.2,LEX,0)),"^",2)) LEX=$P($G(^LEXT(757.2,LEX,0)),"^",2)
70 Q:$D(^LEXT(757.2,"AA",LEX)) $O(^LEXT(757.2,"AA",LEX,0))
71 Q 0
Note: See TracBrowser for help on using the repository browser.