source: cprs/trunk/CPRS-Chart/Templates/rTemplates.pas@ 1780

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

Upgrade to version 27

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