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

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

Initial Upload of Official WV CPRS 1.0.26.76

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