- LEXSET3 ;ISL/KER - Overwrite/Merge Appl/User Defaults ;04/21/2014
- ;;2.0;LEXICON UTILITY;**6,80**;Sep 23, 1996;Build 10
- ;
- 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
- LEXSET3 ;ISL/KER - Overwrite/Merge Appl/User Defaults ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**6,80**;Sep 23, 1996;Build 10
- +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
