source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/rConsults.pas@ 1619

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 30.5 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit rConsults;
3
4interface
5
6uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, uConsults, rTIU, uTIU;
7
8type
9
10 TUnresolvedConsults = record
11 UnresolvedConsultsExist: boolean;
12 ShowNagScreen: boolean;
13 end;
14
15{Consult Titles }
16function DfltConsultTitle: integer;
17function DfltConsultTitleName: string;
18function DfltClinProcTitle: integer;
19function DfltClinProcTitleName: string;
20function IdentifyConsultsClass: integer;
21function IdentifyClinProcClass: integer;
22procedure ListConsultTitlesShort(Dest: TStrings);
23procedure ListClinProcTitlesShort(Dest: TStrings);
24function SubSetOfConsultTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
25function SubSetOfClinProcTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
26procedure ResetConsultTitles;
27procedure ResetClinProcTitles;
28
29{ Data Retrieval }
30procedure GetConsultsList(Dest: TStrings; Early, Late: double;
31 Service, Status: string; SortAscending: Boolean);
32procedure LoadConsultDetail(Dest: TStrings; IEN: integer) ;
33function GetCurrentContext: TSelectContext;
34procedure SaveCurrentContext(AContext: TSelectContext) ;
35procedure DisplayResults(Dest: TStrings; IEN: integer) ;
36procedure GetConsultRec(IEN: integer) ;
37function ShowSF513(ConsultIEN: integer): TStrings ;
38procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
39 var ErrMsg: string);
40function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
41function UnresolvedConsultsExist: boolean;
42procedure GetUnresolvedConsultsInfo;
43
44{list box fillers}
45function SubSetOfStatus: TStrings;
46function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
47function LoadServiceList(Purpose: integer): TStrings ;
48function LoadServiceListWithSynonyms(Purpose: integer): TStrings ; overload;
49function LoadServiceListWithSynonyms(Purpose, ConsultIEN: integer): TStrings ; overload;
50function SubSetOfServices(const StartFrom: string; Direction: Integer): TStrings;
51function FindConsult(ConsultIEN: integer): string ;
52
53{user access level functions}
54function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
55function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
56
57{consult result functions}
58function GetAssignableMedResults(ConsultIEN: integer): TStrings;
59function GetRemovableMedResults(ConsultIEN: integer): TStrings;
60function GetDetailedMedicineResults(ResultID: string): TStrings;
61procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
62procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
63
64{Consult Request Actions}
65procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
66procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
67 AlertTo: string; Comments: TStrings);
68procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
69 DiscontinueDate: TFMDateTime; Comments: TStrings);
70procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
71 DenialDate: TFMDateTime; Comments: TStrings);
72procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64;
73 Urgency: integer; ActionDate: TFMDateTime; Comments: TStrings);
74procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
75 AlertTo: string) ;
76procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime;Alert: integer;
77 AlertTo: string) ;
78procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
79 RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
80
81 { Consults Ordering Calls }
82function ODForConsults: TStrings;
83function ODForProcedures: TStrings;
84function ConsultMessage(AnIEN: Integer): string;
85function LoadConsultsQuickList: TStrings ;
86function GetProcedureServices(ProcIEN: integer): TStrings;
87function ConsultCanBeResubmitted(ConsultIEN: integer): string;
88function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
89function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
90function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
91function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
92function ReasonForRequestEditable(Service: string): string;
93function GetNewDialog(OrderType: string): string;
94function GetServiceIEN(ORIEN: string): string;
95function GetProcedureIEN(ORIEN: string): string;
96function GetConsultOrderIEN(ConsultIEN: integer): string;
97function GetServicePrerequisites(Service: string): TStrings;
98procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
99
100{ Clinical Procedures Specific}
101function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
102
103var
104 uConsultsClass: integer;
105 uConsultTitles: TConsultTitles;
106 uClinProcClass: integer;
107 uClinProcTitles: TClinProcTitles;
108 uUnresolvedConsults: TUnresolvedConsults;
109
110implementation
111
112uses rODBase;
113
114var
115 uLastOrderedIEN: Integer;
116 uLastOrderMsg: string;
117
118{ -------------------------- Consult Titles --------------------------------- }
119
120function IdentifyConsultsClass: integer;
121begin
122 if uConsultsClass = 0 then
123 uConsultsClass := StrToIntDef(sCallV('TIU IDENTIFY CONSULTS CLASS',[nil]), 0) ;
124 Result := uConsultsClass;
125end;
126
127procedure LoadConsultTitles;
128{ private - called one time to set up the uConsultTitles object }
129var
130 x: string;
131begin
132 if uConsultTitles <> nil then Exit;
133 CallV('TIU PERSONAL TITLE LIST', [User.DUZ, IdentifyConsultsClass]);
134 RPCBrokerV.Results.Insert(0, '~SHORT LIST'); // insert so can call ExtractItems
135 uConsultTitles := TConsultTitles.Create;
136 ExtractItems(uConsultTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST');
137 x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST');
138 uConsultTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0);
139 uConsultTitles.DfltTitleName := Piece(x, U, 2);
140end;
141
142procedure ResetConsultTitles;
143begin
144 if uConsultTitles <> nil then
145 begin
146 uConsultTitles.Free;
147 uConsultTitles := nil;
148 LoadConsultTitles;
149 end;
150end;
151
152function DfltConsultTitle: integer;
153{ returns the user defined default Consult title (if any) }
154begin
155 if uConsultTitles = nil then LoadConsultTitles;
156 Result := uConsultTitles.DfltTitle;
157end;
158
159function DfltConsultTitleName: string;
160{ returns the name of the user defined default progress note title (if any) }
161begin
162 if uConsultTitles = nil then LoadConsultTitles;
163 Result := uConsultTitles.DfltTitleName;
164end;
165
166procedure ListConsultTitlesShort(Dest: TStrings);
167{ returns the user defined list (short list) of Consult titles }
168begin
169 if uConsultTitles = nil then LoadConsultTitles;
170 Dest.AddStrings(uConsultTitles.ShortList);
171 if uConsultTitles.ShortList.Count > 0 then
172 begin
173 Dest.Add('0^________________________________________________________________________');
174 Dest.Add('0^ ');
175 end;
176end;
177
178function SubSetOfConsultTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
179{ returns a pointer to a list of consults progress note titles (for use in a long list box) -
180 The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE
181 the next broker call! }
182begin
183(* if IDNoteTitlesOnly then // This RPC not changed for initial ID Notes release
184 CallV('TIU LONG LIST CONSULT TITLES', [StartFrom, Direction, IDNoteTitlesOnly])
185 else*)
186 CallV('TIU LONG LIST CONSULT TITLES', [StartFrom, Direction]);
187 //MixedCaseList(RPCBrokerV.Results);
188 Result := RPCBrokerV.Results;
189end;
190
191
192{ -------------------------- Clinical Procedures Titles --------------------------------- }
193function IdentifyClinProcClass: integer;
194begin
195 if uClinProcClass = 0 then
196 uClinProcClass := StrToIntDef(sCallV('TIU IDENTIFY CLINPROC CLASS',[nil]), 0) ;
197 Result := uClinProcClass;
198end;
199
200procedure LoadClinProcTitles;
201{ private - called one time to set up the uConsultTitles object }
202var
203 x: string;
204begin
205 if uClinProcTitles <> nil then Exit;
206 CallV('TIU PERSONAL TITLE LIST', [User.DUZ, IdentifyClinProcClass]);
207 RPCBrokerV.Results.Insert(0, '~SHORT LIST'); // insert so can call ExtractItems
208 uClinProcTitles := TClinProcTitles.Create;
209 ExtractItems(uClinProcTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST');
210 x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST');
211 uClinProcTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0);
212 uClinProcTitles.DfltTitleName := Piece(x, U, 2);
213end;
214
215procedure ResetClinProcTitles;
216begin
217 if uClinProcTitles <> nil then
218 begin
219 uClinProcTitles.Free;
220 uClinProcTitles := nil;
221 LoadClinProcTitles;
222 end;
223end;
224
225function DfltClinProcTitle: integer;
226{ returns the user defined default ClinProc title (if any) }
227begin
228 if uClinProcTitles = nil then LoadClinProcTitles;
229 Result := uClinProcTitles.DfltTitle;
230end;
231
232function DfltClinProcTitleName: string;
233{ returns the name of the user defined default progress note title (if any) }
234begin
235 if uClinProcTitles = nil then LoadClinProcTitles;
236 Result := uClinProcTitles.DfltTitleName;
237end;
238
239procedure ListClinProcTitlesShort(Dest: TStrings);
240{ returns the user defined list (short list) of ClinProc titles }
241begin
242 if uClinProcTitles = nil then LoadClinProcTitles;
243 Dest.AddStrings(uClinProcTitles.ShortList);
244 if uClinProcTitles.ShortList.Count > 0 then
245 begin
246 Dest.Add('0^________________________________________________________________________');
247 Dest.Add('0^ ');
248 end;
249end;
250
251function SubSetOfClinProcTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
252{ returns a pointer to a list of clinical procedures titles (for use in a long list box) -
253 The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE
254 the next broker call! }
255begin
256(* if IDNoteTitlesOnly then // This RPC not changed for initial ID Notes release
257 CallV('TIU LONG LIST CLINPROC TITLES', [StartFrom, Direction, IDNoteTitlesOnly])
258 else*)
259 CallV('TIU LONG LIST CLINPROC TITLES', [StartFrom, Direction]);
260 //MixedCaseList(RPCBrokerV.Results);
261 Result := RPCBrokerV.Results;
262end;
263
264{--------------- data retrieval ------------------------------------------}
265
266procedure GetConsultsList(Dest: TStrings; Early, Late: double;
267 Service, Status: string; SortAscending: Boolean);
268{ returns a list of consults for a patient, based on selected dates, service, status, or ALL}
269var
270 i: Integer;
271 x, date1, date2: string;
272begin
273 if Early <= 0 then date1 := '' else date1 := FloatToStr(Early) ;
274 if Late <= 0 then date2 := '' else date2 := FloatToStr(Late) ;
275 CallV('ORQQCN LIST', [Patient.DFN, date1, date2, Service, Status]);
276 with RPCBrokerV do
277 begin
278 if Copy(Results[0],1,1) <> '<' then
279 begin
280 SortByPiece(TStringList(Results), U, 2);
281 if not SortAscending then InvertStringList(TStringList(Results));
282 //SetListFMDateTime('mmm dd,yy', TStringList(Results), U, 2);
283 for i := 0 to Results.Count - 1 do
284 begin
285 x := MakeConsultListItem(Results[i]);
286 Results[i] := x;
287 end;
288 Dest.Assign(Results);
289 end
290 else
291 begin
292 Dest.Clear ;
293 Dest.Add('-1^No Matches') ;
294 end ;
295 end;
296end;
297
298procedure LoadConsultDetail(Dest: TStrings; IEN: integer) ;
299{ returns the detail of a consult }
300begin
301 CallV('ORQQCN DETAIL', [IEN]);
302 Dest.Assign(RPCBrokerV.Results);
303end;
304
305procedure DisplayResults(Dest: TStrings; IEN: integer) ;
306{ returns the results for a consult }
307begin
308 CallV('ORQQCN MED RESULTS', [IEN]);
309 Dest.Assign(RPCBrokerV.Results);
310end;
311
312procedure GetConsultRec(IEN: integer);
313{returns zero node from file 123, plus a list of all related TIU documents, if any}
314const
315 SHOW_ADDENDA = True;
316
317var
318 alist: TStrings;
319 x: string ;
320 i: integer;
321{ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
322{ Pieces: EntDt^Pat^OrIFN^PtLoc^ToSvc^From^ReqDt^Typ^Urg^Place^Attn^Sts^LstAct^SndPrv^Rslt^
323 16 17 18 19 20 21 22
324 ^EntMode^ReqTyp^InOut^SigFnd^TIUPtr^OrdFac^FrgnCslt}
325begin
326 FillChar(ConsultRec, SizeOf(ConsultRec), 0);
327 CallV('ORQQCN GET CONSULT', [IEN, SHOW_ADDENDA]);
328 ConsultRec.IEN := IEN ;
329 alist := TStringList.Create ;
330 try
331 alist.Assign(RPCBrokerV.Results) ;
332 x := alist[0] ;
333 if Piece(x,u,1) <> '-1' then
334 with ConsultRec do
335 begin
336 EntryDate := MakeFMDateTime(Piece(x, U, 1));
337 ORFileNumber := StrToIntDef(Piece(x, U, 3),0);
338 PatientLocation := StrToIntDef(Piece(x, U, 4),0);
339 OrderingFacility := StrToIntDef(Piece(x, U, 21),0);
340 ForeignConsultFileNum := StrToIntDef(Piece(x, U, 22),0);
341 ToService := StrToIntDef(Piece(x, U, 5),0);
342 From := StrToIntDef(Piece(x, U, 6),0);
343 RequestDate := MakeFMDateTime(Piece(x, U, 7));
344 ConsultProcedure := Piece(x, U, 8) ;
345 Urgency := StrToIntDef(Piece(x, U, 9),0);
346 PlaceOfConsult := StrToIntDef(Piece(x, U, 10),0);
347 Attention := StrToInt64Def(Piece(x, U, 11),0);
348 ORStatus := StrToIntDef(Piece(x, U, 12),0);
349 LastAction := StrToIntDef(Piece(x, U, 13),0);
350 SendingProvider := StrToInt64Def(Piece(Piece(x, U, 14),';',1),0);
351 SendingProviderName := Piece(Piece(x, U, 14),';',2) ;
352 Result := Piece(x, U, 15) ;
353 ModeOfEntry := Piece(x, U, 16) ;
354 RequestType := StrToIntDef(Piece(x, U, 17),0);
355 InOut := Piece(x, U, 18) ;
356 Findings := Piece(x, U, 19) ;
357 TIUResultNarrative := StrToIntDef(Piece(x, U, 20),0);
358 //ProvDiagnosis := Piece(x, U, 23); NO!!!!! Up to 180 Characters!!!!
359 alist.delete(0) ;
360 TIUDocuments := TStringList.Create ;
361 MedResults := TStringList.Create;
362 if alist.count > 0 then
363 begin
364 SortByPiece(TStringList(alist), U, 3);
365 for i := 0 to alist.Count - 1 do
366 if Copy(Piece(Piece(alist[i], U, 1), ';', 2), 1, 4) = 'MCAR' then
367 MedResults.Add(alist[i])
368 else
369 TIUDocuments.Add(alist[i]);
370 end;
371 end {ConsultRec}
372 else
373 ConsultRec.EntryDate := -1 ;
374 finally
375 alist.free ;
376 end ;
377end ;
378
379{---------------- list box fillers -----------------------------------}
380
381function SubSetOfStatus: TStrings;
382{ returns a pointer to a list of stati (for use in a list box) }
383begin
384 CallV('ORQQCN STATUS', [nil]);
385 MixedCaseList(RPCBrokerV.Results);
386 Result := RPCBrokerV.Results;
387end;
388
389function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
390{ returns a pointer to a list of urgencies }
391begin
392 CallV('ORQQCN URGENCIES',[ConsultIEN]) ;
393 MixedCaseList(RPCBrokerV.Results);
394 Result := RPCBrokerV.Results;
395end;
396
397function FindConsult(ConsultIEN: integer): string ;
398var
399 x: string;
400begin
401 x := sCallV('ORQQCN FIND CONSULT',[ConsultIEN]);
402 Result := MakeConsultListItem(x);
403end;
404
405{-----------------consult result functions-----------------------------------}
406function GetAssignableMedResults(ConsultIEN: integer): TStrings;
407begin
408 CallV('ORQQCN ASSIGNABLE MED RESULTS', [ConsultIEN]);
409 Result := RPCBrokerV.Results;
410end;
411
412function GetRemovableMedResults(ConsultIEN: integer): TStrings;
413begin
414 CallV('ORQQCN REMOVABLE MED RESULTS', [ConsultIEN]);
415 Result := RPCBrokerV.Results;
416end;
417
418function GetDetailedMedicineResults(ResultID: string): TStrings;
419begin
420 CallV('ORQQCN GET MED RESULT DETAILS', [ResultID]);
421 Result := RPCBrokerV.Results;
422end;
423
424procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
425begin
426 CallV('ORQQCN ATTACH MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson, AlertTo]);
427end;
428
429procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
430begin
431 CallV('ORQQCN REMOVE MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson]);
432end;
433{-------------- user access level functions ---------------------------------}
434
435function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
436var
437 i: integer ;
438begin
439 Result := False ;
440 CallV('ORWU GENERIC', ['',1,'^GMR(123.5,'+IntToStr(ServiceIEN)+',123.3,"B")']) ;
441 for i:=0 to RPCBrokerV.Results.Count-1 do
442 if StrToInt64(Piece(RPCBrokerV.Results[i],u,2))=DUZ then result := True ;
443end ;
444
445function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
446var
447 x: string;
448begin
449 x := sCallV('ORQQCN SET ACT MENUS', [ConsultIEN]) ;
450 Result.UserLevel := StrToIntDef(Piece(x, U, 1), 1);
451 Result.AllowMedResulting := (Piece(x, U, 4) = '1');
452 Result.AllowMedDissociate := (Piece(x, U, 5) = '1');
453 Result.AllowResubmit := (Piece(x, U, 6) = '1') and (Piece(ConsultCanBeResubmitted(ConsultIEN), U, 1) <> '0');
454 Result.ClinProcFlag := StrToIntDef(Piece(x, U, 7), CP_NOT_CLINPROC);
455 Result.IsClinicalProcedure := (Result.ClinProcFlag > CP_NOT_CLINPROC);
456end ;
457
458{------------------- Consult request actions -------------------------------}
459
460procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
461begin
462 CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]);
463 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
464end;
465
466procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
467 AlertTo: string; Comments: TStrings);
468begin
469 CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]);
470 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
471end;
472
473procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
474 DenialDate: TFMDateTime; Comments: TStrings);
475begin
476 CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]);
477 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
478end;
479
480procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
481 DiscontinueDate: TFMDateTime; Comments: TStrings);
482begin
483 CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]);
484 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
485end;
486
487procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64; Urgency: integer;
488 ActionDate: TFMDateTime; Comments: TStrings);
489begin
490 CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
491 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
492end ;
493
494procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
495AlertTo: string) ;
496begin
497 CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
498 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
499end ;
500
501procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
502 RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
503begin
504 CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
505 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
506end ;
507
508procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
509AlertTo: string) ;
510begin
511 CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
512 Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
513end ;
514
515//================== Ordering functions ===================================
516function ODForConsults: TStrings;
517{ Returns init values for consults dialog. The results must be used immediately. }
518begin
519 CallV('ORWDCN32 DEF', ['C']);
520 Result := RPCBrokerV.Results;
521end;
522
523function ODForProcedures: TStrings;
524{ Returns init values for procedures dialog. The results must be used immediately. }
525begin
526 CallV('ORWDCN32 DEF', ['P']);
527 Result := RPCBrokerV.Results;
528end;
529
530function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
531begin
532begin
533 CallV('ORWDCN32 PROCEDURES', [StartFrom, Direction]);
534 Result := RPCBrokerV.Results;
535end;
536end;
537
538function LoadServiceList(Purpose: integer): TStrings ;
539// Purpose: 0=display all services, 1=forward or order from possible services
540begin
541 Callv('ORQQCN SVCTREE',[Purpose]) ;
542 MixedCaseList(RPCBrokerV.Results) ;
543 Result := RPCBrokerV.Results;
544end ;
545
546function LoadServiceListWithSynonyms(Purpose: integer): TStrings ;
547// Param 1 = Starting service (1=All Services)
548// Param 2 = Purpose: 0=display all services, 1=forward or order from possible services
549// Param 3 = Show synonyms
550begin
551 Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True]) ;
552 MixedCaseList(RPCBrokerV.Results) ;
553 Result := RPCBrokerV.Results;
554end ;
555
556function LoadServiceListWithSynonyms(Purpose, ConsultIEN: integer): TStrings ;
557// Param 1 = Starting service (1=All Services)
558// Param 2 = Purpose: 0=display all services, 1=forward or order from possible services
559// Param 3 = Show synonyms
560// Param 4 = Consult IEN
561begin
562 Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True, ConsultIEN]) ;
563 MixedCaseList(RPCBrokerV.Results) ;
564 Result := RPCBrokerV.Results;
565end ;
566
567function SubSetOfServices(const StartFrom: string; Direction: Integer): TStrings;
568// used only on consults order dialog for service long combo box, which needs to include quick orders
569begin
570 CallV('ORQQCN SVCLIST', [StartFrom, Direction]);
571 Result := RPCBrokerV.Results;
572end;
573
574function LoadConsultsQuickList: TStrings ;
575begin
576 Callv('ORWDXQ GETQLST',['CSLT', 'Q']) ;
577 Result := RPCBrokerV.Results;
578end ;
579
580function ShowSF513(ConsultIEN: integer): TStrings ;
581var
582 x: string;
583 i: integer;
584begin
585 CallV('ORQQCN SHOW SF513',[ConsultIEN]) ;
586 if RPCBrokerV.Results.Count > 0 then
587 begin
588 x := RPCBrokerV.Results[0];
589 i := Pos('-', x);
590 x := Copy(x, i, 999);
591 RPCBrokerV.Results[0] := x;
592 end;
593 Result := RPCBrokerV.Results;
594end ;
595
596procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
597 var ErrMsg: string);
598{ prints a SF 513 on the selected device }
599begin
600 ErrMsg := sCallV('ORQQCN PRINT SF513', [AConsult, ChartCopy, ADevice]);
601// if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
602end;
603
604function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
605begin
606 CallV('ORQQCN SF513 WINDOWS PRINT',[AConsult, ChartCopy]);
607 Result := RPCBrokerV.Results;
608end;
609
610function UnresolvedConsultsExist: boolean;
611begin
612 Result := (sCallV('ORQQCN UNRESOLVED', [Patient.DFN]) = '1');
613end;
614
615procedure GetUnresolvedConsultsInfo;
616var
617 x: string;
618begin
619 x := sCallV('ORQQCN UNRESOLVED', [Patient.DFN]);
620 with uUnresolvedConsults do
621 begin
622 UnresolvedConsultsExist := (Piece(x, U, 1) = '1');
623 ShowNagScreen := (Piece(x, U, 2) = '1');
624 end;
625end;
626
627function ConsultMessage(AnIEN: Integer): string;
628begin
629 if AnIEN = uLastOrderedIEN then Result := uLastOrderMsg else
630 begin
631 Result := sCallV('ORWDCN32 ORDRMSG', [AnIEN]);
632 uLastOrderedIEN := AnIEN;
633 uLastOrderMsg := Result;
634 end;
635end;
636
637function GetProcedureIEN(ORIEN: string): string;
638begin
639 Result := sCallV('ORQQCN GET PROC IEN', [ORIEN]);
640end;
641
642function GetProcedureServices(ProcIEN: integer): TStrings;
643begin
644 CallV('ORQQCN GET PROC SVCS',[ProcIEN]) ;
645 Result := RPCBrokerV.Results;
646end;
647
648function ConsultCanBeResubmitted(ConsultIEN: integer): string;
649begin
650 Result := sCallV('ORQQCN CANEDIT', [ConsultIEN]);
651end;
652
653function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
654var
655 Dest: TStringList;
656 EditRec: TEditResubmitRec;
657begin
658 Dest := TStringList.Create;
659 try
660 tCallV(Dest, 'ORQQCN LOAD FOR EDIT',[ConsultIEN]) ;
661 with EditRec do
662 begin
663 Changed := False;
664 IEN := ConsultIEN;
665 ToService := StrToIntDef(Piece(ExtractDefault(Dest, 'SERVICE'), U, 2), 0);
666 RequestType := Piece(ExtractDefault(Dest, 'TYPE'), U, 3);
667 OrderableItem := StrToIntDef(Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 1), 0);
668 ConsultProc := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 3);
669 ConsultProcName := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 2);
670 Urgency := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0);
671 UrgencyName := Piece(ExtractDefault(Dest, 'URGENCY'), U, 2);
672 Place := Piece(ExtractDefault(Dest, 'PLACE'), U, 1);
673 PlaceName := Piece(ExtractDefault(Dest, 'PLACE'), U, 2);
674 Attention := StrToInt64Def(Piece(ExtractDefault(Dest, 'ATTENTION'), U, 1), 0);
675 AttnName := Piece(ExtractDefault(Dest, 'ATTENTION'), U, 2);
676 InpOutp := Piece(ExtractDefault(Dest, 'CATEGORY'), U, 1);
677 ProvDiagnosis := Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 1);
678 ProvDxCode := Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 2);
679 ProvDxCodeInactive := (Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 3) = '1');
680 RequestReason := TStringList.Create;
681 ExtractText(RequestReason, Dest, 'REASON');
682 LimitStringLength(RequestReason, 74);
683 DenyComments := TStringList.Create;
684 ExtractText(DenyComments, Dest, 'DENY COMMENT');
685 OtherComments := TStringList.Create;
686 ExtractText(OtherComments, Dest, 'ADDED COMMENT');
687 NewComments := TStringList.Create;
688 end;
689 Result := EditRec;
690 finally
691 Dest.Free;
692 end;
693end;
694
695function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
696var
697 i: integer;
698begin
699 with RPCBrokerV, EditResubmitRec do
700 begin
701 ClearParameters := True;
702 RemoteProcedure := 'ORQQCN RESUBMIT';
703 Param[0].PType := literal;
704 Param[0].Value := IntToStr(IEN);
705 Param[1].PType := list;
706 with Param[1] do
707 begin
708 if ToService > 0 then
709 Mult['1'] := 'GMRCSS^' + IntToStr(ToService);
710 if ConsultProc <> '' then
711 Mult['2'] := 'GMRCPROC^' + ConsultProc ;
712 if Urgency > 0 then
713 Mult['3'] := 'GMRCURG^' + IntToStr(Urgency);
714 if Length(Place) > 0 then
715 Mult['4'] := 'GMRCPL^' + Place;
716 if Attention > 0 then
717 Mult['5'] := 'GMRCATN^' + IntToStr(Attention)
718 else if Attention = -1 then
719 Mult['5'] := 'GMRCATN^' + '@';
720 if RequestType <> '' then
721 Mult['6'] := 'GMRCRQT^' + RequestType;
722 if Length(InpOutP) > 0 then
723 Mult['7'] := 'GMRCION^' + InpOutp;
724 if Length(ProvDiagnosis) > 0 then
725 Mult['8'] := 'GMRCDIAG^' + ProvDiagnosis + U + ProvDxCode;
726 if RequestReason.Count > 0 then
727 begin
728 Mult['9'] := 'GMRCRFQ^20';
729 for i := 0 to RequestReason.Count - 1 do
730 Mult['9,' + IntToStr(i+1)] := RequestReason.Strings[i];
731 end;
732 if NewComments.Count > 0 then
733 begin
734 Mult['10'] := 'COMMENT^';
735 for i := 0 to NewComments.Count - 1 do
736 Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i];
737 end;
738 end;
739 CallBroker;
740 Result := '0';
741 //Result := Results[0];
742 end;
743end;
744
745function GetCurrentContext: TSelectContext;
746var
747 x: string;
748 AContext: TSelectContext;
749begin
750 x := sCallV('ORQQCN2 GET CONTEXT', [User.DUZ]) ;
751 with AContext do
752 begin
753 Changed := True;
754 BeginDate := Piece(x, ';', 1);
755 EndDate := Piece(x, ';', 2);
756 Status := Piece(x, ';', 3);
757 Service := Piece(x, ';', 4);
758 GroupBy := Piece(x, ';', 5);
759 Ascending := (Piece(x, ';', 6) = '1');
760 end;
761 Result := AContext;
762end;
763
764procedure SaveCurrentContext(AContext: TSelectContext) ;
765var
766 x: string;
767begin
768 with AContext do
769 begin
770 SetPiece(x, ';', 1, BeginDate);
771 SetPiece(x, ';', 2, EndDate);
772 SetPiece(x, ';', 3, Status);
773 SetPiece(x, ';', 4, Service);
774 SetPiece(x, ';', 5, GroupBy);
775 SetPiece(x, ';', 6, BOOLCHAR[Ascending]);
776 end;
777 CallV('ORQQCN2 SAVE CONTEXT', [x]);
778end;
779
780function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
781begin
782 CallV('ORQQCN DEFAULT REQUEST REASON',[Service, Patient.DFN, Resolve]) ;
783 Result := RPCBrokerV.Results;
784end;
785
786function ReasonForRequestEditable(Service: string): string;
787begin
788 Result := sCallV('ORQQCN EDIT DEFAULT REASON', [Service]);
789end;
790
791function GetServicePrerequisites(Service: string): TStrings;
792begin
793 CallV('ORQQCN2 GET PREREQUISITE',[Service, Patient.DFN]) ;
794 Result := RPCBrokerV.Results;
795end;
796
797function GetNewDialog(OrderType: string): string;
798{ get dialog for new consults}
799begin
800 Result := sCallV('ORWDCN32 NEWDLG', [OrderType, Encounter.Location]);
801end;
802
803function GetServiceIEN(ORIEN: string): string;
804begin
805 Result := sCallV('ORQQCN GET SERVICE IEN', [ORIEN]);
806end;
807
808procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
809var
810 x: string;
811begin
812 x := sCallV('ORQQCN PROVDX', [SvcIEN]);
813 ProvDx.Reqd := Piece(x, U, 1);
814 ProvDx.PromptMode := Piece(x, U, 2);
815end;
816
817function GetConsultOrderIEN(ConsultIEN: integer): string;
818begin
819 Result := sCallV('ORQQCN GET ORDER NUMBER', [ConsultIEN]);
820end;
821
822function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
823var
824 x: string;
825 AnEditRec: TEditNoteRec;
826begin
827 x := sCallV('ORWTIU GET SAVED CP FIELDS', [NoteIEN]);
828 with AnEditRec do
829 begin
830 Author := StrToInt64Def(Piece(x, U, 1), 0);
831 Cosigner := StrToInt64Def(Piece(x, U, 2), 0);
832 ClinProcSummCode := StrToIntDef(Piece(x, U, 3), 0);
833 ClinProcDateTime := StrToFMDateTime(Piece(x, U, 4));
834 Title := StrToIntDef(Piece(x, U, 5), 0);
835 end;
836 Result := AnEditRec;
837end;
838
839initialization
840 uLastOrderedIEN := 0;
841 uLastOrderMsg := '';
842 uConsultsClass := 0;
843 uClinProcClass := 0;
844
845finalization
846 if uConsultTitles <> nil then uConsultTitles.Free;
847 if uClinProcTitles <> nil then uClinProcTitles.Free;
848
849end.
Note: See TracBrowser for help on using the repository browser.