source: cprs/branches/tmg-cprs/CPRS-Chart/rReminders.pas@ 1806

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 12.0 KB
Line 
1//kt -- Modified with SourceScanner on 8/7/2007
2unit rReminders;
3
4interface
5uses
6 Windows,Classes, SysUtils, TRPCB, ORNet, ORFn;
7
8procedure GetCurrentReminders;
9procedure GetOtherReminders(Dest: TStrings);
10procedure EvaluateReminders(RemList: TStringList);
11function EvaluateReminder(IEN: string): string;
12procedure GetEducationTopicsForReminder(ReminderID: integer);
13procedure GetEducationSubtopics(TopicID: integer);
14procedure GetReminderWebPages(ReminderID: string);
15function DetailReminder(IEN: Integer): TStrings;
16function ReminderInquiry(IEN: Integer): TStrings;
17function EducationTopicDetail(IEN: Integer): TStrings;
18function GetDialogInfo(IEN: string; RemIEN: boolean): TStrings;
19function GetDialogPrompts(IEN: string; Historical: boolean; FindingType: string): TStrings;
20procedure GetDialogStatus(AList: TStringList);
21function GetRemindersActive: boolean;
22function GetProgressNoteHeader: string;
23function LoadMentalHealthTest(TestName: string): TStrings;
24procedure MentalHealthTestResults(var AText: string; const DlgIEN: integer; const TestName:
25 string; const AProvider: Int64; const Answers: string);
26procedure SaveMentalHealthTest(const TestName: string; ADate: TFMDateTime;
27 const AProvider: Int64; const Answers: string);
28procedure SaveWomenHealthData(var WHData: TStringlist);
29function CheckGECValue(const RemIEN: string; NoteIEN: integer): String;
30procedure SaveMSTDataFromReminder(VDate, Sts, Prov, FType, FIEN, Res: string);
31
32function GetReminderFolders: string;
33procedure SetReminderFolders(const Value: string);
34function GetDefLocations: TStrings;
35function InsertRemTextAtCursor: boolean;
36
37function NewRemCoverSheetListActive: boolean;
38function CanEditAllRemCoverSheetLists: boolean;
39function GetCoverSheetLevelData(ALevel, AClass: string): TStrings;
40procedure SetCoverSheetLevelData(ALevel, AClass: string; Data: TStrings);
41function GetCategoryItems(CatIEN: integer): TStrings;
42function GetAllRemindersAndCategories: TStrings;
43function VerifyMentalHealthTestComplete(TestName, Answers: string): String;
44
45
46implementation
47
48uses
49 uCore, uReminders, rCore;
50
51var
52 uLastDefLocUser: int64 = -1;
53 uDefLocs: TStringList = nil;
54 uRemInsertAtCursor: integer = -1;
55 uNewCoverSheetListActive: integer = -1;
56 uCanEditAllCoverSheetLists: integer = -1;
57
58procedure GetCurrentReminders;
59begin
60 CallV('ORQQPXRM REMINDERS UNEVALUATED', [Patient.DFN, Encounter.Location]);
61end;
62
63procedure GetOtherReminders(Dest: TStrings);
64begin
65 CallV('ORQQPXRM REMINDER CATEGORIES', [Patient.DFN, Encounter.Location]);
66 Dest.Assign(RPCBrokerV.Results);
67end;
68
69procedure EvaluateReminders(RemList: TStringList);
70var
71 i: integer;
72
73begin
74 with RPCBrokerV do
75 begin
76 ClearParameters := True;
77 RemoteProcedure := 'ORQQPXRM REMINDER EVALUATION';
78 Param[0].PType := literal;
79 Param[0].Value := Patient.DFN;
80 Param[1].PType := list;
81 for i := 0 to RemList.Count-1 do
82 Param[1].Mult[IntToStr(i+1)] := Piece(RemList[i],U,1);
83 CallBroker;
84 end;
85end;
86
87function EvaluateReminder(IEN: string): string;
88var
89 TmpSL: TStringList;
90
91begin
92 TmpSL := TStringList.Create;
93 try
94 TmpSL.Add(IEN);
95 EvaluateReminders(TmpSL);
96 if(RPCBrokerV.Results.Count > 0) then
97 Result := RPCBrokerV.Results[0]
98 else
99 Result := IEN;
100 finally
101 TmpSL.Free;
102 end;
103end;
104
105procedure GetEducationTopicsForReminder(ReminderID: integer);
106begin
107 CallV('ORQQPXRM EDUCATION SUMMARY', [ReminderID]);
108end;
109
110procedure GetEducationSubtopics(TopicID: integer);
111begin
112 CallV('ORQQPXRM EDUCATION SUBTOPICS', [TopicID]);
113end;
114
115procedure GetReminderWebPages(ReminderID: string);
116begin
117 if(User.WebAccess) then
118 CallV('ORQQPXRM REMINDER WEB', [ReminderID])
119 else
120 RPCBrokerV.ClearParameters := True;
121end;
122
123function DetailReminder(IEN: Integer): TStrings; // Clinical Maintenance
124begin
125 if InteractiveRemindersActive then
126 CallV('ORQQPXRM REMINDER DETAIL', [Patient.DFN, IEN])
127 else
128 CallV('ORQQPX REMINDER DETAIL', [Patient.DFN, IEN]);
129 Result := RPCBrokerV.Results;
130end;
131
132function ReminderInquiry(IEN: Integer): TStrings;
133begin
134 CallV('ORQQPXRM REMINDER INQUIRY', [IEN]);
135 Result := RPCBrokerV.Results;
136end;
137
138function EducationTopicDetail(IEN: Integer): TStrings;
139begin
140 CallV('ORQQPXRM EDUCATION TOPIC', [IEN]);
141 Result := RPCBrokerV.Results;
142end;
143
144function GetDialogInfo(IEN: string; RemIEN: boolean): TStrings;
145begin
146 if RemIEN then
147 CallV('ORQQPXRM REMINDER DIALOG', [IEN, Patient.DFN])
148 else
149 CallV('PXRM REMINDER DIALOG (TIU)', [IEN, Patient.DFN]);
150 Result := RPCBrokerV.Results;
151end;
152
153function GetDialogPrompts(IEN: string; Historical: boolean; FindingType: string): TStrings;
154begin
155 CallV('ORQQPXRM DIALOG PROMPTS', [IEN, Historical, FindingType]);
156 Result := RPCBrokerV.Results;
157end;
158
159procedure GetDialogStatus(AList: TStringList);
160var
161 i: integer;
162
163begin
164 if(Alist.Count = 0) then exit;
165 with RPCBrokerV do
166 begin
167 ClearParameters := True;
168 RemoteProcedure := 'ORQQPXRM DIALOG ACTIVE';
169 Param[0].PType := list;
170 for i := 0 to AList.Count-1 do
171 Param[0].Mult[AList[i]] := '';
172 CallBroker;
173 AList.Assign(Results);
174 end;
175end;
176
177function GetRemindersActive: boolean;
178begin
179 CallV('ORQQPX NEW REMINDERS ACTIVE', []);
180 Result := ((RPCBrokerV.Results.Count = 1) and (RPCBrokerV.Results[0] = '1'));
181end;
182
183function GetProgressNoteHeader: string;
184begin
185 Result := sCallV('ORQQPXRM PROGRESS NOTE HEADER', [Encounter.Location]);
186end;
187
188function LoadMentalHealthTest(TestName: string): TStrings;
189begin
190 CallV('ORQQPXRM MENTAL HEALTH', [TestName]);
191 Result := RPCBrokerV.Results;
192end;
193
194procedure MentalHealthTestResults(var AText: string; const DlgIEN: integer; const TestName:
195 string; const AProvider: Int64; const Answers: string);
196var
197 i, R: integer;
198 Ans, tmp: string;
199
200begin
201 with RPCBrokerV do
202 begin
203 ClearParameters := True;
204 RemoteProcedure := 'ORQQPXRM MENTAL HEALTH RESULTS';
205 Param[0].PType := literal;
206 Param[0].Value := IntToStr(DlgIEN);
207 Param[1].PType := list;
208 Param[1].Mult['"DFN"'] := Patient.DFN;
209 Param[1].Mult['"CODE"'] := TestName;
210 Param[1].Mult['"ADATE"'] := 'T';
211 Param[1].Mult['"STAFF"'] := IntToStr(AProvider);
212 R := 0;
213 tmp := '';
214 Ans := Answers;
215 repeat
216 tmp := copy(Ans,1,200);
217 delete(Ans,1,200);
218 inc(R);
219 Param[1].Mult['"R' + IntToStr(R) + '"'] := tmp;
220 until(Ans = '');
221 CallBroker;
222 AText := '';
223 for i := 0 to Results.Count-1 do
224 begin
225 tmp := Results[i];
226 if(Piece(tmp,U,1) = '7') then
227 begin
228 if(AText <> '') then
229 begin
230 if(copy(AText, length(AText), 1) = '.') then
231 AText := AText + ' ';
232 AText := AText + ' ';
233 end;
234 AText := AText + Trim(Piece(tmp, U, 2));
235 end;
236 end;
237 end;
238end;
239
240procedure SaveMentalHealthTest(const TestName: string; ADate: TFMDateTime;
241 const AProvider: Int64; const Answers: string);
242var
243 R: integer;
244 Ans, tmp: string;
245
246begin
247 with RPCBrokerV do
248 begin
249 ClearParameters := True;
250 RemoteProcedure := 'ORQQPXRM MENTAL HEALTH SAVE';
251 Param[0].PType := list;
252 Param[0].Mult['"DFN"'] := Patient.DFN;
253 Param[0].Mult['"CODE"'] := TestName;
254 Param[0].Mult['"ADATE"'] := FloatToStr(ADate);
255 Param[0].Mult['"STAFF"'] := IntToStr(AProvider);
256 R := 0;
257 tmp := '';
258 Ans := Answers;
259 repeat
260 tmp := copy(Ans,1,200);
261 delete(Ans,1,200);
262 inc(R);
263 Param[0].Mult['"R' + IntToStr(R) + '"'] := tmp;
264 until(Ans = '');
265 CallBroker;
266 end;
267end;
268
269procedure SaveWomenHealthData(var WHData: TStringlist);
270begin
271 if assigned(WHData) then
272 begin
273 CallV('ORQQPXRM WOMEN HEALTH SAVE', [WHData]);
274// if RPCBrokerV.Results<>nil then
275// infoBox(RPCBrokerV.Results.Text,'Error in Saving WH Data',MB_OK);
276 end;
277end;
278
279function CheckGECValue(const RemIEN: string; NoteIEN: integer): String;
280var
281ans,str,str1,title: string;
282fin: boolean;
283i,cnt: integer;
284
285begin
286 Result := sCallV('ORQQPXRM GEC DIALOG', [RemIEN, Patient.DFN, Encounter.VisitStr, NoteIEN]);
287 if Piece(Result,U,1) <> '0' then
288 begin
289 if Piece(Result,U,5)='1' then
290 begin
291 if pos('~',Piece(Result,U,4))>0 then
292 begin
293 str:='';
294 str1 := Piece(Result,U,4);
295 cnt := DelimCount(str1, '~');
296 for i:=1 to cnt+1 do
297 begin
298 if i = 1 then str := Piece(str1,'~',i);
299 if i > 1 then str :=str+CRLF+Piece(str1,'~',i);
300 end;
301 end
302 else str := Piece(Result,U,1);
303 title := Piece(Result,U,3);
304 fin := (InfoBox(str,title, MB_YESNO)=IDYES);
305 if fin = true then ans := '1';
306 if fin = false then ans := '0';
307 CallV('ORQQPXRM GEC FINISHED?',[Patient.DFN,ans]);
308 end;
309 Result := Piece(Result, U,2);
310 end
311 else Result := '';
312end;
313
314procedure SaveMSTDataFromReminder(VDate, Sts, Prov, FType, FIEN, Res: string);
315begin
316 CallV('ORQQPXRM MST UPDATE', [Patient.DFN, VDate, Sts, Prov, FType, FIEN, Res]);
317end;
318
319function GetReminderFolders: string;
320begin
321 Result := sCallV('ORQQPX GET FOLDERS', []);
322end;
323
324procedure SetReminderFolders(const Value: string);
325begin
326 CallV('ORQQPX SET FOLDERS', [Value]);
327end;
328
329function GetDefLocations: TStrings;
330begin
331 if (User.DUZ <> uLastDefLocUser) then
332 begin
333 if(not assigned(uDefLocs)) then
334 uDefLocs := TStringList.Create;
335 tCallV(uDefLocs, 'ORQQPX GET DEF LOCATIONS', []);
336 uLastDefLocUser := User.DUZ;
337 end;
338 Result := uDefLocs;
339end;
340
341function InsertRemTextAtCursor: boolean;
342begin
343 if uRemInsertAtCursor < 0 then
344 begin
345 Result := (sCallV('ORQQPX REM INSERT AT CURSOR', []) = '1');
346 uRemInsertAtCursor := ord(Result);
347 end
348 else
349 Result := Boolean(uRemInsertAtCursor);
350end;
351
352function NewRemCoverSheetListActive: boolean;
353begin
354 if uNewCoverSheetListActive < 0 then
355 begin
356 Result := (sCallV('ORQQPX NEW COVER SHEET ACTIVE', []) = '1');
357 uNewCoverSheetListActive := ord(Result);
358 end
359 else
360 Result := Boolean(uNewCoverSheetListActive);
361end;
362
363function CanEditAllRemCoverSheetLists: boolean;
364begin
365 if uCanEditAllCoverSheetLists < 0 then
366 begin
367 Result := HasMenuOptionAccess('PXRM CPRS CONFIGURATION');
368 uCanEditAllCoverSheetLists := ord(Result);
369 end
370 else
371 Result := Boolean(uCanEditAllCoverSheetLists);
372end;
373
374function GetCoverSheetLevelData(ALevel, AClass: string): TStrings;
375begin
376 CallV('ORQQPX LVREMLST', [ALevel, AClass]);
377 Result := RPCBrokerV.Results;
378end;
379
380procedure SetCoverSheetLevelData(ALevel, AClass: string; Data: TStrings);
381var
382 i: integer;
383
384begin
385 with RPCBrokerV do
386 begin
387 ClearParameters := True;
388 RemoteProcedure := 'ORQQPX SAVELVL';
389 Param[0].PType := literal;
390 Param[0].Value := ALevel;
391 Param[1].PType := literal;
392 Param[1].Value := AClass;
393 Param[2].PType := list;
394 for i := 0 to Data.Count-1 do
395 Param[2].Mult[IntToStr(i+1)] := Data[i];
396 CallBroker;
397 end;
398end;
399
400function GetCategoryItems(CatIEN: integer): TStrings;
401begin
402 CallV('PXRM REMINDER CATEGORY', [CatIEN]);
403 Result := RPCBrokerV.Results;
404end;
405
406function GetAllRemindersAndCategories: TStrings;
407begin
408 CallV('PXRM REMINDERS AND CATEGORIES', []);
409 Result := RPCBrokerV.Results;
410end;
411
412function VerifyMentalHealthTestComplete(TestName, Answers: string): String;
413
414begin
415 CallV('ORQQPXRM MHV', [Patient.DFN, TestName, Answers]);
416 if RPCBrokerV.Results[0]='2' then
417 begin
418 Result := '2'+ U;
419 EXIT;
420 end;
421 if RPCBrokerV.Results[0] = '1' then
422 begin
423 Result := '1' + U;
424 EXIT;
425 end;
426 if RPCBrokerV.Results[0] = '0' then
427 begin
428 Result := '0' + U + RPCBrokerV.Results[1];
429 EXIT;
430 end;
431end;
432
433initialization
434
435finalization
436 FreeAndNil(uDefLocs);
437
438end.
Note: See TracBrowser for help on using the repository browser.