source: cprs/branches/tmg-cprs/m_files/TMGSELED.m@ 1682

Last change on this file since 1682 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 29.1 KB
Line 
1TMGSELED ;TMG/kst/Group record selected editer ;03/25/06
2 ;;1.0;TMG-LIB;**1**;01/25/07
3
4 ;"TMG -- Group record selected editer
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"1-25-2007
8
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"ASKSELED -- A record group selecter/editor, with asking user for options
13 ;"ASK1ED -- A record editor
14 ;"$$SELED(Options) -- entry point for group selecting and editing of records
15 ;" Options -- PASS BY REFERENCE. Format:
16 ;" Options("FILE")=Filenumber^FileName
17 ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber
18 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
19 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
20 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
21 ;" Options("IEN LIST",IEN in FILE)=""
22 ;" Options("IEN LIST",IEN in FILE)=""
23 ;" Options("IEN LIST",IEN in FILE,"SEL")="" ;"<-- Optional. Makes preselected
24 ;" Note: alternative Format
25 ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width
26 ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and
27 ;" FldNum2 is in file2. This value is a pointer to file3, and
28 ;" FldNum3 is a value in file3
29 ;"
30 ;"$$EditRecs(pList,Options,LookupFn) -- get new values for fields in records
31 ;"$$GetFields(Options) -- Interact with user to choose fields, and their display widths
32
33 ;"=======================================================================
34 ;" Private Functions.
35 ;"=======================================================================
36 ;"GetIENs(Options) -- Interact with user to choose IENs to be edited
37
38 ;"GetFldVScreen(File,FieldNum,ScrnCode,pResults,Flags) -- get List of IENs in File matching ScreenCode
39 ;"GetFldValue(File,FieldNum,Value,pResults) --get List of IENs in File with missing Field
40 ;"FixValue(pList,FileNum,FieldNum) -- Ask user for a valid value & apply to all entries in pList
41
42
43
44ASKSELED
45 ;"Scope: PUBLIC
46 ;"Purpose: A record group selecter/editor
47 ;"Input: None
48 ;"Output: Data in database may be edited.
49 ;"Results: none
50
51 write !,"Group Select-and-Edit Routine",!
52 write "-------------------------------",!
53 write "Here are the steps we will go through . . .",!
54 write "Step #1. Pick FILE to browse",!
55 write "Step #2. Pick FIELDS to show when browsing",!
56 write "Step #3. Pick Records to browse from",!
57 write "Step #4. Select sepecific Records to edit",!
58 write "Step #5. Edit values in selected records",!
59 write "Loop back to Step #4",!
60
61 new DIC,X,Y
62 new FileNum,IEN
63 new UseDefault set UseDefault=1
64
65 ;"Pick file to edit from
66ASK1 set DIC=1
67 set DIC(0)="AEQM"
68 if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called
69 . do ^DICRW ;" ^DICRW has default value of user's last response
70 else do ^DIC ;"^DIC doesn't use a default value...
71 write !
72 if +Y'>0 write ! goto ASKDone
73
74 new Options
75 set Options("FILE")=Y
76 if $$GetFields(.Options)=0 goto ASKDone
77 if $$GetWidths(.Options)=0 goto ASKDone
78
79ASK2 if $$GetIENs(.Options)=0 goto ASKDone
80
81 if $$SELED(.Options)=2 goto ASK2
82
83ASKDone
84 quit
85
86
87ASK1ED
88 ;"Scope: PUBLIC
89 ;"Purpose: A record editor
90 ;"Input: None
91 ;"Output: Data in database may be edited.
92 ;"Results: none
93
94 new DIC,X,Y
95 new FileNum,IEN
96 new UseDefault set UseDefault=0
97
98 ;"Pick file to edit from
99AK1 kill DIC
100 set DIC=1
101 set DIC(0)="AEQM"
102 set DIC("A")="Enter Name of File Containing Record to Edit: ^// "
103 if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called
104 . do ^DICRW ;" ^DICRW has default value of user's last response
105 else do ^DIC ;"^DIC doesn't use a default value...
106 write !
107 if +Y'>0 write ! goto AKDone
108
109 new Options
110 set Options("FILE")=Y
111 if $$GetFields(.Options)=0 goto AKDone
112
113AK2 kill DIC
114 set DIC("A")="Enter Record in "_$piece(Y,"^",2)_" to Edit: ^// "
115 set DIC=+Y
116 set DIC(0)="AEQM"
117 do ^DIC
118 if Y=-1 goto AK1
119 new list set list(+Y)=""
120 if $$EditRecs("list",.Options)=1 goto AK2
121
122AKDone
123 quit
124
125
126GetFields(Options)
127 ;"Purpose: Interact with user to choose fields, and their display widths
128 ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER)
129 ;" Note: prior entries are NOT KILLED
130 ;" Options("FILE")=Filenumber^FileName
131 ;" Options("FILE")=Filenumber <---- FileName will be filled in.
132 ;"Output: Options is filled as follows:
133 ;" Options("FILE")=Filenumber^FileName <-- left in from input
134 ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber
135 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
136 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
137 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
138 ;"Results: 1=OK To continue, 0=abort
139
140 new result set result=1
141 new DIC,X,Y
142 new SeqNum set SeqNum=1
143 new Field
144
145 new FName set FName=$piece($get(Options("FILE")),"^",2)
146 new FileNum set FileNum=+$get(Options("FILE"))
147 if FileNum=0 set result=0 goto GFDone
148 if FName="" do
149 . set FName=$$GetFName^TMGDBAPI(FileNum)
150 . set $piece(Options("FILE"),"^",2)=FName
151 set DIC="^DD("_FileNum_","
152 set DIC(0)="MEQ"
153GFLoop
154 write "Enter "
155 if SeqNum=1 write "first "
156 else write "next "
157 write "field to display/edit (^ to abort): "
158 read Field:$get(DTIME,3600)
159 if Field="^" set result=0 goto GFDone
160 if Field="" goto GFDone
161 if Field[":" do
162 . new i,CurFile,abort
163 . new NewField set NewField=""
164 . new NewFldNames set NewFldNames=""
165 . set CurFile=FileNum,abort=0
166 . for i=1:1:$length(Field,":") do quit:(abort=1)
167 . . new fld,DIC,X,Y
168 . . set fld=$piece(Field,":",i)
169 . . set DIC="^DD("_CurFile_","
170 . . set DIC(0)="MEQ"
171 . . set X=fld
172 . . do ^DIC
173 . . if Y=-1 set abort=1 quit
174 . . if NewField'="" set NewField=NewField_":"
175 . . if NewFldNames'="" set NewFldNames=NewFldNames_":"
176 . . set NewField=NewField_+Y
177 . . set NewFldNames=NewFldNames_$piece(Y,"^",2)
178 . . new FldInfo set FldInfo=$piece($get(^DD(CurFile,+Y,0)),"^",2)
179 . . if FldInfo["P" do
180 . . . set CurFile=+$piece(FldInfo,"P",2)
181 . . . write "->"
182 . set Field=NewField_"^"_NewFldNames
183 . if Field="^" set Field=""
184 . write !
185 else do
186 . set X=Field
187 . do ^DIC write !
188 . if +Y>0 set Field=Y
189 . ;"NOTE: I need to ask for subfield if PTR to another file.
190 . else do
191 . . ;"if Field'["?" write "??",!
192 . . set Field=""
193 if Field="" goto GFLoop
194 set Options("FIELDS",SeqNum)=Field
195 set Options("FIELDS","MAX NUM")=SeqNum
196 new % set %=2
197 write " DISPLAY only (i.e. don't allow edit)" do YN^DICN write !
198 if %=1 set Options("FIELDS",SeqNum,"NO EDIT")=1
199 if %=-1 goto GFDone
200 set SeqNum=SeqNum+1
201 goto GFLoop
202
203GFDone
204 write !
205 quit result
206
207
208GetWidths(Options)
209 ;"Purpose: Interact with user to choose adjust widths of displayed fields
210 ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER)
211 ;" Note: prior entries are NOT KILLED
212 ;" Options("FILE")=Filenumber^FileName
213 ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber
214 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName
215 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName
216 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName
217 ;"Output: Options is filled as follows:
218 ;" Options("FILE")=Filenumber^FileName <-- left in from input
219 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
220 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
221 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
222 ;"Results: 1=OK To continue, 0=abort
223
224 ;"Note: Later I could rewrite this function to allow a more graphical
225 ;" resizing of the fields, by displaying the line with one field
226 ;" in reverse colors, indicating that it has been selected. Then
227 ;" left-right would adjust size, and TAB would rotate to next field.
228
229 new result set result=1
230 new LMargin set LMargin=6
231 new TMGMINW set TMGMINW=3
232 new FldCount set FldCount=$get(Options("FIELDS","MAX NUM"),0)
233 if FldCount=0 set result=0 goto GWDone
234 new ScrnWidth set ScrnWidth=$get(IOM,80)-LMargin-1 ;"leave room for selector numbers
235 new tempW set tempW=ScrnWidth\FldCount
236
237 ;"Set default values
238 new i for i=1:1:FldCount set $piece(Options("FIELDS",i),"^",3)=tempW
239
240 write !,$$GetDispStr(.Options),!
241
242 new %,i,Num,TMGW,Delta,MinW,TMGMAXW
243 new SufferCol,SufferW
244 new Menu,UsrSlct,MenuCount,MenuDflt
245 set MenuCount=1
246 set MenuDflt=1
247 new DIR,FldName
248
249 set Menu(0)="Pick Option"
250 for i=1:1:FldCount do
251 . set Menu(MenuCount)="Adjust ["_$piece(Options("FIELDS",i),"^",2)_"]"_$char(9)_i
252 . set MenuCount=MenuCount+1
253 set Menu(MenuCount)="Enter ^ to abort"_$char(9)_"^"
254
255GWLoop
256 set %=2 ;"default to 'NO' the first time into loop.
257 write "Adjust column widths"
258 do YN^DICN write !
259 if %=2 goto GWDone
260
261 set UsrSlct=$$Menu^TMGUSRIF(.Menu,MenuDflt,.MenuDflt)
262 if (UsrSlct="^")!(UsrSlct="") goto GWDone
263
264 set Num=+UsrSlct
265 set TMGW=$piece($get(Options("FIELDS",Num)),"^",3)
266 set FldName=$piece($get(Options("FIELDS",Num)),"^",2)
267
268 ;"Determine which column will have compensatory changes as Column is changed
269 set SufferCol=FldCount
270 if Num<FldCount set SufferCol=Num+1
271 else if Num>1 set SufferCol=Num-1
272 set SufferW=$piece($get(Options("FIELDS",SufferCol)),"^",3)
273
274 set TMGMAXW=ScrnWidth-((FldCount-1)*TMGMINW) ;"min colum width is 3
275 if TMGMAXW<TMGMINW set TMGMAXW=TMGMINW
276 set DIR(0)="N^"_(TMGMINW-TMGW)_":"_(SufferW-TMGMINW)_":0^K:(TMGW-X<TMGMINW)!(TMGW+X>TMGMAXW) X"
277 set DIR("A")="Enter amount to adjust "_FldName_" width by"
278 set DIR("B")=""
279
280 write $$GetDispStr(.Options)
281 do ^DIR write !
282 if (Y="")!(Y["^") goto GWDone
283
284 set delta=+Y
285 if delta'=0 do
286 . do AdjCol(.Options,Num,delta)
287 . do AdjCol(.Options,SufferCol,-delta)
288
289 ;"write #
290 write $$GetDispStr(.Options),!
291
292 goto GWLoop
293GWDone
294 quit result
295
296AdjCol(Options,Num,Delta)
297 ;"Purpose: To adust one column width
298 ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER)
299 ;" Note: prior entries are NOT KILLED
300 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName
301 ;"Output:Width for one column is changed. No check for total width made
302 ;"Results: none
303
304 new W
305 set W=$piece($get(Options("FIELDS",Num)),"^",3)
306 set W=W+Delta
307 set $piece(Options("FIELDS",Num),"^",3)=W
308 quit
309
310
311GetDispStr(Options)
312 ;"Purpose: get a display representation of widths
313 ;"Input: Options -- PASS BY REFERENCE
314 ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber
315 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
316 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
317 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
318 ;"Results: returns a display string
319
320 new outS set $piece(outS," ",LMargin)=""
321 ;"Display current widths
322 for i=1:1:FldCount do
323 . new W set W=$piece(Options("FIELDS",i),"^",3)
324 . new name set name=$piece($get(Options("FIELDS",i)),"^",2)
325 . set name=$extract(name,1,W-2)
326 . set name=$$LJ^XLFSTR(name,W-2,".") if name="" set name="!"
327 . set outS=outS_"["_name_"]"
328
329 quit outS
330
331
332GetIENs(Options)
333 ;"Purpose: Interact with user to choose IENs to be edited
334 ;" User will be able to pick IENs from a SORT TEMPLATE, or
335 ;" a custom search.
336 ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER)
337 ;" Note: prior entries are NOT KILLED
338 ;" Options("FILE")=Filenumber^FileName
339 ;"Output: Options is filled as follows:
340 ;" Options("FILE")=Filenumber^FileName <-- left from input
341 ;" Options("IEN LIST",IEN in FILE)=""
342 ;" Options("IEN LIST",IEN in FILE)=""
343 ;"Results: 1=OK To continue, 0=abort
344
345 new Menu,UsrSlct
346 new FileNum set FileNum=$piece($get(Options("FILE")),"^",1)
347 new FileName set FileName=$piece($get(Options("FILE")),"^",2)
348 new result set result=1
349
350 set Menu(0)="Pick Records from "_FileName_" to Browse"
351 set Menu(1)="Choose a TEMPLATE from a former FILEMAN SEARCH"_$char(9)_"TEMPLATE"
352 set Menu(2)="Browse ALL records"_$char(9)_"ALL"
353 set Menu(3)="Browse records with a given Field VALUE"_$char(9)_"SCREEN"
354 set Menu(4)="Enter ^ to abort"_$char(9)_"^"
355 ;"write #
356 set UsrSlct=$$Menu^TMGUSRIF(.Menu,1)
357 if UsrSlct="^" set result=0 goto GIDone
358 if UsrSlct=0 set UsrSlct=""
359
360 new abort set abort=0
361 if UsrSlct="TEMPLATE" do
362 . new DIC,Y
363 . set DIC=.401
364 . set DIC(0)="MAEQ"
365TPLOOP . write "Select a TEMPLATE Containing Records for Browsing.",!
366 . set DIC("A")="Enter Template (^ to abort): "
367 . do ^DIC write !
368 . if +Y'>0 set abort=1 quit
369 . new node set node=$get(^DIBT(+Y,0))
370 . if $piece(node,"^",4)'=FileNum do goto TPLOOP
371 . . set Y=0 ;"signal to try again
372 . . new PriorErrorFound
373 . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: That template doesn't contain records from "_FileName_". Please select another.")
374 . . do PressToCont^TMGUSRIF
375 . if (+Y>0)&($data(^DIBT(+Y,1))>1) do
376 . . merge Options("IEN LIST")=^DIBT(+Y,1)
377
378 else if UsrSlct="ALL" do
379 . do GetFldValue(FileNum,.01,"ALL",$name(Options("IEN LIST")))
380
381 else if UsrSlct="SCREEN" do
382 . new DIC,X,Y,DIR,FldNum,Value
383 . set DIC="^DD("_FileNum_","
384 . set DIC(0)="MAEQ"
385 . set DIC("A")="Enter FIELD to use for SCREEN: "
386 . do ^DIC write !
387 . if Y=-1 quit
388 . set FldNum=+Y
389 . set DIR(0)=FileNum_","_FldNum
390 . set DIR("?",1)="Enter value to search for. Records will be included"
391 . set DIR("?",2)="if the field chosed contains the value entered here."
392 . set DIR("?",3)="A @ may be entered to represent a NULL value for a field."
393 . set DIR("?",4)="For more complex searches, use Fileman search function,"
394 . set DIR("?",5)="store results in a template, and then chose that template"
395 . set DIR("?",6)="as the input source instead of choosing a screening value."
396 . do ^DIR write !
397 . if X="@" set Y="@"
398 . if Y="" quit
399 . set Value=$piece(Y,"^",1)
400 . do GetFldValue(FileNum,FldNum,Value,$name(Options("IEN LIST")))
401
402 if abort=1 set result=0
403GIDone
404 quit result
405
406
407GetFldVScreen(File,FieldNum,ScrnCode,pResults,Flags)
408 ;"Purpose: get List of IENs in File with matching Field
409 ;"Input: File -- the File to scan
410 ;" FieldNum -- the Field number to get from file
411 ;" ScrnCode -- Screening code to be executed....
412 ;" Format: '$$MyFn^MyModule()', or
413 ;" '(some test)' such that the following is valid code:
414 ;" set @("flagToSkip="_ScrnCode)
415 ;" ---> If flagToSkip=1, then record is NOT selected
416 ;" The following variables will be available for use:
417 ;" File -- the File name or number
418 ;" FieldNum -- the field number
419 ;" IEN -- the IEN of the current record.
420 ;" RecValue -- the current value of the field
421 ;" pResults -- PASS BY NAME, an OUT PARAMETER.
422 ;" Flags -- OPTIONAL. Possible Flags
423 ;" "E" search for external forms (default is internal forms)
424 ;"Output: @pResults is filled as following. Note: prior results are not killed
425 ;" @pResults@(IEN)=""
426 ;" @pResults@(IEN)=""
427 ;"Results: none
428
429 new Itr,IEN,RecValue,FMFlag
430 new abort set abort=0
431 set FMFlag="I" if $get(Flags)["E" set FMFlag=""
432
433 set RecValue=$$ItrFInit^TMGITR(File,.Itr,.IEN,FieldNum,,FMFlag)
434 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
435 for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.RecValue)="@@@@@@@@")!(+IEN=0))!abort
436 . if $$UserAborted^TMGUSRIF set abort=1 quit
437 . new flagToSkip set @("flagToSkip="_ScrnCode)
438 . if flagToSkip quit
439 . set @pResults@(IEN)=""
440 do ProgressDone^TMGITR(.Itr)
441
442 quit
443
444
445GetFldValue(File,FieldNum,Value,pResults,Flags)
446 ;"Purpose: get List of IENs in File with matching Field
447 ;"Input: File -- the File to scan
448 ;" FieldNum -- the Field number to get from file
449 ;" Value -- the value to compare against. Poss Values
450 ;" VALUE: if field=VALUE, then record selected
451 ;" "@": if field=null (empty), then record selected
452 ;" "ALL": all records are selected
453 ;" pResults -- PASS BY NAME, an OUT PARAMETER.
454 ;" Flags -- OPTIONAL. Possible Flags
455 ;" "E" search for external forms (default is internal forms)
456 ;"Output: @pResults is filled as following. Note: prior results are not killed
457 ;" @pResults@(IEN)=""
458 ;" @pResults@(IEN)=""
459 ;"Results: none
460
461
462 new Itr,IEN,RecValue,FMFlag
463 if $get(Value)="ALL" goto GFV3
464
465GFV1 set FMFlag="I" if $get(Flags)["E" set FMFlag=""
466 set RecValue=$$ItrFInit^TMGITR(File,.Itr,.IEN,FieldNum,,FMFlag)
467 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
468 for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.RecValue)="@@@@@@@@")!(+IEN=0))
469 . if (RecValue=Value)!((Value="@")&(RecValue="")) do
470 . . set @pResults@(IEN)=""
471 write !
472 goto GFVDone
473
474GFV3 write "Gathering ALL records...",!
475 set IEN=$$ItrInit^TMGITR(File,.Itr,.IEN)
476 do PrepProgress^TMGITR(.Itr,100,0,"IEN")
477 for do quit:($$ItrNext^TMGITR(.Itr,.IEN)="")
478 . if +IEN'=IEN quit
479 . set @pResults@(IEN)=""
480 do ProgressDone^TMGITR(.Itr)
481GFVDone
482 quit
483
484
485SELED(Options)
486 ;"Scope: PUBLIC
487 ;"Purpose: the entry point for group selecting and editing of recrods
488 ;" Note: this can be used as an API entry point
489 ;"Input: Options -- PASS BY REFERENCE
490 ;" Format:
491 ;" Options("FILE")=Filenumber^FileName
492 ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber
493 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
494 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
495 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width
496 ;" Options("FIELDS",DisplaySequence,"LOOKUP FN") -- OPTIONAL
497 ;" A function for looking up new values.
498 ;" Must be in format like this:
499 ;" Options("FIELDS",DisplaySequence,"LOOKUP FN")="$$MyFn^MyModule(File,FldNum)"
500 ;" i.e. must be a function name. Function may take passed
501 ;" parameters 'File' and 'FldNum'
502 ;" Default value="$$ValueLookup(File,FldNum)"
503 ;" Options("IEN LIST",IEN in FILE)=""
504 ;" Options("IEN LIST",IEN in FILE)=""
505 ;" Options("IEN LIST",IEN in FILE,"SEL")="" ;"<-- optional. Makes preselected
506 ;" Note: alternative Format
507 ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width
508 ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and
509 ;" FldNum2 is in file2. This value is a pointer to file3, and
510 ;" FldNum3 is a value in file3
511 ;"Output: Data in database may be edited.
512 ;"Results: 1=Normal exit, 2=Needs rescan and recall
513
514 new result set result=1
515 new SelList,pList,pIENList
516 set pList=$name(SelList)
517 set pIENList=$name(Options("IEN LIST"))
518
519 new Fields,Widths
520 set Fields="",Widths=""
521
522 new File set File=+$get(Options("FILE"))
523 if File="" goto SEDone
524
525 new i for i=1:1:$get(Options("FIELDS","MAX NUM")) do
526 . set Fields=Fields_$piece($get(Options("FIELDS",i)),"^",1)_";"
527 . set Widths=Widths_$piece($get(Options("FIELDS",i)),"^",3)_";"
528
529 new tempResult
530 new pSaveArray ;"will store ref of stored display array --> faster
531SLoop kill @pList
532
533 ;"Later change this to allow custom order of sort fields.
534 do IENSelector^TMGUSRIF(pIENList,pList,File,Fields,Widths,"Pick Records to Edit. [ESC],[ESC] when done",Fields,.pSaveArray)
535 new count set count=$$ListCt^TMGMISC(pList)
536 write count," items selected.",!
537
538 if count>0 set tempResult=$$EditRecs(pList,.Options)
539
540 write !,"Fix more"
541 new % set %=1
542 if count=0 set %=2
543 do YN^DICN write !
544 if %'=1 goto SEDone
545 if $data(@pList)=0 goto SLoop
546
547 new needsRepack set needsRepack=0
548 write "Removing fixed items from list. Here are the old entries...",!
549 if $get(pSaveArray)="" do
550 . do ListNot^TMGMISC(pIENList,pList) ;"<-- probably a bug in this function
551 else do
552 . new Itr,IEN,DispLineNum
553 . ;"zwr @pList
554 . set IEN=$$ItrAInit^TMGITR(pList,.Itr)
555 . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")
556 . . set DispLineNum=+$get(@pList@(IEN))
557 . . if DispLineNum=0 quit
558 . . new tempS
559 . . set tempS=$get(@pSaveArray@(DispLineNum))
560 . . set tempS=$piece(tempS,$char(9),2)
561 . . write " --",tempS,!
562 . . kill @pSaveArray@(DispLineNum)
563 . . set needsRepack=1
564 . write !
565 write !
566 ;"IMPORTANT NOTE: It seems that that after deleting items in pSaveArray, the ordering
567 ;" gets out of sync, such that the display number is NOT the same as the index
568 ;" and the wrong references can be used!!! Must renumber somehow...
569
570 set %=2
571 write "Rescan file (slow)"
572 do YN^DICN write !
573 if %=1 set result=2 goto SEDone
574 if %=-1 goto SEDone
575
576 write "Packing display list..."
577 do ListPack^TMGMISC(pSaveArray)
578 write !
579
580 goto SLoop
581SEDone
582 quit result
583
584EditRecs(pList,Options,LookupFn)
585 ;"Purpose: To get new values for display fields in records
586 ;"Input: pList -- PASS BY NAME. A list of IENs to process
587 ;" @pList@(IEN)=IgnoredValue
588 ;" @pList@(IEN)=IgnoredValue
589 ;" @pList@(IEN)=IgnoredValue
590 ;" Options -- PASS BY REFERENCE. Format:
591 ;" Options("FILE")=Filenumber^FileName
592 ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber
593 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width <-- Width is ignored
594 ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width <-- Width is ignored
595 ;" Options("FIELDS",DisplaySequence)=FldNum <-- FldName OPTIONAL
596 ;" Options("FIELDS",DisplaySequence,"LOOKUP FN") -- OPTIONAL
597 ;" A function for looking up new values.
598 ;" Must be in format like this:
599 ;" Options("FIELDS",DisplaySequence,"LOOKUP FN")="$$MyFn^MyModule(File,FldNum)"
600 ;" i.e. must be a function name. Function may take passed
601 ;" parameters 'File' and 'FldNum'
602 ;" Default value="$$ValueLookup(File,FldNum)"
603 ;" Options("FIELDS",DisplaySequence,"NO EDIT")=1 <-- indicates this field NOT to be edited.
604 ;" Note: alternative Format
605 ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width
606 ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and
607 ;" FldNum2 is in file2. This value is a pointer to file3, and
608 ;" FldNum3 is a value in file3
609 ;"
610 ;"Results: 1=OK to continue, 0 if error
611
612 new result set result=0 ;"default to error
613 new Menu,UsrSlct,MenuCount,FldCount,File
614 new TMGFDA,TMGMSG
615 set FldCount=+$get(Options("FIELDS","MAX NUM")) if FldCount=0 goto GNVDone
616 set File=+$get(Options("FILE")) if File=0 goto GNVDone
617 new LookupFn
618 new DIR,FldNum,NewValue
619
620GNVL1 kill Menu
621 set Menu(0)="Pick Field to EDIT"
622 set MenuCount=1
623 for i=1:1:FldCount do
624 . new CommonValue,FieldNum,FieldName
625 . if $get(Options("FIELDS",i,"NO EDIT"))=1 quit ;"don't edit this field
626 . set FieldNum=$piece($get(Options("FIELDS",i)),"^",1)
627 . set FieldName=$piece($get(Options("FIELDS",i)),"^",2)
628 . if FieldName="" set FieldName=$$GetFldName^TMGDBAPI(File,FieldNum)
629 . set CommonValue=$$GetCommonValue(File,FieldNum,pList)
630 . set Menu(MenuCount)=FieldName_": ["_CommonValue_"]"_$char(9)_i
631 . set MenuCount=MenuCount+1
632 ;"set Menu(MenuCount)="Enter ^ to abort"_$char(9)_"^"
633
634GNVL2
635 set UsrSlct=$$Menu^TMGUSRIF(.Menu)
636 ;"if FldCount>1 do
637 ;". set UsrSlct=$$Menu^TMGUSRIF(.Menu)
638 ;"else set UsrSlct=1 ;"If only 1 option, then auto-select
639 if (UsrSlct="^")!(UsrSlct="") goto GWDone
640
641 set LookupFn=$get(Options("FIELDS",UsrSlct,"LOOKUP FN"),"$$ValueLookup(File,FldNum)")
642
643 kill DIR,NewValue
644 set FldNum=+$piece($get(Options("FIELDS",UsrSlct)),"^",1)
645 if FldNum=0 goto GNVDone
646
647 set @("Y="_LookupFn)
648 ;"write !,"Enter new value for field below."
649 ;"set DIR(0)=File_","_FldNum
650 ;"do ^DIR write !
651
652 if Y="" goto GNVL2
653 if Y="^" goto GNVDone
654 set NewValue=$piece(Y,"^",1)
655 if NewValue=+NewValue do
656 . new array
657 . do GetFieldInfo^TMGDBAPI(File,FldNum,"array")
658 . if $get(array("SPECIFIER"))["S" quit ;"check if field is a SET, if so, don't add ` mark
659 . set NewValue="`"_NewValue ;"indicate that number is a pointer
660
661 new Itr,IEN,Value,results
662 set result=1
663 set IEN=$$ItrAInit^TMGITR(pList,.Itr)
664 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")
665 . kill TMGFDA,TMGMSG
666 . set TMGFDA(File,IEN_",",FldNum)=NewValue
667 . do FILE^DIE("EK","TMGFDA","TMGMSG")
668 . if $data(TMGMSG("DIERR")) do
669 . . set result=0
670 . . new PriorErrorFound
671 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
672
673 goto GNVL1
674
675GNVDone
676 quit result
677
678
679ValueLookup(File,FldNum)
680 ;"Purpose: To interact with user and obtain a value for field in file
681 ;"Input: File: A valid file number
682 ;" FldNum: A valid field number in File
683 ;"Result: Returns value of user input.
684
685 new DIR
686 write !,"Enter new value for field below."
687 set DIR(0)=File_","_FldNum
688 do ^DIR write !
689 quit Y
690
691
692GetCommonValue(File,Field,pList,Flags)
693 ;"Purpose: Return a value held by all records in pList, or "" if mixed values
694 ;"Input: File -- file number
695 ;" Field -- field number or 'num:num2:num3" etc
696 ;" Flags -- value to pass to GET1^DIQ during lookup
697 ;"Output: returns a common value, or "" if not common value
698
699 new Itr,IEN,Value,abort,result
700 set abort=0,result=""
701
702 new Itr,IEN,Value,abort
703 set abort=0
704 set IEN=$$ItrAInit^TMGITR(pList,.Itr)
705 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!(abort=1)
706 . set Value=$$GET1^DIQ(File,IEN_",",Field)
707 . if result="" set result=Value
708 . if Value'=result set result="<MIXED VALUES>",abort=1
709
710 quit result
711
712
713
Note: See TracBrowser for help on using the repository browser.