source: FOIAVistA/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRECCL.m@ 710

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1USRECCL ; SLC/PKR,MA - Routines for expanding/collapsing class views ;2/21/01 14:53
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**7,18**;Jun 20, 1997
3 ; Patch USR*1*18 additional quit to contract logic in tag EC.
4 ; This routine invokes IA #872
5 ;======================================================================
6COPYCL(LIST,LSTART,START,END) ;Copy elements of ^TMP("USRCLASS",$J) starting
7 ;at START going to END.
8 N IND,TEXT
9 F IND=START:1:END D
10 . S LSTART=LSTART+1
11 . S TEXT=^TMP("USRCLASS",$J,IND,0)
12 . S TEXT=$$SETFLD^VALM1(LSTART,TEXT,"NUMBER")
13 . S LIST(LSTART)=TEXT_U_$P($G(^TMP("USRCLASSIDX",$J,IND)),U,2)
14 Q LSTART
15 ;
16 ;======================================================================
17EC(VALMY) ;Expand or contract the list of classes in VALMY.
18 ;Make sure the request is valid.
19 I '$$VEXREQ(.VALMY) Q
20 N ACTION,DIROUT,LISTNUM,REBUILD,START,TSTART,TEXT,TMPLIST
21 N USRDATA,USRI,USRIEN,USRPICK
22 S REBUILD=0
23 S START=1
24 S TSTART=0
25 S USRI=""
26 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
27 . S USRDATA=^TMP("USRCLASSIDX",$J,USRI)
28 . S LISTNUM=$P(USRDATA,U,1)
29 . S USRIEN=$P(USRDATA,U,2)
30 . S TEXT=$G(^TMP("USRCLASS",$J,LISTNUM,0))
31 . S ACTION=$S(TEXT["+":"+",TEXT["-":"-",1:"")
32 . I ACTION="" Q
33 .;If ACTION="+" then expand the class, if ACTION="-" shrink the class.
34 . I ACTION="+" D
35 .. S REBUILD=1
36 .. S TSTART=$$COPYCL(.TMPLIST,TSTART,START,LISTNUM-1)
37 .. S START=LISTNUM+1
38 .. S TSTART=TSTART+1
39 .. S TMPLIST(TSTART)=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
40 .. S TMPLIST(TSTART)=$TR(TMPLIST(TSTART),"+","-")
41 .. S TMPLIST(TSTART)=TMPLIST(TSTART)_U_USRIEN
42 .. S TSTART=$$INSSUB(.TMPLIST,TSTART,USRIEN)
43 .;
44 . I ACTION="-" D
45 .. N TEMP,CONTRACT
46 .. S REBUILD=1
47 .. S TSTART=$$COPYCL(.TMPLIST,TSTART,START,LISTNUM-1)
48 .. S TSTART=TSTART+1
49 .. S TMPLIST(TSTART)=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
50 .. S LEVEL=$L(TEXT,"|")
51 .. S TMPLIST(TSTART)=$TR(TMPLIST(TSTART),"-","+")_U_USRIEN
52 .. S START=USRI+1
53 .. S CONTRACT=1
54 .. ; Patch 18 added the second quit.
55 .. F Q:'CONTRACT Q:'$D(^TMP("USRCLASS",$J,START,0)) D
56 ... S TEMP=^TMP("USRCLASS",$J,START,0)
57 ...;Contract if at a or higher level than the main line
58 ... I TEMP["|",$L(TEMP,"|")>LEVEL S START=START+1
59 ... E S CONTRACT=0
60 .;
61 .;Restore the original video attributes.
62 . D RESTORE^VALM10(USRI)
63 ;No more classes to expand or contract, add the rest of the list.
64 I 'REBUILD Q
65 S LISTNUM=$P(^TMP("USRCLASS",$J,0),U,1)
66 S TSTART=$$COPYCL(.TMPLIST,TSTART,START,LISTNUM)
67 ;Rebuild the ^TMP arrays.
68 K ^TMP("USRCLASS",$J),^TMP("USRCLASSIDX",$J),^TMP("USRCLASS",$J,"PICK")
69 S VALMCNT=0
70 S START=0
71 F S START=$O(TMPLIST(START)) Q:START="" D
72 . S VALMCNT=VALMCNT+1
73 . S TEXT=$P(TMPLIST(START),U,1)
74 . S USRIEN=$P(TMPLIST(START),U,2)
75 . S ^TMP("USRCLASS",$J,START,0)=TEXT
76 . S ^TMP("USRCLASS",$J,"IDX",START,START)=""
77 . S ^TMP("USRCLASSIDX",$J,START)=START_U_USRIEN
78 . ;S ^TMP("USRCLASS",$J,"PICK",START,START)=""
79 S ^TMP("USRCLASS",$J,0)=VALMCNT
80 S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
81 S ^TMP("USRCLASS",$J,"#")=USRPICK_U_"1:"_+$G(VALMCNT)
82 Q
83 ;
84 ;======================================================================
85INSSUB(LIST,TSTART,USRIEN) ;Insert the subclasses into the list.
86 N ACTIVE,CLN,CLNS,DATA,IND,IEN,LEVEL,MSG,TEXT
87 ;Determine the level of the subclass and create the appropriate
88 ;diagram.
89 S LEVEL=$L(LIST(TSTART),"|")
90 I LEVEL=1 S CLNS=" "
91 E S CLNS=""
92 F IND=2:1:LEVEL S CLNS=CLNS_" | "
93 I LEVEL>1 S CLNS=CLNS_" |_"
94 E S CLNS=CLNS_"|_"
95 S IND=0
96 F S IND=$O(^USR(8930,USRIEN,1,IND)) Q:+IND=0 D
97 . S IEN=^USR(8930,USRIEN,1,IND,0)
98 . S DATA=$G(^USR(8930,IEN,0))
99 . S TSTART=TSTART+1
100 . S TEXT=$$SETFLD^VALM1(TSTART,"","NUMBER")
101 . S CLN=CLNS
102 . I $D(^USR(8930,IEN,1,0))&$D(^USR(8930,IEN,1,"B")) S CLN=CLN_"+"
103 . E S CLN=CLN_" "
104 . S CLN=CLN_$P(DATA,U,4)
105 . S TEXT=$$SETFLD^VALM1(CLN,TEXT,"CLASS NAME")
106 . S TEXT=$$SETFLD^VALM1($P(DATA,U,2),TEXT,"ABBREVIATION")
107 . S ACTIVE=$$EXTERNAL^DILFD(8930,.03,"",$P(DATA,U,3),"MSG")
108 . S TEXT=$$SETFLD^VALM1(ACTIVE,TEXT,"ACTIVE")
109 .;NEED USRCLASSIDX INFO
110 . S LIST(TSTART)=TEXT_U_IEN
111 Q TSTART
112 ;
113 ;======================================================================
114ISSUB(CLASS1,CLASS2,LEVEL) ;Return true if CLASS2 is sub to CLASS1.
115 N IND,ISSUB
116 I LEVEL(CLASS1)'<LEVEL(CLASS2) Q 0
117 ;Check sublevel links between class1 and class2
118 S ISSUB=1
119 F IND=(CLASS1+1):1:(CLASS2-1) D
120 . I LEVEL(IND)=1 D Q
121 .. S ISSUB=0
122 Q ISSUB
123 ;
124 ;======================================================================
125VEXREQ(VALMY) ;Check for valid expand/contract requests.
126 N END,START
127 S START=$O(VALMY(""))
128 S END=$O(VALMY(""),-1)
129 I START=END Q 1
130 ;
131 N ACTION,ACTIND,ACTJND,CIND,CN,IND,JND,LEVEL,MSG,TEXT,VALID
132 ;Build the level list.
133 F IND=START:1:END D
134 . S LEVEL(IND)=$L(^TMP("USRCLASS",$J,IND,0),"|")
135 S VALID=1
136 S IND=""
137 F S IND=$O(VALMY(IND)) Q:IND="" D
138 . S TEXT(IND)=$G(^TMP("USRCLASS",$J,IND,0))
139 . S ACTIND=$S(TEXT(IND)["+":"+ ",TEXT(IND)["-":"-",1:"")
140 . I ACTIND="" Q
141 . S ACTION(IND)=$S(TEXT(IND)["+":"expand ",TEXT(IND)["-":"collapse ",1:"")
142 . S JND=IND
143 . F S JND=$O(VALMY(JND)) Q:JND="" D
144 .. S TEXT(JND)=$G(^TMP("USRCLASS",$J,JND,0))
145 .. S ACTJND=$S(TEXT(JND)["+":"+",TEXT(JND)["-":"-",1:"")
146 .. I ACTJND="" Q
147 .. S ACTION(JND)=$S(TEXT(JND)["+":"expand ",TEXT(JND)["-":"collapse ",1:"")
148 .. I $$ISSUB(IND,JND,.LEVEL) D
149 ... I ACTION(IND)'=ACTION(JND) D Q
150 .... S CIND(IND)=$P(^TMP("USRCLASSIDX",$J,IND),U,2)
151 .... S CN(IND)=$P(^USR(8930,CIND(IND),0),U,1)
152 .... S CIND(JND)=$P(^TMP("USRCLASSIDX",$J,JND),U,2)
153 .... S CN(JND)=$P(^USR(8930,CIND(JND),0),U,1)
154 .... S MSG="You cannot "_ACTION(IND)_CN(IND)_" and "_ACTION(JND)_CN(JND)
155 .... D MSG^VALM10(MSG)
156 .... H 4
157 .... S VALID=0
158 Q VALID
159 ;
Note: See TracBrowser for help on using the repository browser.