- LEXDD2 ;ISL/KER - Display Defaults - Build List ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; $$GET1^DIQ ICR 2056
- ;
- BUILD ; Display defaults
- Q:+($G(LEXDUZ))<1 Q:'$L($$GET1^DIQ(200,+($G(LEXDUZ)),.01))
- I '$D(LEXLC) N LEXLC S LEXLC=0
- I '$D(LEXC) N LEXC S LEXC=""
- APPS ; Get applications authorizing user defaults
- K LEXD S LEXD(0)=0 N LEXA,LEXAP
- D BLANK^LEXDD4,BLANK^LEXDD4,NAME^LEXDD4,BLANK^LEXDD4
- D SEV^LEXDD4
- S LEXA="" F S LEXA=$O(^LEXT(757.2,"ADEF",LEXA)) Q:LEXA="" D
- . N LEXAP S LEXAP=0
- . F S LEXAP=$O(^LEXT(757.2,"ADEF",LEXA,LEXAP)) Q:+LEXAP=0 D
- . . N LEXOK S LEXOK=$$FLD
- . . I LEXOK D
- . . . D BLANK^LEXDD4,APP^LEXDD4,BLANK^LEXDD4
- . . . S LEXDICS=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,1))
- . . . S LEXDICS(0)=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,1.5))
- . . . S LEXSHOW=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,2))
- . . . S LEXSHOW(0)=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,2.5))
- . . . S LEXSUB=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,3))
- . . . S LEXSUB(0)=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,3.5))
- . . . S LEXCTX=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,4))
- . . . S LEXCTX(0)=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,4.5))
- . . . D DEF^LEXDD4
- D DSPLY^LEXDD3
- Q
- FLD(X) ; User Defaults
- N LEX1,LEX2,LEX3,LEX4 S X=0
- S LEX1=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,1))
- S LEX2=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,2))
- S LEX3=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,3))
- S LEX4=$G(^LEXT(757.2,LEXAP,200,LEXDUZ,4))
- S:($L(LEX1)+$L(LEX2)+$L(LEX3)+$L(LEX4))>0 X=1
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDD2 1591 printed Jan 18, 2025@03:08:18 Page 2
- LEXDD2 ;ISL/KER - Display Defaults - Build List ;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 ; $$GET1^DIQ ICR 2056
- +8 ;
- BUILD ; Display defaults
- +1 if +($GET(LEXDUZ))<1
- QUIT
- if '$LENGTH($$GET1^DIQ(200,+($GET(LEXDUZ)),.01))
- QUIT
- +2 IF '$DATA(LEXLC)
- NEW LEXLC
- SET LEXLC=0
- +3 IF '$DATA(LEXC)
- NEW LEXC
- SET LEXC=""
- APPS ; Get applications authorizing user defaults
- +1 KILL LEXD
- SET LEXD(0)=0
- NEW LEXA,LEXAP
- +2 DO BLANK^LEXDD4
- DO BLANK^LEXDD4
- DO NAME^LEXDD4
- DO BLANK^LEXDD4
- +3 DO SEV^LEXDD4
- +4 SET LEXA=""
- FOR
- SET LEXA=$ORDER(^LEXT(757.2,"ADEF",LEXA))
- if LEXA=""
- QUIT
- Begin DoDot:1
- +5 NEW LEXAP
- SET LEXAP=0
- +6 FOR
- SET LEXAP=$ORDER(^LEXT(757.2,"ADEF",LEXA,LEXAP))
- if +LEXAP=0
- QUIT
- Begin DoDot:2
- +7 NEW LEXOK
- SET LEXOK=$$FLD
- +8 IF LEXOK
- Begin DoDot:3
- +9 DO BLANK^LEXDD4
- DO APP^LEXDD4
- DO BLANK^LEXDD4
- +10 SET LEXDICS=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,1))
- +11 SET LEXDICS(0)=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,1.5))
- +12 SET LEXSHOW=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,2))
- +13 SET LEXSHOW(0)=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,2.5))
- +14 SET LEXSUB=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,3))
- +15 SET LEXSUB(0)=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,3.5))
- +16 SET LEXCTX=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,4))
- +17 SET LEXCTX(0)=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,4.5))
- +18 DO DEF^LEXDD4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 DO DSPLY^LEXDD3
- +20 QUIT
- FLD(X) ; User Defaults
- +1 NEW LEX1,LEX2,LEX3,LEX4
- SET X=0
- +2 SET LEX1=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,1))
- +3 SET LEX2=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,2))
- +4 SET LEX3=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,3))
- +5 SET LEX4=$GET(^LEXT(757.2,LEXAP,200,LEXDUZ,4))
- +6 if ($LENGTH(LEX1)+$LENGTH(LEX2)+$LENGTH(LEX3)+$LENGTH(LEX4))>0
- SET X=1
- +7 QUIT X