LEXDDTD ;ISL/KER - Display Defaults - Display ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; None
;
DSO ; Display Sources
; Required LEXSHOW
K LEX N LEXTCTR,LEXTI,LEXTIC,LEXTSTR,LEXT
S:'$D(LEXSTLN) LEXSTLN=56
D:'$L($G(LEXSHOW)) NONE D:$L($G(LEXSHOW)) SHOW
Q
SHOW ; Show Classification Codes (sources)
S LEX=LEXSHOW,LEXTCTR=0,LEX("L")=LEX
S LEX("L","H")="Display codes from"
S LEX("L","T")="coding system",LEXTCTR=0
F LEXTI=1:1:$L(LEX("L"),"/") D
. N LEXTIC S LEXTIC=$P(LEX("L"),"/",LEXTI) Q:LEXTIC="UND"
. S LEXTCTR=LEXTCTR+1,LEX("L",LEXTCTR)=$$CN^LEXDDTF(LEXTIC)
S:LEXTCTR>1 LEX("L","T")=LEX("L","T")_"s"
S LEX("L","T")=LEX("L","T")_"."
S LEX("L",0)=LEXTCTR
S LEXTCTR=0,LEXTSTR="",LEXT="L"
D:$G(LEX("L",0)) LNK^LEXDDTF
D EOC^LEXDDT2
Q
NONE ; LEXSHOW is Null (nothing to show)
S LEX=LEXSHOW,LEX("L")=LEX,LEXTCTR=0,LEXTSTR="",LEXT="L"
S LEX("L","H")="Do not display Classification Codes",LEX("L",0)=0
D LNK^LEXDDTF,EOC^LEXDDT2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDDTD 1112 printed Oct 16, 2024@18:08:14 Page 2
LEXDDTD ;ISL/KER - Display Defaults - Display ;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 ;
DSO ; Display Sources
+1 ; Required LEXSHOW
+2 KILL LEX
NEW LEXTCTR,LEXTI,LEXTIC,LEXTSTR,LEXT
+3 if '$DATA(LEXSTLN)
SET LEXSTLN=56
+4 if '$LENGTH($GET(LEXSHOW))
DO NONE
if $LENGTH($GET(LEXSHOW))
DO SHOW
+5 QUIT
SHOW ; Show Classification Codes (sources)
+1 SET LEX=LEXSHOW
SET LEXTCTR=0
SET LEX("L")=LEX
+2 SET LEX("L","H")="Display codes from"
+3 SET LEX("L","T")="coding system"
SET LEXTCTR=0
+4 FOR LEXTI=1:1:$LENGTH(LEX("L"),"/")
Begin DoDot:1
+5 NEW LEXTIC
SET LEXTIC=$PIECE(LEX("L"),"/",LEXTI)
if LEXTIC="UND"
QUIT
+6 SET LEXTCTR=LEXTCTR+1
SET LEX("L",LEXTCTR)=$$CN^LEXDDTF(LEXTIC)
End DoDot:1
+7 if LEXTCTR>1
SET LEX("L","T")=LEX("L","T")_"s"
+8 SET LEX("L","T")=LEX("L","T")_"."
+9 SET LEX("L",0)=LEXTCTR
+10 SET LEXTCTR=0
SET LEXTSTR=""
SET LEXT="L"
+11 if $GET(LEX("L",0))
DO LNK^LEXDDTF
+12 DO EOC^LEXDDT2
+13 QUIT
NONE ; LEXSHOW is Null (nothing to show)
+1 SET LEX=LEXSHOW
SET LEX("L")=LEX
SET LEXTCTR=0
SET LEXTSTR=""
SET LEXT="L"
+2 SET LEX("L","H")="Do not display Classification Codes"
SET LEX("L",0)=0
+3 DO LNK^LEXDDTF
DO EOC^LEXDDT2
+4 QUIT
