LEXSET3 ;ISL/KER - Overwrite/Merge Appl/User Defaults ;04/21/2014
;;2.0;LEXICON UTILITY;**6,80**;Sep 23, 1996;Build 1
;
OVER ;
N LEXT
S:LEXM=0&(LEXL=LEXS) LEXT="AP"
S:LEXM=0&(LEXL'=LEXS) LEXT="SS"
I LEXM>0 S:LEXM>0 LEXT="SS"
I $L($G(LEXD("AP","DEF"))),+($G(LEXD("AP","DEF")))=0 S LEXT="AP"
S:$L($G(LEXD(LEXT,"DIS"))) LEXD("DF","DIS")=LEXD(LEXT,"DIS")
S:$L($G(LEXD(LEXT,"DSP"))) LEXD("DF","DSP")=LEXD(LEXT,"DSP")
S:$L($G(LEXD(LEXT,"FIL"))) LEXD("DF","FIL")=LEXD(LEXT,"FIL")
S:$L($G(LEXD(LEXT,"GBL"))) LEXD("DF","GBL")=LEXD(LEXT,"GBL")
S:$L($G(LEXD(LEXT,"HLP"))) LEXD("DF","HLP")=LEXD(LEXT,"HLP")
S:$L($G(LEXD(LEXT,"IDX"))) LEXD("DF","IDX")=LEXD(LEXT,"IDX")
; Modifiers PCH 6
S:$L($G(LEXD(LEXT,"MOD"))) LEXD("DF","MOD")=LEXD(LEXT,"MOD")
S:'$D(LEXD(LEXT,"IDX")) LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
I '$D(LEXD(LEXT,"GBL")) D
. I $D(^LEX(757.01,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.01," Q
. I $D(^LEX(757.21,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.21," Q
. S LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
S:$L($G(LEXD(LEXT,"NAM"))) LEXD("DF","NAM")=LEXD(LEXT,"NAM")
S LEXD("DF","SUB")=$E($G(LEXD(LEXT,"IDX")),2,$L($G(LEXD(LEXT,"IDX"))))
S LEXD("DF","FLN")=$P($P($G(LEXD(LEXT,"GBL")),"(",2),",",1)
I 'LEXD("DF","FLN") D
. S LEXD("DF","FLN")=757.01,LEXD("DF","GBL")="^LEX(757.01,"
. S LEXD("DF","IDX")="AWRD",LEXD("DF","SUB")="WRD"
S:$L($G(LEXD(LEXT,"SCT"))) LEXD("DF","SCT")=LEXD(LEXT,"SCT")
Q
USER ;
N LEXT
S:LEXM=0&(LEXL=LEXS) LEXT="AP"
S:LEXM=0&(LEXL'=LEXS) LEXT="SS"
S:LEXM>0&(LEXM=LEXA) LEXT="AP"
S:LEXM>0&(LEXM'=LEXA) LEXT="SS"
S:$L($G(LEXD(LEXT,"DIS"))) LEXD("DF","DIS")=LEXD(LEXT,"DIS")
S:$L($G(LEXD(LEXT,"DSP"))) LEXD("DF","DSP")=LEXD(LEXT,"DSP")
S:$L($G(LEXD(LEXT,"FIL"))) LEXD("DF","FIL")=LEXD(LEXT,"FIL")
S:$L($G(LEXD(LEXT,"GBL"))) LEXD("DF","GBL")=LEXD(LEXT,"GBL")
S:$L($G(LEXD(LEXT,"HLP"))) LEXD("DF","HLP")=LEXD(LEXT,"HLP")
S:$L($G(LEXD(LEXT,"IDX"))) LEXD("DF","IDX")=LEXD(LEXT,"IDX")
; Modifiers PCH 6
S:$L($G(LEXD(LEXT,"MOD"))) LEXD("DF","MOD")=LEXD(LEXT,"MOD")
S:'$D(LEXD(LEXT,"IDX")) LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
I '$D(LEXD(LEXT,"GBL")) D
. I $D(^LEX(757.01,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.01," Q
. I $D(^LEX(757.21,LEXD(LEXT,"IDX"))) S LEXD(LEXT,"GBL")="^LEX(757.21," Q
. S LEXD(LEXT,"IDX")="AWRD",LEXD(LEXT,"GBL")="^LEX(757.01,"
S:$L($G(LEXD(LEXT,"NAM"))) LEXD("DF","NAM")=LEXD(LEXT,"NAM")
S LEXD("DF","SUB")=$E($G(LEXD(LEXT,"IDX")),2,$L($G(LEXD(LEXT,"IDX"))))
S LEXD("DF","FLN")=$P($P($G(LEXD(LEXT,"GBL")),"(",2),",",1)
I LEXD("DF","FLN")="" D
. S LEXD("DF","FLN")=757.01,LEXD("DF","GBL")="^LEX(757.01,"
. S LEXD("DF","IDX")="AWRD",LEXD("DF","SUB")="WRD"
S:$L($G(LEXD("UD","DIS"))) LEXD("DF","DIS")=LEXD("UD","DIS")
S:$L($G(LEXD("UD","SCT"))) LEXD("DF","SCT")=LEXD("UD","SCT")
I LEXT="AP" D
. S:$L($G(LEXD("UD","FIL"))) LEXD("DF","FIL")=LEXD("UD","FIL")
. S:$L($G(LEXD("UD","DSP"))) LEXD("DF","DSP")=LEXD("UD","DSP")
. S:$L($G(LEXD("UD","HLP"))) LEXD("DF","HLP")=LEXD("UD","HLP")
. S:$L($G(LEXD("UD","IDX"))) LEXD("DF","IDX")=LEXD("UD","IDX")
. S:$L($G(LEXD("UD","SUB"))) LEXD("DF","SUB")=LEXD("UD","SUB")
I $L($G(LEXD("DF","IDX"))),$D(^LEX(757.01,LEXD("DF","IDX"))) S LEXD("DF","GBL")="^LEX(757.01,",LEXD("DF","FLN")="757.01"
I $L($G(LEXD("DF","IDX"))),$D(^LEX(757.21,LEXD("DF","IDX"))) S LEXD("DF","GBL")="^LEX(757.21,",LEXD("DF","FLN")="757.21"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXSET3 3495 printed Apr 09, 2024@21:14:45 Page 2
LEXSET3 ;ISL/KER - Overwrite/Merge Appl/User Defaults ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**6,80**;Sep 23, 1996;Build 1
+2 ;
OVER ;
+1 NEW LEXT
+2 if LEXM=0&(LEXL=LEXS)
SET LEXT="AP"
+3 if LEXM=0&(LEXL'=LEXS)
SET LEXT="SS"
+4 IF LEXM>0
if LEXM>0
SET LEXT="SS"
+5 IF $LENGTH($GET(LEXD("AP","DEF")))
IF +($GET(LEXD("AP","DEF")))=0
SET LEXT="AP"
+6 if $LENGTH($GET(LEXD(LEXT,"DIS")))
SET LEXD("DF","DIS")=LEXD(LEXT,"DIS")
+7 if $LENGTH($GET(LEXD(LEXT,"DSP")))
SET LEXD("DF","DSP")=LEXD(LEXT,"DSP")
+8 if $LENGTH($GET(LEXD(LEXT,"FIL")))
SET LEXD("DF","FIL")=LEXD(LEXT,"FIL")
+9 if $LENGTH($GET(LEXD(LEXT,"GBL")))
SET LEXD("DF","GBL")=LEXD(LEXT,"GBL")
+10 if $LENGTH($GET(LEXD(LEXT,"HLP")))
SET LEXD("DF","HLP")=LEXD(LEXT,"HLP")
+11 if $LENGTH($GET(LEXD(LEXT,"IDX")))
SET LEXD("DF","IDX")=LEXD(LEXT,"IDX")
+12 ; Modifiers PCH 6
+13 if $LENGTH($GET(LEXD(LEXT,"MOD")))
SET LEXD("DF","MOD")=LEXD(LEXT,"MOD")
+14 if '$DATA(LEXD(LEXT,"IDX"))
SET LEXD(LEXT,"IDX")="AWRD"
SET LEXD(LEXT,"GBL")="^LEX(757.01,"
+15 IF '$DATA(LEXD(LEXT,"GBL"))
Begin DoDot:1
+16 IF $DATA(^LEX(757.01,LEXD(LEXT,"IDX")))
SET LEXD(LEXT,"GBL")="^LEX(757.01,"
QUIT
+17 IF $DATA(^LEX(757.21,LEXD(LEXT,"IDX")))
SET LEXD(LEXT,"GBL")="^LEX(757.21,"
QUIT
+18 SET LEXD(LEXT,"IDX")="AWRD"
SET LEXD(LEXT,"GBL")="^LEX(757.01,"
End DoDot:1
+19 if $LENGTH($GET(LEXD(LEXT,"NAM")))
SET LEXD("DF","NAM")=LEXD(LEXT,"NAM")
+20 SET LEXD("DF","SUB")=$EXTRACT($GET(LEXD(LEXT,"IDX")),2,$LENGTH($GET(LEXD(LEXT,"IDX"))))
+21 SET LEXD("DF","FLN")=$PIECE($PIECE($GET(LEXD(LEXT,"GBL")),"(",2),",",1)
+22 IF 'LEXD("DF","FLN")
Begin DoDot:1
+23 SET LEXD("DF","FLN")=757.01
SET LEXD("DF","GBL")="^LEX(757.01,"
+24 SET LEXD("DF","IDX")="AWRD"
SET LEXD("DF","SUB")="WRD"
End DoDot:1
+25 if $LENGTH($GET(LEXD(LEXT,"SCT")))
SET LEXD("DF","SCT")=LEXD(LEXT,"SCT")
+26 QUIT
USER ;
+1 NEW LEXT
+2 if LEXM=0&(LEXL=LEXS)
SET LEXT="AP"
+3 if LEXM=0&(LEXL'=LEXS)
SET LEXT="SS"
+4 if LEXM>0&(LEXM=LEXA)
SET LEXT="AP"
+5 if LEXM>0&(LEXM'=LEXA)
SET LEXT="SS"
+6 if $LENGTH($GET(LEXD(LEXT,"DIS")))
SET LEXD("DF","DIS")=LEXD(LEXT,"DIS")
+7 if $LENGTH($GET(LEXD(LEXT,"DSP")))
SET LEXD("DF","DSP")=LEXD(LEXT,"DSP")
+8 if $LENGTH($GET(LEXD(LEXT,"FIL")))
SET LEXD("DF","FIL")=LEXD(LEXT,"FIL")
+9 if $LENGTH($GET(LEXD(LEXT,"GBL")))
SET LEXD("DF","GBL")=LEXD(LEXT,"GBL")
+10 if $LENGTH($GET(LEXD(LEXT,"HLP")))
SET LEXD("DF","HLP")=LEXD(LEXT,"HLP")
+11 if $LENGTH($GET(LEXD(LEXT,"IDX")))
SET LEXD("DF","IDX")=LEXD(LEXT,"IDX")
+12 ; Modifiers PCH 6
+13 if $LENGTH($GET(LEXD(LEXT,"MOD")))
SET LEXD("DF","MOD")=LEXD(LEXT,"MOD")
+14 if '$DATA(LEXD(LEXT,"IDX"))
SET LEXD(LEXT,"IDX")="AWRD"
SET LEXD(LEXT,"GBL")="^LEX(757.01,"
+15 IF '$DATA(LEXD(LEXT,"GBL"))
Begin DoDot:1
+16 IF $DATA(^LEX(757.01,LEXD(LEXT,"IDX")))
SET LEXD(LEXT,"GBL")="^LEX(757.01,"
QUIT
+17 IF $DATA(^LEX(757.21,LEXD(LEXT,"IDX")))
SET LEXD(LEXT,"GBL")="^LEX(757.21,"
QUIT
+18 SET LEXD(LEXT,"IDX")="AWRD"
SET LEXD(LEXT,"GBL")="^LEX(757.01,"
End DoDot:1
+19 if $LENGTH($GET(LEXD(LEXT,"NAM")))
SET LEXD("DF","NAM")=LEXD(LEXT,"NAM")
+20 SET LEXD("DF","SUB")=$EXTRACT($GET(LEXD(LEXT,"IDX")),2,$LENGTH($GET(LEXD(LEXT,"IDX"))))
+21 SET LEXD("DF","FLN")=$PIECE($PIECE($GET(LEXD(LEXT,"GBL")),"(",2),",",1)
+22 IF LEXD("DF","FLN")=""
Begin DoDot:1
+23 SET LEXD("DF","FLN")=757.01
SET LEXD("DF","GBL")="^LEX(757.01,"
+24 SET LEXD("DF","IDX")="AWRD"
SET LEXD("DF","SUB")="WRD"
End DoDot:1
+25 if $LENGTH($GET(LEXD("UD","DIS")))
SET LEXD("DF","DIS")=LEXD("UD","DIS")
+26 if $LENGTH($GET(LEXD("UD","SCT")))
SET LEXD("DF","SCT")=LEXD("UD","SCT")
+27 IF LEXT="AP"
Begin DoDot:1
+28 if $LENGTH($GET(LEXD("UD","FIL")))
SET LEXD("DF","FIL")=LEXD("UD","FIL")
+29 if $LENGTH($GET(LEXD("UD","DSP")))
SET LEXD("DF","DSP")=LEXD("UD","DSP")
+30 if $LENGTH($GET(LEXD("UD","HLP")))
SET LEXD("DF","HLP")=LEXD("UD","HLP")
+31 if $LENGTH($GET(LEXD("UD","IDX")))
SET LEXD("DF","IDX")=LEXD("UD","IDX")
+32 if $LENGTH($GET(LEXD("UD","SUB")))
SET LEXD("DF","SUB")=LEXD("UD","SUB")
End DoDot:1
+33 IF $LENGTH($GET(LEXD("DF","IDX")))
IF $DATA(^LEX(757.01,LEXD("DF","IDX")))
SET LEXD("DF","GBL")="^LEX(757.01,"
SET LEXD("DF","FLN")="757.01"
+34 IF $LENGTH($GET(LEXD("DF","IDX")))
IF $DATA(^LEX(757.21,LEXD("DF","IDX")))
SET LEXD("DF","GBL")="^LEX(757.21,"
SET LEXD("DF","FLN")="757.21"
+35 QUIT
