LEXDDTV ;ISL/KER - Display Defaults - Vocabulary ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; None
;
SUB ; Select between Logical and Physical Subsets
; Required LEXSUB Optional LEXDICS
N LEXTCTR,LEXTD,LEXTI,LEXTIC,LEXTL,LEXTN,LEXTSTR,LEXT,LEXTV
K LEX S:'$L($G(LEXSUB)) LEX="WRD"
S:$L($G(LEXSUB)) LEX=LEXSUB
S:'$D(LEXSTLN) LEXSTLN=56
S LEXTI=0,(LEXTIC,LEXTN,LEXTV,LEXTD)="" D INT
K:LEXSTLN=56 LEXSTLN Q
INT ; Interpret string
; LEXSUB is an Application Subset "AB"
I $D(^LEXT(757.2,"AB",LEX)) D
. S LEXTIC=$O(^LEXT(757.2,"AB",LEX,0))
. S LEXTN=$P($G(^LEXT(757.2,+LEXTIC,0)),"^",1)
. I +LEXTIC'=1 S LEXTN=LEXTN_" Subset"
; LEXSUB is a Compiled Subset "AA"
I $D(^LEXT(757.2,"AA",LEX)) D
. S LEXTIC=$O(^LEXT(757.2,"AA",LEX,0))
. S LEXTN=$P($G(^LEXT(757.2,+LEXTIC,0)),"^",1)
. I +LEXTIC'=1 S LEXTN=LEXTN_" Subset"
; View of a Subset - DIC("S") with LEXSUB
I $L($G(LEXDICS)) D
. S LEXTD=""
. F S LEXTD=$O(^LEXT(757.2,"AB",LEXTD)) Q:LEXTD=""!(LEXTV'="") D
. . S LEXTL=$O(^LEXT(757.2,"AB",LEXTD,0)) Q:+LEXTL'>0
. . I $G(^LEXT(757.2,+LEXTL,6))=LEXDICS D
. . . S LEXTV=$P($G(^LEXT(757.2,+LEXTL,0)),"^",1)
; Build temporary phrase
I LEXTV'="",LEXTN'="" S LEX("V",1)=LEXTV_" view of the "_LEXTN
I LEXTV="",LEXTN'="" K LEX("V")
; Process phrase
I $D(LEX("V",1)) D
. S LEX("V",0)=1,LEXT="V",LEXTCTR=0,LEXTSTR=""
. D CONCAT^LEXDDT2 K LEX("V")
. I $E(LEXTSTR,$L(LEXTSTR))?1P S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
. I $E(LEXTSTR,$L(LEXTSTR))?1P S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
. D EOC^LEXDDT2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDDTV 1724 printed Dec 13, 2024@02:07:34 Page 2
LEXDDTV ;ISL/KER - Display Defaults - Vocabulary ;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 ;
SUB ; Select between Logical and Physical Subsets
+1 ; Required LEXSUB Optional LEXDICS
+2 NEW LEXTCTR,LEXTD,LEXTI,LEXTIC,LEXTL,LEXTN,LEXTSTR,LEXT,LEXTV
+3 KILL LEX
if '$LENGTH($GET(LEXSUB))
SET LEX="WRD"
+4 if $LENGTH($GET(LEXSUB))
SET LEX=LEXSUB
+5 if '$DATA(LEXSTLN)
SET LEXSTLN=56
+6 SET LEXTI=0
SET (LEXTIC,LEXTN,LEXTV,LEXTD)=""
DO INT
+7 if LEXSTLN=56
KILL LEXSTLN
QUIT
INT ; Interpret string
+1 ; LEXSUB is an Application Subset "AB"
+2 IF $DATA(^LEXT(757.2,"AB",LEX))
Begin DoDot:1
+3 SET LEXTIC=$ORDER(^LEXT(757.2,"AB",LEX,0))
+4 SET LEXTN=$PIECE($GET(^LEXT(757.2,+LEXTIC,0)),"^",1)
+5 IF +LEXTIC'=1
SET LEXTN=LEXTN_" Subset"
End DoDot:1
+6 ; LEXSUB is a Compiled Subset "AA"
+7 IF $DATA(^LEXT(757.2,"AA",LEX))
Begin DoDot:1
+8 SET LEXTIC=$ORDER(^LEXT(757.2,"AA",LEX,0))
+9 SET LEXTN=$PIECE($GET(^LEXT(757.2,+LEXTIC,0)),"^",1)
+10 IF +LEXTIC'=1
SET LEXTN=LEXTN_" Subset"
End DoDot:1
+11 ; View of a Subset - DIC("S") with LEXSUB
+12 IF $LENGTH($GET(LEXDICS))
Begin DoDot:1
+13 SET LEXTD=""
+14 FOR
SET LEXTD=$ORDER(^LEXT(757.2,"AB",LEXTD))
if LEXTD=""!(LEXTV'="")
QUIT
Begin DoDot:2
+15 SET LEXTL=$ORDER(^LEXT(757.2,"AB",LEXTD,0))
if +LEXTL'>0
QUIT
+16 IF $GET(^LEXT(757.2,+LEXTL,6))=LEXDICS
Begin DoDot:3
+17 SET LEXTV=$PIECE($GET(^LEXT(757.2,+LEXTL,0)),"^",1)
End DoDot:3
End DoDot:2
End DoDot:1
+18 ; Build temporary phrase
+19 IF LEXTV'=""
IF LEXTN'=""
SET LEX("V",1)=LEXTV_" view of the "_LEXTN
+20 IF LEXTV=""
IF LEXTN'=""
KILL LEX("V")
+21 ; Process phrase
+22 IF $DATA(LEX("V",1))
Begin DoDot:1
+23 SET LEX("V",0)=1
SET LEXT="V"
SET LEXTCTR=0
SET LEXTSTR=""
+24 DO CONCAT^LEXDDT2
KILL LEX("V")
+25 IF $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))?1P
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
+26 IF $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))?1P
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
+27 DO EOC^LEXDDT2
End DoDot:1
+28 QUIT
