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 Dec 13, 2024@02:07:23 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
