- LEXDDSD ;ISL/KER - Display Defaults - Single User Disp ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- ;
- ; Global Variables
- ; ^TMP("LEXDIC") SACC 2.3.2.5.1
- ;
- ; External References
- ; ^DIR ICR 10026
- ;
- LEXSHOW ; Translate LEXSHOW
- D:$G(^LEXT(757.2,LEXAP,200,DUZ,2))'=""
- . D DIS^LEXDDSS($G(^LEXT(757.2,LEXAP,200,DUZ,2.5)))
- . D CODES(^LEXT(757.2,LEXAP,200,DUZ,2))
- D:$G(^LEXT(757.2,LEXAP,200,DUZ,2))=""
- . D DIS^LEXDDSS("No default display defined")
- Q
- DICS ; Save filter in array LEX(
- N LEXID,LEXIC,LEXEC,LEXCLA
- N LEXCTR,LEXXI,LEXXE,LEXCT
- D LB^LEXDDSS(" Include: Exclude:")
- S LEXID="",(LEXIC,LEXEC)=0
- I $D(^TMP("LEXDIC",$J,"INC","CLASS")) D
- . F S LEXID=$O(^TMP("LEXDIC",$J,"INC","CLASS",LEXID)) Q:LEXID="" D
- . . Q:'$D(^LEX(757.11,"B",LEXID))
- . . S LEXCLA=$O(^LEX(757.11,"B",LEXID,0)),LEXIC=LEXIC+1
- . . S ^TMP("LEXDIC",$J,"INCLUDE",LEXIC,$P(^LEX(757.11,LEXCLA,0),U,2))=""
- I $D(^TMP("LEXDIC",$J,"INC","TYPE")) D
- . S LEXID=0
- . F S LEXID=$O(^TMP("LEXDIC",$J,"INC","TYPE",LEXID)) Q:+LEXID=0 D
- . . S LEXIC=LEXIC+1
- . . S ^TMP("LEXDIC",$J,"INCLUDE",LEXIC,$P(^LEX(757.12,LEXID,0),U,2))=""
- I $D(^TMP("LEXDIC",$J,"EXC","CLASS")) D
- . F S LEXID=$O(^TMP("LEXDIC",$J,"EXC","CLASS",LEXID)) Q:LEXID="" D
- . . Q:'$D(^LEX(757.11,"B",LEXID))
- . . S LEXCLA=$O(^LEX(757.11,"B",LEXID,0)),LEXEC=LEXEC+1
- . . S ^TMP("LEXDIC",$J,"EXCLUDE",LEXEC,$P(^LEX(757.11,LEXCLA,0),U,2))=""
- I $D(^TMP("LEXDIC",$J,"EXC","TYPE")) D
- . S LEXID=0
- . F S LEXID=$O(^TMP("LEXDIC",$J,"EXC","TYPE",LEXID)) Q:+LEXID=0 D
- . . S LEXEC=LEXEC+1
- . . S ^TMP("LEXDIC",$J,"EXCLUDE",LEXEC,$P(^LEX(757.12,LEXID,0),U,2))=""
- S LEXCTR=$S(LEXIC>LEXEC:LEXIC,1:LEXEC)
- N LEXXI,LEXXE F LEXCT=1:1:LEXCTR D
- . S (LEXXI,LEXXE)=""
- . S:$D(^TMP("LEXDIC",$J,"INCLUDE",LEXCT)) LEXXI=$E($O(^TMP("LEXDIC",$J,"INCLUDE",LEXCT,"")),1,35)
- . S:$D(^TMP("LEXDIC",$J,"EXCLUDE",LEXCT)) LEXXE=$E($O(^TMP("LEXDIC",$J,"EXCLUDE",LEXCT,"")),1,35)
- . D FIE^LEXDDSS(LEXXI,LEXXE)
- K ^TMP("LEXDIC",$J) Q
- Q
- CODES(LEXSTR) ; Save contents of LEXSHOW in local array LEX(
- N LEXCT F LEXCT=1:1:$L(LEXSTR,"/") D DISE^LEXDDSS(($P(LEXSTR,"/",LEXCT)))
- D:$L(LEXSTR,"/")>0 BL^LEXDDSS Q
- DP ; Display single user defaults in array LEX( continuous
- N LEXC Q:+($G(LEX(0)))=0 F LEXC=1:1:LEX(0) W !,LEX(LEXC)
- K LEX
- Q
- DSPLY ; Display Defaults contained in LEX(
- Q:'$D(LEX(0)) N LEXC,LEXLC,LEXI S LEXC="",LEXLC=0
- F LEXI=1:1:LEX(0) D Q:$G(LEXC)[U
- . W !,LEX(LEXI) D LF Q:$G(LEXC)[U
- D:LEXC'[U&(IOST["C-") CONT W:IOST["P-" @IOF
- K LEX Q
- LF ; Line Feed
- Q:LEXI=LEX(0) S LEXLC=LEXLC+1
- I IOST["P-",LEXLC>(IOSL-7) D CONT
- I IOST'["P-",LEXLC>(IOSL-4) D CONT
- Q
- CONT ; Page/Form Feed
- S LEXLC=0 I IOST["P-" W @IOF Q
- W ! S DIR("?")=" Additional information is available"
- S LEXC="" N X,Y S DIR(0)="E" D ^DIR
- S:$D(DTOUT)!(X[U) LEXC=U
- K DIR,DTOUT,DUOUT,DIRUT,DIROUT W ! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDDSD 2987 printed Feb 18, 2025@23:33:31 Page 2
- LEXDDSD ;ISL/KER - Display Defaults - Single User Disp ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
- +2 ;
- +3 ; Global Variables
- +4 ; ^TMP("LEXDIC") SACC 2.3.2.5.1
- +5 ;
- +6 ; External References
- +7 ; ^DIR ICR 10026
- +8 ;
- LEXSHOW ; Translate LEXSHOW
- +1 if $GET(^LEXT(757.2,LEXAP,200,DUZ,2))'=""
- Begin DoDot:1
- +2 DO DIS^LEXDDSS($GET(^LEXT(757.2,LEXAP,200,DUZ,2.5)))
- +3 DO CODES(^LEXT(757.2,LEXAP,200,DUZ,2))
- End DoDot:1
- +4 if $GET(^LEXT(757.2,LEXAP,200,DUZ,2))=""
- Begin DoDot:1
- +5 DO DIS^LEXDDSS("No default display defined")
- End DoDot:1
- +6 QUIT
- DICS ; Save filter in array LEX(
- +1 NEW LEXID,LEXIC,LEXEC,LEXCLA
- +2 NEW LEXCTR,LEXXI,LEXXE,LEXCT
- +3 DO LB^LEXDDSS(" Include: Exclude:")
- +4 SET LEXID=""
- SET (LEXIC,LEXEC)=0
- +5 IF $DATA(^TMP("LEXDIC",$JOB,"INC","CLASS"))
- Begin DoDot:1
- +6 FOR
- SET LEXID=$ORDER(^TMP("LEXDIC",$JOB,"INC","CLASS",LEXID))
- if LEXID=""
- QUIT
- Begin DoDot:2
- +7 if '$DATA(^LEX(757.11,"B",LEXID))
- QUIT
- +8 SET LEXCLA=$ORDER(^LEX(757.11,"B",LEXID,0))
- SET LEXIC=LEXIC+1
- +9 SET ^TMP("LEXDIC",$JOB,"INCLUDE",LEXIC,$PIECE(^LEX(757.11,LEXCLA,0),U,2))=""
- End DoDot:2
- End DoDot:1
- +10 IF $DATA(^TMP("LEXDIC",$JOB,"INC","TYPE"))
- Begin DoDot:1
- +11 SET LEXID=0
- +12 FOR
- SET LEXID=$ORDER(^TMP("LEXDIC",$JOB,"INC","TYPE",LEXID))
- if +LEXID=0
- QUIT
- Begin DoDot:2
- +13 SET LEXIC=LEXIC+1
- +14 SET ^TMP("LEXDIC",$JOB,"INCLUDE",LEXIC,$PIECE(^LEX(757.12,LEXID,0),U,2))=""
- End DoDot:2
- End DoDot:1
- +15 IF $DATA(^TMP("LEXDIC",$JOB,"EXC","CLASS"))
- Begin DoDot:1
- +16 FOR
- SET LEXID=$ORDER(^TMP("LEXDIC",$JOB,"EXC","CLASS",LEXID))
- if LEXID=""
- QUIT
- Begin DoDot:2
- +17 if '$DATA(^LEX(757.11,"B",LEXID))
- QUIT
- +18 SET LEXCLA=$ORDER(^LEX(757.11,"B",LEXID,0))
- SET LEXEC=LEXEC+1
- +19 SET ^TMP("LEXDIC",$JOB,"EXCLUDE",LEXEC,$PIECE(^LEX(757.11,LEXCLA,0),U,2))=""
- End DoDot:2
- End DoDot:1
- +20 IF $DATA(^TMP("LEXDIC",$JOB,"EXC","TYPE"))
- Begin DoDot:1
- +21 SET LEXID=0
- +22 FOR
- SET LEXID=$ORDER(^TMP("LEXDIC",$JOB,"EXC","TYPE",LEXID))
- if +LEXID=0
- QUIT
- Begin DoDot:2
- +23 SET LEXEC=LEXEC+1
- +24 SET ^TMP("LEXDIC",$JOB,"EXCLUDE",LEXEC,$PIECE(^LEX(757.12,LEXID,0),U,2))=""
- End DoDot:2
- End DoDot:1
- +25 SET LEXCTR=$SELECT(LEXIC>LEXEC:LEXIC,1:LEXEC)
- +26 NEW LEXXI,LEXXE
- FOR LEXCT=1:1:LEXCTR
- Begin DoDot:1
- +27 SET (LEXXI,LEXXE)=""
- +28 if $DATA(^TMP("LEXDIC",$JOB,"INCLUDE",LEXCT))
- SET LEXXI=$EXTRACT($ORDER(^TMP("LEXDIC",$JOB,"INCLUDE",LEXCT,"")),1,35)
- +29 if $DATA(^TMP("LEXDIC",$JOB,"EXCLUDE",LEXCT))
- SET LEXXE=$EXTRACT($ORDER(^TMP("LEXDIC",$JOB,"EXCLUDE",LEXCT,"")),1,35)
- +30 DO FIE^LEXDDSS(LEXXI,LEXXE)
- End DoDot:1
- +31 KILL ^TMP("LEXDIC",$JOB)
- QUIT
- +32 QUIT
- CODES(LEXSTR) ; Save contents of LEXSHOW in local array LEX(
- +1 NEW LEXCT
- FOR LEXCT=1:1:$LENGTH(LEXSTR,"/")
- DO DISE^LEXDDSS(($PIECE(LEXSTR,"/",LEXCT)))
- +2 if $LENGTH(LEXSTR,"/")>0
- DO BL^LEXDDSS
- QUIT
- DP ; Display single user defaults in array LEX( continuous
- +1 NEW LEXC
- if +($GET(LEX(0)))=0
- QUIT
- FOR LEXC=1:1:LEX(0)
- WRITE !,LEX(LEXC)
- +2 KILL LEX
- +3 QUIT
- DSPLY ; Display Defaults contained in LEX(
- +1 if '$DATA(LEX(0))
- QUIT
- NEW LEXC,LEXLC,LEXI
- SET LEXC=""
- SET LEXLC=0
- +2 FOR LEXI=1:1:LEX(0)
- Begin DoDot:1
- +3 WRITE !,LEX(LEXI)
- DO LF
- if $GET(LEXC)[U
- QUIT
- End DoDot:1
- if $GET(LEXC)[U
- QUIT
- +4 if LEXC'[U&(IOST["C-")
- DO CONT
- if IOST["P-"
- WRITE @IOF
- +5 KILL LEX
- QUIT
- LF ; Line Feed
- +1 if LEXI=LEX(0)
- QUIT
- SET LEXLC=LEXLC+1
- +2 IF IOST["P-"
- IF LEXLC>(IOSL-7)
- DO CONT
- +3 IF IOST'["P-"
- IF LEXLC>(IOSL-4)
- DO CONT
- +4 QUIT
- CONT ; Page/Form Feed
- +1 SET LEXLC=0
- IF IOST["P-"
- WRITE @IOF
- QUIT
- +2 WRITE !
- SET DIR("?")=" Additional information is available"
- +3 SET LEXC=""
- NEW X,Y
- SET DIR(0)="E"
- DO ^DIR
- +4 if $DATA(DTOUT)!(X[U)
- SET LEXC=U
- +5 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
- WRITE !
- QUIT