[453] | 1 | //kt -- Modified with SourceScanner on 8/8/2007
|
---|
| 2 | unit rConsults;
|
---|
| 3 |
|
---|
| 4 | interface
|
---|
| 5 |
|
---|
| 6 | uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, uConsults, rTIU, uTIU;
|
---|
| 7 |
|
---|
| 8 | type
|
---|
| 9 |
|
---|
| 10 | TUnresolvedConsults = record
|
---|
| 11 | UnresolvedConsultsExist: boolean;
|
---|
| 12 | ShowNagScreen: boolean;
|
---|
| 13 | end;
|
---|
| 14 |
|
---|
| 15 | {Consult Titles }
|
---|
| 16 | function DfltConsultTitle: integer;
|
---|
| 17 | function DfltConsultTitleName: string;
|
---|
| 18 | function DfltClinProcTitle: integer;
|
---|
| 19 | function DfltClinProcTitleName: string;
|
---|
| 20 | function IdentifyConsultsClass: integer;
|
---|
| 21 | function IdentifyClinProcClass: integer;
|
---|
| 22 | procedure ListConsultTitlesShort(Dest: TStrings);
|
---|
| 23 | procedure ListClinProcTitlesShort(Dest: TStrings);
|
---|
| 24 | function SubSetOfConsultTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
|
---|
| 25 | function SubSetOfClinProcTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
|
---|
| 26 | procedure ResetConsultTitles;
|
---|
| 27 | procedure ResetClinProcTitles;
|
---|
| 28 |
|
---|
| 29 | { Data Retrieval }
|
---|
| 30 | procedure GetConsultsList(Dest: TStrings; Early, Late: double;
|
---|
| 31 | Service, Status: string; SortAscending: Boolean);
|
---|
| 32 | procedure LoadConsultDetail(Dest: TStrings; IEN: integer) ;
|
---|
| 33 | function GetCurrentContext: TSelectContext;
|
---|
| 34 | procedure SaveCurrentContext(AContext: TSelectContext) ;
|
---|
| 35 | procedure DisplayResults(Dest: TStrings; IEN: integer) ;
|
---|
| 36 | procedure GetConsultRec(IEN: integer) ;
|
---|
| 37 | function ShowSF513(ConsultIEN: integer): TStrings ;
|
---|
| 38 | procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
|
---|
| 39 | var ErrMsg: string);
|
---|
| 40 | function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
|
---|
| 41 | function UnresolvedConsultsExist: boolean;
|
---|
| 42 | procedure GetUnresolvedConsultsInfo;
|
---|
| 43 |
|
---|
| 44 | {list box fillers}
|
---|
| 45 | function SubSetOfStatus: TStrings;
|
---|
| 46 | function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
|
---|
| 47 | function LoadServiceList(Purpose: integer): TStrings ;
|
---|
| 48 | function LoadServiceListWithSynonyms(Purpose: integer): TStrings ; overload;
|
---|
| 49 | function LoadServiceListWithSynonyms(Purpose, ConsultIEN: integer): TStrings ; overload;
|
---|
| 50 | function SubSetOfServices(const StartFrom: string; Direction: Integer): TStrings;
|
---|
| 51 | function FindConsult(ConsultIEN: integer): string ;
|
---|
| 52 |
|
---|
| 53 | {user access level functions}
|
---|
| 54 | function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
|
---|
| 55 | function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
|
---|
| 56 |
|
---|
| 57 | {consult result functions}
|
---|
| 58 | function GetAssignableMedResults(ConsultIEN: integer): TStrings;
|
---|
| 59 | function GetRemovableMedResults(ConsultIEN: integer): TStrings;
|
---|
| 60 | function GetDetailedMedicineResults(ResultID: string): TStrings;
|
---|
| 61 | procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
|
---|
| 62 | procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
|
---|
| 63 |
|
---|
| 64 | {Consult Request Actions}
|
---|
| 65 | procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
|
---|
| 66 | procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
|
---|
| 67 | AlertTo: string; Comments: TStrings);
|
---|
| 68 | procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
|
---|
| 69 | DiscontinueDate: TFMDateTime; Comments: TStrings);
|
---|
| 70 | procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
|
---|
| 71 | DenialDate: TFMDateTime; Comments: TStrings);
|
---|
| 72 | procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64;
|
---|
| 73 | Urgency: integer; ActionDate: TFMDateTime; Comments: TStrings);
|
---|
| 74 | procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
|
---|
| 75 | AlertTo: string) ;
|
---|
| 76 | procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime;Alert: integer;
|
---|
| 77 | AlertTo: string) ;
|
---|
| 78 | procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
|
---|
| 79 | RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
|
---|
| 80 |
|
---|
| 81 | { Consults Ordering Calls }
|
---|
| 82 | function ODForConsults: TStrings;
|
---|
| 83 | function ODForProcedures: TStrings;
|
---|
| 84 | function ConsultMessage(AnIEN: Integer): string;
|
---|
| 85 | function LoadConsultsQuickList: TStrings ;
|
---|
| 86 | function GetProcedureServices(ProcIEN: integer): TStrings;
|
---|
| 87 | function ConsultCanBeResubmitted(ConsultIEN: integer): string;
|
---|
| 88 | function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
|
---|
| 89 | function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
|
---|
| 90 | function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
|
---|
| 91 | function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
|
---|
| 92 | function ReasonForRequestEditable(Service: string): string;
|
---|
| 93 | function GetNewDialog(OrderType: string): string;
|
---|
| 94 | function GetServiceIEN(ORIEN: string): string;
|
---|
| 95 | function GetProcedureIEN(ORIEN: string): string;
|
---|
| 96 | function GetConsultOrderIEN(ConsultIEN: integer): string;
|
---|
| 97 | function GetServicePrerequisites(Service: string): TStrings;
|
---|
| 98 | procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
|
---|
| 99 |
|
---|
| 100 | { Clinical Procedures Specific}
|
---|
| 101 | function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
|
---|
| 102 |
|
---|
| 103 | var
|
---|
| 104 | uConsultsClass: integer;
|
---|
| 105 | uConsultTitles: TConsultTitles;
|
---|
| 106 | uClinProcClass: integer;
|
---|
| 107 | uClinProcTitles: TClinProcTitles;
|
---|
| 108 | uUnresolvedConsults: TUnresolvedConsults;
|
---|
| 109 |
|
---|
| 110 | implementation
|
---|
| 111 |
|
---|
| 112 | uses rODBase;
|
---|
| 113 |
|
---|
| 114 | var
|
---|
| 115 | uLastOrderedIEN: Integer;
|
---|
| 116 | uLastOrderMsg: string;
|
---|
| 117 |
|
---|
| 118 | { -------------------------- Consult Titles --------------------------------- }
|
---|
| 119 |
|
---|
| 120 | function IdentifyConsultsClass: integer;
|
---|
| 121 | begin
|
---|
| 122 | if uConsultsClass = 0 then
|
---|
| 123 | uConsultsClass := StrToIntDef(sCallV('TIU IDENTIFY CONSULTS CLASS',[nil]), 0) ;
|
---|
| 124 | Result := uConsultsClass;
|
---|
| 125 | end;
|
---|
| 126 |
|
---|
| 127 | procedure LoadConsultTitles;
|
---|
| 128 | { private - called one time to set up the uConsultTitles object }
|
---|
| 129 | var
|
---|
| 130 | x: string;
|
---|
| 131 | begin
|
---|
| 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);
|
---|
| 140 | end;
|
---|
| 141 |
|
---|
| 142 | procedure ResetConsultTitles;
|
---|
| 143 | begin
|
---|
| 144 | if uConsultTitles <> nil then
|
---|
| 145 | begin
|
---|
| 146 | uConsultTitles.Free;
|
---|
| 147 | uConsultTitles := nil;
|
---|
| 148 | LoadConsultTitles;
|
---|
| 149 | end;
|
---|
| 150 | end;
|
---|
| 151 |
|
---|
| 152 | function DfltConsultTitle: integer;
|
---|
| 153 | { returns the user defined default Consult title (if any) }
|
---|
| 154 | begin
|
---|
| 155 | if uConsultTitles = nil then LoadConsultTitles;
|
---|
| 156 | Result := uConsultTitles.DfltTitle;
|
---|
| 157 | end;
|
---|
| 158 |
|
---|
| 159 | function DfltConsultTitleName: string;
|
---|
| 160 | { returns the name of the user defined default progress note title (if any) }
|
---|
| 161 | begin
|
---|
| 162 | if uConsultTitles = nil then LoadConsultTitles;
|
---|
| 163 | Result := uConsultTitles.DfltTitleName;
|
---|
| 164 | end;
|
---|
| 165 |
|
---|
| 166 | procedure ListConsultTitlesShort(Dest: TStrings);
|
---|
| 167 | { returns the user defined list (short list) of Consult titles }
|
---|
| 168 | begin
|
---|
| 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;
|
---|
| 176 | end;
|
---|
| 177 |
|
---|
| 178 | function 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! }
|
---|
| 182 | begin
|
---|
| 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;
|
---|
| 189 | end;
|
---|
| 190 |
|
---|
| 191 |
|
---|
| 192 | { -------------------------- Clinical Procedures Titles --------------------------------- }
|
---|
| 193 | function IdentifyClinProcClass: integer;
|
---|
| 194 | begin
|
---|
| 195 | if uClinProcClass = 0 then
|
---|
| 196 | uClinProcClass := StrToIntDef(sCallV('TIU IDENTIFY CLINPROC CLASS',[nil]), 0) ;
|
---|
| 197 | Result := uClinProcClass;
|
---|
| 198 | end;
|
---|
| 199 |
|
---|
| 200 | procedure LoadClinProcTitles;
|
---|
| 201 | { private - called one time to set up the uConsultTitles object }
|
---|
| 202 | var
|
---|
| 203 | x: string;
|
---|
| 204 | begin
|
---|
| 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);
|
---|
| 213 | end;
|
---|
| 214 |
|
---|
| 215 | procedure ResetClinProcTitles;
|
---|
| 216 | begin
|
---|
| 217 | if uClinProcTitles <> nil then
|
---|
| 218 | begin
|
---|
| 219 | uClinProcTitles.Free;
|
---|
| 220 | uClinProcTitles := nil;
|
---|
| 221 | LoadClinProcTitles;
|
---|
| 222 | end;
|
---|
| 223 | end;
|
---|
| 224 |
|
---|
| 225 | function DfltClinProcTitle: integer;
|
---|
| 226 | { returns the user defined default ClinProc title (if any) }
|
---|
| 227 | begin
|
---|
| 228 | if uClinProcTitles = nil then LoadClinProcTitles;
|
---|
| 229 | Result := uClinProcTitles.DfltTitle;
|
---|
| 230 | end;
|
---|
| 231 |
|
---|
| 232 | function DfltClinProcTitleName: string;
|
---|
| 233 | { returns the name of the user defined default progress note title (if any) }
|
---|
| 234 | begin
|
---|
| 235 | if uClinProcTitles = nil then LoadClinProcTitles;
|
---|
| 236 | Result := uClinProcTitles.DfltTitleName;
|
---|
| 237 | end;
|
---|
| 238 |
|
---|
| 239 | procedure ListClinProcTitlesShort(Dest: TStrings);
|
---|
| 240 | { returns the user defined list (short list) of ClinProc titles }
|
---|
| 241 | begin
|
---|
| 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;
|
---|
| 249 | end;
|
---|
| 250 |
|
---|
| 251 | function 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! }
|
---|
| 255 | begin
|
---|
| 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;
|
---|
| 262 | end;
|
---|
| 263 |
|
---|
| 264 | {--------------- data retrieval ------------------------------------------}
|
---|
| 265 |
|
---|
| 266 | procedure 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}
|
---|
| 269 | var
|
---|
| 270 | i: Integer;
|
---|
| 271 | x, date1, date2: string;
|
---|
| 272 | begin
|
---|
| 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;
|
---|
| 296 | end;
|
---|
| 297 |
|
---|
| 298 | procedure LoadConsultDetail(Dest: TStrings; IEN: integer) ;
|
---|
| 299 | { returns the detail of a consult }
|
---|
| 300 | begin
|
---|
| 301 | CallV('ORQQCN DETAIL', [IEN]);
|
---|
| 302 | Dest.Assign(RPCBrokerV.Results);
|
---|
| 303 | end;
|
---|
| 304 |
|
---|
| 305 | procedure DisplayResults(Dest: TStrings; IEN: integer) ;
|
---|
| 306 | { returns the results for a consult }
|
---|
| 307 | begin
|
---|
| 308 | CallV('ORQQCN MED RESULTS', [IEN]);
|
---|
| 309 | Dest.Assign(RPCBrokerV.Results);
|
---|
| 310 | end;
|
---|
| 311 |
|
---|
| 312 | procedure GetConsultRec(IEN: integer);
|
---|
| 313 | {returns zero node from file 123, plus a list of all related TIU documents, if any}
|
---|
| 314 | const
|
---|
| 315 | SHOW_ADDENDA = True;
|
---|
| 316 |
|
---|
| 317 | var
|
---|
| 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}
|
---|
| 325 | begin
|
---|
| 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 ;
|
---|
| 377 | end ;
|
---|
| 378 |
|
---|
| 379 | {---------------- list box fillers -----------------------------------}
|
---|
| 380 |
|
---|
| 381 | function SubSetOfStatus: TStrings;
|
---|
| 382 | { returns a pointer to a list of stati (for use in a list box) }
|
---|
| 383 | begin
|
---|
| 384 | CallV('ORQQCN STATUS', [nil]);
|
---|
| 385 | MixedCaseList(RPCBrokerV.Results);
|
---|
| 386 | Result := RPCBrokerV.Results;
|
---|
| 387 | end;
|
---|
| 388 |
|
---|
| 389 | function SubSetOfUrgencies(ConsultIEN: integer): TStrings;
|
---|
| 390 | { returns a pointer to a list of urgencies }
|
---|
| 391 | begin
|
---|
| 392 | CallV('ORQQCN URGENCIES',[ConsultIEN]) ;
|
---|
| 393 | MixedCaseList(RPCBrokerV.Results);
|
---|
| 394 | Result := RPCBrokerV.Results;
|
---|
| 395 | end;
|
---|
| 396 |
|
---|
| 397 | function FindConsult(ConsultIEN: integer): string ;
|
---|
| 398 | var
|
---|
| 399 | x: string;
|
---|
| 400 | begin
|
---|
| 401 | x := sCallV('ORQQCN FIND CONSULT',[ConsultIEN]);
|
---|
| 402 | Result := MakeConsultListItem(x);
|
---|
| 403 | end;
|
---|
| 404 |
|
---|
| 405 | {-----------------consult result functions-----------------------------------}
|
---|
| 406 | function GetAssignableMedResults(ConsultIEN: integer): TStrings;
|
---|
| 407 | begin
|
---|
| 408 | CallV('ORQQCN ASSIGNABLE MED RESULTS', [ConsultIEN]);
|
---|
| 409 | Result := RPCBrokerV.Results;
|
---|
| 410 | end;
|
---|
| 411 |
|
---|
| 412 | function GetRemovableMedResults(ConsultIEN: integer): TStrings;
|
---|
| 413 | begin
|
---|
| 414 | CallV('ORQQCN REMOVABLE MED RESULTS', [ConsultIEN]);
|
---|
| 415 | Result := RPCBrokerV.Results;
|
---|
| 416 | end;
|
---|
| 417 |
|
---|
| 418 | function GetDetailedMedicineResults(ResultID: string): TStrings;
|
---|
| 419 | begin
|
---|
| 420 | CallV('ORQQCN GET MED RESULT DETAILS', [ResultID]);
|
---|
| 421 | Result := RPCBrokerV.Results;
|
---|
| 422 | end;
|
---|
| 423 |
|
---|
| 424 | procedure AttachMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64; AlertTo: string);
|
---|
| 425 | begin
|
---|
| 426 | CallV('ORQQCN ATTACH MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson, AlertTo]);
|
---|
| 427 | end;
|
---|
| 428 |
|
---|
| 429 | procedure RemoveMedicineResult(ConsultIEN: integer; ResultID: string; DateTime: TFMDateTime; ResponsiblePerson: int64);
|
---|
| 430 | begin
|
---|
| 431 | CallV('ORQQCN REMOVE MED RESULTS', [ConsultIEN, ResultID, DateTime, ResponsiblePerson]);
|
---|
| 432 | end;
|
---|
| 433 | {-------------- user access level functions ---------------------------------}
|
---|
| 434 |
|
---|
| 435 | function ConsultServiceUser(ServiceIEN: integer; DUZ: int64): boolean ;
|
---|
| 436 | var
|
---|
| 437 | i: integer ;
|
---|
| 438 | begin
|
---|
| 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 ;
|
---|
| 443 | end ;
|
---|
| 444 |
|
---|
| 445 | function GetActionMenuLevel(ConsultIEN: integer): TMenuAccessRec ;
|
---|
| 446 | var
|
---|
| 447 | x: string;
|
---|
| 448 | begin
|
---|
| 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);
|
---|
| 456 | end ;
|
---|
| 457 |
|
---|
| 458 | {------------------- Consult request actions -------------------------------}
|
---|
| 459 |
|
---|
| 460 | procedure ReceiveConsult(Dest: TStrings; IEN: integer; ReceivedBy: int64; RcptDate: TFMDateTime; Comments: TStrings);
|
---|
| 461 | begin
|
---|
| 462 | CallV('ORQQCN RECEIVE', [IEN, ReceivedBy, RcptDate, Comments]);
|
---|
| 463 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 464 | end;
|
---|
| 465 |
|
---|
| 466 | procedure ScheduleConsult(Dest: TStrings; IEN: integer; ScheduledBy: Int64; SchdDate: TFMDateTime; Alert: integer;
|
---|
| 467 | AlertTo: string; Comments: TStrings);
|
---|
| 468 | begin
|
---|
| 469 | CallV('ORQQCN2 SCHEDULE CONSULT', [IEN, ScheduledBy, SchdDate, Alert, AlertTo, Comments]);
|
---|
| 470 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 471 | end;
|
---|
| 472 |
|
---|
| 473 | procedure DenyConsult(Dest: TStrings; IEN: integer; DeniedBy: int64;
|
---|
| 474 | DenialDate: TFMDateTime; Comments: TStrings);
|
---|
| 475 | begin
|
---|
| 476 | CallV('ORQQCN DISCONTINUE', [IEN, DeniedBy, DenialDate,'DY',Comments]);
|
---|
| 477 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 478 | end;
|
---|
| 479 |
|
---|
| 480 | procedure DiscontinueConsult(Dest: TStrings; IEN: integer; DiscontinuedBy: int64;
|
---|
| 481 | DiscontinueDate: TFMDateTime; Comments: TStrings);
|
---|
| 482 | begin
|
---|
| 483 | CallV('ORQQCN DISCONTINUE', [IEN, DiscontinuedBy, DiscontinueDate,'DC',Comments]);
|
---|
| 484 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 485 | end;
|
---|
| 486 |
|
---|
| 487 | procedure ForwardConsult(Dest: TStrings; IEN, ToService: integer; Forwarder, AttentionOf: int64; Urgency: integer;
|
---|
| 488 | ActionDate: TFMDateTime; Comments: TStrings);
|
---|
| 489 | begin
|
---|
| 490 | CallV('ORQQCN FORWARD', [IEN, ToService, Forwarder, AttentionOf, Urgency, ActionDate, Comments]);
|
---|
| 491 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 492 | end ;
|
---|
| 493 |
|
---|
| 494 | procedure AddComment(Dest: TStrings; IEN: integer; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
|
---|
| 495 | AlertTo: string) ;
|
---|
| 496 | begin
|
---|
| 497 | CallV('ORQQCN ADDCMT', [IEN, Comments, Alert, AlertTo, ActionDate]);
|
---|
| 498 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 499 | end ;
|
---|
| 500 |
|
---|
| 501 | procedure AdminComplete(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings;
|
---|
| 502 | RespProv: Int64; ActionDate: TFMDateTime; Alert: integer; AlertTo: string) ;
|
---|
| 503 | begin
|
---|
| 504 | CallV('ORQQCN ADMIN COMPLETE', [IEN, SigFindingsFlag, Comments, RespProv, Alert, AlertTo, ActionDate]);
|
---|
| 505 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 506 | end ;
|
---|
| 507 |
|
---|
| 508 | procedure SigFindings(Dest: TStrings; IEN: integer; SigFindingsFlag: string; Comments: TStrings; ActionDate: TFMDateTime; Alert: integer;
|
---|
| 509 | AlertTo: string) ;
|
---|
| 510 | begin
|
---|
| 511 | CallV('ORQQCN SIGFIND', [IEN, SigFindingsFlag, Comments, Alert, AlertTo, ActionDate]);
|
---|
| 512 | Dest.Assign(RPCBrokerV.Results); {1^Error message' or '0'}
|
---|
| 513 | end ;
|
---|
| 514 |
|
---|
| 515 | //================== Ordering functions ===================================
|
---|
| 516 | function ODForConsults: TStrings;
|
---|
| 517 | { Returns init values for consults dialog. The results must be used immediately. }
|
---|
| 518 | begin
|
---|
| 519 | CallV('ORWDCN32 DEF', ['C']);
|
---|
| 520 | Result := RPCBrokerV.Results;
|
---|
| 521 | end;
|
---|
| 522 |
|
---|
| 523 | function ODForProcedures: TStrings;
|
---|
| 524 | { Returns init values for procedures dialog. The results must be used immediately. }
|
---|
| 525 | begin
|
---|
| 526 | CallV('ORWDCN32 DEF', ['P']);
|
---|
| 527 | Result := RPCBrokerV.Results;
|
---|
| 528 | end;
|
---|
| 529 |
|
---|
| 530 | function SubSetOfProcedures(const StartFrom: string; Direction: Integer): TStrings;
|
---|
| 531 | begin
|
---|
| 532 | begin
|
---|
| 533 | CallV('ORWDCN32 PROCEDURES', [StartFrom, Direction]);
|
---|
| 534 | Result := RPCBrokerV.Results;
|
---|
| 535 | end;
|
---|
| 536 | end;
|
---|
| 537 |
|
---|
| 538 | function LoadServiceList(Purpose: integer): TStrings ;
|
---|
| 539 | // Purpose: 0=display all services, 1=forward or order from possible services
|
---|
| 540 | begin
|
---|
| 541 | Callv('ORQQCN SVCTREE',[Purpose]) ;
|
---|
| 542 | MixedCaseList(RPCBrokerV.Results) ;
|
---|
| 543 | Result := RPCBrokerV.Results;
|
---|
| 544 | end ;
|
---|
| 545 |
|
---|
| 546 | function 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
|
---|
| 550 | begin
|
---|
| 551 | Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True]) ;
|
---|
| 552 | MixedCaseList(RPCBrokerV.Results) ;
|
---|
| 553 | Result := RPCBrokerV.Results;
|
---|
| 554 | end ;
|
---|
| 555 |
|
---|
| 556 | function 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
|
---|
| 561 | begin
|
---|
| 562 | Callv('ORQQCN SVC W/SYNONYMS',[1, Purpose, True, ConsultIEN]) ;
|
---|
| 563 | MixedCaseList(RPCBrokerV.Results) ;
|
---|
| 564 | Result := RPCBrokerV.Results;
|
---|
| 565 | end ;
|
---|
| 566 |
|
---|
| 567 | function 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
|
---|
| 569 | begin
|
---|
| 570 | CallV('ORQQCN SVCLIST', [StartFrom, Direction]);
|
---|
| 571 | Result := RPCBrokerV.Results;
|
---|
| 572 | end;
|
---|
| 573 |
|
---|
| 574 | function LoadConsultsQuickList: TStrings ;
|
---|
| 575 | begin
|
---|
| 576 | Callv('ORWDXQ GETQLST',['CSLT', 'Q']) ;
|
---|
| 577 | Result := RPCBrokerV.Results;
|
---|
| 578 | end ;
|
---|
| 579 |
|
---|
| 580 | function ShowSF513(ConsultIEN: integer): TStrings ;
|
---|
| 581 | var
|
---|
| 582 | x: string;
|
---|
| 583 | i: integer;
|
---|
| 584 | begin
|
---|
| 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;
|
---|
| 594 | end ;
|
---|
| 595 |
|
---|
| 596 | procedure PrintSF513ToDevice(AConsult: Integer; const ADevice: string; ChartCopy: string;
|
---|
| 597 | var ErrMsg: string);
|
---|
| 598 | { prints a SF 513 on the selected device }
|
---|
| 599 | begin
|
---|
| 600 | ErrMsg := sCallV('ORQQCN PRINT SF513', [AConsult, ChartCopy, ADevice]);
|
---|
| 601 | // if Piece(ErrMsg, U, 1) = '0' then ErrMsg := '' else ErrMsg := Piece(ErrMsg, U, 2);
|
---|
| 602 | end;
|
---|
| 603 |
|
---|
| 604 | function GetFormattedSF513(AConsult: Integer; ChartCopy: string): TStrings;
|
---|
| 605 | begin
|
---|
| 606 | CallV('ORQQCN SF513 WINDOWS PRINT',[AConsult, ChartCopy]);
|
---|
| 607 | Result := RPCBrokerV.Results;
|
---|
| 608 | end;
|
---|
| 609 |
|
---|
| 610 | function UnresolvedConsultsExist: boolean;
|
---|
| 611 | begin
|
---|
| 612 | Result := (sCallV('ORQQCN UNRESOLVED', [Patient.DFN]) = '1');
|
---|
| 613 | end;
|
---|
| 614 |
|
---|
| 615 | procedure GetUnresolvedConsultsInfo;
|
---|
| 616 | var
|
---|
| 617 | x: string;
|
---|
| 618 | begin
|
---|
| 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;
|
---|
| 625 | end;
|
---|
| 626 |
|
---|
| 627 | function ConsultMessage(AnIEN: Integer): string;
|
---|
| 628 | begin
|
---|
| 629 | if AnIEN = uLastOrderedIEN then Result := uLastOrderMsg else
|
---|
| 630 | begin
|
---|
| 631 | Result := sCallV('ORWDCN32 ORDRMSG', [AnIEN]);
|
---|
| 632 | uLastOrderedIEN := AnIEN;
|
---|
| 633 | uLastOrderMsg := Result;
|
---|
| 634 | end;
|
---|
| 635 | end;
|
---|
| 636 |
|
---|
| 637 | function GetProcedureIEN(ORIEN: string): string;
|
---|
| 638 | begin
|
---|
| 639 | Result := sCallV('ORQQCN GET PROC IEN', [ORIEN]);
|
---|
| 640 | end;
|
---|
| 641 |
|
---|
| 642 | function GetProcedureServices(ProcIEN: integer): TStrings;
|
---|
| 643 | begin
|
---|
| 644 | CallV('ORQQCN GET PROC SVCS',[ProcIEN]) ;
|
---|
| 645 | Result := RPCBrokerV.Results;
|
---|
| 646 | end;
|
---|
| 647 |
|
---|
| 648 | function ConsultCanBeResubmitted(ConsultIEN: integer): string;
|
---|
| 649 | begin
|
---|
| 650 | Result := sCallV('ORQQCN CANEDIT', [ConsultIEN]);
|
---|
| 651 | end;
|
---|
| 652 |
|
---|
| 653 | function LoadConsultForEdit(ConsultIEN: integer): TEditResubmitRec;
|
---|
| 654 | var
|
---|
| 655 | Dest: TStringList;
|
---|
| 656 | EditRec: TEditResubmitRec;
|
---|
| 657 | begin
|
---|
| 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;
|
---|
| 693 | end;
|
---|
| 694 |
|
---|
| 695 | function ResubmitConsult(EditResubmitRec: TEditResubmitRec): string;
|
---|
| 696 | var
|
---|
| 697 | i: integer;
|
---|
| 698 | begin
|
---|
| 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;
|
---|
| 743 | end;
|
---|
| 744 |
|
---|
| 745 | function GetCurrentContext: TSelectContext;
|
---|
| 746 | var
|
---|
| 747 | x: string;
|
---|
| 748 | AContext: TSelectContext;
|
---|
| 749 | begin
|
---|
| 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;
|
---|
| 762 | end;
|
---|
| 763 |
|
---|
| 764 | procedure SaveCurrentContext(AContext: TSelectContext) ;
|
---|
| 765 | var
|
---|
| 766 | x: string;
|
---|
| 767 | begin
|
---|
| 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]);
|
---|
| 778 | end;
|
---|
| 779 |
|
---|
| 780 | function GetDefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
|
---|
| 781 | begin
|
---|
| 782 | CallV('ORQQCN DEFAULT REQUEST REASON',[Service, Patient.DFN, Resolve]) ;
|
---|
| 783 | Result := RPCBrokerV.Results;
|
---|
| 784 | end;
|
---|
| 785 |
|
---|
| 786 | function ReasonForRequestEditable(Service: string): string;
|
---|
| 787 | begin
|
---|
| 788 | Result := sCallV('ORQQCN EDIT DEFAULT REASON', [Service]);
|
---|
| 789 | end;
|
---|
| 790 |
|
---|
| 791 | function GetServicePrerequisites(Service: string): TStrings;
|
---|
| 792 | begin
|
---|
| 793 | CallV('ORQQCN2 GET PREREQUISITE',[Service, Patient.DFN]) ;
|
---|
| 794 | Result := RPCBrokerV.Results;
|
---|
| 795 | end;
|
---|
| 796 |
|
---|
| 797 | function GetNewDialog(OrderType: string): string;
|
---|
| 798 | { get dialog for new consults}
|
---|
| 799 | begin
|
---|
| 800 | Result := sCallV('ORWDCN32 NEWDLG', [OrderType, Encounter.Location]);
|
---|
| 801 | end;
|
---|
| 802 |
|
---|
| 803 | function GetServiceIEN(ORIEN: string): string;
|
---|
| 804 | begin
|
---|
| 805 | Result := sCallV('ORQQCN GET SERVICE IEN', [ORIEN]);
|
---|
| 806 | end;
|
---|
| 807 |
|
---|
| 808 | procedure GetProvDxMode(var ProvDx: TProvisionalDiagnosis; SvcIEN: string);
|
---|
| 809 | var
|
---|
| 810 | x: string;
|
---|
| 811 | begin
|
---|
| 812 | x := sCallV('ORQQCN PROVDX', [SvcIEN]);
|
---|
| 813 | ProvDx.Reqd := Piece(x, U, 1);
|
---|
| 814 | ProvDx.PromptMode := Piece(x, U, 2);
|
---|
| 815 | end;
|
---|
| 816 |
|
---|
| 817 | function GetConsultOrderIEN(ConsultIEN: integer): string;
|
---|
| 818 | begin
|
---|
| 819 | Result := sCallV('ORQQCN GET ORDER NUMBER', [ConsultIEN]);
|
---|
| 820 | end;
|
---|
| 821 |
|
---|
| 822 | function GetSavedCPFields(NoteIEN: integer): TEditNoteRec;
|
---|
| 823 | var
|
---|
| 824 | x: string;
|
---|
| 825 | AnEditRec: TEditNoteRec;
|
---|
| 826 | begin
|
---|
| 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;
|
---|
| 837 | end;
|
---|
| 838 |
|
---|
| 839 | initialization
|
---|
| 840 | uLastOrderedIEN := 0;
|
---|
| 841 | uLastOrderMsg := '';
|
---|
| 842 | uConsultsClass := 0;
|
---|
| 843 | uClinProcClass := 0;
|
---|
| 844 |
|
---|
| 845 | finalization
|
---|
| 846 | if uConsultTitles <> nil then uConsultTitles.Free;
|
---|
| 847 | if uClinProcTitles <> nil then uClinProcTitles.Free;
|
---|
| 848 |
|
---|
| 849 | end.
|
---|