source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURECL.m@ 1806

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

initial load of WorldVistAEHR
File size: 8.2 KB
RevLine 
[613]1TIURECL ; SLC/PKR,JER - Expand/collapse LM views ;3/14/01
2 ;;1.0;TEXT INTETRATION UTILITIES;**88,100**;Jun 20, 1997
3 ;======================================================================
4COPYCL(LSTART,START,END) ;Copy elements of List into ^TMP("TMPLIST",$J),
5 ;starting at START going to END.
6 N IND,TEXT
7 S ^TMP("TMPLIST",$J,0)=$G(@VALMAR@(0))
8 S ^TMP("TMPLIST",$J,"TIURIDX0")=$G(^TMP("TIURIDX",$J,0))
9 ; -- Copy numbered lines: --
10 F IND=START:1:END D:$D(@VALMAR@(IND,0))
11 . S LSTART=LSTART+1
12 . S TEXT=@VALMAR@(IND,0)
13 . S TEXT=$$SETFLD^VALM1(LSTART,TEXT,"NUMBER")
14 . S ^TMP("TMPLIST",$J,LSTART)=TEXT_U_$P($G(^TMP("TIURIDX",$J,IND)),U,2,4)
15 ; -- Copy other nodes, skipping "IDX", "IEN", "EXPAND",
16 ; & "IDDATA", where I need >1 subscript: --
17 S IND="A"
18 F S IND=$O(@VALMAR@(IND)) Q:IND="" D
19 . Q:$S(IND="IDX":1,IND="IEN":1,IND="EXPAND":1,IND="IDDATA":1,1:0)
20 . S ^TMP("TMPLIST",$J,IND)=$G(@VALMAR@(IND))
21 ; -- Copy "EXPAND" node: --
22 S IND=0
23 F S IND=$O(@VALMAR@("EXPAND",IND)) Q:IND="" D
24 . S ^TMP("TMPLIST",$J,"EXPAND",IND)=$G(@VALMAR@("EXPAND",IND))
25 ; -- Copy "IDDATA" node: --
26 S IND=0
27 F S IND=$O(@VALMAR@("IDDATA",IND)) Q:IND="" D
28 . S ^TMP("TMPLIST",$J,"IDDATA",IND)=$G(@VALMAR@("IDDATA",IND))
29 ; -- Copy "IEN" node: --
30 S IND=0
31 F S IND=$O(@VALMAR@("IEN",IND)) Q:IND="" D
32 . N TIUJ S TIUJ=0
33 . F S TIUJ=$O(@VALMAR@("IEN",IND,TIUJ)) Q:+TIUJ'>0 D
34 . . S ^TMP("TMPLIST",$J,"IEN",IND,TIUJ)=""
35 Q LSTART
36 ;
37 ;======================================================================
38EC(VALMY) ;Expand or contract the tree view in VALMY.
39 ;Make sure the request is valid.
40 I '$$VEXREQ^TIURECL1(.VALMY) Q
41 N TIUI
42 S TIUI=""
43 ; -- Traverse pick list in reverse to avoid collisions: --
44 F S TIUI=$O(VALMY(TIUI),-1) Q:+TIUI'>0 D EC1(TIUI)
45 Q
46 ;
47 ;======================================================================
48EC1(TIUI,HUSH) ; Expand a single List Element (line TIUI):
49 ; ORIGPFIX = $$PREFIX^TIULA2
50 ; = Indicators followed by space (if there are any).
51 ; EX:"+< ", or "*+< ", etc.
52 ; CURPFIX = Beginning characters of title/pt column, up to
53 ; but not including title/pt itself.
54 ; = Possible spacer characters (e.g. " |_"),
55 ; followed by possible indicators_space
56 ; (if there are any). If item is expanded,
57 ; indicators +, <, or +< may be replaced
58 ; with "-".
59 ; EX: " |_- ", or " | |_", etc
60 ; When getting indicators for new prefix, EC1 checks for changes
61 ;in record being expanded (changes such as getting an addendum).
62 ; EC1 updates prefix and ^TMP("TIURIDX",$J,listno) with such
63 ;changes.
64 ; EC1 does NOT update text of line, or ^TMP("TIUR",$J,"IDDATA",DA).
65 N ORIGPFIX,CURPFIX,TIUGDATA,PRMSORT,NEWPFIX
66 N TSTART,START,LISTNUM,REBUILD,TEXT
67 N TIUDATA,TIUDA,TIUPICK
68 S START=1,(REBUILD,TSTART)=0
69 K ^TMP("TMPLIST",$J)
70 S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) Q:'+TIUDATA
71 S LISTNUM=$P(TIUDATA,U,1)
72 ; -- Retrieve DA, current prefix; get original prefix: --
73 S TIUDA=$P(TIUDATA,U,2),CURPFIX=$P(TIUDATA,U,3)
74 S ORIGPFIX=$$PREFIX^TIULA2(TIUDA)
75 S NEWPFIX=$$UPPFIX^TIURL1(TIUDA,CURPFIX)
76 ; ---- If docmt cannot be expanded or collapsed, say so and quit: ----
77 I ORIGPFIX'["+",ORIGPFIX'["<",CURPFIX'["-" D Q
78 . N MSG
79 . D RESTORE^VALM10(TIUI)
80 . I '+$G(HUSH) D
81 . . S MSG="** Item #"_TIUI_" cannot be expanded/collapsed. **"
82 . . D MSG^VALM10(MSG) H 2
83 S TEXT=$G(@VALMAR@(LISTNUM,0))
84 ; ---- If docmt not expanded & has addenda but no ID kids,
85 ; expand to show adda: ----
86 I CURPFIX'["-",ORIGPFIX["+",ORIGPFIX'["<" D
87 . S REBUILD=1
88 . ; -- Set lines (from beg to line before TIUI) into ^TMP("TMPLIST",$J):
89 . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
90 . S START=LISTNUM+1
91 . ;-- Set line TIUI into ^TMP("TMPLIST",$J), updating flds NUMBER,
92 . ; and TITLE or PATIENT, with new prefix and spacing: --
93 . S TSTART=TSTART+1
94 . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
95 . S NEWPFIX=$S(NEWPFIX["+>":$TR(NEWPFIX,"+>","-"),1:$TR(NEWPFIX,"+","-"))
96 . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
97 . ; -- Save DA, prefixes, etc., for next time: --
98 . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
99 . ; -- Insert addenda of TIUI: --
100 . S TSTART=$$INSADD^TIURECL2(TSTART,TIUDA,NEWPFIX)
101 . ; -- Update EXPAND index to compensate for insertion: --
102 . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D BUMPEXP(TIUI,TSTART)
103 . ; -- Set new EXPAND node: --
104 . S @VALMAR@("EXPAND",TIUI)=TIUDA
105 ; ---- If tree view can be collapsed, then collapse it: ----
106 I CURPFIX["-" D
107 . N TEMP,CONTRACT,LEVEL
108 . S REBUILD=1
109 . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
110 . S TSTART=TSTART+1
111 . S LEVEL=$L(TEXT,"|")
112 . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
113 . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
114 . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
115 . S START=TIUI+1
116 . S CONTRACT=1
117 . F Q:'CONTRACT D
118 .. S TEMP=$G(@VALMAR@(START,0))
119 ..; -- Contract if at a higher level than the main line: --
120 .. I TEMP["|",$L(TEMP,"|")>LEVEL S START=START+1
121 .. E S CONTRACT=0
122 . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D SUCKEXP(START,TSTART)
123 . K @VALMAR@("EXPAND",TIUI),^TMP("TMPLIST",$J,"EXPAND",TIUI)
124 ; ---- If docmt has ID kids & hasn't
125 ; been expanded, then expand it to show ID kids: ----
126 I CURPFIX'["-",ORIGPFIX["<" D
127 . ; -- Retrieve ID entry order (from docmt parameter): --
128 . ; (Entry order should be ok even if rest needs update.)
129 . S TIUGDATA=^TMP("TIUR",$J,"IDDATA",TIUDA)
130 . S PRMSORT=$P(TIUGDATA,U,4)
131 . S REBUILD=1
132 . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
133 . S START=LISTNUM+1
134 . S TSTART=TSTART+1
135 . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
136 . S NEWPFIX=$S(NEWPFIX["+<":$TR(NEWPFIX,"+<","-"),NEWPFIX["<":$TR(NEWPFIX,"<","-"),1:$TR(NEWPFIX,"+","-"))
137 . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
138 . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
139 . S TSTART=$$INSKIDS^TIURECL2(TSTART,TIUDA,NEWPFIX,PRMSORT)
140 . S ^TMP("TMPLIST",$J,"IDDATA",TIUDA)=TIUGDATA
141 . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D BUMPEXP(TIUI,TSTART)
142 . ; -- Set new EXPAND node: --
143 . S @VALMAR@("EXPAND",TIUI)=TIUDA
144 ; -- Restore the original video attributes: --
145 D RESTORE^VALM10(TIUI)
146 I 'REBUILD Q
147 ; ---- Add the rest of the list to ^TMP("TMPLIST",$J):
148 S LISTNUM=$P(@VALMAR@(0),U,1)
149 S TSTART=$$COPYCL(TSTART,START,LISTNUM)
150 ; --Rebuild the LM ^TMP arrays: --
151 K @VALMAR,^TMP("TIURIDX",$J)
152 S VALMCNT=0
153 S START=0,@VALMAR@(0)=^TMP("TMPLIST",$J,0)
154 S ^TMP("TIURIDX",$J,0)=^TMP("TMPLIST",$J,"TIURIDX0")
155 ; -- Rebuild numbered lines and IDX and TIURIDX nodes: --
156 N CURPFX
157 F S START=$O(^TMP("TMPLIST",$J,START)) Q:+START'>0 D
158 . S VALMCNT=VALMCNT+1
159 . S TEMP=^TMP("TMPLIST",$J,START)
160 . S TEXT=$P(TEMP,U),TIUDA=$P(TEMP,U,2),CURPFX=$P(TEMP,U,3)
161 . S @VALMAR@(START,0)=TEXT
162 . D RESTORE^VALM10(START)
163 . S @VALMAR@("IDX",START,START)=""
164 . S ^TMP("TIURIDX",$J,START)=START_U_TIUDA_U_CURPFX
165 . S @VALMAR@("IEN",TIUDA,START)=""
166 S $P(@VALMAR@(0),U)=VALMCNT
167 ; -- Rebuild other nodes: --
168 S START="A"
169 F S START=$O(^TMP("TMPLIST",$J,START)) Q:START="" D
170 . Q:START="EXPAND"
171 . Q:START="IDDATA"
172 . Q:START="IEN"
173 . S @VALMAR@(START)=$G(^TMP("TMPLIST",$J,START))
174 ; -- Rebuild EXPAND node: --
175 S START=0
176 F S START=$O(^TMP("TMPLIST",$J,"EXPAND",START)) Q:+START'>0 D
177 . S @VALMAR@("EXPAND",START)=$G(^TMP("TMPLIST",$J,"EXPAND",START))
178 ; -- Rebuild IDDATA node: --
179 S START=0
180 F S START=$O(^TMP("TMPLIST",$J,"IDDATA",START)) Q:+START'>0 D
181 . Q:'$D(@VALMAR@("IEN",START))
182 . S @VALMAR@("IDDATA",START)=$G(^TMP("TMPLIST",$J,"IDDATA",START))
183 ; -- Rebuild # node: --
184 S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
185 S @VALMAR@("#")=TIUPICK_U_"1:"_+$G(VALMCNT)
186 ; -- Update # of documents in header: --
187 K VALMHDR,^TMP("TMPLIST",$J)
188 Q
189 ;=======================================================================
190BUMPEXP(TIUI,TSTART) ; Bump EXPAND index to compensate for insertion
191 N TIUJ,GAP S TIUJ="",GAP=TSTART-TIUI
192 F S TIUJ=$O(@VALMAR@("EXPAND",TIUJ),-1) Q:TIUJ'>TIUI D
193 . S @VALMAR@("EXPAND",TIUJ+GAP)=$G(@VALMAR@("EXPAND",TIUJ))
194 . K @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$J,"EXPAND",TIUJ)
195 Q
196 ;=======================================================================
197SUCKEXP(START,TSTART) ; Remove EXPAND index to compensate for collapse
198 N TIUJ,GAP S TIUJ=START,GAP=(START-TSTART)-1
199 F S TIUJ=$O(@VALMAR@("EXPAND",TIUJ)) Q:TIUJ'>0 D
200 . S @VALMAR@("EXPAND",TIUJ-GAP)=$G(@VALMAR@("EXPAND",TIUJ))
201 . K @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$J,"EXPAND",TIUJ)
202 Q
Note: See TracBrowser for help on using the repository browser.