source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXLGM2.m@ 1005

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1LEXLGM2 ; ISL Lexicon Survey (GBL/DEF/XT/OPT/RTN) ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 Q
5POST D OGBL,NGBL,UDEF,MTLU,OOPT,NOPT,SPLL,PLRTN
6 Q
7OGBL ; Old Globals
8 N LEXS S LEXS=""
9 S:$D(^GMP(757.01,0)) LEXS=" ^GMP Global not Deleted"
10 I $D(^GMPT(757.2,0)),LEXS="" D Q
11 . S LEXS=" ^GMPT Global not Deleted" D:$L($G(LEXS)) SET^LEXLGM($G(LEXS))
12 I $D(^GMPT(757.2,0)),LEXS'="" D Q
13 . S LEXS=" ^GMP and ^GMPT not Deleted" D:$L($G(LEXS)) SET^LEXLGM($G(LEXS))
14 I LEXS="" S LEXS=" Old Globals were Deleted"
15 D:$L($G(LEXS)) SET^LEXLGM($G(LEXS)) Q
16NGBL ; New Globals
17 N LEXS S LEXS=""
18 I $D(^LEX),$D(^LEXT) D Q
19 . S LEXS=" New Globals are Installed" D SET2^LEXLGM($G(LEXS))
20 I $D(^LEX),'$D(^LEXT) D Q
21 . S LEXS=" Only ^LEX was Installed" D SET2^LEXLGM($G(LEXS))
22 I '$D(^LEX),$D(^LEXT) D Q
23 . S LEXS=" Only ^LEXT was Installed" D SET2^LEXLGM($G(LEXS))
24 I '$D(^LEX),'$D(^LEXT) D Q
25 . S LEXS=" New Globals were not Installed" D SET2^LEXLGM($G(LEXS))
26 D:$L($G(LEXS)) SET2^LEXLGM($G(LEXS)) Q
27 Q
28UDEF ; User Defaults
29 N LEXS S LEXS=""
30 I $D(^LEXT(757.2,1,200))!($D(^LEXT(757.2,4,200))) D
31 . S LEXS=" User Defaults Transferred" D SET^LEXLGM(LEXS)
32 I LEXS="" S LEXS=" User Defaults not found" D SET^LEXLGM(LEXS)
33 Q
34 ;
35MTLU ; Multi-Term Lookup Utility
36 N LEXS S LEXS=""
37 I $D(^XT(8984.4)),'$D(^XT(8984.4,757.01)) D Q
38 . S LEXS=" Lexicon removed from MTLU" D SET2^LEXLGM(LEXS)
39 I $D(^XT(8984.4)),$D(^XT(8984.4,757.01)) D Q
40 . S LEXS=" Lexicon was not removed from MTLU" D SET2^LEXLGM(LEXS)
41 S LEXS=" Status of MTLU Unknown" D SET2^LEXLGM(LEXS)
42 Q
43 ;
44OOPT ; Old Options
45 N LEXS S LEXS=""
46 I $O(^DIC(19,"B","GMPT "))["GMPT " S LEXS=" Old Options were not Deleted" D:$L(LEXS) SET^LEXLGM(LEXS) Q
47 I $O(^DIC(19,"B","GMPT "))'["GMPT " S LEXS=" Old Options were Deleted"
48 D:$L(LEXS) SET^LEXLGM(LEXS) Q
49 ;
50NOPT ; New Options
51 N LEXS S LEXS=""
52 I $O(^DIC(19,"B","LEX "))["LEX " S LEXS=" New Options are Installed" D:$L(LEXS) SET2^LEXLGM(LEXS) Q
53 I $O(^DIC(19,"B","LEX "))'["LEX " S LEXS=" New Options are not Installed"
54 D:$L(LEXS) SET2^LEXLGM(LEXS) Q
55 ;
56SPLL ; Special Lookup
57 N LEXS S LEXS="" S LEXS=$G(^DD(757.01,0,"DIC"))
58 S:LEXS'="" LEXS=" Special Lookup is "_LEXS
59 D:$L(LEXS) SET^LEXLGM(LEXS) Q
60 ;
61PLRTN ; Problem List Routines
62 N LEXS,LEXCHK,LEXSTAT S LEXSTAT=""
63 F LEXCHK="GMPLBLDC^LEX(757.01","GMPLENFM^LEX(757.01","GMPLHIST^LEX(757.01","GMPLUTL1^LEX(757.01","GMPLX^LEX(757.01" S LEXSTAT=LEXSTAT_$$CHKR(LEXCHK)
64 S LEXS=$S(LEXSTAT="11111":" Problem List calls ^LEX ",1:" Problem List calls ^GMP ")
65 D SET2^LEXLGM(LEXS) S:LEXSTAT'="11111" LEXQ=1 Q
66CHKR(LEXCHK) ; Check routines for LEX
67 N LEXRTN,LEXS,LEXI,LEXOK
68 S LEXRTN=$P(LEXCHK,"^",1),LEXS=$P(LEXCHK,"^",2),LEXOK=0
69 F LEXI=1:1 Q:'$L($T(+LEXI^@LEXRTN)) I $T(+LEXI^@LEXRTN)[LEXS S LEXOK=1
70 S LEXCHK=LEXOK Q LEXCHK
Note: See TracBrowser for help on using the repository browser.