- LEXDDT1 ;ISL/KER - Display Defaults - Translate String ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; None
- ;
- EN ; String Type
- K LEX,LEXTSTR I '$D(LEXSTLN) S LEXSTLN=56
- I $L($G(LEXDICS)),'$L($G(LEXSHOW)),'$L($G(LEXSUB)) D DICS G EXIT
- I '$L($G(LEXDICS)),'$L($G(LEXSUB)),$L($G(LEXSHOW)) D SHOW G EXIT
- I $L($G(LEXSUB)),'$L($G(LEXSHOW)) D SUB
- G EXIT
- Q
- DICS ; Filter String LEXDICS
- N LEXTRTN S LEXTRTN=""
- I LEXDICS="I 1" S LEX(0)=1,LEX=LEXDICS,LEX(1)="Unfiltered" Q
- S:LEXDICS["$$SC^" LEXTRTN="SC^LEXDDTF"
- S:LEXDICS["$$SO^" LEXTRTN="SO^LEXDDTF"
- Q:$G(LEXTRTN)=""
- D @LEXTRTN
- Q
- SUB ; Sub-Set String LEXSUB
- K LEX S LEX=LEXSUB D ^LEXDDTV
- Q
- SHOW ; Display Codes String LEXSHOW
- K LEX S LEX=LEXSHOW D ^LEXDDTD
- Q
- CON ; Shortcut Context LEXCTX
- K LEX S LEX=LEXCTX D ^LEXDDTC
- Q
- ; Values
- VV ; Vocabulary Value
- Q:'$L($G(LEXSUB)) K LEX S:'$D(LEXSTLN) LEXSTLN=56
- S LEX(0)=1,LEX(1)="Value: "_LEXSUB
- Q
- FV ; Filter Value
- Q:'$L($G(LEXDICS)) K LEX S:'$D(LEXSTLN) LEXSTLN=56
- N LEXTSTR,LEXTCTR S LEXTCTR=0,LEXTSTR="Value: "_LEXDICS
- F Q:$L(LEXTSTR)'>LEXSTLN D CONV
- I $L(LEXTSTR) S LEXTCTR=LEXTCTR+1 S LEX(LEXTCTR)=LEXTSTR,LEX(0)=LEXTCTR
- Q
- DV ; Display Value
- Q:'$L($G(LEXSHOW)) K LEX S:'$D(LEXSTLN) LEXSTLN=56
- N LEXTSTR,LEXTCTR S LEXTCTR=0,LEXTSTR="Value: "_LEXSHOW
- F Q:$L(LEXTSTR)'>LEXSTLN D CONV
- I $L(LEXTSTR) S LEXTCTR=LEXTCTR+1 S LEX(LEXTCTR)=LEXTSTR,LEX(0)=LEXTCTR
- Q
- CV ; Vocabulary Value
- Q:'$L($G(LEXCTX)) K LEX S:'$D(LEXSTLN) LEXSTLN=56
- S LEX(0)=1,LEX(1)="Value: "_LEXCTX
- Q
- CONV ; Concatenate VALUE
- N LEXTPSN S LEXTPSN=LEXSTLN
- F LEXTPSN=LEXSTLN:-1:1 Q:$E(LEXTSTR,LEXTPSN)="/"!($E(LEXTSTR,LEXTPSN)=";")
- I $E(LEXTSTR,LEXTPSN)="/" D
- . S LEXTCTR=LEXTCTR+1 S LEX(LEXTCTR)=$E(LEXTSTR,1,LEXTPSN),LEX(0)=LEXTCTR
- . S LEXTSTR=$E(LEXTSTR,(LEXTPSN+1),$L(LEXTSTR))
- Q
- EXIT ; Kill all but the array LEX and the Default Variable
- K LEXSTLN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDDT1 2155 printed Feb 18, 2025@23:33:34 Page 2
- LEXDDT1 ;ISL/KER - Display Defaults - Translate String ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- +2 ;
- +3 ; Global Variables
- +4 ; None
- +5 ;
- +6 ; External References
- +7 ; None
- +8 ;
- EN ; String Type
- +1 KILL LEX,LEXTSTR
- IF '$DATA(LEXSTLN)
- SET LEXSTLN=56
- +2 IF $LENGTH($GET(LEXDICS))
- IF '$LENGTH($GET(LEXSHOW))
- IF '$LENGTH($GET(LEXSUB))
- DO DICS
- GOTO EXIT
- +3 IF '$LENGTH($GET(LEXDICS))
- IF '$LENGTH($GET(LEXSUB))
- IF $LENGTH($GET(LEXSHOW))
- DO SHOW
- GOTO EXIT
- +4 IF $LENGTH($GET(LEXSUB))
- IF '$LENGTH($GET(LEXSHOW))
- DO SUB
- +5 GOTO EXIT
- +6 QUIT
- DICS ; Filter String LEXDICS
- +1 NEW LEXTRTN
- SET LEXTRTN=""
- +2 IF LEXDICS="I 1"
- SET LEX(0)=1
- SET LEX=LEXDICS
- SET LEX(1)="Unfiltered"
- QUIT
- +3 if LEXDICS["$$SC^"
- SET LEXTRTN="SC^LEXDDTF"
- +4 if LEXDICS["$$SO^"
- SET LEXTRTN="SO^LEXDDTF"
- +5 if $GET(LEXTRTN)=""
- QUIT
- +6 DO @LEXTRTN
- +7 QUIT
- SUB ; Sub-Set String LEXSUB
- +1 KILL LEX
- SET LEX=LEXSUB
- DO ^LEXDDTV
- +2 QUIT
- SHOW ; Display Codes String LEXSHOW
- +1 KILL LEX
- SET LEX=LEXSHOW
- DO ^LEXDDTD
- +2 QUIT
- CON ; Shortcut Context LEXCTX
- +1 KILL LEX
- SET LEX=LEXCTX
- DO ^LEXDDTC
- +2 QUIT
- +3 ; Values
- VV ; Vocabulary Value
- +1 if '$LENGTH($GET(LEXSUB))
- QUIT
- KILL LEX
- if '$DATA(LEXSTLN)
- SET LEXSTLN=56
- +2 SET LEX(0)=1
- SET LEX(1)="Value: "_LEXSUB
- +3 QUIT
- FV ; Filter Value
- +1 if '$LENGTH($GET(LEXDICS))
- QUIT
- KILL LEX
- if '$DATA(LEXSTLN)
- SET LEXSTLN=56
- +2 NEW LEXTSTR,LEXTCTR
- SET LEXTCTR=0
- SET LEXTSTR="Value: "_LEXDICS
- +3 FOR
- if $LENGTH(LEXTSTR)'>LEXSTLN
- QUIT
- DO CONV
- +4 IF $LENGTH(LEXTSTR)
- SET LEXTCTR=LEXTCTR+1
- SET LEX(LEXTCTR)=LEXTSTR
- SET LEX(0)=LEXTCTR
- +5 QUIT
- DV ; Display Value
- +1 if '$LENGTH($GET(LEXSHOW))
- QUIT
- KILL LEX
- if '$DATA(LEXSTLN)
- SET LEXSTLN=56
- +2 NEW LEXTSTR,LEXTCTR
- SET LEXTCTR=0
- SET LEXTSTR="Value: "_LEXSHOW
- +3 FOR
- if $LENGTH(LEXTSTR)'>LEXSTLN
- QUIT
- DO CONV
- +4 IF $LENGTH(LEXTSTR)
- SET LEXTCTR=LEXTCTR+1
- SET LEX(LEXTCTR)=LEXTSTR
- SET LEX(0)=LEXTCTR
- +5 QUIT
- CV ; Vocabulary Value
- +1 if '$LENGTH($GET(LEXCTX))
- QUIT
- KILL LEX
- if '$DATA(LEXSTLN)
- SET LEXSTLN=56
- +2 SET LEX(0)=1
- SET LEX(1)="Value: "_LEXCTX
- +3 QUIT
- CONV ; Concatenate VALUE
- +1 NEW LEXTPSN
- SET LEXTPSN=LEXSTLN
- +2 FOR LEXTPSN=LEXSTLN:-1:1
- if $EXTRACT(LEXTSTR,LEXTPSN)="/"!($EXTRACT(LEXTSTR,LEXTPSN)=";")
- QUIT
- +3 IF $EXTRACT(LEXTSTR,LEXTPSN)="/"
- Begin DoDot:1
- +4 SET LEXTCTR=LEXTCTR+1
- SET LEX(LEXTCTR)=$EXTRACT(LEXTSTR,1,LEXTPSN)
- SET LEX(0)=LEXTCTR
- +5 SET LEXTSTR=$EXTRACT(LEXTSTR,(LEXTPSN+1),$LENGTH(LEXTSTR))
- End DoDot:1
- +6 QUIT
- EXIT ; Kill all but the array LEX and the Default Variable
- +1 KILL LEXSTLN
- +2 QUIT
