- 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 Feb 18, 2025@23:33:38 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
