source: cprs/branches/tmg-cprs/m_files/TMGXINST.m

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

Initial upload
File size: 83.1 KB
Line 
1TMGXINST ;TMG/kst/XML Configuration Scripting System ;03/25/06
2 ;;1.0;TMG-LIB;**1**;07/12/04
3
4 ;" XML Configuration Scripting System
5 ;"
6 ;" K. Toppenberg, MD
7 ;" 7-12-04
8 ;"
9 ;"Purpose: Intrepret a specially-prepaired XML file, designed
10 ;" for configuring VistA
11
12 ;"Dependancy: Requires TMGXDLG.m, TMGSTUTL.m, TMGDEBUG.m
13
14 ;"-------------------------------------------------------------
15 ;"CHANGE LOG
16 ;"10-17-04: Got WP fields to upload properly. Created FormatArray function.
17 ;"10-15-04: Forgot to log several days. Created <FileUtility>. Ensured data substitution
18 ;" more widely implemented. Worked more on script. Tracked down modal dialog
19 ;" box bug (conflicting globals in two different modules).
20 ;"10-5-04: Learned that WP fields must be treated differently, so worked on support.
21 ;" Had trouble with a locked record after a crash. Learn about GTM lke utility.
22 ;"10-4-04: Tracked down apparent bug in FILE^DIE that doesn't allow upload to a word
23 ;" processor field. Also allowed redirection of debug output to a file or to
24 ;" an X graphic tail box.
25 ;"10-2-05: Changed record node divider character from "/" to "|" because I could not
26 ;" ever remember to protect the / as // and I'm sure others wouldn't remember
27 ;" either. Fixed bug that caused crash when showing error box before XML
28 ;" parse was complete, and datanode contained valid data. Changed UploadFile
29 ;" to UploadRecord with <Record></Record> syntax
30 ;"10-1-04: Fixed bug with line wrapping disordering in dialog boxes. Fixed bug
31 ;" preventing non-modal dialog boxes ("&"-->" &") NOTE: ??working?
32 ;"9-30-04: Allowed data substitution {{...}} to be used in Show and message boxes.
33 ;" Fixed bug to allow multiple data substitutions on one line.
34 ;"9-27-04:
35 ;" Ran a test menu upload and got Adam and TMG Text menu to upload
36 ;" Cleaned up error reporting. Discovered that including the ` character
37 ;" in upload data causes an error... haven't tracked down reason yet.
38 ;"9-26-04:
39 ;" Started this change log
40 ;" Change parameter system so that unlimited number of params allowed
41 ;" Cleaned up command execution and passing of parameters
42 ;" Got X graphic dialogs working -- can call from XML script.
43 ;" Added options for a variety of user interfaces: GUI,CHUI,Roll
44 ;" Changed log in process so that user #1 is used (MGR,IRM on my system)
45 ;"2/9/2008: Moved some functions out into TMGXMLT for reuse by other code.
46
47
48 ;"-------------------------------------------------------------
49 ;"Public Functions
50
51 ;"Run(DispMode,DebugMode,UserPath,UserFName)
52
53 ;"-------------------------------------------------------------
54 ;"Private Functions
55 ;"
56 ;"ShowWelcome()
57 ;"GetFName(Path,Filename)
58 ;"LoadFile(Path,Filename)
59 ;"ShutDown
60 ;"InitVars()
61 ;"CMDProcess(Command,Params)
62 ;"DoComment(Params)
63 ;"DoShow(Params)
64 ;"DoM(Params)
65 ;"DoMenu(Params)
66 ;"DoLookup(Params) -- take data from XML file, and look up if it is already in database
67 ;"DoValueLookup(Params) -- look for a value of a given value in a given record in given file.
68 ;"DoFileUtility(Params)
69 ;"DoSearchRec(Params)
70 ;"DoUpload(Params)
71 ;"GetRInfo(ID,Data) -- get record info from the <DATA> section and store it in the Data variable.
72 ;"ProcessRNode(DataP,Field,Text,EntryNumber,FileNumber,DoingSubNodes,Flags) -- Allow for recursive calling when doing GetRInfo
73 ;"WPHandle(DataP,EntryNumber,FieldNumber,Text) -- process word-processing fields for ProcessRNode()
74 ;"CheckArraySubst(TextArray)
75 ;"ParamSubstitute(Params)
76 ;"CheckSubstituteData(Text)
77 ;"DoJump(Params)
78 ;"GetLabelNode(Label)
79 ;"GetData(Ref)
80 ;"ParseSeg(Ref,ID)
81 ;"GetDescIDNode(ParentNode,Name,ID)
82 ;"GetCMDLine(ExecNode,Command,Params)
83 ;"GetNextCMD(ExecNode)
84 ;"RunScript(ExecNode)
85 ;"GetDispMode()
86 ;"DoMsgBox(Params)
87 ;"=================================================================
88 ;"=================================================================
89
90
91Run(DispMode,DebugMode,UserPath,UserFName)
92 ;"Purpose: To use given XML filename to process
93 ;"Input:
94 ;" DispMode: OPTIONAL -- If not given, will ask user. Should be
95 ;" 1 for GUI
96 ;" 2 for CHUI
97 ;" 3 for Roll-n-Scroll
98 ;" DebugMode: OPTIONAL -- If not given, will ask user. Should be:
99 ;" 0 for none,
100 ;" 1 for To Screen
101 ;" 2 for To File
102 ;" 3 for To Tail (only valid if DispMode="GUI")
103 ;" UserPath: OPTIONAL --Directory to load from
104 ;" UserFName: OPTIONAL --the full filename. If not given, will ask user
105
106 ;"Set up some global variables.
107
108 new TMGDEBUG set TMGDEBUG=0 ;"Note: user could change this at runtime...
109 new DBIndent set DBIndent=0
110 new PriorErrorFound set PriorErrorFound=0
111 ;"new DispMode
112 new cGUI set cGUI="GUI"
113 new cCHUI set cCHUI="CHUI"
114 new cRoll set cRoll="Roll-n-Scroll"
115 new DModes
116 new cDialog set cDialog="UseDialog"
117 set DModes(0)="x"
118 set DModes(1)=cGUI
119 set DModes(2)=cCHUI
120 set DModes(3)=cRoll
121 set DModes(4)="x"
122
123 new ExecNode ;"This is the execution point
124 new DataNode ;"A handle to <Data> node
125 new ScriptNode ;"A handle to <Script> node
126 new TopNode ;"A handle to top level node <CONFIG_SCRIPT>
127 new XMLHandle ;"Handle referring to current XML document
128
129 new cNodeDiv set cNodeDiv="|"
130 new c2NodeDiv set c2NodeDiv=cNodeDiv_cNodeDiv
131
132 new cProtect set cProtect="~~"
133 new cDataOpen set cDataOpen="{{"
134 new cDataClose set cDataClose="}}"
135 new cNewLn set cNewLn="\n"
136 new cEntries set cEntries="Entries"
137 new cGlobal set cGlobal="GLOBAL"
138 new cOpen set cOpen="OPEN"
139 new cParentIENS set cParentIENS="ParentIENS"
140 new cTrue set cTrue=1
141 new cFalse set cFalse=0
142 new cdbNone set cdbNone=0
143 new cdbToScrn set cdbToScrn=1 ;"was 2
144 new cdbToFile set cdbToFile=2 ;"was 3
145 new cdbToTail set cdbToTail=3 ;"was 4
146 new cdbAbort set cdbAbort=-1
147 new cOKToCont set cOKToCont=1
148 new cAbort set cAbort=0
149
150 new cScript set cScript="SCRIPT" ;"Script"
151 new cData set cData="DATA" ;"Data"
152 new cMVar set cMVar="MVAR" ;"MVar"
153 new cOption set cOption="OPTION" ;"option"
154 new cCondition set cCondition="CONDITION" ;"condition"
155 new cMatchThis set cMatchThis="MATCHTHIS" ;"MatchThis"
156 new cMatchValue set cMatchValue="MATCHVALUE" ;"MatchValue
157 new cField set cField="FIELD" ;"Field"
158 new cFile set cFile="FILE" ;"File"
159 new cRecNum set cRecNum="RECNUM" ;"RecNum
160 new cRecord set cRecord="RECORD" ;"Record"
161 new cId set cId="ID" ;"id"
162 new cOutput set cOutput="OUTVAR" ;"OutVar"
163 new cInput set cInput="INVAR" ;"InVar
164 new cShow set cShow="SHOW" ;"Show"
165 new cM set cM="M" ;"M"
166 new cMenu set cMenu="DOMENUOPTION" ;"DoMenuOption"
167 new cUpload set cUpload="UPLOADRECORD" ;"UploadRecord"
168 new cLookup set cLookup="LOOKUPFILEINFO" ;"LookupFileInfo"
169 new cValueLookup set cValueLookup="LOOKUPFIELDVALUE" ;"LookupFieldValue"
170 new cSearchRec set cSearchRec="SEARCHREC" ;"SearchRec
171 new cFileUtility set cFileUtility="FILEUTILITY" ;"FileUtility
172 new cMsgBox set cMsgBox="MSGBOX" ;"MsgBox
173 new cHeader set cHeader="HEADER" ;"Header
174 new cText set cText="TEXT" ;"Text
175 new cJump set cJump="JUMP" ;"Jump"
176 new cRemark set cRemark="REM" ;"Rem"
177 new cLabel set cLabel="LABEL" ;"Label"
178 new cFlags set cFlags="FLAGS" ;"Flags"
179 new cWidth set cWidth="WIDTH" ;"Width
180 new cModal set cModal="MODAL" ;"Modal"
181 new cFn set cFn="FN" ;"Fn
182 new cInfo set cInfo="INFO" ;"Info
183 new cDelete set cDelete="DELETE" ;"Delete
184 new cNextRec set cNextRec="NEXTREC"
185 new cPrev set cPrev="PREV"
186 new cNumRecs set cNumRecs="NUMRECS"
187 new cFirstRec set cFirstRec="FIRSTREC"
188 new cLastRec set cLastRec="LASTREC"
189 new cRef set cRef="Ref"
190 new cNonModal set cNonModal="0"
191 new cModalMode set cModalMode="1"
192 ;"Field flags
193 new cHack set cHack="H"
194 new cNoOverwrite set cNoOverwrite="N"
195 new cEncrypt set cEncrypt="E"
196 ;"----------
197 new cUpperCase set cUpperCase="UpperCase"
198 new cName set cName="Name"
199 new cValue set cValue="VALUE"
200 new cSet set cSet="SET"
201 new cNull set cNull="(none)"
202 new cMaxNode set cMaxNode="Max Node Num"
203 new Filename
204 new DebugFPath
205 new DebugFName
206 new DebugFile
207
208 new result
209 new FileSpec
210
211 new ProcTable
212 set ProcTable(cRemark)="DoComment" ;"a do-nothing function
213 set ProcTable(cLabel)="DoComment" ;"a do-nothing function
214 set ProcTable(cShow)="DoShow"
215 set ProcTable(cM)="DoM"
216 set ProcTable(cMenu)="DoMenu"
217 set ProcTable(cUpload)="DoUpload"
218 set ProcTable(cJump)="DoJump"
219 set ProcTable(cLookup)="DoLookup"
220 set ProcTable(cMsgBox)="DoMsgBox"
221 set ProcTable(cValueLookup)="DoValueLookup"
222 set ProcTable(cFileUtility)="DoFileUtility"
223 set ProcTable(cSearchRec)="DoSearchRec"
224
225 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"Main Run")
226
227 if $get(WelcomeShown)'=1 do ShowWelcome()
228
229 ;"A local code login function.
230 if $$XUP^TMGXUP()=0 do goto RunDone
231 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error setting up a user privilages for configuration.")
232
233 if ($data(DispMode)#10=0)!($get(DispMode)>3)!($get(DispMode)<1) do
234 . set DispMode=$$GetDispMode()
235 set DispMode=DModes(DispMode)
236 if DispMode="x" goto RunDone
237 set DispMode(cDialog)=(DispMode'=cRoll)
238
239 if ($data(DebugMode)#10=0)!($get(DebugMode)<0)!($get(DebugMode)>3)!(($get(DebugMode)=1)&(DispMode'=cGUI)) do
240 . set TMGDEBUG=$$GetDebugMode^TMGDEBUG(2) ;"2=default to File output
241 else set TMGDEBUG=DebugMode
242 if TMGDEBUG=cdbAbort goto RunDone
243
244 do
245 . new DefPath set DefPath="/tmp/"
246 . new DefName set DefName="XMLInst_DebugLog.tmp"
247 . new DefFName set DefFName=DefPath_DefName
248 . do OpenLogFile^TMGDEBUG(DefPath,DefName)
249 . if TMGDEBUG=cdbToTail do
250 . . set result=$$Tail^TMGXDLG(DefFName,0,0,0)
251
252 if ($data(UserPath)#10=0)!($data(UserFName)#10=0) do
253 .
254 . set result=$$GetFName(.UserPath,.UserFName)
255 . if result=cAbort do PopupBox^TMGUSRIF("<!> No script file selected.","Come back again soon!")
256 else set result=cOKToCont
257 if (result=cAbort)!($data(UserPath)=0)!($data(UserFName)=0) goto RunDone
258
259 set Filename=UserPath_UserFName
260
261 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Let's go! Cranking up system!...")
262
263 kill ^TMP("TMG",$J)
264 set XML1Ref=$name(^TMP("TMG",$J,1)) ;"I have to use this to load file
265 set XMLRef=$name(^TMP("TMG",$J)) ;"I have to pass this to XML parser
266
267 set XMLHandle=$$LoadFile(UserPath,UserFName)
268
269 if XMLHandle=0 do goto RunDone
270 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to load/parse file")
271
272 if '$$InitVars do goto RunDone
273 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error setting up script system (InitVars procedure).")
274
275 if TMGDEBUG do
276 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling ArrayDump")
277 . do ArrayDump^TMGDEBUG("^TMP(""TMG"")",$J)
278
279 new Text
280 set Text(0)="[*] XML Script"
281 set Text(1)="Beginning execution of user XML script:"
282 set Text(2)=Filename
283 set Text(2)=" "
284 set Text(3)="This could be the beginning of "
285 set Text(4)="something wonderful..."
286 do PopupArray^TMGUSRIF(5,45,.Text)
287
288 new RunResult
289 set RunResult=$$RunScript(.ExecNode)
290
291 new Text
292 set Text(0)="[*] XML Script"
293 set Text(1)="Done with execution of user XML script."
294 set Text(2)=" "
295 set Text(3)="See you later..."
296 if RunResult=cAbort do
297 . set Text(4)="Note: Script was not completed."
298 do PopupArray^TMGUSRIF(5,45,.Text)
299
300RunDone
301 do ShutDown
302
303 write "Clean shutdown completed. Goodbye.",!,!
304
305 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"Main Run")
306
307 quit
308
309
310 ;"=================================================================
311 ;" Subroutines
312 ;"=================================================================
313
314ShowWelcome()
315 ;"Purpose: To show a splash for program
316
317 write !,!
318
319 new Text
320 set Text(0)="XML Configurator for VistA on GT.M"
321 set Text(1)=" "
322 set Text(2)="WELCOME..."
323 set Text(3)=" "
324 set Text(4)="Interpreter created by: Kevin Toppenberg, MD"
325 set Text(5)="GNU General Public License, 7/2004"
326 set Text(6)=" "
327 do PopupArray^TMGUSRIF(5,55,.Text)
328
329 quit
330
331
332GetFName(Path,Filename)
333 ;"Purpose: Interact with user to get path and filename
334 ;"Input: Path--should be passed by reference, used to pass back result
335 ;" Filename--should be passed by reference, used to pass back result
336 ;"Output: Results passed in Path and Filename
337 ;" Function will result in 0 if user 'cancelled', 1 otherwise
338
339 new result set result=cAbort
340 new FullNamePath
341 new PathNode
342 set Path="/"
343 set Filename=""
344
345 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFName")
346
347 if DispMode=cRoll goto GFNRoll
348
349 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling $$FileSel()")
350 set FullNamePath=$$FileSel^TMGXDLG("Please select script to process . . .","~/XMLScript")
351 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Results=",FullNamePath)
352 if FullNamePath="" goto GFNDone ;"result=cAbort still --> cancelled.
353
354 ;"Separate path from filename
355GFNL1
356 if '(FullNamePath["/") set Filename=FullNamePath goto GFNL2
357 set PathNode=$piece(FullNamePath,"/",1)
358 set Path=Path_PathNode_"/"
359 set $piece(FullNamePath,"/",1)=""
360 set FullNamePath=$extract(FullNamePath,2,255)
361 goto GFNL1
362GFNL2
363 set result=cOKToCont
364 goto GFNDone
365
366GFNRoll
367 new DefFName set DefFName="XMLScript"
368 new DefPath set DefPath="/home/kdtop/OpenVistA_UserData/r"
369 new Msg set Msg="Select script file:"
370 new tempName
371
372 ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Will new file picker work?")
373
374 set tempName=$$GetFName^TMGIOUTL(.Msg,.DefPath,.DefFName,"/",.Path,.Filename)
375 write "Path=",$get(Path)," and Filename=",$get(Filename),!
376 if tempName'="" set result=cOKToCont
377 goto GFNDone
378
379 ;"write !,"------------------------------------------",!
380 write !
381 write "Enter script filename with path:",!
382 write " ['^'] = Abort",!
383 write " [Enter] = '",DefPath,"/",DefFName,"'",!
384 write "> "
385 read Filename:240
386 write !
387 if Filename="^" goto GFNDone
388 if Filename="" do
389 . set Filename=DefFName
390 . set Path=DefPath
391 . write "Using default: ",Path,"/",Filename,!,!,!
392 set result=cOKToCont
393
394GFNDone
395 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFName")
396 quit result
397
398
399
400LoadFile(Path,Filename)
401 ;"Purpose: To load the file and check for XML validity
402 ;" Also check for DOCTYPE = 'CONFIG_SCRIPT' and other
403 ;" possible validity tests.
404 ;"Input: FullFile: full filename with path, ready to pass to Host file system.
405 ;"NOTE: uses XML1Ref and XMLRef vars with global scope
406 ;"Returns: 0 if fails, otherwise XML file handle.
407
408 new FileHandle
409 set XMLHandle=0
410
411 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"LoadFile")
412 set FileHandle=$$FTG^%ZISH(Path,Filename,XML1Ref,3)
413 if FileHandle=0 do goto QLoad
414 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening file. Path="_Path_", Filename="_Filename)
415 else do
416 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"File Loaded... Handle#="_FileHandle)
417
418 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling EN^MXMLDOM")
419 write "Parsing XML File. Please wait . . .",!
420 set XMLHandle=$$EN^MXMLDOM(XMLRef,"")
421 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Back from calling EN^MXMLDOM. XMLHandle="_XMLHandle)
422 if XMLHandle=0 do
423 . new ErrMsg
424 . set ErrMsg="Error parsing XML document.\n\n"
425 . set ErrMsg=ErrMsg_"Now analyzing XML file to determine problem...\n"
426 . do ShowError^TMGDEBUG(.PriorErrorFound,ErrMsg)
427 . do DetailParse^TMGXMLP()
428
429QLoad
430 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"LoadFile")
431 quit XMLHandle
432
433ShutDown
434 ;"Purpose: to do any cleanup needed to exit system cleanly
435
436 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Freeing vars...")
437
438 if $get(XMLHandle) do DELETE^MXMLDOM(XMLHandle)
439 kill ^TMP("TMG",$J)
440
441 ;"Kill a few variables. The others should be automatically freed
442 ;" when they go out of scope as the program exits.
443 kill TMGDEBUG
444 kill LoggedUsr
445 kill SubMarkNum
446
447 if $data(DebugFile) close DebugFile
448
449 write "Exiting XML Scripter.",!,!
450
451 quit
452
453
454InitVars()
455 ;"Purpose: Initialize variables
456 ;"Input: None:
457 ;"Output: Global (program-wide) variables are set up.
458 ;" Return value is 0 if an error occurs.
459
460 new result
461 set result=cAbort
462 set TopNode=1
463
464 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Entry InitVars()",1)
465
466 set ScriptNode=$$GetDescNode^TMGXMLT(XMLHandle,TopNode,cScript)
467 if ScriptNode=0 do goto QInitVar
468 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find node: '"_cScript_"'.")
469
470 set ExecNode=$$CHILD^MXMLDOM(XMLHandle,ScriptNode)
471 if ExecNode=0 do goto QInitVar
472 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error finding first child of ScriptNode (#"_ScriptNode_").")
473
474 set DataNode=$$GetDescNode^TMGXMLT(XMLHandle,TopNode,cData)
475 if DataNode=0 do goto QInitVar
476 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find node: '"_cData_"'")
477
478 set result=cOKToCont
479
480QInitVar
481 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Exit InitVars()",1)
482 quit result
483
484
485CMDProcess(Command,Params)
486 ;"Purpose: Take allowed command, and carry out appropriate action
487 ;"Input: Command: One of following allowed commands:
488 ;" Show,M,DoMenuOption,UploadRecord,Jump
489 ;" Params: An array holding parameters. See GetParams() for format.
490 ;" Note: if node had no parameters, this array will be undefined.
491 ;"Note: Not all commands will have valid data for all attribs.
492 ;"Returns: If should continue execution: 1=OK to continue. 0=abort.
493
494 new OKToCont set OKToCont=1
495
496 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"CMDProcess")
497
498 if $data(ProcTable(Command)) do
499 . new Cmd set Cmd=ProcTable(Command)
500 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"CMD=",Cmd)
501 . set @("OKToCont=$$"_Cmd_"(.Params)")
502
503 goto CMDQuit
504
505CMDQuit
506 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"CMDProcess")
507 quit OKToCont
508
509
510DoComment(Params)
511 ;"Purpose: To provide a function for doing nothing.... for comments in the code.
512 quit 1
513
514DoShow(Params)
515 ;"Purpose: execute Show command
516 ;"Syntax: e.g. <Show>This is a test script system.</Show>
517 ;"Input: Params -- an array that holds all parameters (or is undefined if there were none)
518 ;" if there is text to be show, it should be in
519 ;" Params(cText)
520 ;"Input: TextArray: a reference to global array, holding the text found between tags
521 ;"Returns: If should continue execution: 1=OK to continue. 0=abort.
522
523 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoShow")
524
525 new done
526 new lineI
527 new OneLine
528 new result set result=cOKToCont
529
530 new TextArray
531
532 if $data(Params(cText))=0 do goto DSDone
533 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Asked to show text, but none found!")
534 . ;"if TMGDEBUG do ArrayDump^TMGDEBUG("Params") ;"zwr Params(*)
535 merge TextArray=Params(cText)
536 if TMGDEBUG do ArrayDump^TMGDEBUG("TextArray") ;"zwr TextArray(*)
537
538 set result=$$CheckArraySubst(.TextArray)
539
540 set lineI=$Order(TextArray(""))
541 for do quit:(lineI="")!(result=cAbort)
542 . set OneLine=TextArray(lineI)
543 . write OneLine,!
544 . set lineI=$Order(TextArray(lineI))
545
546DSDone
547 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoShow")
548
549 quit result
550
551DoM(Params)
552 ;"Purpose: execute a single line of M code
553 ;"Syntax: e.g. <M>write "This is a test of M code"</M>
554 ;" e.g. <M>set XMLData={{Data.Site.Office[Kevin].Field[Doctor]}}</M>
555 ;"Input: Params -- an array that holds all parameters (or is undefined if there were none)
556 ;" if there is code to be executed, it should be in
557 ;" Params(cText,1)
558 ;"Note: If a {{...}} pair is found, then the contents between the braces will
559 ;" be interpreted as a data reference, and the value will be looked up.
560 ;" The references are read-only. Attempts to write to them will only
561 ;" create an unused variable by the name of the data result. Will likely
562 ;" cause an error.
563 ;" Note: This code could be anything. Script execution will only continue
564 ;" after M code execution is complete.
565 ;"Returns: If should continue execution: 1=OK to continue. 0=abort.
566
567 new RefB
568 new Abort
569 new result set result=cOKToCont
570 new OrigCode
571
572 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoM")
573
574 new Code set Code=$get(Params(cText,1))
575 if Code="" do goto DMDone
576 . do ShowError^TMGDEBUG(.PriorErrorFound,"No M code found to execute!")
577
578 ;"Check if Code contains a data reference. Replace with data if found
579 set OrigCode=Code
580 set result=$$CheckSubstituteData(.Code)
581 if result=cAbort do goto DMDone
582 . do ShowError^TMGDEBUG(.PriorErrorFound,"UNABLE to execute this code: "_OrigCode)
583 . do ShowError^TMGDEBUG(.PriorErrorFound,"After lookup, code was:"_Code)
584
585 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"execute:> "_Code)
586
587 ;"Note: Here I trap execution errors, and return 0 if error encountered
588 do
589 . new $etrap set $etrap="do DoMErrTrap^TMGXINST"
590 . set ^TMP("TMG",$J,"trap")=cOKToCont
591 . xecute Code
592 . set result=^TMP("TMG",$J,"trap")
593 . if result=cAbort do
594 . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error executing code: \n"_Code)
595
596DMDone
597 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoM")
598 quit result
599
600
601 ;"=========================================================
602 ;"DoM Error trap routine
603 ;"=========================================================
604DoMErrTrap
605 set $etrap=""
606 set $ecode=""
607 set ^TMP("TMG",$J,"trap")=cAbort
608 quit
609 ;"=========================================================
610 ;"DoM End of Error trap routine
611 ;"=========================================================
612
613
614DoMenu(Params)
615 ;"Purpose: To execute a menu option inside the VistA system
616 ;"Syntax: e.g. <DoMenuOption option="DIUSER"></DoMenuOption>
617 ;"Input: Params -- an array that holds all parameters (or is undefined if there were none)
618 ;" if there is code to be executed, it should be in
619 ;" Params(cOption)
620 ;" This should be a valid VistA menu option name.
621 ;"Returns: If should continue execution: 1=OK to continue. 0=abort.
622
623 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoMenu")
624
625 set result=$$DoShow(.Params) ;"Show any associated text as a message
626
627 new MenuOption
628 set MenuOption=$get(Params(cOption)) ;"note use of attrib value with case UN-MODIFIED
629 if MenuOption="" do goto DoMenuQ
630 . do ShowError^TMGDEBUG(.PriorErrorFound,"No menu option found to execute!")
631
632 new Text
633 set Text(0)="<!> Notice:"
634 set Text(1)=" "
635 set Text(2)="Temporarily leaving XML Script Configurator"
636 set Text(3)="to run VistA menu option system...."
637 set Text(4)="This script will return to this point when"
638 set Text(5)="VistA menu option exited."
639 set Text(6)=" "
640 do PopupArray^TMGUSRIF(5,55,.Text)
641
642 new result
643 set result=cOKToCont
644
645 set DIC=19 ;"File 19 is the OPTION file
646 set DIC(0)="M" ;"M=Multiple index lookup allowed
647 set X=MenuOption
648 do ^DIC ;"Do lookup for variable X. Result returns in Y
649 if Y<0 do quit
650 . do ShowError^TMGDEBUG(.PriorErrorFound,"Menu option '"_MenuOption_"' wasn't found.\nTry specifying a more specific name, or check spelling.")
651
652 ;"Note: DIC is already set to 19
653 set X=$piece(Y,"^",1) ;"X=Menu option IEN to execute
654
655 ;Note: If the OPTION is a run routine, then this won't work. I could
656 ; Get the run routine my self, but I would also need to do the
657 ; entry and exit points etc. etc., so I am not now going to.
658
659 do EN^XQOR ;"call standard entry point to run menu/option X
660
661 new Text
662 set Text(0)="<!> Notice:"
663 set Text(1)=" "
664 set Text(2)="Re-entering XML Script Configurator"
665 set Text(3)="(Back from VistA menu option system)"
666 set Text(4)="Script continuing..."
667 set Text(5)=" "
668 do PopupArray^TMGUSRIF(5,55,.Text)
669
670
671 ;"Note: Here I could do some error checking, and return
672 ;" result=cAbort if we need to abort.
673DoMenuQ
674 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoMenu")
675 quit result
676
677
678DoLookup(Params)
679 ;"Purpose: To take data from XML file, and look if it is already in database
680 ;" -- if so, then put RecNum-IEN of record into variable pointed to by OutVarP
681 ;"Syntax: e.g. <LookupFileInfo id="Kevin" OutVar="MyVar"></LookupFileInfo>
682 ;"Input: Params -- an array loaded with expected parameters. I.e.:
683 ;" Params(cId): the ID of the <Record> data entry.
684 ;" Params(cId)="Kevin" in our example
685 ;" Params(cOutput)=the NAME of a variable to put RecNum-IEN into.
686 ;" Params(cOutput)="MyVar" in example
687 ;"Output: OutVarP is loaded with data, i.e.:
688 ;" @OutVarP@(cRecNum)=81
689 ;" @OutVarP@(cFile)=200
690 ;" @OutVarP@(cGlobal)="^VA(200)"
691 ;" @OutVarP@(cGlobal,cOpen)="^VA(200,"
692 ;"Returns: If should continue execution: 1=OK to continue. 0=abort.
693 ;"Note: Even if <Record> specifies a RecNum="2", this function will STILL do a
694 ;" search and return THAT value, not the "2" in this example.
695
696 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoLookup")
697
698 new Data
699 new RecNumIEN
700 new result set result=cOKToCont
701 new ID set ID=$get(Params(cId))
702 new OutVarP set OutVarP=$get(Params(cOutput))
703
704 set result=$$DoShow(.Params) ;"Show any associated text as a message
705
706 if OutVarP="" goto LkDone
707
708 ;"Parse XML data into a usable form. Verification is done.
709 if '$$GetRInfo(ID,.Data) do goto LkDone
710 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to process <Record> section with id='"_ID_"'.")
711 . set result=cAbort ;"0=Abort
712
713 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Parsed data.")
714 set @OutVarP@(cFile)=$get(Data(0,cFile))
715 set @OutVarP@(cGlobal)=$get(Data(0,cFile,cGlobal))
716 set @OutVarP@(cGlobal,cOpen)=$get(Data(0,cFile,cGlobal,cOpen))
717
718 set result=$$GetRecMatch^TMGDBAPI(.Data,.RecNumIEN) ;"if no prior record, returns 0
719 ;"set RecNumIEN=$$GetRecMatch^TMGDBAPI(.Data) ;"if no prior record, returns 0
720 set @OutVarP@(cRecNum)=RecNumIEN
721
722LkDone
723 set result=(+result>0) ;"Change RecNum-IEN into boolean 1 or 0
724 if result=cAbort do ShowError^TMGDEBUG(.PriorErrorFound,"Lookup command failed.")
725 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoLookup")
726 quit result
727
728
729DoValueLookup(Params)
730 ;"Purpose: To look for a value of a given value in a given record in given file.
731 ;"Syntax: e.g. <LookupFieldValue File="NEW PERSON" RecNum="1" Field=".01" OutVar="MyVar">
732 ;"Input: Params -- an array loaded with expected parameters. I.e.:
733 ;" Params(cFile)="NEW PERSON" in our example
734 ;" Params(cRecNum)="1" in example
735 ;" Params(cField)=".01" in our example (could be Name of field)
736 ;" Params(cOutput)="MyVar"
737 ;"Output: MyVar is loaded with data, i.e.:
738 ;" MyVar(cFile)=200
739 ;" MyVar(cGlobal)="^VA(200)"
740 ;" MyVar(cGlobal,cOpen)="^VA(200,"
741 ;" MyVar(cRecNum)=1
742 ;" MyVar(cField)=.01
743 ;" MyVar(cValue)=xxx <-- the looked-up value
744 ;"Returns: If should continue execution: 1=OK to continue. 0=unsuccessful lookup
745 ;"Note: I am getting values by directly looking into database, rather than use
746 ;" the usual lookup commands. I am doing this so that there will be no
747 ;" 'hidden' data, based on security etc.
748
749 new result
750
751 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoValueLookup")
752
753 set result=$$ParamSubstitute(.Params)
754 if result=cAbort goto DVLDone
755
756 set result=$$ValueLookup^TMGDBAPI(.Params)
757
758DVLDone
759 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoValueLookup")
760 quit result
761
762
763DoFileUtility(Params)
764 ;"Purpose: To provide file access/manipulation utilities to script user
765 ;"syntax:
766 ;" <FileUtility File="NEW PERSON" Fn="xxx" RecNum="1" Field=".01" OutVar"MyOutVar" Value="xx" >
767 ;" File: The name of the file to act upon.
768 ;" File may have subnodes (i.e. "NEW PERSON|ALIAS|TITLE")
769 ;" **BUT**, any deletion or set values will only work on top level (i.e. "NEW PERSON")
770 ;" Fn can be on of the following [OPTIONAL]. (Data substitution is allowed)
771 ;" Fn="delete" If Field is not specified:
772 ;" Will cause record RecNum to be deleted.
773 ;" MyOutVar("DELETED")=RecNum of deleted record, or
774 ;" 0 if not found.
775 ;" If Field IS specified:
776 ;" Will delete the value in field, in record RecNum
777 ;" Note: delete is intended only for the highest-level records
778 ;" (i.e. not subfiels, or multiple fields)
779 ;" Note: delete method uses ^DIK to delete the record
780 ;" Fn="info" Will just fill in info below.
781 ;" If Fn not specified, this is default
782 ;" Fn="set" Will put Value into Field, in RecNum, in File (all required)
783 ;" RecNum: [OPTIONAL] Specifies which record to act on. If not
784 ;" specified, then just file info is returned. Data substitution is allowed
785 ;" Field: [OPTIONAL] Specifies which field to act on. Data substitution is allowed
786 ;" OutVar: Needed to get information back from function (but still Optional)
787 ;" Gives name of variable to put info into.
788 ;" Data substitution is allowed.
789 ;"Input: Params -- an array loaded with expected parameters. I.e.:
790 ;" Params(cFile)="NEW PERSON" in our example
791 ;" Params(cFn)="info" or "delete", or "set"
792 ;" Params(cRecNum)="1" in example
793 ;" Params(cField)=".01" in our example (could be Name of field)
794 ;" Params(cOutput)="MyVar"
795 ;"Output: MyVar is loaded with data, i.e.
796 ;" i.e. MyOutVar("FILE")=Filenumber
797 ;" MyOutVar("FILE","FILE")=SubFilenumber <-- only if subnodes input in File name (e.g."ALIAS")
798 ;" MyOutVar("FILE","FILE","FILE")=SubSubFilenumber <-- only if subnodes input in File name (e.g."TITLE")
799 ;" MyOutVar("GLOBAL")="^VA(200)"
800 ;" MyOutVar("GLOBAL, OPEN")="^VA(200,"
801 ;" MyOutVar("RECNUM")=record number
802 ;" MyOutVar("FIELD")=Filenumber
803 ;" MyOutVar("VALUE")=xxxx <=== value of field (PRIOR TO deletion, if deleted)
804 ;" MyOutVar("NEXTREC")=record number after RecNum, or "" if none
805 ;" MyOutVar("PREVREC")=record number before RecNum, or "" if none
806 ;" MyOutVar("FN")=the function executed
807 ;" MyOutVar("NUMRECS")=Number of records in file PRIOR to any deletions
808 ;" MyOutVar("FIRSTREC")=Rec number of first record in file
809 ;" MyOutVar("LASTREC")=Rec number of last record in file
810 ;"Returns: If should continue execution: 1=OK to continue. 0=abort
811 ;"Note: I am getting values by directly looking into database, rather than use
812 ;" the usual lookup commands. I am doing this so that there will be no
813 ;" 'hidden' data, based on security etc.
814
815 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoFileUtility")
816
817 new result
818
819 set result=$$ParamSubstitute(.Params)
820 if result=cAbort goto DFUTDone
821
822 set result=$$FileUtility^TMGDBAPI(.Params)
823
824DFUTDone
825 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoFileUtility")
826 quit result
827
828
829DoSearchRec(Params)
830 ;"Purpose: To allow the user to search for a specif record number
831 ;"Syntax: <SearchRec File="PERSON CLASS" InVar="MyInput" OutVar="MyOutput"></SearchRec>
832 ;" File: The name of the file to act upon.
833 ;" InVar: the name of a variable with global scope that will hold lookup info
834 ;" OutVar: the name of variable to receive results
835 ;"Input: Params -- an array loaded with expected parameters. I.e.:
836 ;" Params(cFile)="NEW PERSON" in our example
837 ;" Params(cOutput)="MyOutput"
838 ;" Params(cInput)="MyInput"
839 ;"Note: The format of the input params variable (e.g. 'MyInput') should be as follows:
840 ;" MyInput(FieldNum)=ValueToSearchFor
841 ;" MyInput(FieldNum)=ValueToSearchFor
842 ;" MyInput(FieldNum)=ValueToSearchFor
843 ;" ... etc.
844 ;"Output: MyVar is loaded with data, i.e.
845 ;" MyOutVar("RECNUM")=record number, or 0 if not found
846 ;"Returns: If should continue execution: 1=OK to continue. 0=abort
847
848 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoSearchRec")
849
850 new result set result=cAbort
851 new SrchParams,RecNum,OutVar
852 new MyInput,MyOutput
853
854 if $$DoShow(.Params)=0 goto DSRDone ;"Show any associated text as a message
855
856 if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Params") ;"zwr Params(*)
857
858 set MyInput=$get(Params(cInput))
859 set MyOutput=$get(Params(cOutput))
860 if (MyOutput="")!(MyInput="") goto DSRDone ;"result=cAbort be default
861
862 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"MyInput=",MyInput)
863 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"MyOutput=",MyOutput)
864 merge SrchParams=@MyInput
865 set SrchParams(0,cFile)=$get(Params(cFile))
866 set RecNum=$$RecFind^TMGDBAPI(.SrchParams)
867 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Found record number: ",RecNum)
868 set @MyOutput@(cRecNum)=RecNum
869 if RecNum=0 goto DSRDone
870 set result=cOKToCont
871
872DSRDone
873 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoSearchRec")
874 quit result
875
876
877DoUpload(Params)
878 ;"Purpose: To take data from XML file, and get it up into the VistA database
879 ;"Syntax: e.g. <UploadRecord id="Kevin"></UploadRecord>
880 ;"Note: ***See documentation in GetRInfo for expected formats
881 ;"Input: Params -- an array that holds all parameters (or is undefined if there were none)
882 ;" Params(cId,cUpperCase) -- the ID ofthe data to upload
883 ;" Expected ID -- the ID of the <Record> data entry. e.g. "Kevin" in our example
884 ;" Params(cOutput)=the NAME of a variable to put RecNum-IEN into. (Optional)
885 ;" i.g. Params(cOutput)="MyVar" will cause MyVar=IEN
886 ;"Returns: If should continue execution: 1=OK to continue. 0=abort.
887
888 new Data
889 new result set result=cOKToCont
890 new RecNumIEN
891
892 new OutVarP set OutVarP=$get(Params(cOutput))
893
894 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoUpload")
895
896 set result=$$DoShow(.Params) ;"Show any associated text as a message
897
898 new ID
899 set ID=$get(Params(cId,cUpperCase))
900 if ID="" do goto ULDone
901 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get ID of file to upload!")
902
903 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Uploading file info -- id="_ID)
904
905 ;"Parse XML data into a usable form. Verification is done.
906 if '$$GetRInfo(ID,.Data) do goto ULDone
907 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to process <Record> section with id='"_ID_"'.")
908 . set result=cAbort ;"0=Abort
909
910 set RecNumIEN=$get(Data(0,cRecNum),0) ;"Get user-specified Record Num(IEN), or null
911 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"User-requested recordnum is (0=not requested): ",RecNumIEN)
912 set result=$$UploadData^TMGDBAPI(.Data,.RecNumIEN)
913 if OutVarP'="" do
914 . set @OutVarP@(cRecNum)=RecNumIEN
915
916ULDone
917 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result = ",result)
918 if result=cAbort do ShowError^TMGDEBUG(.PriorErrorFound,"Error uploading data.")
919 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoUpload")
920 quit result
921
922
923
924GetRInfo(ID,Data)
925 ;"Purpose: To get record info from the <DATA> section of the XML file,
926 ;" and to store it in the Data variable.
927 ;"Input: ID: The name of the record info to get.
928 ;" e.g. to get the info for this entry:
929 ;" <Record id="Kevin" File="1234.1">
930 ;" Then ID should = "Kevin" (no extra quotes)
931 ;" Data: This is to be an array that is passed by reference
932 ;" Any preexisting contents will be deleted
933 ;" See output below.
934 ;"Note: The syntax of the <Record> block is as follows. Note, <Record>
935 ;" should be a child (i.e. not a grandchild) of the <DATA> block.
936 ;" example:
937 ;" <Record id="InstFile" File="1234.1">
938 ;" or <Record id="InstFile" File="NEW PERSON">
939 ;" or <Record id="InstFile" File="NEW PERSON" RecNum="1">
940 ;" <Field id=".01" MatchThis="true">MyData1</Field>
941 ;" <Field id=".02" MatchValue="John">Bill</Field>
942 ;" <Field id=".03">MyData3</Field>
943 ;" <Field id=".04">MyData4</Field>
944 ;" <Field id="NAME">MyData5</Field>
945 ;" <Field id="ITEM/.01">SubEntry1</Field>
946 ;" <Field id="ITEM/SYNONYM">SE1</Field> ;"Note: SYNONYM here is field .02
947 ;" <Field id="ITEM/INFO">'Some Info'</Field> ;"Note: INFO here is field .03
948 ;" <Field id="ITEM/MENU">SubEntry2</Field> <-- start of 2nd subfile entry
949 ;" <Field id="ITEM/TEXT/INITS">JD</Field> ;"TEXT=.4; INITS=.1
950 ;" <Field id="ITEM/TEXT/CREATOR">Doe,John</Field> ;"CREATOR is field .2
951 ;" </Record>
952 ;"
953 ;" 'id': specifies a name that is used in <UploadRecord> command
954 ;" 'File': specifies the filenumber or formal file name to put info into
955 ;" 'RecNum': an OPTIONAL parameter. If specified, data will be forced into the
956 ;" specified record number. If not specified, then data matching is used
957 ;" to determine where to put record. Data substitution is allowed.
958 ;" A value of 0 will be treated as if no value specified.
959 ;"
960 ;" At least one (and likely many) <Field> entries must exist in the <Record> block
961 ;" Syntax:
962 ;" <Field id=".01">MyDataplacing</Field>
963 ;" <Field id="NAME" MatchThis="true">MyDataplacing</Field>
964 ;" <Field id="ITEM/SYNONYM">M1</Field>
965 ;"
966 ;" 'id' gives the field number or name
967 ;" Multiple field names/numbers may be included here.
968 ;" "ITEM/SYNONYM" means that SYNONYM is a field within
969 ;" the ITEM subfile (a field with multiple entries). Thus
970 ;" field ITEM would be located, then SYNONYM subfield.
971 ;" To have a '/' character as part of the field name, and not
972 ;" to be interpreted as a node divider, then use '//', this will
973 ;" be replaced with '/'.
974 ;" Note: When a field allows multiple entries (like "ITEM" above),
975 ;" then there must be a way to determine group of the data into
976 ;" one entry or another. The field ".01" (or a name that resolves
977 ;" to ".01" will serve this purpose. For example:
978 ;" ITEM|.01 <---- the beginning of one entry
979 ;" ITEM|SYNONYM
980 ;" ITEM|INFO
981 ;" ITEM|MENU <---- beginning of the next entry. (MENU=.01)
982 ;" ITEM|TEXT|INITS
983 ;" ITEM|TEXT|CREATOR
984 ;" 'MatchThis': if value="true", then this entry will be used to
985 ;" search for preexisting record in file. Should only be
986 ;" used for highest levels, i.e. match in subfields not supported
987 ;" 'MatchValue': if specified, then value of entry will be used to
988 ;" search for preexisting record in file. Should only be
989 ;" used for highest levels, i.e. match in subfields not supported
990 ;"
991 ;" The data is found between the <Field></Field> tags.
992 ;" Note: The data values may contain lookup codes. For example
993 ;" <Field id="ITEM|CREATOR">{{Data.Site.Office[EastSide].Field[Doctor]}}</Field>
994 ;" would cause the {{..}} value to be looked up in the corresponding
995 ;" section in the XML file and replaced. Thus the line would be converted to:
996 ;" <Field id="ITEM|CREATOR">Kevin</Field>
997 ;"
998 ;"Output: The Data array will be filed with data. Thus for above example:
999 ;" Data(0,cFile)="1234.1" <-- "NEW PERSON" Note conversion
1000 ;" Data(0,cFile,cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200,"
1001 ;" Data(0,cRecNum)=2 <-- only if user-specified.
1002 ;" Data(0,cEntries)=1
1003 ;" Data(1,".01")="MyData1"
1004 ;" Data(1,".01",cMatchValue)="MyData1"
1005 ;" Data(1,".02")="Bill"
1006 ;" Data(1,".02",cMatchValue)="John"
1007 ;" Data(1,".03")="MyData3"
1008 ;" Data(1,".04")="MyData4"
1009 ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06"
1010 ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07"
1011 ;" Data(1,".07",1,".01")="SubEntry1"
1012 ;" Data(1,".07",1,".02")="SE1"
1013 ;" Data(1,".07",1,".03")="'Some Info'"
1014 ;" Data(1,".07",2,".01")="SubEntry2"
1015 ;" Data(1,".07",2,".02")="SE2"
1016 ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04
1017 ;" Data(1,".07",2,".04",1,".01")="JD"
1018 ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN"
1019 ;" ADDENDUM
1020 ;" Data(1,".01",cFlags)=any flags specified for given field.
1021 ;" only present if user specified.
1022
1023
1024 ;" Note: The output is somewhat validated, in that if file NAME is given
1025 ;" instead of a number, the name will be converted. The same applies
1026 ;" for field NUMBERS. This ensures that the file exists, and
1027 ;" puts the global reference in the array
1028 ;"Result: 1 if valid data in Data, 0 if data invalid
1029
1030 new result
1031 new ChildNode
1032 new FileNode
1033 new Text,TextArray
1034 new NodeName,AtrN,AtrVal
1035 new AtrMatch,MatchValue
1036 new MatchThis
1037 new Entries set Entries=0
1038 new Field,FieldNumber
1039 new RecNum
1040 new Flags
1041 set result=cOKToCont
1042 set ChildNode=0
1043 set Entries=0
1044 new FileNumber,FileName,File
1045 new index
1046 new DataP set DataP="Data"
1047 new EntryNumber set EntryNumber=0 ;"was 1
1048
1049 new InitDebug set InitDebug=TMGDEBUG
1050 ;"set TMGDEBUG=0 ;"Force this function to not put out TMGDEBUG info.
1051
1052 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetRInfo")
1053
1054 if $data(ID)'=0 do
1055 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"var ID=",ID)
1056 else do
1057 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"var ID=(empty)")
1058
1059 if $data(ID)'=0 do
1060 . set FileNode=$$GetDescIDNode(DataNode,cRecord,ID)
1061 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Node with ",cRecord,"=",FileNode)
1062 else do
1063 . set FileNode=0
1064 if FileNode=0 do goto GInfPast
1065 . set result=cAbort
1066 . do ShowError^TMGDEBUG(.PriorErrorFound,"File entry named '"_ID_"' not found.")
1067
1068 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking for user-specified record number in node: ",FileNode)
1069 set RecNum=$$GetAtrVal^TMGXMLT(XMLHandle,FileNode,cRecNum) ;"get user-specified RecNum IEN (optional)
1070 set result=$$CheckSubstituteData(.RecNum)
1071 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Specified RecNum='",RecNum,"'")
1072 if +RecNum>0 set Data(0,cRecNum)=RecNum
1073
1074 set File=$$GetAtrVal^TMGXMLT(XMLHandle,FileNode,cFile)
1075 set Data(0,cFile)=File
1076 set result=$$SetupFileNum^TMGDBAPI(.Data)
1077 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setup file number result=",result)
1078 if result=cAbort do goto GInfPast
1079 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to set up file '"_File_"'.")
1080 set FileNumber=$get(Data(0,cFile),-1)
1081 if FileNumber=-1 do goto GInfQuit
1082 . set result=cAbort
1083
1084GInfLoop
1085 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Starting GInfLoop")
1086 set ChildNode=$$CHILD^MXMLDOM(XMLHandle,FileNode,ChildNode)
1087 if ChildNode=0 goto GInfPast
1088 set NodeName=$$GetNName^TMGXMLT(XMLHandle,ChildNode)
1089 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Name="_NodeName)
1090 if NodeName'=cField goto GInfLoop
1091 set Text=$$Get1NText^TMGXMLT(XMLHandle,ChildNode,.TextArray)
1092 if $data(TextArray(2)) do
1093 . merge Text(cText)=TextArray
1094
1095 if $$UP^XLFSTR($$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cMatchThis))=cTrue do
1096 . set MatchValue=Text
1097 set MatchValue=$get(MatchValue)
1098 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Attrib Match value='",MatchValue,"'")
1099 set Entries=Entries+1
1100 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Entries='",Entries,"'")
1101
1102 set Field=$$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cId) ;"May get either a name or a number
1103 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Field='",Field,"'")
1104
1105 ;"Protect any //'s by converting to ~~'s
1106 set Field=$$Substitute^TMGSTUTL(.Field,c2NodeDiv,cProtect)
1107 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"After substitution, Field '",cId,"'=",Field)
1108
1109 set Flags=$$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cFlags) ;"Get any flags that might exist.
1110 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Flags for node #",ChildNode," = '",Flags,"'")
1111
1112 ;"Allow recursive calls via ProcessRNode
1113 set result=$$ProcessRNode(DataP,Field,.Text,.EntryNumber,FileNumber,0,MatchValue,Flags)
1114 if result=cAbort goto GInfQuit
1115 ;"temp ... set EntryNumber=EntryNumber+1
1116 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"EntryNumber=",EntryNumber)
1117
1118 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Completed loop cycle (maybe there will be more to come)")
1119 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"------------")
1120 goto GInfLoop
1121
1122GInfPast
1123 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Done with loop")
1124 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"------------")
1125
1126 if $data(Data(0,cEntries))=0 do goto GInfQuit
1127 . set result=cAbort
1128
1129 ;"Ensure that there is at least a .01 field. Required for every record
1130 ;"Note: I think that other files have multiple KEY fields.... I am not checking
1131 ;" for this (perhaps I should later??)
1132 new bFound set bFound=0
1133 for index=1:1:Data(0,cEntries) do quit:bFound
1134 . ;"if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Data(",index,",.01)='",$get(Data(index,".01")),"'")
1135 . if $data(Data(index,".01")) set bFound=1
1136
1137 if bFound=0 do goto GInfQuit
1138 . do ShowError^TMGDEBUG(.PriorErrorFound,"Data entry did not specify any entry for field .01")
1139 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is data:")
1140 . if TMGDEBUG do ArrayDump^TMGDEBUG("Data") ;"zwr Data(*)
1141 . set result=cAbort
1142
1143GInfQuit
1144 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetRInfo")
1145 set TMGDEBUG=InitDebug
1146 quit result
1147
1148
1149ProcessRNode(DataP,Field,Text,EntryNumber,FileNumber,DoingSubNodes,MatchValue,Flags)
1150 ;"Purpose: Allow for recursive calling when doing GetRInfo
1151 ;" This takes one entry and processes it.
1152 ;"Input: DataP: The 'name' of the data array -- like this: "Data(1)"
1153 ;" Field: a field name with 0..n subnodes
1154 ;" i.e. "ITEM", OR "ITEM|NUMBER", OR "ITEM|NUMBER|ID"
1155 ;" Text: the value that should be put into field. should be passed by REFERENCE
1156 ;" Text will have the following format:
1157 ;" Text="First line of text"
1158 ;" Text(cText,1)="First line of text" <-- only present if multiple
1159 ;" Text(cText,2)="Second line of text" lines of text present.
1160 ;" EntryNumber: The current entry number. Should be passed by REFERENCE
1161 ;" FileNumber: the current file number, or sub-filenumber. DON'T PASS BY REFERENCE
1162 ;" The first node (i.e. "ITEM") should be field in FileNumber
1163 ;" DoingSubNodes: 1 if true (changes behavior or entry numbering for subnodes), 0 otherwise
1164 ;" //AtrMatch: if this field should be matched for during DB lookup
1165 ;" MatchValue: Value to looking in database when finding matching record.
1166 ;" Flags: any user specified flags for field
1167 ;"Result: Returns success 1=OK to continue. 0=Abort
1168
1169 ;"Note: This entry--><Field id="ITEM|TEXT|CREATOR">Doe,John</Field>
1170 ;"Should result it--> Data(6,".07",2,".04",1,".02")="DOE,JOHN"
1171 ;"See data format description in GetRInfo
1172
1173 new PartA,PartB
1174 new tempA,tempB
1175 new result set result=cOKToCont
1176 new cFieldNumber set cFieldNumber="Field Number"
1177
1178 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"ProcessRNode")
1179
1180 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"DataP='",$get(DataP),"'")
1181 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"File number=",$get(FileNumber))
1182 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Field=",$get(Field))
1183 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"EntryNumber=",$get(EntryNumber))
1184 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"MatchValue='",$get(MatchValue),"'")
1185 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Flags='",$get(Flags),"'")
1186 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"DoingSubNodes=",$get(DoingSubNodes))
1187
1188 new SpliceArray
1189 new temp
1190
1191 if Field[cNodeDiv do ;"Parse 'ITEM|NUMBER|ID' into 'ITEM', 'NUMBER', 'ID'
1192 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Multiple nodes found for field. Processing...")
1193 . do CleaveStr^TMGSTUTL(.Field,cNodeDiv,.PartB)
1194 . set FieldNumber=$$GetNumField^TMGDBAPI(FileNumber,Field)
1195 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Parsed off first part of Field. Looking at only '",Field,"'")
1196 . ;"Note: this does NOT handle processesing of more than 2 nodes.
1197 . if PartB'=cNull do ;"If PartB has data, then PartB(cFieldNumber) will also have data
1198 . . if PartB=".01" do
1199 . . . set PartB(cFieldNumber)=".01"
1200 . . else do
1201 . . . new BFileNumber
1202 . . . set BFileNumber=$$GetSubFileNumber^TMGDBAPI(FileNumber,FieldNumber) ;"get 'file number' of subfile
1203 . . . if BFileNumber'=0 do
1204 . . . . set PartB(cFieldNumber)=$$GetNumField^TMGDBAPI(BFileNumber,PartB)
1205 . . . else set PartB(cFieldNumber)=0
1206 . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Will deal with '",PartB,"' later")
1207
1208 set Field=$$Substitute^TMGSTUTL(.Field,cProtect,cNodeDiv) ;"convert protected ||'s back from }}'s to single |
1209 if $data(PartB) set PartB=$$Substitute^TMGSTUTL(.PartB,cProtect,cNodeDiv)
1210
1211 set FieldNumber=+Field
1212 if FieldNumber=0 do
1213 . set FieldNumber=$$GetNumField^TMGDBAPI(FileNumber,Field)
1214 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Converted '",Field,"' to field number ",FieldNumber)
1215 else if $$VFIELD^DILFD(FileNumber,Field)=0 do goto PFNDone
1216 . do ShowError^TMGDEBUG(.PriorErrorFound,Field_" is not a valid field number in file "_FileNumber)
1217 . set result=cAbort
1218 if FieldNumber=0 do goto PFNDone
1219 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to convert field '"_Field_"' to a field number. (Hint: If this name is supposed to contain multiple nodes, did you use '"_cNodeDiv_"' as a divider?)")
1220 . set result=cAbort
1221
1222 if FieldNumber=.01 do
1223 . set EntryNumber=EntryNumber+1 ;"Test this!!
1224 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Found .01 field. Incrementing EntryNumber to "_EntryNumber)
1225
1226
1227 if $data(PartB) do
1228 . ;"If there are subnodes, then search if current entry should be under a prior entry
1229 . if $data(@DataP@(EntryNumber-1,FieldNumber,0,cEntries)) do
1230 . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"EntryNumber=",EntryNumber)
1231 . . ;"set EntryNumber=EntryNumber-1
1232 . . set DoingSubNodes=1
1233 . . ;"if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Attaching current data as a subnode of prior entry.")
1234 . . ;"if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Changing EntryNumber to ",EntryNumber)
1235
1236 if DoingSubNodes=0 goto PFNPast
1237 if (EntryNumber=0) do goto PFNDone
1238 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"No '.01' field found yet, so skipping processing.")
1239
1240PFNPast
1241 if $data(PartB)=0 do
1242 . set result=$$CheckSubstituteData(.Text) ;"Do any data lookup needed
1243 . if result=cAbort do
1244 . . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to do data lookup: "_Text)
1245 . else do
1246 . . ;"HERE IS WHERE WE PUT THE INFO INTO THE DATA ARRAY.
1247 . . set @DataP@(EntryNumber,FieldNumber)=Text
1248 . . set @DataP@(EntryNumber,FieldNumber,"FieldName")=$get(Field) ;"mainly for debugging.
1249 . . if Flags'=" " set @DataP@(EntryNumber,FieldNumber,cFlags)=Flags
1250 . . new FieldInfo
1251 . . do GetFieldInfo^TMGDBAPI(FileNumber,FieldNumber,"FieldInfo")
1252 . . if $get(FieldInfo("TYPE"))="WORD-PROCESSING" do
1253 . . . do WPHandle(DataP,EntryNumber,FieldNumber,.Text)
1254 . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setting ",DataP,"(",EntryNumber,",",FieldNumber,")=",Text)
1255 . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Flags were: '",Flags,"'")
1256 else do
1257 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"DoingSubNodes=",DoingSubNodes,", PartB='",$get(PartB),"'")
1258 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Doing subnodes, so did NOT set ",DataP,"(",EntryNumber,",",FieldNumber,")=",Text)
1259
1260 if result=cAbort goto PFNDone
1261
1262 if FieldNumber=.01 set MatchValue=Text
1263
1264 if (MatchValue'="")!(FieldNumber=.01) do
1265 . ;"set @DataP@(EntryNumber,FieldNumber,cMatchThis)=1 ;"i.e. true
1266 . set @DataP@(EntryNumber,FieldNumber,cMatchValue)=MatchValue
1267 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setting ",DataP,"(",EntryNumber,",",FieldNumber,",",cMatchValue,")=",MatchValue)
1268
1269 set @DataP@(0,cEntries)=EntryNumber
1270 set @DataP@(0,cFile)=FileNumber
1271
1272 if $data(PartB) do ;"I.e. we have subnodes. -- process
1273 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Subnodes detected. Here is where we deal with that '",PartB,"'")
1274 . new SubEntryNumber
1275 . set SubEntryNumber=$get(@DataP@(EntryNumber,FieldNumber,0,cEntries),0)
1276 . if (PartB(cFieldNumber)=".01")!(SubEntryNumber=0) do
1277 . . ;"test ... set SubEntryNumber=SubEntryNumber+1
1278 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"SubEntryNumber=",SubEntryNumber)
1279 . set FileNumber=$$GetSubFileNumber^TMGDBAPI(FileNumber,FieldNumber) ;"get 'file number' of subfile
1280 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"file number=",FileNumber)
1281 . if FileNumber=0 quit
1282 . set DataP=$name(@DataP@(EntryNumber,FieldNumber))
1283 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling self recursively")
1284 . new SubFlags set SubFlags=Flags ;"SubFlags=" "
1285 . new SubMatchValue set SubMatchValue=""
1286 . set result=$$ProcessRNode(DataP,PartB,.Text,.SubEntryNumber,FileNumber,1,SubMatchValue,SubFlags) ;"Call self recursively
1287
1288PFNDone
1289 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"ProcessRNode")
1290 quit result
1291
1292WPHandle(DataP,EntryNumber,FieldNumber,Text)
1293 ;"Purpose: to process word-processing fields for ProcessRNode()
1294 ;" It will get text into form ready for use by FILE^DIE
1295 ;"Input: DataP: The 'name' of the data array -- like this: "Data(1)"
1296 ;" EntryNumber: The current entry number. Should be passed by REFERENCE
1297 ;" FileNumber: the current file number, or sub-filenumber. DON'T PASS BY REFERENCE
1298 ;" The first node (i.e. "ITEM") should be field in FileNumber
1299 ;" Text: the value that should be put into field. should be passed by REFERENCE
1300 ;" Text will have the following format:
1301 ;" Text="First line of text"
1302 ;" Text(cText,1)="First line of text" <-- only present if multiple
1303 ;" Text(cText,2)="Second line of text" lines of text present.
1304 ;"Result: none
1305
1306 new Array,temp
1307 new result
1308
1309 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"WPHandle")
1310
1311 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is Text to use to put into WP field:")
1312 if TMGDEBUG do ArrayDump^TMGDEBUG("Text")
1313 if $data(Text(cText)) do
1314 . set result=$$FormatArray^TMGSTUTL(.Text,.Array,"\n")
1315 else do
1316 . do CleaveToArray^TMGSTUTL(Text,"\n",.Array,1)
1317
1318 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is array after processing, ready to put into WP field:")
1319 if TMGDEBUG do ArrayDump^TMGDEBUG("Array")
1320
1321 merge @DataP@(EntryNumber,FieldNumber,"WP")=Array
1322 set @DataP@(EntryNumber,FieldNumber)=$name(@DataP@(EntryNumber,FieldNumber,"WP"))
1323 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setting: ",DataP,"(",EntryNumber,",",FieldNumber,")=",$name(@DataP@(EntryNumber,FieldNumber,"WP")))
1324
1325 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"WPHandle")
1326 quit
1327
1328
1329CheckArraySubst(TextArray)
1330 ;"Purpose: Accept a text array, and scan all lines for any needed data substitution
1331 ;"Input: TextArray -- should be passed by reference.
1332 ;" any number scheme of lines may be used.
1333 ;"Output -- Text array is changed, if passed by reference
1334 ;"Result: 1=OK to continue, 0=Error (data requested, but not found)
1335
1336 new lineI,Count
1337 new OneLine
1338 new result set result=cOKToCont
1339
1340 if $data(TextArray)'=10 goto CKASq
1341
1342 set lineI=$Order(TextArray(""))
1343 for do quit:(lineI="")!(result=cAbort)
1344 . set OneLine=TextArray(lineI)
1345 . set result=$$CheckSubstituteData(.OneLine) ;"Do any data lookup needed
1346 . set TextArray(lineI)=OneLine
1347 . set lineI=$Order(TextArray(lineI))
1348
1349CKASq
1350 quit result
1351
1352ParamSubstitute(Params)
1353 ;"Purpose: To accept an array of parameters, and do data substitution on all entries
1354 ;"Input: Params: an array of parameters
1355 ;"Result: 1=OK to continue, 0=Error (data requested, but not found)
1356
1357 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"ParamSubstitute")
1358
1359 new result set result=cAbort
1360 if $data(Params)=0 goto PStDone
1361 new index
1362
1363 set index=$order(Params(""))
1364 for do quit:(index="")!(result=cAbort)
1365 . if index="" quit
1366 . new s
1367 . if $data(Params(index))#10'=0 do
1368 . . set s=Params(index)
1369 . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking at Param(",index,")=",s)
1370 . . set result=$$CheckSubstituteData(.s)
1371 . . if result=cAbort quit
1372 . . set Params(index)=s
1373 . else do
1374 . . new subindex
1375 . . set subindex=$order(Params(index,""))
1376 . . for do quit:(subindex="")!(result=cAbort)
1377 . . . set s=Params(index,subindex)
1378 . . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking at Param("_index_","_subindex_")=",s)
1379 . . . set result=$$CheckSubstituteData(.s)
1380 . . . if result=cAbort quit
1381 . . . set Params(index)=s
1382 . . . set subindex=$order(Params(index,subindex))
1383 . set index=$order(Params(index))
1384
1385PStDone
1386 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"ParamSubstitute")
1387 quit result
1388
1389CheckSubstituteData(Text)
1390 ;"Purpose: To look for data-substitution codes (i.e. {{...}}), and if
1391 ;" found, to replace with data from XML file
1392 ;"Input: A line of text that may or may not have codes. ** Should be passed by reference
1393 ;"Output: Text is modified if passed by reference
1394 ;"Result: 1=OK to continue, 0=Error (data requested, but not found, or error occured)
1395 ;"Note: Nesting is allowed, and all instances of {{...}} will be substituted
1396
1397 new PartA,PartB,PartC,RefB
1398 new result set result=cOKToCont
1399
1400 new InitDebug set InitDebug=TMGDEBUG
1401 set TMGDEBUG=0 ;"Force this function to not put out TMGDEBUG info.
1402
1403 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"CheckSubstituteData")
1404
1405CKSubL1 ;"Check if Code contains a data reference
1406 if $$NestSplit^TMGSTUTL(.Text,cDataOpen,cDataClose,.PartA,.PartB,.PartC)=0 goto CkSubDone
1407 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Reference to data found... replacing now.")
1408 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Initline: '",Text,"'")
1409
1410 set RefB=$$GetData(PartB)
1411 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looked up data: '",RefB,"'")
1412 if RefB="" do goto CkSubDone
1413 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error. Unable to find data reference: "_PartB)
1414 . set result=cAbort
1415 set Text=PartA_RefB_PartC ;"reassemble new code line
1416 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"After replacement, line='",Text,"'")
1417 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"---------------------")
1418 goto CKSubL1
1419
1420CkSubDone
1421 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"CheckSubstituteData")
1422 set TMGDEBUG=InitDebug
1423 quit result
1424
1425
1426DoJump(Params)
1427 ;"Purpose: To allow limited program flow control
1428 ;"Syntax: e.g. <Jump condition="if State=1" label="C"></Jump>
1429 ;"Input: Params -- an array containg parameters to run
1430 ;" Params(cCondition): M code executed to determine whether to jump
1431 ;" e.g. Params(cCondition)="if State=2"
1432 ;" Params(cLabel): The name of the block to jump to.
1433 ;" Params(cLabel)="TargetLabel"
1434 ;"Note: The expected syntax of the label is: <Label>B</Label>
1435 ;" In this example, the label name is "B"
1436 ;"Returns: If should continue execution: 1=OK to continue. 0=abort.
1437
1438 new result
1439 set result=cOKToCont
1440 new CondBool set CondBool=1
1441
1442 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoJump")
1443
1444 new CondCode set CondCode=$get(Params(cCondition))
1445 set result=$$CheckSubstituteData(.CondCode)
1446 if result=cAbort goto DJDone
1447 new Label set Label=$get(Params(cLabel))
1448 set result=$$CheckSubstituteData(.Label)
1449 if result=cAbort goto DJDone
1450
1451 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Condition code='"_CondCode_"'")
1452 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Label="_Label)
1453
1454 ;"Note: Here I trap errors that might be returned from xecute,
1455 ;" and set result=cAbort to cause script abort
1456 if CondCode'="" do
1457 . new $etrap set $etrap="do DoJErrTrap^TMGXINST"
1458 . set ^TMP("TMG",$J,"trap")=cOKToCont
1459 . xecute CondCode
1460 . set CondBool=$TEST
1461 . set result=^TMP("TMG",$J,"trap")
1462 . if result=cAbort do
1463 . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error executing Jump conditional code: \n"_CondCode)
1464 else do
1465 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"No condition code given, so should already have set bool")
1466
1467 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"CondBool",CondBool)
1468
1469 if (CondBool)&(Label'="")&(result=cOKToCont) do
1470 . set result=$$DoShow(.Params) ;"Show any associated text as a message
1471 . new OldNode set OldNode=ExecNode
1472 . set ExecNode=$$GetLabelNode(Label)
1473 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Changed point of execution from ",OldNode," to ",ExecNode)
1474 . if ExecNode=0 do
1475 . . do ShowError^TMGDEBUG(.PriorErrorFound,"In Jump instruction, label '"_Label_"' not found.")
1476 . . set result=cAbort ;"i.e. abort
1477 else do
1478 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Jump not done.")
1479
1480DJDone
1481 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoJump")
1482 if result=cAbort do ShowError^TMGDEBUG(.PriorErrorFound,"Jump command failed.")
1483
1484 quit result
1485
1486
1487 ;"=========================================================
1488 ;"DoJump Error trap routine
1489 ;"=========================================================
1490DoJErrTrap
1491 set $etrap=""
1492 set $ecode=""
1493 set ^TMP("TMG",$J,"trap")=cAbort
1494 quit
1495 ;"=========================================================
1496 ;"DoJump End of Error trap routine
1497 ;"=========================================================
1498
1499
1500
1501GetLabelNode(Label)
1502 ;"Purpose: Scan through <Script> section for a <Label> that matches
1503 ;"Input: Label: the name to search for (case insensitive)
1504 ;"Results: the handle of the node sought, or 0 if not found
1505
1506 new ChildNode
1507 set ChildNode=0
1508
1509GLNLoop set ChildNode=$$CHILD^MXMLDOM(XMLHandle,ScriptNode,ChildNode)
1510 if ChildNode=0 goto GLNQuit
1511 if $$UP^XLFSTR($$Get1NText^TMGXMLT(XMLHandle,ChildNode))=$$UP^XLFSTR(Label) goto GLNQuit
1512 goto GLNLoop
1513
1514GLNQuit quit ChildNode
1515
1516
1517GetData(Ref)
1518 ;"Purpose: To get data from the <DATA> section of the XML file
1519 ;"Input: Ref: the refrence path.
1520 ;" e.g. Data.Site.Office[EastSide].Field[OpenDate],
1521 ;" when used with the following data section...
1522 ;" <Data>
1523 ;" <Site>
1524 ;" <Office id="EastSide">
1525 ;" <Field id="Doctor">Kevin</Field>
1526 ;" <Field id="OpenDate">12/1/04</Field>
1527 ;" </Office>
1528 ;" </Site>
1529 ;" </Data>
1530 ;" will return the value of '12/1/04'
1531 ;"
1532 ;" Alternative acceptible input:
1533 ;" e.g. MVar.SomeVar
1534 ;" This will retrieve the value of variable 'SomeVar'
1535 ;" that is defined in the M language, i.e. a local variable
1536 ;" that might have been set in some M code.
1537 ;" The name for SomeVar is case-specific.
1538 ;"
1539 ;"Note: The first node must be 'Data' or 'MVar'
1540 ;"Returns: the value requested, or "" if not found.
1541
1542 new result set result=""
1543
1544 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetData")
1545 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Ref to search for="_Ref)
1546
1547 if $data(Ref)=0 goto QGetDat
1548
1549 new Segment
1550 new SegNode
1551 new ID
1552
1553 set Segment=$$ParseSeg(.Ref,.ID)
1554 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Segment="_Segment)
1555 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"ID=["_ID_"]")
1556 if $$UP^XLFSTR(Segment)=cData goto GetData1
1557 if $$UP^XLFSTR(Segment)='cMVar goto QGetDat
1558
1559 ;"Here we are dealing with {{MVar.SomeVar}} pattern
1560 ;"Get name of variable to access.
1561 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Found request to access M variable: ",ID)
1562 set Segment=$$ParseSeg(.Ref,.ID) ;"ID to be ignored.
1563 set result=$get(@Segment)
1564 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Requested variable: ",Segment,"= '",result,"'")
1565 goto QGetDat
1566
1567GetData1
1568 if $data(DataNode)=0 goto QGetDat ;"Occurs if error box occurs before full XML parse
1569 set SegNode=DataNode
1570GetData2
1571 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Getting ready to parse segment....")
1572 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Ref="_Ref)
1573 set Segment=$$ParseSeg(.Ref,.ID)
1574 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Segment="_Segment)
1575 set SegNode=$$GetDescIDNode(SegNode,Segment,ID)
1576 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"SegNode=#"_SegNode)
1577 if SegNode=0 goto QGetDat
1578
1579 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"?ready to loop? Ref='"_Ref_"'")
1580 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Ref='' is "_Ref="")
1581 if Ref="" goto QGetDat1
1582
1583 goto GetData2
1584
1585QGetDat1
1586 ;"If we get here, must have found correct node
1587 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Success. data node found. SegNode="_SegNode)
1588 set result=$$Get1NText^TMGXMLT(XMLHandle,SegNode)
1589 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result="_result)
1590
1591QGetDat
1592 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetData")
1593 quit result
1594
1595
1596ParseSeg(Ref,ID)
1597 ;"Purpose: to parse a line in the following format
1598 ;" Data.Site.Office[EastSide].Field[OpenDate]
1599 ;" Function will return the next segment (divided
1600 ;" by '.', left-to-right
1601 ;"Input: Ref: Should be passed by reference . text of line, as described above
1602 ;" ID: Should be passed by reference. An OUT parameter (not used for input)
1603 ;"Output: Ref is changed (shortened). When all done, Ref will equal " "
1604 ;" If an ID is found (i.e. 'EastSide' in above example), then ID will
1605 ;" will be set, otherwise " "
1606 ;"Result: The leftmost section, or " " if none found
1607
1608 new result
1609 set result=" "
1610 set ID=" "
1611 new PartA,PartB,PartC
1612
1613 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"ParseSeg")
1614
1615 ;"If no more pieces, just return input
1616 if 'Ref["." do goto Parse2
1617 . set result=Ref
1618 . set Ref=" "
1619
1620 set result=$piece(Ref,".",1)
1621 set result=$get(result," ")
1622 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result="_result)
1623 set PartB=$piece(Ref,".",2,100)
1624 set PartB=$get(PartB," ")
1625 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"PartB="_PartB)
1626 set Ref=PartB
1627
1628Parse2 ;"If Office[EastSide] pattern found, separate parts
1629 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is result: "_result_" Will now look for '['")
1630 if (result["[")&(result["]") do
1631 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"... found.")
1632 . set PartA=$piece(result,"[",1)
1633 . set PartB=$piece(result,"[",2)
1634 . set PartC=$piece(PartB,"]",1)
1635 . set result=PartA
1636 . set ID=PartC
1637 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result now ="_result_" ID="_ID)
1638
1639 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"ParseSeg")
1640 quit result
1641
1642
1643GetDescIDNode(ParentNode,Name,ID)
1644 ;"Purpose: get a descendant node that matches Name and ID
1645 ;"Input: ParentNode node handle of parent
1646 ;" Name is name of node
1647 ;" ID, the ID to match against. ID is an attrib of "id"
1648 ;"e.g. Look for <Field id="Doctor">Kevin</Field> type pattern.
1649 ;" Here, Name='Field', ID='Doctor'
1650 ;"Note: only immediate children (not grandchildren) are searched.
1651 ;"Returns: the handle of the sought node, or 0 if not found.
1652
1653 new ChildNode
1654 set ChildNode=0
1655 new NodeName,AtrVal
1656
1657 new InitDebug set InitDebug=TMGDEBUG
1658 set TMGDEBUG=0 ;"Force this function to not put out TMGDEBUG info.
1659
1660 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetDescIDNode")
1661
1662 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking for children of node="_ParentNode)
1663 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"with name="_Name_" ID="_ID)
1664 ;"if ID=" " write "ID=space (null)",!
1665 ;"else write "ID is something other than space. ",!
1666
1667GDILoop set ChildNode=$$CHILD^MXMLDOM(XMLHandle,ParentNode,ChildNode)
1668 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking at child node #"_ChildNode)
1669 ;"if TMGDEBUG>0 do ShowXMLNode(ChildNode)
1670 if ChildNode=0 goto GDIQuit
1671 set NodeName=$$GetNName^TMGXMLT(XMLHandle,ChildNode) ;"Returns result in UPPERCASE
1672 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Name="_NodeName)
1673 if NodeName'=$$UP^XLFSTR(Name) goto GDILoop
1674 if ID=" " goto GDIQuit ;"if no ID specified, then match based on Name only.
1675 set AtrVal=$$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cId)
1676 set AtrVal=$$UP^XLFSTR(AtrVal)
1677 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Value: ",AtrVal)
1678 if AtrVal'=$$UP^XLFSTR(ID) goto GDILoop
1679 ;"If we get here, we have a match
1680
1681GDIQuit
1682 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Success! Node: ",ChildNode)
1683 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetDescIDNode")
1684
1685 set TMGDEBUG=InitDebug
1686 quit ChildNode
1687
1688
1689GetCMDLine(ExecNode,Command,Params)
1690 ;"Purpose: Load elements needed to execute line
1691 ;"Input: ExecNode, the node to be executed...
1692 ;" Other parameters are OUT params... should be passed by reference
1693 ;"Output: Command -- the command of the line
1694 ;" Params -- PASS BY REFERENCE-- to accept back the parameters
1695 ;"Results: 1=if valid info; 0=should NOT be executed (i.e. abort)
1696
1697 new result set result=cOKToCont
1698
1699 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetCMDLine")
1700
1701 set Command=$$GetNName^TMGXMLT(XMLHandle,ExecNode)
1702 set Command=$$UP^XLFSTR(Command) ;"convert to uppercase
1703
1704 if $data(ProcTable(Command)) goto GCOK
1705 else do goto GCDone
1706 . do ShowError^TMGDEBUG(.PriorErrorFound,"Command '"_Command_"' is invalid.")
1707 . set result=cAbort
1708
1709GCOK
1710 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"CMD Command=",Command)
1711
1712 new TextArray,ValidText
1713 set ValidText=$$GetNText^TMGXMLT(XMLHandle,ExecNode,.TextArray)
1714 ;"if result=cAbort do goto GCDone
1715 ;". do ShowError^TMGDEBUG(.PriorErrorFound,"Error retrieving text into array.")
1716 if ValidText merge Params(cText)=TextArray
1717
1718 set result=$$GetParams^TMGXMLT(XMLHandle,ExecNode,.Params)
1719 if result=cAbort do
1720 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error getting parameters")
1721
1722GCDone
1723 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetCMDLine")
1724 quit result
1725
1726
1727GetNextCMD(ExecNode)
1728 ;"Purpose: Advance execution point
1729 ;"Input: ExecNode: the current execution point, should be passed by reference
1730 ;"Output: ExecNode is changed
1731 ;" returns 0 if end of program, otherwise positive number (i.e. ExecNode)
1732
1733 set ExecNode=$$CHILD^MXMLDOM(XMLHandle,ScriptNode,ExecNode)
1734
1735 quit ExecNode
1736
1737
1738RunScript(ExecNode)
1739 ;"Purpose: To run the entire script
1740 ;"Input: ExecNode, should be passed by reference
1741 ;"Assumptions: That ExecNode points to first line of script.
1742 ;"Result: 1: quit normally. 0=error exit.
1743
1744 new Command
1745 new Params
1746 new OKToCont set OKToCont=1 ;"1=OK to continue 0=should abort
1747
1748 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"RunScript")
1749RunLoop
1750 if ExecNode=0 goto RSDone
1751
1752 ;"Get current command line information
1753 ;"if TMGDEBUG>0 do ShowXMLNode(ExecNode)
1754 kill Params
1755
1756 set OKToCont=$$GetCMDLine(ExecNode,.Command,.Params)
1757 if OKToCont=0 do goto RSDone ;"If error, then quit execution.
1758 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error parsing command line.")
1759 . if TMGDEBUG>0 do ShowXMLNode^TMGXMLT(ExecNode)
1760
1761 set OKToCont=$$CMDProcess(Command,.Params)
1762 if OKToCont=0 do goto RSDone ;"If error, then quit execution.
1763 . do ShowError^TMGDEBUG(.PriorErrorFound,"Error executing command.")
1764 . if TMGDEBUG>0 do ShowXMLNode^TMGXMLT(ExecNode)
1765
1766 ;"Look for ESC that will cause loop abort
1767 ;"write "#"
1768 read *CheckKey:0
1769 if CheckKey=27 do goto RSDone
1770 . write !,!,"Escape key pressed. Aborting script.",!,!
1771
1772 ;"Advance to next command line
1773 set OKToCont=$$GetNextCMD(.ExecNode)
1774 if OKToCont'=0 goto RunLoop
1775 set OKToCont=1 ;"At this point, exit is normal.
1776
1777RSDone
1778 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"RunScript")
1779 quit OKToCont
1780
1781 ;"------------------------------------------------------------------------
1782 ;"========================================================================
1783 ;"------------------------------------------------------------------------
1784GetDispMode()
1785 ;"Purpose: To determine with form of input user wants
1786 ;"Results: 1=GUI,2=CHUI,3=RollNScroll,0=abort
1787 new Input
1788 new result set result=cAbort
1789 new Default set Default=3 ;"If changed, change(1) below
1790
1791 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetDispMode")
1792
1793 write "Select interface option:",!
1794 write " 0. Quit. (Goodbye!)",!
1795 write " 1. Linux X graphics/ 'GUI' (Recommended)",!
1796 write " 2. Text graphics / 'CHUI' (Incomplete)",!
1797 write " 3. Line-by-Line / 'Roll-and-scroll'",!
1798
1799 write "Enter option number ("_Default_"): "
1800 read Input,!
1801 if Input="" do
1802 . ;"write "Defaulting to: ",Default,!
1803 . set Input=Default
1804 else if +Input>4 do
1805 . set Input=Default
1806
1807 set result=+Input
1808 if (Input=1)!(Input=2) do
1809 . do SetupConsts^TMGXDLG()
1810 . do SetGUI^TMGXDLG(Input=1)
1811 ;"if Input=2 do goto GIMDone
1812 ;". do SetupConsts^TMGXDLG()
1813 ;". do SetGUI^TMGXDLG(0)
1814
1815GIMDone
1816 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Display mode set at: ",result)
1817 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetDispMode")
1818 quit result
1819
1820
1821
1822DoMsgBox(Params)
1823 ;"Purpose: To provide a method for script users to
1824 ;" show a message box
1825 ;"Input: Params -- an array loaded with needed values:
1826 ;" Params(cHeader): Header text
1827 ;" Params(cText,*): Array containing text
1828 ;" i.e. Params(cText,1)="text of line 1"
1829 ;" i.e. Params(cText,2)="text of line 2"
1830 ;" i.e. Params(cText,3)="text of line 3"
1831 ;" i.e. Params(cText,4)="text of line 4"
1832 ;"Result: 1=ok to continue, 0=abort
1833
1834 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoMsgBox")
1835
1836 new Width
1837 new Text,S,PartB,PartB1
1838 new index,j
1839 new Modal
1840 new result set result=cOKToCont
1841
1842 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is a dump of the params")
1843 if TMGDEBUG do ArrayDump^TMGDEBUG("Params") ;"zwr Params(*)
1844
1845 set Text(0)=$get(Params(cHeader),"Message:")
1846 set Width=$get(Params(cWidth,cUpperCase),0)
1847 set Modal=$get(Params(cModal),cModalMode)
1848 set index=$order(Params(cText,""))
1849 set j=1
1850DMSGLoop
1851 if index="" goto DMSGPast
1852 set S=$get(Params(cText,index))
1853 set result=$$CheckSubstituteData(.S)
1854 if result=cAbort goto DMSGQuit
1855DMSG2Loop ;"Load string up into Text array, to pass to PopupArray
1856 if S[cNewLn do
1857 . do CleaveStr^TMGSTUTL(.S,cNewLn,.PartB1)
1858 do SplitStr^TMGSTUTL(.S,(Width-4),.PartB)
1859 set PartB=PartB_PartB1 set PartB1=""
1860 set Text(j)=S
1861 set j=j+1
1862 if $length(PartB)>0 do goto DMSG2Loop
1863 . set S=PartB
1864 . set PartB=""
1865
1866 set index=$order(Params(cText,index))
1867 goto DMSGLoop
1868
1869DMSGPast
1870 if TMGDEBUG do
1871 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is Text array to send to PopupArray:")
1872 . do ArrayDump^TMGDEBUG("Text") ;"zwr Text(*)
1873
1874 do PopupArray^TMGUSRIF(2,Width,.Text,Modal)
1875DMSGQuit
1876 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoMsgBox")
1877 quit result
1878
1879
Note: See TracBrowser for help on using the repository browser.