- 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 Feb 18, 2025@23:35:44 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