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

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

Upgrading to version 27

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