| 1 | LEXDM2 ; ISL Default Misc - Ask to delete ; 09-23-96
|
|---|
| 2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; Entry: S X=$$EN^LEXDM2(USER,AP,DEF)
|
|---|
| 5 | ;
|
|---|
| 6 | ; Input
|
|---|
| 7 | ; USER DUZ
|
|---|
| 8 | ; AP Application
|
|---|
| 9 | ; DEF Default (1 thru 4)
|
|---|
| 10 | ;
|
|---|
| 11 | ; Returns
|
|---|
| 12 | ; 0 Do not Delete default
|
|---|
| 13 | ; 1 Delete default
|
|---|
| 14 | ;
|
|---|
| 15 | EN(LEXUSER,LEXAP,LEXDEF) ;
|
|---|
| 16 | ; A few good reasons to quit
|
|---|
| 17 | Q:+($G(LEXUSER))=0 0 Q:'$D(^VA(200,+($G(LEXUSER)))) 0
|
|---|
| 18 | Q:+($G(LEXAP))=0 0 Q:'$D(^LEXT(757.2,+($G(LEXAP)))) 0
|
|---|
| 19 | Q:+($P($G(^LEXT(757.2,+LEXAP,5)),"^",3))'>0 0
|
|---|
| 20 | Q:+($G(LEXDEF))<1!(+($G(LEXDEF))>4) 0
|
|---|
| 21 | ; Check for default
|
|---|
| 22 | N LEXOV,LEXN S LEXN=""
|
|---|
| 23 | S LEXOV=$G(^LEXT(757.2,LEXAP,200,LEXUSER,LEXDEF))
|
|---|
| 24 | S LEXN=$G(^LEXT(757.2,LEXAP,200,LEXUSER,(LEXDEF+.5)))
|
|---|
| 25 | Q:LEXOV="" 0 D:$L(LEXOV) ASK Q LEXDEF
|
|---|
| 26 | ;
|
|---|
| 27 | ASK ; Ask to delete
|
|---|
| 28 | W ! N LEXYPE,DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y S LEXYPE=$S(LEXDEF=1:"filter",LEXDEF=2:"display",LEXDEF=3:"vocabulary",1:"shortcut context")
|
|---|
| 29 | I LEXN="" S:LEXDEF=1 LEXN=$$N1(LEXOV) S:LEXDEF=2 LEXN=$$N2(LEXOV) S:LEXDEF=3 LEXN=$$N3(LEXOV) S:LEXDEF=4 LEXN=$$N4(LEXOV)
|
|---|
| 30 | S DIR("A",1)="You did not select"_$S(LEXDEF=1:"/create",LEXDEF=2:"/create",1:"")_" a default "_$$UP^XLFSTR(LEXYPE)_", however you already"
|
|---|
| 31 | S DIR("A",2)="have a default "_$$UP^XLFSTR(LEXYPE)_" on file. Did you want to delete"
|
|---|
| 32 | S DIR("A",3)="your current default?",DIR("A",4)="",DIR("A",5)=" "_LEXN,DIR("A",6)=""
|
|---|
| 33 | S DIR("A")="Delete? ",DIR("B")="NO",DIR(0)="YAO" D ^DIR K DIR S LEXDEF=+Y Q
|
|---|
| 34 | ;
|
|---|
| 35 | ; Get default names (N1, N2, N3, and N4)
|
|---|
| 36 | ;
|
|---|
| 37 | ; Input LEXX - The actual value for the default
|
|---|
| 38 | ; Returns LEXX - The name of the default value
|
|---|
| 39 | ;
|
|---|
| 40 | N1(LEXX) ; Filter name
|
|---|
| 41 | Q:'$L($G(LEXX)) "Unknown filter"
|
|---|
| 42 | N LEXSS,LEXN,LEXSO,LEXI,LEXSP S LEXN="",LEXSP=0,LEXSS=$E(LEXX,1,63)
|
|---|
| 43 | S LEXSO=$E(LEXSS,1,($L(LEXSS)-1))_$C($A($E(LEXSS,$L(LEXSS)))-1)_"~"
|
|---|
| 44 | F S LEXSO=$O(^LEX(757.3,"AS",LEXSO)) Q:+LEXSP!(LEXSO'[LEXSS) D
|
|---|
| 45 | . S LEXI=0 F S LEXI=$O(^LEX(757.3,"AS",LEXSO,LEXI)) Q:+LEXI=0!(+LEXSP'=0) D
|
|---|
| 46 | . . S:$G(^LEX(757.3,+LEXI,1))=LEXX LEXSP=LEXI
|
|---|
| 47 | . . S:+LEXSP>0 LEXN=$P($G(^LEX(757.3,+LEXSP,0)),"^",1)
|
|---|
| 48 | S LEXX=$S($L(LEXN):LEXN,1:"User defined") Q LEXX
|
|---|
| 49 | N2(LEXX) ; Display name
|
|---|
| 50 | Q:'$L($G(LEXX)) "Unknown display"
|
|---|
| 51 | N LEXDP,LEXDS,LEXN S LEXDP=0,LEXN="",LEXDS=$E(LEXX,1,63)
|
|---|
| 52 | S LEXDS=$E(LEXDS,1,($L(LEXDS)-1))_$C($A($E(LEXDS,1,$L(LEXDS)))-1)_"~"
|
|---|
| 53 | F S LEXDS=$O(^LEX(757.31,"ADSP",LEXDS)) Q:LEXDS'[LEXX!($L($G(LEXN))) D
|
|---|
| 54 | . S LEXDP=0 F S LEXDP=$O(^LEX(757.31,"ADSP",LEXDS,LEXDP)) Q:+LEXDP=0!($L($G(LEXN))) D
|
|---|
| 55 | . . I ^LEX(757.31,+LEXDP,1)=LEXX S LEXN=$P(^LEX(757.31,+LEXDP,0),"^",1)
|
|---|
| 56 | S LEXX=$S($L(LEXN):LEXN,1:"User defined") Q LEXX
|
|---|
| 57 | N3(LEXX) ; Vocabulary name
|
|---|
| 58 | Q:'$L($G(LEXX)) "Unknown vocabulary"
|
|---|
| 59 | Q:'$D(^LEXT(757.2,"AA",LEXX)) "Unknown vocabulary"
|
|---|
| 60 | N LEXN S LEXN=$P($G(^LEXT(757.2,$O(^LEXT(757.2,"AA",LEXX,0)),0)),"^",1)
|
|---|
| 61 | S LEXX=$S($L(LEXN):LEXN,1:"Unknown vocabulary") Q LEXX
|
|---|
| 62 | N4(LEXX) ; Context name
|
|---|
| 63 | Q:'$L($G(LEXX)) "Unknown context" Q:+LEXX=0 "Unknown context"
|
|---|
| 64 | Q:'$D(^LEX(757.41,LEXX)) "Unknown context" N LEXN S LEXN=$P($G(^LEX(757.41,+LEXX,0)),"^",1)
|
|---|
| 65 | S LEXX=$S($L(LEXN):LEXN,1:"Unknown context") Q LEXX
|
|---|
