Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXDDSD

LEXDDSD.m

Go to the documentation of this file.
  1. LEXDDSD ;ISL/KER - Display Defaults - Single User Disp ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
  1. ;
  1. ; Global Variables
  1. ; ^TMP("LEXDIC") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; ^DIR ICR 10026
  1. ;
  1. LEXSHOW ; Translate LEXSHOW
  1. D:$G(^LEXT(757.2,LEXAP,200,DUZ,2))'=""
  1. . D DIS^LEXDDSS($G(^LEXT(757.2,LEXAP,200,DUZ,2.5)))
  1. . D CODES(^LEXT(757.2,LEXAP,200,DUZ,2))
  1. D:$G(^LEXT(757.2,LEXAP,200,DUZ,2))=""
  1. . D DIS^LEXDDSS("No default display defined")
  1. Q
  1. DICS ; Save filter in array LEX(
  1. N LEXID,LEXIC,LEXEC,LEXCLA
  1. N LEXCTR,LEXXI,LEXXE,LEXCT
  1. D LB^LEXDDSS(" Include: Exclude:")
  1. S LEXID="",(LEXIC,LEXEC)=0
  1. I $D(^TMP("LEXDIC",$J,"INC","CLASS")) D
  1. . F S LEXID=$O(^TMP("LEXDIC",$J,"INC","CLASS",LEXID)) Q:LEXID="" D
  1. . . Q:'$D(^LEX(757.11,"B",LEXID))
  1. . . S LEXCLA=$O(^LEX(757.11,"B",LEXID,0)),LEXIC=LEXIC+1
  1. . . S ^TMP("LEXDIC",$J,"INCLUDE",LEXIC,$P(^LEX(757.11,LEXCLA,0),U,2))=""
  1. I $D(^TMP("LEXDIC",$J,"INC","TYPE")) D
  1. . S LEXID=0
  1. . F S LEXID=$O(^TMP("LEXDIC",$J,"INC","TYPE",LEXID)) Q:+LEXID=0 D
  1. . . S LEXIC=LEXIC+1
  1. . . S ^TMP("LEXDIC",$J,"INCLUDE",LEXIC,$P(^LEX(757.12,LEXID,0),U,2))=""
  1. I $D(^TMP("LEXDIC",$J,"EXC","CLASS")) D
  1. . F S LEXID=$O(^TMP("LEXDIC",$J,"EXC","CLASS",LEXID)) Q:LEXID="" D
  1. . . Q:'$D(^LEX(757.11,"B",LEXID))
  1. . . S LEXCLA=$O(^LEX(757.11,"B",LEXID,0)),LEXEC=LEXEC+1
  1. . . S ^TMP("LEXDIC",$J,"EXCLUDE",LEXEC,$P(^LEX(757.11,LEXCLA,0),U,2))=""
  1. I $D(^TMP("LEXDIC",$J,"EXC","TYPE")) D
  1. . S LEXID=0
  1. . F S LEXID=$O(^TMP("LEXDIC",$J,"EXC","TYPE",LEXID)) Q:+LEXID=0 D
  1. . . S LEXEC=LEXEC+1
  1. . . S ^TMP("LEXDIC",$J,"EXCLUDE",LEXEC,$P(^LEX(757.12,LEXID,0),U,2))=""
  1. S LEXCTR=$S(LEXIC>LEXEC:LEXIC,1:LEXEC)
  1. N LEXXI,LEXXE F LEXCT=1:1:LEXCTR D
  1. . S (LEXXI,LEXXE)=""
  1. . S:$D(^TMP("LEXDIC",$J,"INCLUDE",LEXCT)) LEXXI=$E($O(^TMP("LEXDIC",$J,"INCLUDE",LEXCT,"")),1,35)
  1. . S:$D(^TMP("LEXDIC",$J,"EXCLUDE",LEXCT)) LEXXE=$E($O(^TMP("LEXDIC",$J,"EXCLUDE",LEXCT,"")),1,35)
  1. . D FIE^LEXDDSS(LEXXI,LEXXE)
  1. K ^TMP("LEXDIC",$J) Q
  1. Q
  1. CODES(LEXSTR) ; Save contents of LEXSHOW in local array LEX(
  1. N LEXCT F LEXCT=1:1:$L(LEXSTR,"/") D DISE^LEXDDSS(($P(LEXSTR,"/",LEXCT)))
  1. D:$L(LEXSTR,"/")>0 BL^LEXDDSS Q
  1. DP ; Display single user defaults in array LEX( continuous
  1. N LEXC Q:+($G(LEX(0)))=0 F LEXC=1:1:LEX(0) W !,LEX(LEXC)
  1. K LEX
  1. Q
  1. DSPLY ; Display Defaults contained in LEX(
  1. Q:'$D(LEX(0)) N LEXC,LEXLC,LEXI S LEXC="",LEXLC=0
  1. F LEXI=1:1:LEX(0) D Q:$G(LEXC)[U
  1. . W !,LEX(LEXI) D LF Q:$G(LEXC)[U
  1. D:LEXC'[U&(IOST["C-") CONT W:IOST["P-" @IOF
  1. K LEX Q
  1. LF ; Line Feed
  1. Q:LEXI=LEX(0) S LEXLC=LEXLC+1
  1. I IOST["P-",LEXLC>(IOSL-7) D CONT
  1. I IOST'["P-",LEXLC>(IOSL-4) D CONT
  1. Q
  1. CONT ; Page/Form Feed
  1. S LEXLC=0 I IOST["P-" W @IOF Q
  1. W ! S DIR("?")=" Additional information is available"
  1. S LEXC="" N X,Y S DIR(0)="E" D ^DIR
  1. S:$D(DTOUT)!(X[U) LEXC=U
  1. K DIR,DTOUT,DUOUT,DIRUT,DIROUT W ! Q