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 Oct 16, 2024@18:08:12 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
