source: cprs/trunk/CPRS-Chart/Consults/uConsults.pas@ 1699

Last change on this file since 1699 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 18.0 KB
Line 
1unit uConsults;
2
3interface
4
5uses
6 SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, uTIU, ORCtrls,
7 Contnrs, DateUtils;
8
9type
10
11 TConsultRequest = record {file 123} {Order Dialog}
12 IEN: integer ; {.001}
13 EntryDate: TFMDateTime ; { .01}
14 ORFileNumber: integer ; { .03}
15 PatientLocation: integer ; { .04}
16 OrderingFacility: integer ; { .05}
17 ForeignConsultFileNum: integer ; { .06}
18 ToService: integer ; { 1} { * }
19 From: integer ; { 2}
20 RequestDate: TFMDateTime ; { 3}
21 ConsultProcedure: string ; { 4}
22 Urgency: integer ; { 5} { * }
23 PlaceOfConsult: integer ; { 6} { * }
24 Attention: int64 ; { 7} { * }
25 ORStatus: integer ; { 8}
26 LastAction: integer ; { 9}
27 SendingProvider: int64 ; { 10}
28 SendingProviderName: string ;
29 Result: string ; { 11}
30 ModeOfEntry: string ; { 12}
31 RequestType: integer ; { 13}
32 InOut: string ; { 14} { * }
33 Findings: string ; { 15}
34 TIUResultNarrative: integer ; { 16}
35 TIUDocuments: TStrings ; {from '50' node of file 123}
36 MedResults: TStrings; {from '50' node of file 123}
37 RequestReason: TStringList ; { 20} { * }
38 ProvDiagnosis: string ; { 30} { * }
39 ProvDxCode: string; { 30.1}
40 RequestProcessingActivity: TStringList; { 40}
41 EarliestDate: TFMDateTime;
42 //LatestDate: TFMDateTime; //dropped requirement WAT
43 end ;
44
45 TEditResubmitRec = record
46 Changed: boolean;
47 IEN: integer;
48 OrderableItem: integer;
49 RequestType: string;
50 ToService: integer;
51 ToServiceName: string;
52 ConsultProc: string;
53 ConsultProcName: string;
54 Urgency: integer;
55 UrgencyName: string;
56 EarliestDate: TFMDateTime;
57 //LatestDate: TFMDateTime; //dropped requirement WAT
58 Place: string;
59 PlaceName: string;
60 Attention: int64;
61 AttnName: string;
62 InpOutp: string;
63 RequestReason: TStringList;
64 ProvDiagnosis: string;
65 ProvDxCode: string;
66 ProvDxCodeInactive: boolean;
67 DenyComments: TStringList;
68 OtherComments: TStringList;
69 NewComments: TStringList;
70 end;
71
72 TSelectContext = record
73 Changed: Boolean;
74 BeginDate: string;
75 EndDate: string;
76 Ascending: Boolean;
77 Service: string;
78 ServiceName: string;
79 ConsultUser: Boolean ;
80 Status: string;
81 StatusName: string;
82 GroupBy: string;
83 end ;
84
85 TMenuAccessRec = record
86 UserLevel: integer;
87 AllowMedResulting: Boolean;
88 AllowMedDissociate: Boolean;
89 AllowResubmit: Boolean;
90 ClinProcFlag: integer;
91 IsClinicalProcedure: Boolean;
92 end;
93
94 TProvisionalDiagnosis = record
95 Code: string;
96 Text: string;
97 CodeInactive: boolean;
98 Reqd: string;
99 PromptMode: string;
100 end;
101
102 TConsultTitles = class
103 DfltTitle: Integer;
104 DfltTitleName: string;
105 ShortList: TStringList;
106 constructor Create;
107 destructor Destroy; override;
108 end;
109
110 TClinProcTitles = class
111 DfltTitle: Integer;
112 DfltTitleName: string;
113 ShortList: TStringList;
114 constructor Create;
115 destructor Destroy; override;
116 end;
117
118function MakeConsultListItem(InputString: string):string;
119function MakeConsultListDisplayText(InputString: string): string;
120function MakeConsultNoteDisplayText(RawText: string): string;
121procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode);
122procedure CreateListItemsForConsultTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
123 Ascending: Boolean);
124procedure BuildConsultsTree(Tree: TORTreeView; tmpList: TStrings; const Parent: string; Node: TORTreeNode;
125 CurrentContext: TSelectContext);
126procedure SetNodeImage(Node: TORTreeNode; CurrentContext: TSelectContext);
127
128const
129 CN_SVC_LIST_DISP = 0 ;
130 CN_SVC_LIST_FWD = 1 ;
131 CN_SVC_LIST_ORD = 1 ;
132 CSLT_PTR = ';99CON';
133 PROC_PTR = ';99PRC';
134
135 {MenuAccessRec.UserLevel}
136 UL_NONE = 0;
137 UL_REVIEW = 1;
138 UL_UPDATE = 2;
139 UL_ADMIN = 3;
140 UL_UPDATE_AND_ADMIN = 4;
141 UL_UNRESTRICTED = 5;
142
143 {Clinical Procedure statuses}
144 CP_NOT_CLINPROC = 0;
145 CP_NO_INSTRUMENT = 1;
146 CP_INSTR_NO_STUB = 2;
147 CP_INSTR_INCOMPLETE = 3;
148 CP_INSTR_COMPLETE = 4;
149
150 CN_NEW_CSLT_NOTE = '-30';
151 CN_NEW_CP_NOTE = '-20';
152
153var
154 ConsultRec: TConsultRequest ;
155
156implementation
157
158uses
159 uConst;
160
161constructor TConsultTitles.Create;
162{ creates an object to store Consult titles so only obtained from server once }
163begin
164 inherited Create;
165 ShortList := TStringList.Create;
166end;
167
168destructor TConsultTitles.Destroy;
169{ frees the lists that were used to store the Consult titles }
170begin
171 ShortList.Free;
172 inherited Destroy;
173end;
174
175constructor TClinProcTitles.Create;
176{ creates an object to store ClinProc titles so only obtained from server once }
177begin
178 inherited Create;
179 ShortList := TStringList.Create;
180end;
181
182destructor TClinProcTitles.Destroy;
183{ frees the lists that were used to store the ClinProc titles }
184begin
185 ShortList.Free;
186 inherited Destroy;
187end;
188
189{============================================================================================
1901016^Jun 04,98 ^(dc)^ COLONOSCOPY GASTROENTEROLOGY Proc^Consult #: 1016^15814^^P
1911033^Jun 10,98 ^(c)^ GASTROENTEROLOGY Cons^Consult #: 1033^15881^^C
192=============================================================================================
193function call [GetConsultsList] returns the following string '^' pieces:
194===============================================================
195 1 - Consult IEN
196 2 - Consult Date
197 3 - (Status)
198 4 - Consult/Procedure Display Text
199 5 - Consult #: ###
200 6 - Order IFN
201 7 - '' (used for HasChildren in tree)
202 8 - Parent in tree
203 9 - 'Consult', 'Procedure', or 'Clinical Procedure'
204 10 - Service Name
205 11 - FMDate of piece 2
206 12 - 'C' or 'P' or 'M' or 'I' or 'R'
207===============================================================}
208
209function MakeConsultListItem(InputString: string): string;
210var
211 x: string;
212begin
213 x := InputString;
214 if Piece(x, U, 6) = '' then SetPiece(x, U, 6, ' ');
215 if Piece(x, U, 9) <> '' then
216 case Piece(x, U, 9)[1] of
217 'C': SetPiece(x, U, 10, 'Consult');
218 'P': SetPiece(x, U, 10, 'Procedure');
219 'M': SetPiece(x, U, 10, 'Procedure'); //'Clinical Procedure');
220 'I': SetPiece(x, U, 10, 'Consult - Interfacility');
221 'R': SetPiece(x, U, 10, 'Procedure - Interfacility');
222 end
223 else
224 begin
225 if Piece(x, U, 5) = 'Consult' then SetPiece(x, U, 10, 'Consult')
226 else SetPiece(x, U, 10, 'Procedure');
227 end;
228 x := Piece(x, U, 1) + U + FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 2))) + ' ' + U + '(' + Piece(x, U, 3) + ')' + U + Piece(x, U, 6) + Piece(x, U, 7) + U +
229 'Consult #: ' + Piece(x, U, 1) + U + Piece(x, U, 8) + U + U + U + Piece(x, U, 10) + U + Piece(x, U, 4)+ U +
230 Piece(x, U, 2) + U + Piece(x, U, 9);
231 Result := x;
232end;
233
234function MakeConsultListDisplayText(InputString: string): string;
235var
236 x: string;
237begin
238 x := InputString;
239 x := Piece(x, U, 2) + ' ' + Piece(x, U, 3) + ' ' + Piece(x, U, 4) + ' ' + Piece(x, U, 5);
240 Result := x;
241end;
242
243function MakeConsultNoteDisplayText(RawText: string): string;
244var
245 x: string;
246begin
247 x := RawText;
248 if Piece(x, U, 1)[1] in ['A', 'N', 'E'] then
249 x := Piece(x, U, 2)
250 else
251 begin
252 x := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3))) + ' ' + Piece(x, U, 2) +
253 ' (#' + Piece(Piece(x, U, 1), ';', 1) + ')';
254 if not (Copy(Piece(Piece(RawText, U, 1), ';', 2), 1, 4) = 'MCAR') then
255 x := x + ', ' + Piece(RawText, U, 6) + ', ' + Piece(Piece(RawText, U, 5), ';', 2);
256 end;
257 Result := x;
258end;
259
260procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode);
261var
262 MyID, MyParent, Name, item: string;
263 i, Idx: Integer;
264 ParentNode, ChildNode: TORTreeNode;
265// tmpNode: TORTreeNode;
266 HasChildren: Boolean;
267// AllNodes: TStringList;
268 ParentNodes: TStringList;
269// List: TList;
270// Lists: TObjectList;
271// bad: boolean;
272
273// Former code was only filtering out half the duplicates, depending on
274// how they appeared in the tree. Commented out code filters out all the duplicates,
275// and still keeps the fast tree build. However, CPRS Clinical Workgroup determined
276// that no duplicates should be filtered out. Code kept here in order to keep fast filter
277// logic, in case duplicates are ever filtered out in the future.
278
279{
280 procedure FilterOutDuplicates;
281 var
282 j: integer;
283 begin
284 bad := false;
285 if AllNodes.Find(MyID, Idx) then
286 begin
287 if AllNodes.Objects[Idx] is TORTreeNode then
288 begin
289 tmpNode := TORTreeNode(AllNodes.Objects[Idx]);
290 bad := tmpNode.HasAsParent(ParentNode);
291 if (not bad) and assigned(tmpNode.Parent) then
292 bad := ParentNode.HasAsParent(tmpNode.Parent);
293 end
294 else
295 begin
296 bad := False;
297 List := TList(AllNodes.Objects[Idx]);
298 for j := 0 to List.Count - 1 do
299 begin
300 tmpNode := TORTreeNode(List[j]);
301 bad := TORTreeNode(List[j]).HasAsParent(ParentNode);
302 if (not bad) and assigned(tmpNode.Parent) then
303 bad := ParentNode.HasAsParent(tmpNode.Parent);
304 if bad then break;
305 end;
306 end;
307 end;
308 end;
309
310 procedure AddNode;
311 begin
312 if AllNodes.Find(MyID, Idx) then
313 begin
314 if AllNodes.Objects[Idx] is TORTreeNode then
315 begin
316 List := TList.Create;
317 Lists.Add(List);
318 List.Add(AllNodes.Objects[Idx]);
319 AllNodes.Objects[Idx] := List;
320 end
321 else
322 List := TList(AllNodes.Objects[Idx]);
323 List.Add(ChildNode);
324 end
325 else
326 AllNodes.AddObject(MyId, ChildNode);
327 end;
328}
329
330begin
331 Tree.Items.BeginUpdate;
332 ParentNodes := TStringList.Create;
333// AllNodes := TStringList.Create;
334// Lists := TObjectList.Create;
335 try
336 ParentNodes.Sorted := True;
337// AllNodes.Sorted := True;
338 for i := 0 to SvcList.Count - 1 do
339 begin
340 item := SvcList[i];
341 if Piece(item, U, 5) = 'S' then Continue;
342 MyParent := Piece(item, U, 3);
343 MyID := Piece(item, U, 1);
344 if not ParentNodes.Find(MyParent, Idx) then
345 ParentNode := nil
346 else
347 begin
348 ParentNode := TORTreeNode(ParentNodes.Objects[Idx]);
349// FilterOutDuplicates;
350// if bad then Continue;
351 end;
352 Name := Piece(item, U, 2);
353 HasChildren := Piece(item, U, 4) = '+';
354 ChildNode := TORTreeNode(Tree.Items.AddChild(ParentNode, Name));
355 ChildNode.StringData := item;
356// AddNode;
357 if HasChildren then
358 ParentNodes.AddObject(MyID, ChildNode);
359 end;
360 finally
361 ParentNodes.Free;
362// AllNodes.Free;
363// Lists.Free;
364 end;
365 Tree.Items.EndUpdate;
366end;
367
368procedure CreateListItemsForConsultTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
369 Ascending: Boolean);
370var
371 i: Integer;
372 x, x3, MyParent, MyService, MyStatus, MyType, StatusText: string;
373 AList, SrcList: TStringList;
374begin
375 AList := TStringList.Create;
376 SrcList := TStringList.Create;
377 try
378 FastAssign(Source, SrcList);
379 with SrcList do
380 begin
381 if (Count = 1) and (Piece(Strings[0], U, 1) = '-1') then
382 begin
383 Dest.Insert(0, IntToStr(Context) + '^^^' + 'No Matching Consults Found' + '^^^^0^^^^');
384 Exit;
385 end;
386 for i := 0 to Count - 1 do
387 begin
388 x := Strings[i];
389 MyType := Piece(x, U, 9);
390 if Context = 0 then Context := CC_ALL;
391 SetPiece(x, U, 8, IntToStr(Context));
392 MyParent := Piece(x, U, 8);
393 MyService := Piece(x, U, 10);
394 MyStatus := Piece(x, U, 3);
395 if Length(Trim(MyService)) = 0 then
396 begin
397 MyService := '** No Service **';
398 SetPiece(x, U, 10, MyService);
399 end;
400 if Length(Trim(MyStatus)) = 0 then
401 begin
402 MyStatus := '** No Status **';
403 SetPiece(x, U, 3, MyStatus);
404 end;
405 if GroupBy <> '' then case GroupBy[1] of
406 'S': begin
407 SetPiece(x, U, 8, MyParent + MyStatus);
408 if MyStatus = '(a)' then StatusText := 'Active'
409 else if MyStatus = '(p)' then StatusText := 'Pending'
410 else if MyStatus = '(pr)' then StatusText := 'Partial Results'
411 else if MyStatus = '(s)' then StatusText := 'Scheduled'
412 else if MyStatus = '(x)' then StatusText := 'Cancelled'
413 else if MyStatus = '(dc)' then StatusText := 'Discontinued'
414 else if MyStatus = '(c)' then StatusText := 'Completed'
415 else StatusText := 'Other';
416 x3 := MyStatus + U + StatusText + U + IntToStr(Context);
417 if (AList.IndexOf(x3) = -1) then AList.Add(x3);
418 end;
419 'V': begin
420 SetPiece(x, U, 8, MyParent + MyService);
421 x3 := MyService + U + MixedCase(MyService) + U + IntToStr(Context);
422 if (AList.IndexOf(x3) = -1) then AList.Add(x3);
423 end;
424 'T': begin
425 SetPiece(x, U, 8, MyParent + MyType);
426 x3 := MyType + U + MixedCase(MyType) + U + IntToStr(Context);
427 if (AList.IndexOf(x3) = -1) then AList.Add(x3);
428 end;
429 end;
430 Dest.Add(x);
431 end; {for}
432 SortByPiece(TStringList(Dest), U, 11);
433 if not Ascending then InvertStringList(TStringList(Dest));
434 Dest.Insert(0, IntToStr(Context) + '^^^' + CC_TV_TEXT[Context] + '^^^+^0^^^^');
435 Alist.Sort;
436 InvertStringList(AList);
437 for i := 0 to AList.Count-1 do
438 Dest.Insert(0, IntToStr(Context) + Piece(AList[i], U, 1) + '^^^' + Piece(AList[i], U, 2) + '^^^+^' + Piece(AList[i], U, 3) + '^^^^');
439 end;
440 finally
441 AList.Free;
442 SrcList.Free;
443 end;
444end;
445
446procedure BuildConsultsTree(Tree: TORTreeView; tmpList: TStrings; const Parent: string; Node: TORTreeNode;
447 CurrentContext: TSelectContext);
448var
449 MyID, MyParent, Name, temp: string;
450 i: Integer;
451 ChildNode, tmpNode: TORTreeNode;
452 HasChildren: Boolean;
453begin
454 Tree.Items.BeginUpdate;
455 with tmpList do for i := 0 to Count - 1 do
456 begin
457 MyParent := Piece(Strings[i], U, 8);
458 if (MyParent = Parent) then
459 begin
460 MyID := Piece(Strings[i], U, 1);
461 Name := MakeConsultListDisplayText(Strings[i]);
462 temp := Strings[i];
463 tmpNode := nil;
464 HasChildren := Piece(Strings[i], U, 7) = '+';
465 if Node <> nil then if Node.HasChildren then
466 tmpNode := Tree.FindPieceNode(MyID, 1, U, Node);
467 if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then
468 Continue
469 else
470 begin
471 ChildNode := TORTreeNode(Tree.Items.AddChild(Node, Name));
472 ChildNode.StringData := temp;
473 SetNodeImage(ChildNode, CurrentContext);
474 if HasChildren then
475 BuildConsultsTree(Tree, tmpList, MyID, ChildNode, CurrentContext);
476 end;
477 end;
478 end;
479 Tree.Items.EndUpdate;
480end;
481
482procedure SetNodeImage(Node: TORTreeNode; CurrentContext: TSelectContext);
483begin
484 with Node do
485 begin
486 if Piece(Stringdata, U, 8) = '0' then
487 begin
488 ImageIndex := IMG_GMRC_TOP_LEVEL;
489 SelectedIndex := IMG_GMRC_TOP_LEVEL;
490 if (Piece(StringData, U, 4) = 'No Matching Consults Found') then exit;
491 if Piece(Stringdata, U, 1) <> '-1' then
492 with CurrentContext, Node do
493 if GroupBy <> '' then case GroupBy[1] of
494 'V': Text := CC_TV_TEXT[StrToInt(Piece(Stringdata, U, 1))] + ' by Service';
495 'S': Text := CC_TV_TEXT[StrToInt(Piece(Stringdata, U, 1))] + ' by Status';
496 'T': Text := CC_TV_TEXT[StrToInt(Piece(Stringdata, U, 1))] + ' by Type';
497 end;
498 end
499 else
500 begin
501 if Piece(Stringdata, U, 7) <> '' then
502 case Piece(Stringdata, U, 7)[1] of
503 '+': begin
504 ImageIndex := IMG_GMRC_GROUP_SHUT;
505 SelectedIndex := IMG_GMRC_GROUP_OPEN;
506 end;
507 end
508 else
509 begin
510 if Piece(StringData, U, 12) <> '' then
511 case Piece(StringData, U, 12)[1] of
512 'C': ImageIndex := IMG_GMRC_CONSULT;
513 'P': ImageIndex := IMG_GMRC_ALL_PROC; //IMG_GMRC_PROC;
514 'M': ImageIndex := IMG_GMRC_ALL_PROC; //IMG_GMRC_CLINPROC;
515 'I': ImageIndex := IMG_GMRC_IFC_CONSULT;
516 'R': ImageIndex := IMG_GMRC_IFC_PROC;
517 end
518 else
519 begin
520 if Piece(StringData, U, 9) = 'Procedure' then
521 ImageIndex := IMG_GMRC_ALL_PROC
522 else
523 ImageIndex := IMG_GMRC_CONSULT;
524 end;
525 SelectedIndex := ImageIndex;
526 end;
527 end;
528 StateIndex := IMG_NONE;
529 end;
530end;
531
532end.
Note: See TracBrowser for help on using the repository browser.