78 lines
4.0 KiB
Mathematica
78 lines
4.0 KiB
Mathematica
LEXSET2 ; ISL Retrieve Appl/Sub/Mode/User Defaults ; 10-15-97
|
|
;;2.0;LEXICON UTILITY;**6**;Sep 23, 1996;Build 1
|
|
;
|
|
APP(LEXA) ; Application
|
|
K LEXD("AP") N LEXT,LEXI S LEXA=+($G(LEXA))
|
|
Q:LEXA=0 Q:'$D(^LEXT(757.2,LEXA)) Q:$P($G(^LEXT(757.2,LEXA,5)),"^",5)=""
|
|
S LEXT="AP",LEXI=LEXA D COMMON
|
|
S:$L($G(^LEXT(757.2,LEXI,7))) LEXD(LEXT,"DIS")=$G(^LEXT(757.2,LEXI,7))
|
|
S LEXD(LEXT,"UNR")=+($P($G(^LEXT(757.2,LEXI,5)),"^",6))
|
|
S LEXD(LEXT,"DEF")=+($P($G(^LEXT(757.2,LEXI,5)),"^",3))
|
|
S LEXD(LEXT,"SCT")=+($P($G(^LEXT(757.2,LEXI,5)),"^",8))
|
|
; Modifiers PCH 6
|
|
S LEXD(LEXT,"MOD")=+($P($G(^LEXT(757.2,LEXI,5)),"^",9))
|
|
K:+(LEXD(LEXT,"SCT"))=0 LEXD(LEXT,"SCT")
|
|
S LEXD(LEXT,"FIL")=$G(^LEXT(757.2,LEXI,6))
|
|
S LEXD("DF","UNR")=+($P($G(^LEXT(757.2,LEXI,5)),"^",6))
|
|
S LEXD(LEXT,"SUB")=$P($G(^LEXT(757.2,LEXI,5)),"^",2)
|
|
S:LEXD(LEXT,"SUB")="" LEXD(LEXT,"SUB")="WRD"
|
|
S LEXD(LEXT,"IDX")="A"_LEXD(LEXT,"SUB")
|
|
Q
|
|
SUB(LEXS) ; Subset
|
|
K LEXD("SS") N LEXT,LEXI S LEXS=+($G(LEXS))
|
|
Q:LEXS=0 Q:'$D(^LEXT(757.2,LEXS)) Q:$P($G(^LEXT(757.2,LEXS,0)),"^",2)=""
|
|
S LEXT="SS",LEXI=LEXS D COMMON
|
|
S:$L($G(^LEXT(757.2,LEXI,4))) LEXD(LEXT,"DIS")=$G(^LEXT(757.2,LEXI,4))
|
|
S LEXD(LEXT,"SCT")=+($P($G(^LEXT(757.2,LEXI,5)),"^",8))
|
|
K:+(LEXD(LEXT,"SCT"))=0 LEXD(LEXT,"SCT")
|
|
; Modifiers PCH 6
|
|
S LEXD(LEXT,"MOD")=+($P($G(^LEXT(757.2,LEXI,5)),"^",9))
|
|
S LEXD(LEXT,"FIL")=$G(^LEXT(757.2,LEXI,6))
|
|
S LEXD(LEXT,"SUB")=$P($G(^LEXT(757.2,LEXI,0)),"^",2)
|
|
S:LEXD(LEXT,"SUB")="" LEXD(LEXT,"SUB")="WRD"
|
|
S LEXD(LEXT,"IDX")="A"_LEXD(LEXT,"SUB")
|
|
Q
|
|
GEN S LEXD("DF","OVR")=0 S:$G(LEXD("AP","OVR"))=1!($G(LEXD("SS","OVR"))=1) LEXD("DF","OVR")=1
|
|
Q
|
|
MOD(LEXM) ; Mode
|
|
K LEXD("SS") N LEXT,LEXI S LEXM=+($G(LEXM))
|
|
Q:LEXM=0 Q:'$D(^LEXT(757.2,LEXM,5)) Q:$P(^LEXT(757.2,LEXM,5),"^",1)="" Q:$P(^LEXT(757.2,LEXM,5),"^",5)'="" Q:$P($G(^LEXT(757.2,LEXM,5)),"^",1)="" S LEXT="SS",LEXI=LEXM D COMMON
|
|
S:$L($G(^LEXT(757.2,LEXI,7))) LEXD(LEXT,"DIS")=$G(^LEXT(757.2,LEXI,7))
|
|
S LEXD(LEXT,"FIL")=$G(^LEXT(757.2,LEXI,6))
|
|
S LEXD(LEXT,"SCT")=+($P($G(^LEXT(757.2,LEXI,5)),"^",8))
|
|
; Modifiers PCH 6
|
|
S LEXD(LEXT,"MOD")=+($P($G(^LEXT(757.2,LEXI,5)),"^",9))
|
|
K:+(LEXD(LEXT,"SCT"))=0 LEXD(LEXT,"SCT")
|
|
S LEXD(LEXT,"SUB")=$P($G(^LEXT(757.2,LEXI,5)),"^",2)
|
|
S:LEXD(LEXT,"SUB")="" LEXD(LEXT,"SUB")="WRD"
|
|
S LEXD(LEXT,"IDX")="A"_LEXD(LEXT,"SUB")
|
|
Q
|
|
IND ;
|
|
S LEXD("DF","XTLKSAY")=1 S:'$L($G(DIC(0))) DIC(0)="EQM" S:'$L($G(X))&(DIC(0)'["A") DIC(0)="A"_DIC(0)
|
|
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)
|
|
S LEXD("DF","DIC(0)")=DIC(0) K DIC(0)
|
|
Q
|
|
COMMON ; Common Values
|
|
S LEXD(LEXT,"IEN")=LEXI S:LEXT="AP" LEXD("DF","LEXAP")=LEXI
|
|
S LEXD(LEXT,"NAM")=$P($G(^LEXT(757.2,LEXI,0)),"^",1)
|
|
S LEXD(LEXT,"GBL")=$G(^LEXT(757.2,LEXI,1))
|
|
S LEXD(LEXT,"OVR")=+($P($G(^LEXT(757.2,LEXI,5)),"^",7))
|
|
S:$G(^LEXT(757.2,LEXI,2))'="" LEXD(LEXT,"DSP")=$G(^LEXT(757.2,LEXI,3))
|
|
S:$G(^LEXT(757.2,LEXI,3))'="" LEXD(LEXT,"HLP")="D "_$G(^LEXT(757.2,LEXI,2))
|
|
Q
|
|
USR(LEXI) ; User defaults
|
|
Q:+($G(LEXI))=0 Q:+($G(DUZ))=0 Q:'$D(^LEXT(757.2,+LEXI,200,DUZ))
|
|
N LEXEMP S LEXEMP=$G(^LEXT(757.2,+LEXI,200,DUZ,1)) S:LEXEMP'="" LEXD("UD","FIL")=LEXEMP
|
|
S LEXEMP=$G(^LEXT(757.2,+LEXI,200,DUZ,2)) S:LEXEMP'="" LEXD("UD","DIS")=LEXEMP
|
|
S LEXEMP=$G(^LEXT(757.2,+LEXI,200,DUZ,3)) S:LEXEMP'="" LEXD("UD","SUB")=LEXEMP,LEXD("UD","IDX")="A"_LEXEMP
|
|
S LEXEMP=$G(^LEXT(757.2,+LEXI,200,DUZ,4)) S:LEXEMP'="" LEXD("UD","SCT")=LEXEMP
|
|
I $L($G(LEXD("UD","SUB"))) D
|
|
. I $D(^LEXT(757.2,"AA",LEXD("UD","SUB"))) S LEXD("UD","IEN")=$O(^LEXT(757.2,"AA",LEXD("UD","SUB"),0))
|
|
. I $D(^LEXT(757.2,"AB",LEXD("UD","SUB"))) S LEXD("UD","IEN")=$O(^LEXT(757.2,"AB",LEXD("UD","SUB"),0))
|
|
. I +($G(LEXD("UD","IEN")))>0,$D(^LEXT(757.2,+($G(LEXD("UD","IEN"))))) D
|
|
. . S:$L($G(^LEXT(757.2,+($G(LEXD("UD","IEN"))),1))) LEXD("UD","GBL")=$G(^LEXT(757.2,+($G(LEXD("UD","IEN"))),1))
|
|
. . S:$L($G(^LEXT(757.2,+($G(LEXD("UD","IEN"))),2))) LEXD("UD","DSP")=$G(^LEXT(757.2,+($G(LEXD("UD","IEN"))),2))
|
|
. . S:$L($G(^LEXT(757.2,+($G(LEXD("UD","IEN"))),3))) LEXD("UD","HLP")=$G(^LEXT(757.2,+($G(LEXD("UD","IEN"))),3))
|
|
. I '$L($G(LEXD("UD","GBL"))) K LEXD("UD","SUB"),LEXD("UD","IDX")
|
|
Q
|