| 1 | LEXLGM2 ; ISL Lexicon Survey (GBL/DEF/XT/OPT/RTN) ; 09-23-96 | 
|---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996 | 
|---|
| 3 | ; | 
|---|
| 4 | Q | 
|---|
| 5 | POST D OGBL,NGBL,UDEF,MTLU,OOPT,NOPT,SPLL,PLRTN | 
|---|
| 6 | Q | 
|---|
| 7 | OGBL ; 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 | 
|---|
| 16 | NGBL ; 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 | 
|---|
| 28 | UDEF ; 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 | ; | 
|---|
| 35 | MTLU ; 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 | ; | 
|---|
| 44 | OOPT ; 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 | ; | 
|---|
| 50 | NOPT ; 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 | ; | 
|---|
| 56 | SPLL ; 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 | ; | 
|---|
| 61 | PLRTN ; 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 | 
|---|
| 66 | CHKR(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 | 
|---|