source: cprs/trunk/CPRS-Chart/Consults/rConsults.pas

Last change on this file was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28

File size: 31.4 KB
Line 
1unit rConsults;
2
3interface
4
5uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, uConsults, rTIU, uTIU;
6
7type
8
9 TUnresolvedConsults = record
10 UnresolvedConsultsExist: boolean;
11 ShowNagScreen: boolean;
12 end;
13
14{Consult Titles }
15function DfltConsultTitle: integer;
16function DfltConsultTitleName: string;
17function DfltClinProcTitle: integer;
18function DfltClinProcTitleName: string;
19function IdentifyConsultsClass: integer;
20function IdentifyClinProcClass: integer;
21procedure ListConsultTitlesShort(Dest: TStrings);
22procedure ListClinProcTitlesShort(Dest: TStrings);
23function SubSetOfConsultTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
24function SubSetOfClinProcTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
25procedure ResetConsultTitles;
26procedure ResetClinProcTitles;
27
28{ Data Retrieval }
29procedure GetConsultsList(Dest: TStrings; Early, Late: double;
30 Service, Status: string; SortAscending: Boolean);
31procedure LoadConsultDetail(Dest: TStrings; IEN: integer) ;
32function GetCurrentContext: TSelectContext;
33procedure SaveCurrentContext(AContext: TSelectContext) ;
34procedure DisplayResults(Dest: TStrings; IEN: integer) ;
35procedure GetConsultRec(IEN: integer) ;
36function ShowSF513(ConsultIEN: integer): TStrings ;
37procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
38 var ErrMsg: string);
39function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
40function UnresolvedConsultsExist: boolean;
41procedure GetUnresolvedConsultsInfo;
42
43{list box fillers}
44function SubSetOfStatus: TStrings;
45function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
46function LoadServiceList(Purpose: integer): TStrings ;
47function LoadServiceListWithSynonyms(Purpose: integer): TStrings ; overload;
48function LoadServiceListWithSynonyms(Purpose, ConsultIEN: integer): TStrings ; overload;
49function SubSetOfServices(const StartFrom: string; Direction: Integer): TStrings;
50function FindConsult(ConsultIEN: integer): string ;
51
52{user access level functions}
53function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
54function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
55
56{consult result functions}
57function GetAssignableMedResults(ConsultIEN: integer): TStrings;
58function GetRemovableMedResults(ConsultIEN: integer): TStrings;
59function GetDetailedMedicineResults(ResultID: string): TStrings;
60procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
61procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
62
63{Consult Request Actions}
64procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
65procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
66 AlertTo: string; Comments: TStrings);
67procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
68 DiscontinueDate: TFMDateTime; Comments: TStrings);
69procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
70 DenialDate: TFMDateTime; Comments: TStrings);
71procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64;
72 Urgency: integer; ActionDate: TFMDateTime; Comments: TStrings);
73procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
74 AlertTo: string) ;
75procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime;Alert: integer;
76 AlertTo: string) ;
77procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
78 RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
79
80 { Consults Ordering Calls }
81function ODForConsults: TStrings;
82function ODForProcedures: TStrings;
83function ConsultMessage(AnIEN: Integer): string;
84function LoadConsultsQuickList: TStrings ;
85function GetProcedureServices(ProcIEN: integer): TStrings;
86function ConsultCanBeResubmitted(ConsultIEN: integer): string;
87function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
88function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
89function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
90function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
91function ReasonForRequestEditable(Service: string): string;
92function GetNewDialog(OrderType: string): string;
93function GetServiceIEN(ORIEN: string): string;
94function GetProcedureIEN(ORIEN: string): string;
95function GetConsultOrderIEN(ConsultIEN: integer): string;
96function GetServicePrerequisites(Service: string): TStrings;
97procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
98function IsProstheticsService(SvcIen: int64) : 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 FastAssign(Results, Dest);
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 FastAssign(RPCBrokerV.Results, Dest);
303end;
304
305procedure DisplayResults(Dest: TStrings; IEN: integer) ;
306{ returns the results for a consult }
307begin
308 CallV('ORQQCN MED RESULTS', [IEN]);
309 FastAssign(RPCBrokerV.Results, Dest);
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;
316var
317 alist: TStrings;
318 x: string ;
319 i: integer;
320{ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
321{ Pieces: EntDt^Pat^OrIFN^PtLoc^ToSvc^From^ReqDt^Typ^Urg^Place^Attn^Sts^LstAct^SndPrv^Rslt^
322 16 17 18 19 20 21 22
323 ^EntMode^ReqTyp^InOut^SigFnd^TIUPtr^OrdFac^FrgnCslt}
324begin
325 FillChar(ConsultRec, SizeOf(ConsultRec), 0);
326 CallV('ORQQCN GET CONSULT', [IEN, SHOW_ADDENDA]);
327 ConsultRec.IEN := IEN ;
328 alist := TStringList.Create ;
329 try
330 FastAssign(RPCBrokerV.Results, aList);
331 x := alist[0] ;
332 if Piece(x,u,1) <> '-1' then
333 with ConsultRec do
334 begin
335 EntryDate := MakeFMDateTime(Piece(x, U, 1));
336 ORFileNumber := StrToIntDef(Piece(x, U, 3),0);
337 PatientLocation := StrToIntDef(Piece(x, U, 4),0);
338 OrderingFacility := StrToIntDef(Piece(x, U, 21),0);
339 ForeignConsultFileNum := StrToIntDef(Piece(x, U, 22),0);
340 ToService := StrToIntDef(Piece(x, U, 5),0);
341 From := StrToIntDef(Piece(x, U, 6),0);
342 RequestDate := MakeFMDateTime(Piece(x, U, 7));
343 ConsultProcedure := Piece(x, U, 8) ;
344 Urgency := StrToIntDef(Piece(x, U, 9),0);
345 PlaceOfConsult := StrToIntDef(Piece(x, U, 10),0);
346 Attention := StrToInt64Def(Piece(x, U, 11),0);
347 ORStatus := StrToIntDef(Piece(x, U, 12),0);
348 LastAction := StrToIntDef(Piece(x, U, 13),0);
349 SendingProvider := StrToInt64Def(Piece(Piece(x, U, 14),';',1),0);
350 SendingProviderName := Piece(Piece(x, U, 14),';',2) ;
351 Result := Piece(x, U, 15) ;
352 ModeOfEntry := Piece(x, U, 16) ;
353 RequestType := StrToIntDef(Piece(x, U, 17),0);
354 InOut := Piece(x, U, 18) ;
355 Findings := Piece(x, U, 19) ;
356 TIUResultNarrative := StrToIntDef(Piece(x, U, 20),0);
357 EarliestDate := StrToFloatDef(Piece(x, U, 98), 0);
358 //LatestDate := StrToFloatDef(Piece(x, U, 99), 0); //dropped requirement WAT
359 //ProvDiagnosis := Piece(x, U, 23); NO!!!!! Up to 180 Characters!!!!
360 alist.delete(0) ;
361 TIUDocuments := TStringList.Create ;
362 MedResults := TStringList.Create;
363 if alist.count > 0 then
364 begin
365 SortByPiece(TStringList(alist), U, 3);
366 for i := 0 to alist.Count - 1 do
367 if Copy(Piece(Piece(alist[i], U, 1), ';', 2), 1, 4) = 'MCAR' then
368 MedResults.Add(alist[i])
369 else
370 TIUDocuments.Add(alist[i]);
371 end;
372 end {ConsultRec}
373 else
374 ConsultRec.EntryDate := -1 ;
375 finally
376 alist.free ;
377 end ;
378end ;
379
380{---------------- list box fillers -----------------------------------}
381
382function SubSetOfStatus: TStrings;
383{ returns a pointer to a list of stati (for use in a list box) }
384begin
385 CallV('ORQQCN STATUS', [nil]);
386 MixedCaseList(RPCBrokerV.Results);
387 Result := RPCBrokerV.Results;
388end;
389
390function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
391{ returns a pointer to a list of urgencies }
392begin
393 CallV('ORQQCN URGENCIES',[ConsultIEN]) ;
394 MixedCaseList(RPCBrokerV.Results);
395 Result := RPCBrokerV.Results;
396end;
397
398function FindConsult(ConsultIEN: integer): string ;
399var
400 x: string;
401begin
402 x := sCallV('ORQQCN FIND CONSULT',[ConsultIEN]);
403 Result := MakeConsultListItem(x);
404end;
405
406{-----------------consult result functions-----------------------------------}
407function GetAssignableMedResults(ConsultIEN: integer): TStrings;
408begin
409 CallV('ORQQCN ASSIGNABLE MED RESULTS', [ConsultIEN]);
410 Result := RPCBrokerV.Results;
411end;
412
413function GetRemovableMedResults(ConsultIEN: integer): TStrings;
414begin
415 CallV('ORQQCN REMOVABLE MED RESULTS', [ConsultIEN]);
416 Result := RPCBrokerV.Results;
417end;
418
419function GetDetailedMedicineResults(ResultID: string): TStrings;
420begin
421 CallV('ORQQCN GET MED RESULT DETAILS', [ResultID]);
422 Result := RPCBrokerV.Results;
423end;
424
425procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
426begin
427 CallV('ORQQCN ATTACH MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson, AlertTo]);
428end;
429
430procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
431begin
432 CallV('ORQQCN REMOVE MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson]);
433end;
434{-------------- user access level functions ---------------------------------}
435
436function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
437var
438 i: integer ;
439begin
440 Result := False ;
441 CallV('ORWU GENERIC', ['',1,'^GMR(123.5,'+IntToStr(ServiceIEN)+',123.3,"B")']) ;
442 for i:=0 to RPCBrokerV.Results.Count-1 do
443 if StrToInt64(Piece(RPCBrokerV.Results[i],u,2))=DUZ then result := True ;
444end ;
445
446function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
447var
448 x: string;
449begin
450 x := sCallV('ORQQCN SET ACT MENUS', [ConsultIEN]) ;
451 Result.UserLevel := StrToIntDef(Piece(x, U, 1), 1);
452 Result.AllowMedResulting := (Piece(x, U, 4) = '1');
453 Result.AllowMedDissociate := (Piece(x, U, 5) = '1');
454 Result.AllowResubmit := (Piece(x, U, 6) = '1') and (Piece(ConsultCanBeResubmitted(ConsultIEN), U, 1) <> '0');
455 Result.ClinProcFlag := StrToIntDef(Piece(x, U, 7), CP_NOT_CLINPROC);
456 Result.IsClinicalProcedure := (Result.ClinProcFlag > CP_NOT_CLINPROC);
457end ;
458
459{------------------- Consult request actions -------------------------------}
460
461procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
462begin
463 CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]);
464 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
465end;
466
467procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
468 AlertTo: string; Comments: TStrings);
469begin
470 CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]);
471 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
472end;
473
474procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
475 DenialDate: TFMDateTime; Comments: TStrings);
476begin
477 CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]);
478 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
479end;
480
481procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
482 DiscontinueDate: TFMDateTime; Comments: TStrings);
483begin
484 CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]);
485 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
486end;
487
488procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64; Urgency: integer;
489 ActionDate: TFMDateTime; Comments: TStrings);
490begin
491 CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
492 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
493end ;
494
495procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
496AlertTo: string) ;
497begin
498 CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
499 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
500end ;
501
502procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
503 RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
504begin
505 CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
506 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
507end ;
508
509procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
510AlertTo: string) ;
511begin
512 CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
513 FastAssign(RPCBrokerV.Results, Dest); {1^Error message' or '0'}
514end ;
515
516//================== Ordering functions ===================================
517function ODForConsults: TStrings;
518{ Returns init values for consults dialog. The results must be used immediately. }
519begin
520 CallV('ORWDCN32 DEF', ['C']);
521 Result := RPCBrokerV.Results;
522end;
523
524function ODForProcedures: TStrings;
525{ Returns init values for procedures dialog. The results must be used immediately. }
526begin
527 CallV('ORWDCN32 DEF', ['P']);
528 Result := RPCBrokerV.Results;
529end;
530
531function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
532begin
533begin
534 CallV('ORWDCN32 PROCEDURES', [StartFrom, Direction]);
535 Result := RPCBrokerV.Results;
536end;
537end;
538
539function LoadServiceList(Purpose: integer): TStrings ;
540// Purpose: 0=display all services, 1=forward or order from possible services
541begin
542 Callv('ORQQCN SVCTREE',[Purpose]) ;
543 MixedCaseList(RPCBrokerV.Results) ;
544 Result := RPCBrokerV.Results;
545end ;
546
547function LoadServiceListWithSynonyms(Purpose: integer): TStrings ;
548// Param 1 = Starting service (1=All Services)
549// Param 2 = Purpose: 0=display all services, 1=forward or order from possible services
550// Param 3 = Show synonyms
551begin
552 Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True]) ;
553 MixedCaseList(RPCBrokerV.Results) ;
554 Result := RPCBrokerV.Results;
555end ;
556
557function LoadServiceListWithSynonyms(Purpose, ConsultIEN: integer): TStrings ;
558// Param 1 = Starting service (1=All Services)
559// Param 2 = Purpose: 0=display all services, 1=forward or order from possible services
560// Param 3 = Show synonyms
561// Param 4 = Consult IEN
562begin
563 Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True, ConsultIEN]) ;
564 MixedCaseList(RPCBrokerV.Results) ;
565 Result := RPCBrokerV.Results;
566end ;
567
568function SubSetOfServices(const StartFrom: string; Direction: Integer): TStrings;
569// used only on consults order dialog for service long combo box, which needs to include quick orders
570begin
571 CallV('ORQQCN SVCLIST', [StartFrom, Direction]);
572 Result := RPCBrokerV.Results;
573end;
574
575function LoadConsultsQuickList: TStrings ;
576begin
577 Callv('ORWDXQ GETQLST',['CSLT', 'Q']) ;
578 Result := RPCBrokerV.Results;
579end ;
580
581function ShowSF513(ConsultIEN: integer): TStrings ;
582var
583 x: string;
584 i: integer;
585begin
586 CallV('ORQQCN SHOW SF513',[ConsultIEN]) ;
587 if RPCBrokerV.Results.Count > 0 then
588 begin
589 x := RPCBrokerV.Results[0];
590 i := Pos('-', x);
591 x := Copy(x, i, 999);
592 RPCBrokerV.Results[0] := x;
593 end;
594 Result := RPCBrokerV.Results;
595end ;
596
597procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
598 var ErrMsg: string);
599{ prints a SF 513 on the selected device }
600begin
601 ErrMsg := sCallV('ORQQCN PRINT SF513', [AConsult, ChartCopy, ADevice]);
602// if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
603end;
604
605function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
606begin
607 CallV('ORQQCN SF513 WINDOWS PRINT',[AConsult, ChartCopy]);
608 Result := RPCBrokerV.Results;
609end;
610
611function UnresolvedConsultsExist: boolean;
612begin
613 Result := (sCallV('ORQQCN UNRESOLVED', [Patient.DFN]) = '1');
614end;
615
616procedure GetUnresolvedConsultsInfo;
617var
618 x: string;
619begin
620 x := sCallV('ORQQCN UNRESOLVED', [Patient.DFN]);
621 with uUnresolvedConsults do
622 begin
623 UnresolvedConsultsExist := (Piece(x, U, 1) = '1');
624 ShowNagScreen := (Piece(x, U, 2) = '1');
625 end;
626end;
627
628function ConsultMessage(AnIEN: Integer): string;
629begin
630 if AnIEN = uLastOrderedIEN then Result := uLastOrderMsg else
631 begin
632 Result := sCallV('ORWDCN32 ORDRMSG', [AnIEN]);
633 uLastOrderedIEN := AnIEN;
634 uLastOrderMsg := Result;
635 end;
636end;
637
638function GetProcedureIEN(ORIEN: string): string;
639begin
640 Result := sCallV('ORQQCN GET PROC IEN', [ORIEN]);
641end;
642
643function GetProcedureServices(ProcIEN: integer): TStrings;
644begin
645 CallV('ORQQCN GET PROC SVCS',[ProcIEN]) ;
646 Result := RPCBrokerV.Results;
647end;
648
649function ConsultCanBeResubmitted(ConsultIEN: integer): string;
650begin
651 Result := sCallV('ORQQCN CANEDIT', [ConsultIEN]);
652end;
653
654function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
655var
656 Dest: TStringList;
657 EditRec: TEditResubmitRec;
658begin
659 Dest := TStringList.Create;
660 try
661 tCallV(Dest, 'ORQQCN LOAD FOR EDIT',[ConsultIEN]) ;
662 with EditRec do
663 begin
664 Changed := False;
665 IEN := ConsultIEN;
666 ToService := StrToIntDef(Piece(ExtractDefault(Dest, 'SERVICE'), U, 2), 0);
667 RequestType := Piece(ExtractDefault(Dest, 'TYPE'), U, 3);
668 OrderableItem := StrToIntDef(Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 1), 0);
669 ConsultProc := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 3);
670 ConsultProcName := Piece(ExtractDefault(Dest, 'PROCEDURE'), U, 2);
671 Urgency := StrToIntDef(Piece(ExtractDefault(Dest, 'URGENCY'), U, 3), 0);
672 UrgencyName := Piece(ExtractDefault(Dest, 'URGENCY'), U, 2);
673 EarliestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'EARLIEST'), U, 2), 0);
674 //LatestDate := StrToFloatDef(Piece(ExtractDefault(Dest, 'LATEST'), U, 2), 0); //dropped requirement WAT
675 Place := Piece(ExtractDefault(Dest, 'PLACE'), U, 1);
676 PlaceName := Piece(ExtractDefault(Dest, 'PLACE'), U, 2);
677 Attention := StrToInt64Def(Piece(ExtractDefault(Dest, 'ATTENTION'), U, 1), 0);
678 AttnName := Piece(ExtractDefault(Dest, 'ATTENTION'), U, 2);
679 InpOutp := Piece(ExtractDefault(Dest, 'CATEGORY'), U, 1);
680 ProvDiagnosis := Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 1);
681 ProvDxCode := Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 2);
682 ProvDxCodeInactive := (Piece(ExtractDefault(Dest, 'DIAGNOSIS'), U, 3) = '1');
683 RequestReason := TStringList.Create;
684 ExtractText(RequestReason, Dest, 'REASON');
685 LimitStringLength(RequestReason, 74);
686 DenyComments := TStringList.Create;
687 ExtractText(DenyComments, Dest, 'DENY COMMENT');
688 OtherComments := TStringList.Create;
689 ExtractText(OtherComments, Dest, 'ADDED COMMENT');
690 NewComments := TStringList.Create;
691 end;
692 Result := EditRec;
693 finally
694 Dest.Free;
695 end;
696end;
697
698function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
699var
700 i: integer;
701begin
702 with RPCBrokerV, EditResubmitRec do
703 begin
704 ClearParameters := True;
705 RemoteProcedure := 'ORQQCN RESUBMIT';
706 Param[0].PType := literal;
707 Param[0].Value := IntToStr(IEN);
708 Param[1].PType := list;
709 with Param[1] do
710 begin
711 if ToService > 0 then
712 Mult['1'] := 'GMRCSS^' + IntToStr(ToService);
713 if ConsultProc <> '' then
714 Mult['2'] := 'GMRCPROC^' + ConsultProc ;
715 if Urgency > 0 then
716 Mult['3'] := 'GMRCURG^' + IntToStr(Urgency);
717 if Length(Place) > 0 then
718 Mult['4'] := 'GMRCPL^' + Place;
719 if Attention > 0 then
720 Mult['5'] := 'GMRCATN^' + IntToStr(Attention)
721 else if Attention = -1 then
722 Mult['5'] := 'GMRCATN^' + '@';
723 if RequestType <> '' then
724 Mult['6'] := 'GMRCRQT^' + RequestType;
725 if Length(InpOutP) > 0 then
726 Mult['7'] := 'GMRCION^' + InpOutp;
727 if Length(ProvDiagnosis) > 0 then
728 Mult['8'] := 'GMRCDIAG^' + ProvDiagnosis + U + ProvDxCode;
729 if RequestReason.Count > 0 then
730 begin
731 Mult['9'] := 'GMRCRFQ^20';
732 for i := 0 to RequestReason.Count - 1 do
733 Mult['9,' + IntToStr(i+1)] := RequestReason.Strings[i];
734 end;
735 if NewComments.Count > 0 then
736 begin
737 Mult['10'] := 'COMMENT^';
738 for i := 0 to NewComments.Count - 1 do
739 Mult['10,' + IntToStr(i+1)] := NewComments.Strings[i];
740 end;
741 if EarliestDate > 0 then
742 Mult['11'] := 'GMRCERDT^' + FloatToStr(EarliestDate); //wat renamed v28
743 {if LatestDate > 0 then
744 Mult['12'] := 'GMRCLATE^' + FloatToStr(LatestDate);} //dropped requirement WAT
745 end;
746 CallBroker;
747 Result := '0';
748 //Result := Results[0];
749 end;
750end;
751
752function GetCurrentContext: TSelectContext;
753var
754 x: string;
755 AContext: TSelectContext;
756begin
757 x := sCallV('ORQQCN2 GET CONTEXT', [User.DUZ]) ;
758 with AContext do
759 begin
760 Changed := True;
761 BeginDate := Piece(x, ';', 1);
762 EndDate := Piece(x, ';', 2);
763 Status := Piece(x, ';', 3);
764 Service := Piece(x, ';', 4);
765 GroupBy := Piece(x, ';', 5);
766 Ascending := (Piece(x, ';', 6) = '1');
767 end;
768 Result := AContext;
769end;
770
771procedure SaveCurrentContext(AContext: TSelectContext) ;
772var
773 x: string;
774begin
775 with AContext do
776 begin
777 SetPiece(x, ';', 1, BeginDate);
778 SetPiece(x, ';', 2, EndDate);
779 SetPiece(x, ';', 3, Status);
780 SetPiece(x, ';', 4, Service);
781 SetPiece(x, ';', 5, GroupBy);
782 SetPiece(x, ';', 6, BOOLCHAR[Ascending]);
783 end;
784 CallV('ORQQCN2 SAVE CONTEXT', [x]);
785end;
786
787function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
788begin
789 CallV('ORQQCN DEFAULT REQUEST REASON',[Service, Patient.DFN, Resolve]) ;
790 Result := RPCBrokerV.Results;
791end;
792
793function ReasonForRequestEditable(Service: string): string;
794begin
795 Result := sCallV('ORQQCN EDIT DEFAULT REASON', [Service]);
796end;
797
798function GetServicePrerequisites(Service: string): TStrings;
799begin
800 CallV('ORQQCN2 GET PREREQUISITE',[Service, Patient.DFN]) ;
801 Result := RPCBrokerV.Results;
802end;
803
804function GetNewDialog(OrderType: string): string;
805{ get dialog for new consults}
806begin
807 Result := sCallV('ORWDCN32 NEWDLG', [OrderType, Encounter.Location]);
808end;
809
810function GetServiceIEN(ORIEN: string): string;
811begin
812 Result := sCallV('ORQQCN GET SERVICE IEN', [ORIEN]);
813end;
814
815procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
816var
817 x: string;
818begin
819 x := sCallV('ORQQCN PROVDX', [SvcIEN]);
820 ProvDx.Reqd := Piece(x, U, 1);
821 ProvDx.PromptMode := Piece(x, U, 2);
822end;
823
824function GetConsultOrderIEN(ConsultIEN: integer): string;
825begin
826 Result := sCallV('ORQQCN GET ORDER NUMBER', [ConsultIEN]);
827end;
828
829function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
830var
831 x: string;
832 AnEditRec: TEditNoteRec;
833begin
834 x := sCallV('ORWTIU GET SAVED CP FIELDS', [NoteIEN]);
835 with AnEditRec do
836 begin
837 Author := StrToInt64Def(Piece(x, U, 1), 0);
838 Cosigner := StrToInt64Def(Piece(x, U, 2), 0);
839 ClinProcSummCode := StrToIntDef(Piece(x, U, 3), 0);
840 ClinProcDateTime := StrToFMDateTime(Piece(x, U, 4));
841 Title := StrToIntDef(Piece(x, U, 5), 0);
842 DateTime := StrToFloatDef(Piece(x, U, 6), 0);
843 end;
844 Result := AnEditRec;
845end;
846
847function IsProstheticsService(SvcIen : int64) : string; //wat v28
848 begin
849 Result := sCallV('ORQQCN ISPROSVC', [SvcIen]);
850 end;
851
852initialization
853 uLastOrderedIEN := 0;
854 uLastOrderMsg := '';
855 uConsultsClass := 0;
856 uClinProcClass := 0;
857
858finalization
859 if uConsultTitles <> nil then uConsultTitles.Free;
860 if uClinProcTitles <> nil then uClinProcTitles.Free;
861
862end.
Note: See TracBrowser for help on using the repository browser.