source: cprs/branches/tmg-cprs/CPRS-Chart/Templates/rTemplates.pas@ 973

Last change on this file since 973 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 12.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit rTemplates;
3
4interface
5
6uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, uConst, TRPCB, uTIU;
7
8{ Templates }
9procedure GetTemplateRoots;
10function IsUserTemplateEditor(TemplateID: string; UserID :Int64): boolean;
11procedure GetTemplateChildren(ID: string);
12procedure GetTemplateBoilerplate(ID: string);
13procedure GetTemplateText(BoilerPlate: TStrings);
14function IsTemplateEditor(ID: string): boolean;
15//function SubSetOfTemplateOwners(const StartFrom: string; Direction: Integer): TStrings;
16function UpdateTemplate(ID: string; Fields: TStrings): string;
17procedure UpdateChildren(ID: string; Children: TStrings);
18procedure DeleteTemplates(DelList: TStrings);
19procedure GetObjectList;
20procedure GetAllowedPersonalObjects;
21procedure TestBoilerplate(BoilerPlate: TStrings);
22function GetTemplateAccess(ID: string): integer;
23function SubSetOfBoilerplatedTitles(const StartFrom: string; Direction: Integer): TStrings;
24function GetTitleBoilerplate(TitleIEN: string): string;
25function GetUserTemplateDefaults(LoadFromServer: boolean = FALSE): string;
26procedure SetUserTemplateDefaults(Value: string; PieceNum: integer);
27procedure SaveUserTemplateDefaults;
28procedure LoadTemplateDescription(TemplateIEN: string);
29function GetTemplateAllowedReminderDialogs: TStrings;
30function IsRemDlgAllowed(RemDlgIEN: string): integer;
31function LockTemplate(const ID: string): boolean; // returns true if successful
32procedure UnlockTemplate(const ID: string);
33function GetLinkedTemplateData(const Link: string): string;
34function SubSetOfAllTitles(const StartFrom: string; Direction: Integer): TStrings;
35
36{ Template Fields }
37function SubSetOfTemplateFields(const StartFrom: string; Direction: Integer): TStrings;
38function LoadTemplateField(const DlgFld: string): TStrings;
39function LoadTemplateFieldByIEN(const DlgFld: string): TStrings;
40function CanEditTemplateFields: boolean;
41function UpdateTemplateField(const ID: string; Fields: TStrings): string;
42function LockTemplateField(const ID: string): boolean;
43procedure UnlockTemplateField(const ID: string);
44procedure DeleteTemplateField(const ID: string);
45function ExportTemplateFields(FldList: TStrings): TStrings;
46function ImportTemplateFields(FldList: TStrings): TStrings;
47function IsTemplateFieldNameUnique(const FldName, IEN: string): boolean;
48procedure Convert2LMText(Text: TStringList);
49procedure CheckTemplateFields(ResultString: TStrings);
50function BuildTemplateFields(XMLString: TStrings): boolean;
51function ImportLoadedFields(ResultSet: TStrings): boolean;
52
53implementation
54var
55 uUserTemplateDefaults: string = '';
56 uCanEditDlgFldChecked: boolean = FALSE;
57 uCanEditDlgFlds: boolean;
58
59{ Template RPCs -------------------------------------------------------------- }
60
61procedure GetTemplateRoots;
62begin
63 CallV('TIU TEMPLATE GETROOTS', [User.DUZ]);
64end;
65
66function IsUserTemplateEditor(TemplateID: string; UserID :Int64): boolean;
67begin
68 if StrToIntDef(TemplateID,0) > 0 then
69 Result := (Piece(sCallV('TIU TEMPLATE ISEDITOR', [TemplateID, UserID]),U,1) = '1')
70 else
71 Result := FALSE;
72end;
73
74procedure GetTemplateChildren(ID: string);
75begin
76 if(ID = '') or (ID = '0') then
77 RPCBrokerV.Results.Clear
78 else
79 CallV('TIU TEMPLATE GETITEMS', [ID]);
80end;
81
82procedure GetTemplateBoilerplate(ID: string);
83begin
84 if(ID = '') or (ID = '0') then
85 RPCBrokerV.Results.Clear
86 else
87 CallV('TIU TEMPLATE GETBOIL', [ID]);
88end;
89
90procedure GetTemplateText(BoilerPlate: TStrings);
91var
92 i: integer;
93
94begin
95 with RPCBrokerV do
96 begin
97 ClearParameters := True;
98 RemoteProcedure := 'TIU TEMPLATE GETTEXT';
99 Param[0].PType := literal;
100 Param[0].Value := Patient.DFN;
101 Param[1].PType := literal;
102 Param[1].Value := Encounter.VisitStr;
103 Param[2].PType := list;
104 for i := 0 to BoilerPlate.Count-1 do
105 Param[2].Mult[IntToStr(i+1)+',0'] := BoilerPlate[i];
106 CallBroker;
107 RPCBrokerV.Results.Delete(0);
108 BoilerPlate.Assign(RPCBrokerV.Results);
109 RPCBrokerV.Results.Clear;
110 end;
111end;
112
113function IsTemplateEditor(ID: string): boolean;
114begin
115 Result := (sCallV('TIU TEMPLATE ISEDITOR', [ID, User.DUZ]) = '1');
116end;
117
118//function SubSetOfTemplateOwners(const StartFrom: string; Direction: Integer): TStrings;
119//begin
120// CallV('TIU TEMPLATE LISTOWNR', [StartFrom, Direction]);
121// MixedCaseList(RPCBrokerV.Results);
122// Result := RPCBrokerV.Results;
123//end;
124
125function UpdateTIURec(RPC, ID: string; Fields: TStrings): string;
126var
127 i, j: integer;
128
129begin
130 with RPCBrokerV do
131 begin
132 ClearParameters := True;
133 RemoteProcedure := RPC;
134 Param[0].PType := literal;
135 Param[0].Value := ID;
136 Param[1].PType := list;
137 for i := 0 to Fields.Count-1 do
138 begin
139 j := pos('=',Fields[i]);
140 if(j > 0) then
141 Param[1].Mult[Fields.Names[i]] := copy(Fields[i],j+1,MaxInt);
142 end;
143 CallBroker;
144 Result := RPCBrokerV.Results[0];
145 end;
146end;
147
148function UpdateTemplate(ID: string; Fields: TStrings): string;
149begin
150 Result := UpdateTIURec('TIU TEMPLATE CREATE/MODIFY', ID, Fields);
151end;
152
153procedure UpdateChildren(ID: string; Children: TStrings);
154var
155 i: integer;
156
157begin
158 with RPCBrokerV do
159 begin
160 ClearParameters := True;
161 RemoteProcedure := 'TIU TEMPLATE SET ITEMS';
162 Param[0].PType := literal;
163 Param[0].Value := ID;
164 Param[1].PType := list;
165 for i := 0 to Children.Count-1 do
166 Param[1].Mult[IntToStr(i+1)] := Children[i];
167 CallBroker;
168 end;
169end;
170
171procedure DeleteTemplates(DelList: TStrings);
172var
173 i: integer;
174
175begin
176 if(DelList.Count > 0) then
177 begin
178 with RPCBrokerV do
179 begin
180 ClearParameters := True;
181 RemoteProcedure := 'TIU TEMPLATE DELETE';
182 Param[0].PType := list;
183 for i := 0 to DelList.Count-1 do
184 Param[0].Mult[IntToStr(i+1)] := DelList[i];
185 CallBroker;
186 end;
187 end;
188end;
189
190procedure GetObjectList;
191begin
192 CallV('TIU GET LIST OF OBJECTS', []);
193end;
194
195procedure GetAllowedPersonalObjects;
196begin
197 CallV('TIU TEMPLATE PERSONAL OBJECTS', []);
198end;
199
200procedure TestBoilerplate(BoilerPlate: TStrings);
201var
202 i: integer;
203
204begin
205 with RPCBrokerV do
206 begin
207 ClearParameters := True;
208 RemoteProcedure := 'TIU TEMPLATE CHECK BOILERPLATE';
209 Param[0].PType := list;
210 for i := 0 to BoilerPlate.Count-1 do
211 Param[0].Mult['2,'+IntToStr(i+1)+',0'] := BoilerPlate[i];
212 CallBroker;
213 end;
214end;
215
216function GetTemplateAccess(ID: string): integer;
217begin
218 Result := StrToIntDef(sCallV('TIU TEMPLATE ACCESS LEVEL', [ID, User.DUZ, Encounter.Location]), 0);
219end;
220
221function SubSetOfBoilerplatedTitles(const StartFrom: string; Direction: Integer): TStrings;
222begin
223 CallV('TIU LONG LIST BOILERPLATED', [StartFrom, Direction]);
224 Result := RPCBrokerV.Results;
225end;
226
227function GetTitleBoilerplate(TitleIEN: string): string;
228begin
229 CallV('TIU GET BOILERPLATE', [TitleIEN]);
230 Result := RPCBrokerV.Results.Text;
231end;
232
233function GetUserTemplateDefaults(LoadFromServer: boolean = FALSE): string;
234begin
235 if(LoadFromServer) then
236 uUserTemplateDefaults := sCallV('TIU TEMPLATE GET DEFAULTS', []);
237 Result := uUserTemplateDefaults;
238end;
239
240procedure SetUserTemplateDefaults(Value: string; PieceNum: integer);
241begin
242 SetPiece(uUserTemplateDefaults, '/', PieceNum, Value);
243end;
244
245procedure SaveUserTemplateDefaults;
246begin
247 CallV('TIU TEMPLATE SET DEFAULTS', [uUserTemplateDefaults]);
248end;
249
250procedure LoadTemplateDescription(TemplateIEN: string);
251begin
252 CallV('TIU TEMPLATE GET DESCRIPTION', [TemplateIEN]);
253end;
254
255function GetTemplateAllowedReminderDialogs: TStrings;
256var
257 TmpList: TStringList;
258
259begin
260 CallV('TIU REMINDER DIALOGS', []);
261 TmpList := TStringList.Create;
262 try
263 TmpList.Assign(RPCBrokerV.Results);
264 SortByPiece(TmpList, U, 2);
265 MixedCaseList(TmpList);
266 RPCBrokerV.Results.Assign(TmpList);
267 finally
268 TmpList.Free;
269 end;
270 Result := RPCBrokerV.Results;
271end;
272
273function IsRemDlgAllowed(RemDlgIEN: string): integer;
274// -1 = inactive or deleted, 0 = not in Param, 1 = allowed
275begin
276 Result := StrToIntDef(sCallV('TIU REM DLG OK AS TEMPLATE', [RemDlgIEN]),-1);
277end;
278
279function LockTemplate(const ID: string): boolean; // returns true if successful
280begin
281 Result := (sCallV('TIU TEMPLATE LOCK', [ID]) = '1')
282end;
283
284procedure UnlockTemplate(const ID: string);
285begin
286 CallV('TIU TEMPLATE UNLOCK', [ID]);
287end;
288
289function GetLinkedTemplateData(const Link: string): string;
290begin
291 Result := sCallV('TIU TEMPLATE GETLINK', [Link]);
292end;
293
294function SubSetOfAllTitles(const StartFrom: string; Direction: Integer): TStrings;
295begin
296 CallV('TIU TEMPLATE ALL TITLES', [StartFrom, Direction]);
297 Result := RPCBrokerV.Results;
298end;
299
300{ Template Fields }
301
302function SubSetOfTemplateFields(const StartFrom: string; Direction: Integer): TStrings;
303begin
304 CallV('TIU FIELD LIST', [StartFrom, Direction]);
305 Result := RPCBrokerV.Results;
306end;
307
308function LoadTemplateField(const DlgFld: string): TStrings;
309begin
310 CallV('TIU FIELD LOAD', [DlgFld]);
311 Result := RPCBrokerV.Results;
312end;
313
314function LoadTemplateFieldByIEN(const DlgFld: string): TStrings;
315begin
316 CallV('TIU FIELD LOAD BY IEN', [DlgFld]);
317 Result := RPCBrokerV.Results;
318end;
319
320function CanEditTemplateFields: boolean;
321begin
322 if(not uCanEditDlgFldChecked) then
323 begin
324 uCanEditDlgFldChecked := TRUE;
325 uCanEditDlgFlds := sCallV('TIU FIELD CAN EDIT', []) = '1';
326 end;
327 Result := uCanEditDlgFlds;
328end;
329
330function UpdateTemplateField(const ID: string; Fields: TStrings): string;
331begin
332 Result := UpdateTIURec('TIU FIELD SAVE', ID, Fields);
333end;
334
335function LockTemplateField(const ID: string): boolean; // returns true if successful
336begin
337 Result := (sCallV('TIU FIELD LOCK', [ID]) = '1')
338end;
339
340procedure UnlockTemplateField(const ID: string);
341begin
342 CallV('TIU FIELD UNLOCK', [ID]);
343end;
344
345procedure DeleteTemplateField(const ID: string);
346begin
347 CallV('TIU FIELD DELETE', [ID]);
348end;
349
350function CallImportExportTemplateFields(FldList: TStrings; RPCName: string): TStrings;
351var
352 i: integer;
353
354begin
355 with RPCBrokerV do
356 begin
357 ClearParameters := True;
358 RemoteProcedure := RPCName;
359 Param[0].PType := list;
360 for i := 0 to FldList.Count-1 do
361 Param[0].Mult[IntToStr(i+1)] := FldList[i];
362 CallBroker;
363 end;
364 Result := RPCBrokerV.Results;
365end;
366
367function ExportTemplateFields(FldList: TStrings): TStrings;
368begin
369 Result := CallImportExportTemplateFields(FldList, 'TIU FIELD EXPORT');
370end;
371
372function ImportTemplateFields(FldList: TStrings): TStrings;
373begin
374 Result := CallImportExportTemplateFields(FldList, 'TIU FIELD IMPORT');
375end;
376
377procedure CheckTemplateFields(ResultString: TStrings);
378begin
379 CallV('TIU FIELD CHECK',[nil]);
380 ResultString.Assign(RPCBrokerV.Results);
381end;
382
383function IsTemplateFieldNameUnique(const FldName, IEN: string): boolean;
384begin
385 Result := sCallV('TIU FIELD NAME IS UNIQUE', [FldName, IEN]) = '1';
386end;
387
388procedure Convert2LMText(Text: TStringList);
389var
390 i: integer;
391begin
392 with RPCBrokerV do
393 begin
394 ClearParameters := True;
395 RemoteProcedure := 'TIU FIELD DOLMTEXT';
396 Param[0].PType := list;
397 for i := 0 to Text.Count-1 do
398 Param[0].Mult[IntToStr(i+1)+',0'] := Text[i];
399 CallBroker;
400 end;
401 Text.Assign(RPCBrokerV.Results);
402end;
403
404function BuildTemplateFields(XMLString: TStrings): boolean; //Simply builds XML fields on the server
405var //in chunks.
406 i,j,p1: integer;
407 ok: boolean;
408
409 procedure reset_broker;
410 begin
411 with RPCBrokerV do begin
412 ClearParameters := True;
413 RemoteProcedure := 'TIU FIELD LIST ADD';
414 Param[0].PType := list;
415 end;
416 end;
417
418begin
419 ok := TRUE;
420 with RPCBrokerV do
421 begin
422 reset_broker;
423 j := 1;
424 for i := 0 to XMLString.Count-1 do begin
425 p1 := pos('<FIELD NAME="',XMLString[i]);
426 if (p1 > 0) and (pos('">',copy(XMLString[i],p1+13,maxint)) > 0) then begin
427 j := j + 1;
428 if (j > 50) then begin
429 j := 1;
430 CallBroker;
431 if pos('1',Results[0]) = 0 then begin
432 ok := FALSE;
433 break;
434 end;//if
435 reset_broker;
436 end;//if
437 end;//if
438 Param[0].Mult[IntToStr(i+1)] := XMLString[i];
439 end;//for
440 if ok then begin
441 CallBroker;
442 if pos('1',Results[0]) = 0 then ok := FALSE;
443 end;//if
444 end;
445 Result := ok;
446end;
447
448function ImportLoadedFields(ResultSet: TStrings): boolean;
449begin
450 Result := TRUE;
451 CallV('TIU FIELD LIST IMPORT',[nil]);
452 ResultSet.Assign(RPCBrokerV.Results);
453 if ResultSet.Count < 1 then
454 Result := FALSE;
455end;
456
457end.
Note: See TracBrowser for help on using the repository browser.