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

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

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