source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/uConsults.pas.bak@ 973

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

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