LEXDD2.m

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 ---LEXDD2   1591     printed  Apr 09, 2024@21:13:43                                                                                                                                                                                                      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