source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDDSD.m@ 814

Last change on this file since 814 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1LEXDDSD ; ISL Display Defaults - Single User Disp ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4LEXSHOW ; Translate LEXSHOW
5 D:$G(^LEXT(757.2,LEXAP,200,DUZ,2))'=""
6 . D DIS^LEXDDSS($G(^LEXT(757.2,LEXAP,200,DUZ,2.5)))
7 . D CODES(^LEXT(757.2,LEXAP,200,DUZ,2))
8 D:$G(^LEXT(757.2,LEXAP,200,DUZ,2))=""
9 . D DIS^LEXDDSS("No default display defined")
10 Q
11DICS ; Save filter in array LEX(
12 N LEXID,LEXIC,LEXEC,LEXCLA
13 N LEXCTR,LEXXI,LEXXE,LEXCT
14 D LB^LEXDDSS(" Include: Exclude:")
15 S LEXID="",(LEXIC,LEXEC)=0
16 I $D(^TMP("LEXDIC",$J,"INC","CLASS")) D
17 . F S LEXID=$O(^TMP("LEXDIC",$J,"INC","CLASS",LEXID)) Q:LEXID="" D
18 . . Q:'$D(^LEX(757.11,"B",LEXID))
19 . . S LEXCLA=$O(^LEX(757.11,"B",LEXID,0)),LEXIC=LEXIC+1
20 . . S ^TMP("LEXDIC",$J,"INCLUDE",LEXIC,$P(^LEX(757.11,LEXCLA,0),U,2))=""
21 I $D(^TMP("LEXDIC",$J,"INC","TYPE")) D
22 . S LEXID=0
23 . F S LEXID=$O(^TMP("LEXDIC",$J,"INC","TYPE",LEXID)) Q:+LEXID=0 D
24 . . S LEXIC=LEXIC+1
25 . . S ^TMP("LEXDIC",$J,"INCLUDE",LEXIC,$P(^LEX(757.12,LEXID,0),U,2))=""
26 I $D(^TMP("LEXDIC",$J,"EXC","CLASS")) D
27 . F S LEXID=$O(^TMP("LEXDIC",$J,"EXC","CLASS",LEXID)) Q:LEXID="" D
28 . . Q:'$D(^LEX(757.11,"B",LEXID))
29 . . S LEXCLA=$O(^LEX(757.11,"B",LEXID,0)),LEXEC=LEXEC+1
30 . . S ^TMP("LEXDIC",$J,"EXCLUDE",LEXEC,$P(^LEX(757.11,LEXCLA,0),U,2))=""
31 I $D(^TMP("LEXDIC",$J,"EXC","TYPE")) D
32 . S LEXID=0
33 . F S LEXID=$O(^TMP("LEXDIC",$J,"EXC","TYPE",LEXID)) Q:+LEXID=0 D
34 . . S LEXEC=LEXEC+1
35 . . S ^TMP("LEXDIC",$J,"EXCLUDE",LEXEC,$P(^LEX(757.12,LEXID,0),U,2))=""
36 S LEXCTR=$S(LEXIC>LEXEC:LEXIC,1:LEXEC)
37 N LEXXI,LEXXE F LEXCT=1:1:LEXCTR D
38 . S (LEXXI,LEXXE)=""
39 . S:$D(^TMP("LEXDIC",$J,"INCLUDE",LEXCT)) LEXXI=$E($O(^TMP("LEXDIC",$J,"INCLUDE",LEXCT,"")),1,35)
40 . S:$D(^TMP("LEXDIC",$J,"EXCLUDE",LEXCT)) LEXXE=$E($O(^TMP("LEXDIC",$J,"EXCLUDE",LEXCT,"")),1,35)
41 . D FIE^LEXDDSS(LEXXI,LEXXE)
42 K ^TMP("LEXDIC",$J) Q
43 Q
44CODES(LEXSTR) ; Save contents of LEXSHOW in local array LEX(
45 N LEXCT F LEXCT=1:1:$L(LEXSTR,"/") D DISE^LEXDDSS(($P(LEXSTR,"/",LEXCT)))
46 D:$L(LEXSTR,"/")>0 BL^LEXDDSS Q
47DP ; Display single user defaults in array LEX( continuous
48 N LEXC Q:+($G(LEX(0)))=0 F LEXC=1:1:LEX(0) W !,LEX(LEXC)
49 K LEX
50 Q
51DSPLY ; Display Defaults contained in LEX(
52 Q:'$D(LEX(0)) N LEXC,LEXLC,LEXI S LEXC="",LEXLC=0
53 F LEXI=1:1:LEX(0) D Q:$G(LEXC)[U
54 . W !,LEX(LEXI) D LF Q:$G(LEXC)[U
55 D:LEXC'[U&(IOST["C-") CONT W:IOST["P-" @IOF
56 K LEX Q
57LF ; Line Feed
58 Q:LEXI=LEX(0) S LEXLC=LEXLC+1
59 I IOST["P-",LEXLC>(IOSL-7) D CONT
60 I IOST'["P-",LEXLC>(IOSL-4) D CONT
61 Q
62CONT ; Page/Form Feed
63 S LEXLC=0 I IOST["P-" W @IOF Q
64 W ! S DIR("?")=" Additional information is available"
65 S LEXC="" N X,Y S DIR(0)="E" D ^DIR
66 S:$D(DTOUT)!(X[U) LEXC=U
67 K DIR,DTOUT,DUOUT,DIRUT,DIROUT W ! Q
Note: See TracBrowser for help on using the repository browser.