[459] | 1 | unit rDCSumm;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, rTIU, uConst, uTIU, uDCSumm;
|
---|
| 6 |
|
---|
| 7 |
|
---|
| 8 | { Discharge Summary Titles }
|
---|
| 9 | procedure ResetDCSummTitles;
|
---|
| 10 | function DfltDCSummTitle: Integer;
|
---|
| 11 | function DfltDCSummTitleName: string;
|
---|
| 12 | procedure ListDCSummTitlesShort(Dest: TStrings);
|
---|
| 13 | function SubSetOfDCSummTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
|
---|
| 14 |
|
---|
| 15 | { TIU Preferences }
|
---|
| 16 | procedure ResetDCSummPreferences;
|
---|
| 17 | function ReturnMaxDCSumms: Integer;
|
---|
| 18 | function SortDCSummsAscending: Boolean;
|
---|
| 19 | function GetCurrentDCSummContext: TTIUContext;
|
---|
| 20 | procedure SaveCurrentDCSummContext(AContext: TTIUContext) ;
|
---|
| 21 |
|
---|
| 22 | { Data Retrieval }
|
---|
| 23 | procedure ActOnDCDocument(var AuthSts: TActionRec; IEN: Integer; const ActionName: string);
|
---|
| 24 | (*procedure ListDischargeSummaries(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
|
---|
| 25 | Person: int64; OccLim: Integer; SortAscending: Boolean);*)
|
---|
| 26 | procedure ListSummsForTree(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
|
---|
| 27 | Person: int64; OccLim: Integer; SortAscending: Boolean);
|
---|
| 28 | procedure GetDCSummForEdit(var EditRec: TEditDCSummRec; IEN: Integer);
|
---|
| 29 | function LoadDCUrgencies: TStrings;
|
---|
| 30 | function GetAttending(const DFN: string): string; //*DFN*
|
---|
| 31 | function GetDischargeDate(const DFN: string; AdmitDateTime: string): string; //*DFN*
|
---|
| 32 | function RequireRelease(ANote, AType: Integer): Boolean;
|
---|
| 33 | function RequireMASVerification(ANote, AType: Integer): Boolean;
|
---|
| 34 | function AllowMultipleSummsPerAdmission(ANote, AType: Integer): Boolean;
|
---|
| 35 |
|
---|
| 36 | { Data Storage }
|
---|
| 37 | procedure DeleteDCDocument(var DeleteSts: TActionRec; IEN: Integer; const Reason: string);
|
---|
| 38 | procedure SignDCDocument(var SignSts: TActionRec; IEN: Integer; const ESCode: string);
|
---|
| 39 | procedure PutNewDCSumm(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec);
|
---|
| 40 | procedure PutDCAddendum(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; AddendumTo:
|
---|
| 41 | Integer);
|
---|
| 42 | procedure PutEditedDCSumm(var UpdatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; NoteIEN:
|
---|
| 43 | Integer);
|
---|
| 44 | procedure ChangeAttending(IEN: integer; AnAttending: int64);
|
---|
| 45 |
|
---|
| 46 | const
|
---|
| 47 | CLS_DC_SUMM = 244;
|
---|
| 48 | FN_HOSPITAL_LOCATION = 44;
|
---|
| 49 | FN_NEW_PERSON = 200;
|
---|
| 50 | TIU_ST_UNREL = 3;
|
---|
| 51 | TIU_ST_UNVER = 4;
|
---|
| 52 | TIU_ST_UNSIG = 5;
|
---|
| 53 |
|
---|
| 54 | implementation
|
---|
| 55 |
|
---|
| 56 | var
|
---|
| 57 | uDCSummTitles: TDCSummTitles;
|
---|
| 58 | uDCSummPrefs: TDCSummPrefs;
|
---|
| 59 |
|
---|
| 60 | { Discharge Summary Titles -------------------------------------------------------------------- }
|
---|
| 61 | procedure LoadDCSummTitles;
|
---|
| 62 | { private - called one time to set up the uNoteTitles object }
|
---|
| 63 | var
|
---|
| 64 | x: string;
|
---|
| 65 | begin
|
---|
| 66 | if uDCSummTitles <> nil then Exit;
|
---|
| 67 | CallV('TIU PERSONAL TITLE LIST', [User.DUZ, CLS_DC_SUMM]);
|
---|
| 68 | RPCBrokerV.Results.Insert(0, '~SHORT LIST'); // insert so can call ExtractItems
|
---|
| 69 | uDCSummTitles := TDCSummTitles.Create;
|
---|
| 70 | ExtractItems(uDCSummTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST');
|
---|
| 71 | x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST');
|
---|
| 72 | uDCSummTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0);
|
---|
| 73 | uDCSummTitles.DfltTitleName := Piece(x, U, 2);
|
---|
| 74 | end;
|
---|
| 75 |
|
---|
| 76 | procedure ResetDCSummTitles;
|
---|
| 77 | begin
|
---|
| 78 | if uDCSummTitles <> nil then
|
---|
| 79 | begin
|
---|
| 80 | uDCSummTitles.Free;
|
---|
| 81 | uDCSummTitles := nil;
|
---|
| 82 | LoadDCSummTitles;
|
---|
| 83 | end;
|
---|
| 84 | end;
|
---|
| 85 |
|
---|
| 86 | function DfltDCSummTitle: Integer;
|
---|
| 87 | { returns the IEN of the user defined default Discharge Summary title (if any) }
|
---|
| 88 | begin
|
---|
| 89 | if uDCSummTitles = nil then LoadDCSummTitles;
|
---|
| 90 | Result := uDCSummTitles.DfltTitle;
|
---|
| 91 | end;
|
---|
| 92 |
|
---|
| 93 | function DfltDCSummTitleName: string;
|
---|
| 94 | { returns the name of the user defined default Discharge Summary title (if any) }
|
---|
| 95 | begin
|
---|
| 96 | if uDCSummTitles = nil then LoadDCSummTitles;
|
---|
| 97 | Result := uDCSummTitles.DfltTitleName;
|
---|
| 98 | end;
|
---|
| 99 |
|
---|
| 100 | procedure ListDCSummTitlesShort(Dest: TStrings);
|
---|
| 101 | { returns the user defined list (short list) of Discharge Summary titles }
|
---|
| 102 | begin
|
---|
| 103 | if uDCSummTitles = nil then LoadDCSummTitles;
|
---|
| 104 | Dest.AddStrings(uDCSummTitles.ShortList);
|
---|
| 105 | if uDCSummTitles.ShortList.Count > 0 then
|
---|
| 106 | begin
|
---|
| 107 | Dest.Add('0^________________________________________________________________________');
|
---|
| 108 | Dest.Add('0^ ');
|
---|
| 109 | end;
|
---|
| 110 | end;
|
---|
| 111 |
|
---|
| 112 | function SubSetOfDCSummTitles(const StartFrom: string; Direction: Integer; IDNoteTitlesOnly: boolean): TStrings;
|
---|
| 113 | { returns a pointer to a list of Discharge Summary titles (for use in a long list box) -
|
---|
| 114 | The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE
|
---|
| 115 | the next broker call! }
|
---|
| 116 | begin
|
---|
| 117 | if IDNoteTitlesOnly then
|
---|
| 118 | CallV('TIU LONG LIST OF TITLES', [CLS_DC_SUMM, StartFrom, Direction, IDNoteTitlesOnly])
|
---|
| 119 | else
|
---|
| 120 | CallV('TIU LONG LIST OF TITLES', [CLS_DC_SUMM, StartFrom, Direction]);
|
---|
| 121 | //MixedCaseList(RPCBrokerV.Results);
|
---|
| 122 | Result := RPCBrokerV.Results;
|
---|
| 123 | end;
|
---|
| 124 |
|
---|
| 125 | { TIU Preferences ------------------------------------------------------------------------- }
|
---|
| 126 |
|
---|
| 127 | procedure LoadDCSummPrefs;
|
---|
| 128 | { private - creates DCSummPrefs object for reference throughout the session }
|
---|
| 129 | var
|
---|
| 130 | x: string;
|
---|
| 131 | begin
|
---|
| 132 | uDCSummPrefs := TDCSummPrefs.Create;
|
---|
| 133 | with uDCSummPrefs do
|
---|
| 134 | begin
|
---|
| 135 | x := sCallV('TIU GET PERSONAL PREFERENCES', [User.DUZ]);
|
---|
| 136 | DfltLoc := StrToIntDef(Piece(x, U, 2), 0);
|
---|
| 137 | DfltLocName := ExternalName(DfltLoc, FN_HOSPITAL_LOCATION);
|
---|
| 138 | SortAscending := Piece(x, U, 4) = 'A';
|
---|
| 139 | MaxSumms := StrToIntDef(Piece(x, U, 10), 0);
|
---|
| 140 | x := GetAttending(Patient.DFN);
|
---|
| 141 | DfltCosigner := StrToInt64Def(Piece(x, U, 1), 0);
|
---|
| 142 | DfltCosignerName := ExternalName(DfltCosigner, FN_NEW_PERSON);
|
---|
| 143 | AskCosigner := User.DUZ <> DfltCosigner;
|
---|
| 144 | end;
|
---|
| 145 | end;
|
---|
| 146 |
|
---|
| 147 | procedure ResetDCSummPreferences;
|
---|
| 148 | begin
|
---|
| 149 | if uDCSummPrefs <> nil then
|
---|
| 150 | begin
|
---|
| 151 | uDCSummPrefs.Free;
|
---|
| 152 | uDCSummPrefs := nil;
|
---|
| 153 | LoadDCSummPrefs;
|
---|
| 154 | end;
|
---|
| 155 | end;
|
---|
| 156 |
|
---|
| 157 | function ReturnMaxDCSumms: Integer;
|
---|
| 158 | begin
|
---|
| 159 | if uDCSummPrefs = nil then LoadDCSummPrefs;
|
---|
| 160 | Result := uDCSummPrefs.MaxSumms;
|
---|
| 161 | if Result = 0 then Result := 100;
|
---|
| 162 | end;
|
---|
| 163 |
|
---|
| 164 | function SortDCSummsAscending: Boolean;
|
---|
| 165 | { returns true if Discharge Summarys should be sorted from oldest to newest (chronological) }
|
---|
| 166 | begin
|
---|
| 167 | if uDCSummPrefs = nil then LoadDCSummPrefs;
|
---|
| 168 | Result := uDCSummPrefs.SortAscending;
|
---|
| 169 | end;
|
---|
| 170 |
|
---|
| 171 | { Data Retrieval --------------------------------------------------------------------------- }
|
---|
| 172 |
|
---|
| 173 | procedure ActOnDCDocument(var AuthSts: TActionRec; IEN: Integer; const ActionName: string);
|
---|
| 174 | var
|
---|
| 175 | x: string;
|
---|
| 176 | begin
|
---|
| 177 | if not (IEN > 0) then
|
---|
| 178 | begin
|
---|
| 179 | AuthSts.Success := True;
|
---|
| 180 | AuthSts.Reason := '';
|
---|
| 181 | Exit;
|
---|
| 182 | end;
|
---|
| 183 | x := sCallV('TIU AUTHORIZATION', [IEN, ActionName]);
|
---|
| 184 | AuthSts.Success := Piece(x, U, 1) = '1';
|
---|
| 185 | AuthSts.Reason := Piece(x, U, 2);
|
---|
| 186 | end;
|
---|
| 187 |
|
---|
| 188 | (*procedure ListDischargeSummaries(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
|
---|
| 189 | Person: int64; OccLim: Integer; SortAscending: Boolean);
|
---|
| 190 | { retrieves existing progress notes for a patient according to the parameters passed in
|
---|
| 191 | Pieces: IEN^Title^FMDateOfNote^Patient^Author^Location^Status^Visit
|
---|
| 192 | Return: IEN^ExDateOfNote^Title, Location, Author }
|
---|
| 193 | var
|
---|
| 194 | i: Integer;
|
---|
| 195 | x: string;
|
---|
| 196 | SortSeq: Char;
|
---|
| 197 | begin
|
---|
| 198 | if SortAscending then SortSeq := 'A' else SortSeq := 'D';
|
---|
| 199 | //if OccLim = 0 then OccLim := MaxSummsReturned;
|
---|
| 200 | CallV('TIU DOCUMENTS BY CONTEXT',
|
---|
| 201 | [CLS_DC_SUMM, Context, Patient.DFN, Early, Late, Person, OccLim, SortSeq]);
|
---|
| 202 | with RPCBrokerV do
|
---|
| 203 | begin
|
---|
| 204 | for i := 0 to Results.Count - 1 do
|
---|
| 205 | begin
|
---|
| 206 | x := Results[i];
|
---|
| 207 | if Copy(Piece(x, U, 9), 1, 4) = ' ' then SetPiece(x, U, 9, 'Dis: ');
|
---|
| 208 | x := Piece(x, U, 1) + U + FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3)))
|
---|
| 209 | + U + Piece(x, U, 2) + ', ' + Piece(x, U, 6) + ', ' + Piece(Piece(x, U, 5), ';', 2) +
|
---|
| 210 | ' (' + Piece(x,U,7) + '), ' + Piece(x, U, 8) + ', ' + Piece(x, U, 9) +
|
---|
| 211 | U + Piece(x, U, 3) + U + Piece(x, U, 11);
|
---|
| 212 | Results[i] := x;
|
---|
| 213 | end; {for}
|
---|
| 214 | Dest.Assign(Results);
|
---|
| 215 | end; {with}
|
---|
| 216 | end;*)
|
---|
| 217 |
|
---|
| 218 | procedure ListSummsForTree(Dest: TStrings; Context: Integer; Early, Late: TFMDateTime;
|
---|
| 219 | Person: int64; OccLim: Integer; SortAscending: Boolean);
|
---|
| 220 | { retrieves existing discharge summaries for a patient according to the parameters passed in}
|
---|
| 221 | var
|
---|
| 222 | SortSeq: Char;
|
---|
| 223 | const
|
---|
| 224 | SHOW_ADDENDA = True;
|
---|
| 225 | begin
|
---|
| 226 | if SortAscending then SortSeq := 'A' else SortSeq := 'D';
|
---|
| 227 | if Context > 0 then
|
---|
| 228 | begin
|
---|
| 229 | CallV('TIU DOCUMENTS BY CONTEXT', [CLS_DC_SUMM, Context, Patient.DFN, Early, Late, Person, OccLim, SortSeq, SHOW_ADDENDA]);
|
---|
| 230 | Dest.Assign(RPCBrokerV.Results);
|
---|
| 231 | end;
|
---|
| 232 | end;
|
---|
| 233 |
|
---|
| 234 | procedure GetDCSummForEdit(var EditRec: TEditDCSummRec; IEN: Integer);
|
---|
| 235 | { retrieves internal/external values for Discharge Summary fields & loads them into EditRec
|
---|
| 236 | Fields: Title:.01, RefDate:1301, Author:1204, Cosigner:1208, Subject:1701, Location:1205 }
|
---|
| 237 | var
|
---|
| 238 | i, j: Integer;
|
---|
| 239 |
|
---|
| 240 | function FindDT(const FieldID: string): TFMDateTime;
|
---|
| 241 | var
|
---|
| 242 | i: Integer;
|
---|
| 243 | begin
|
---|
| 244 | Result := 0;
|
---|
| 245 | with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
---|
| 246 | if Piece(Results[i], U, 1) = FieldID then
|
---|
| 247 | begin
|
---|
| 248 | Result := MakeFMDateTime(Piece(Results[i], U, 2));
|
---|
| 249 | Break;
|
---|
| 250 | end;
|
---|
| 251 | end;
|
---|
| 252 |
|
---|
| 253 | function FindExt(const FieldID: string): string;
|
---|
| 254 | var
|
---|
| 255 | i: Integer;
|
---|
| 256 | begin
|
---|
| 257 | Result := '';
|
---|
| 258 | with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
---|
| 259 | if Piece(Results[i], U, 1) = FieldID then
|
---|
| 260 | begin
|
---|
| 261 | Result := Piece(Results[i], U, 3);
|
---|
| 262 | Break;
|
---|
| 263 | end;
|
---|
| 264 | end;
|
---|
| 265 |
|
---|
| 266 | function FindInt(const FieldID: string): Integer;
|
---|
| 267 | var
|
---|
| 268 | i: Integer;
|
---|
| 269 | begin
|
---|
| 270 | Result := 0;
|
---|
| 271 | with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
---|
| 272 | if Piece(Results[i], U, 1) = FieldID then
|
---|
| 273 | begin
|
---|
| 274 | Result := StrToIntDef(Piece(Results[i], U, 2), 0);
|
---|
| 275 | Break;
|
---|
| 276 | end;
|
---|
| 277 | end;
|
---|
| 278 |
|
---|
| 279 | function FindInt64(const FieldID: string): Int64;
|
---|
| 280 | var
|
---|
| 281 | i: Integer;
|
---|
| 282 | begin
|
---|
| 283 | Result := 0;
|
---|
| 284 | with RPCBrokerV do for i := 0 to Results.Count - 1 do
|
---|
| 285 | if Piece(Results[i], U, 1) = FieldID then
|
---|
| 286 | begin
|
---|
| 287 | Result := StrToInt64Def(Piece(Results[i], U, 2), 0);
|
---|
| 288 | Break;
|
---|
| 289 | end;
|
---|
| 290 | end;
|
---|
| 291 |
|
---|
| 292 |
|
---|
| 293 | begin
|
---|
| 294 | CallV('TIU LOAD RECORD FOR EDIT', [IEN, '.01;.06;.07;.09;1202;1205;1208;1209;1301;1302;1307;1701']);
|
---|
| 295 | FillChar(EditRec, SizeOf(EditRec), 0);
|
---|
| 296 | with EditRec do
|
---|
| 297 | begin
|
---|
| 298 | Title := FindInt('.01');
|
---|
| 299 | TitleName := FindExt('.01');
|
---|
| 300 | AdmitDateTime := FindDT('.07');
|
---|
| 301 | DischargeDateTime := FindDT('1301');
|
---|
| 302 | UrgencyName := FindExt('.09');
|
---|
| 303 | Urgency := Copy(UrgencyName,1,1);
|
---|
| 304 | Dictator := FindInt64('1202');
|
---|
| 305 | DictatorName := FindExt('1202');
|
---|
| 306 | Cosigner := FindInt64('1208');
|
---|
| 307 | CosignerName := FindExt('1208');
|
---|
| 308 | DictDateTime := FindDT('1307');
|
---|
| 309 | Attending := FindInt64('1209');
|
---|
| 310 | AttendingName := FindExt('1209');
|
---|
| 311 | Transcriptionist := FindInt64('1302');
|
---|
| 312 | TranscriptionistName := FindExt('1302');
|
---|
| 313 | Location := FindInt('1205');
|
---|
| 314 | LocationName := FindExt('1205');
|
---|
| 315 | if Title = TYP_ADDENDUM then Addend := FindInt('.06');
|
---|
| 316 | with RPCBrokerV do
|
---|
| 317 | begin
|
---|
| 318 | for i := 0 to Results.Count - 1 do if Results[i] = '$TXT' then break;
|
---|
| 319 | for j := i downto 0 do Results.Delete(j);
|
---|
| 320 | // -------------------- v19.1 (RV) LOST NOTES?----------------------------
|
---|
| 321 | //Lines := Results; 'Lines' is being overwritten by subsequent Broker calls
|
---|
| 322 | if not Assigned(Lines) then Lines := TStringList.Create;
|
---|
| 323 | Lines.Assign(Results);
|
---|
| 324 | // -----------------------------------------------------------------------
|
---|
| 325 | end;
|
---|
| 326 | end;
|
---|
| 327 | end;
|
---|
| 328 |
|
---|
| 329 | function LoadDCUrgencies: TStrings;
|
---|
| 330 | var
|
---|
| 331 | i: integer;
|
---|
| 332 | begin
|
---|
| 333 | CallV('TIU GET DS URGENCIES',[nil]);
|
---|
| 334 | with RPCBrokerV do
|
---|
| 335 | for i := 0 to Results.Count-1 do
|
---|
| 336 | Results[i] := MixedCase(UpperCase(Results[i]));
|
---|
| 337 | Result := RPCBrokerV.Results;
|
---|
| 338 | end;
|
---|
| 339 |
|
---|
| 340 | { Data Updates ----------------------------------------------------------------------------- }
|
---|
| 341 |
|
---|
| 342 | procedure DeleteDCDocument(var DeleteSts: TActionRec; IEN: Integer; const Reason: string);
|
---|
| 343 | { delete a TIU document given the internal entry number, return reason if unable to delete }
|
---|
| 344 | var
|
---|
| 345 | x: string;
|
---|
| 346 | begin
|
---|
| 347 | x := sCallV('TIU DELETE RECORD', [IEN, Reason]);
|
---|
| 348 | DeleteSts.Success := Piece(x, U, 1) = '0';
|
---|
| 349 | DeleteSts.Reason := Piece(x, U, 2);
|
---|
| 350 | end;
|
---|
| 351 |
|
---|
| 352 | procedure SignDCDocument(var SignSts: TActionRec; IEN: Integer; const ESCode: string);
|
---|
| 353 | { update signed status of a TIU document, return reason if signature is not accepted }
|
---|
| 354 | var
|
---|
| 355 | x: string;
|
---|
| 356 | begin
|
---|
| 357 | (* with RPCBrokerV do // temp - to insure sign doesn't go interactive
|
---|
| 358 | begin
|
---|
| 359 | ClearParameters := True;
|
---|
| 360 | RemoteProcedure := 'TIU UPDATE RECORD';
|
---|
| 361 | Param[0].PType := literal;
|
---|
| 362 | Param[0].Value := IntToStr(IEN);
|
---|
| 363 | Param[1].PType := list;
|
---|
| 364 | with Param[1] do Mult['.11'] := '0'; // **** block removed in v19.1 - {RV} ****
|
---|
| 365 | CallBroker;
|
---|
| 366 | end; // temp - end*)
|
---|
| 367 | x := sCallV('TIU SIGN RECORD', [IEN, ESCode]);
|
---|
| 368 | SignSts.Success := Piece(x, U, 1) = '0';
|
---|
| 369 | SignSts.Reason := Piece(x, U, 2);
|
---|
| 370 | end;
|
---|
| 371 |
|
---|
| 372 | procedure PutNewDCSumm(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec);
|
---|
| 373 | { create a new discharge summary with the data in DCSummRec and return its internal entry number
|
---|
| 374 | load broker directly since there isn't a good way to set up multiple subscript arrays }
|
---|
| 375 | (*var
|
---|
| 376 | i: Integer;*)
|
---|
| 377 | var
|
---|
| 378 | ErrMsg: string;
|
---|
| 379 | begin
|
---|
| 380 | with RPCBrokerV do
|
---|
| 381 | begin
|
---|
| 382 | ClearParameters := True;
|
---|
| 383 | RemoteProcedure := 'TIU CREATE RECORD';
|
---|
| 384 | Param[0].PType := literal;
|
---|
| 385 | Param[0].Value := Patient.DFN; //*DFN*
|
---|
| 386 | Param[1].PType := literal;
|
---|
| 387 | Param[1].Value := IntToStr(DCSummRec.Title);
|
---|
| 388 | Param[2].PType := literal;
|
---|
| 389 | Param[2].Value := '';
|
---|
| 390 | Param[3].PType := literal;
|
---|
| 391 | Param[3].Value := '';
|
---|
| 392 | Param[4].PType := literal;
|
---|
| 393 | Param[4].Value := '';
|
---|
| 394 | Param[5].PType := list;
|
---|
| 395 | with Param[5] do
|
---|
| 396 | begin
|
---|
| 397 | Mult['.07'] := FloatToStr(DCSummRec.AdmitDateTime);
|
---|
| 398 | Mult['.09'] := DCSummRec.Urgency;
|
---|
| 399 | Mult['1202'] := IntToStr(DCSummRec.Dictator);
|
---|
| 400 | Mult['1205'] := IntToStr(Encounter.Location);
|
---|
| 401 | Mult['1301'] := FloatToStr(DCSummRec.DischargeDateTime);
|
---|
| 402 | Mult['1307'] := FloatToStr(DCSummRec.DictDateTime);
|
---|
| 403 | if DCSummRec.Cosigner > 0 then
|
---|
| 404 | begin
|
---|
| 405 | Mult['1208'] := IntToStr(DCSummRec.Cosigner);
|
---|
| 406 | Mult['1506'] := '1';
|
---|
| 407 | end
|
---|
| 408 | else
|
---|
| 409 | begin
|
---|
| 410 | Mult['1208'] := '';
|
---|
| 411 | Mult['1506'] := '0';
|
---|
| 412 | end ;
|
---|
| 413 | Mult['1209'] := IntToStr(DCSummRec.Attending);
|
---|
| 414 | Mult['1302'] := IntToStr(DCSummRec.Transcriptionist);
|
---|
| 415 | if DCSummRec.IDParent > 0 then Mult['2101'] := IntToStr(DCSummRec.IDParent);
|
---|
| 416 | (* if DCSummRec.Lines <> nil then
|
---|
| 417 | for i := 0 to DCSummRec.Lines.Count - 1 do
|
---|
| 418 | Mult['"TEXT",' + IntToStr(i+1) + ',0'] := FilteredString(DCSummRec.Lines[i]);*)
|
---|
| 419 | end;
|
---|
| 420 | Param[6].PType := literal;
|
---|
| 421 | Param[6].Value := DCSummRec.VisitStr;
|
---|
| 422 | Param[7].PType := literal;
|
---|
| 423 | Param[7].Value := '1'; // suppress commit logic
|
---|
| 424 | CallBroker;
|
---|
| 425 | CreatedDoc.IEN := StrToIntDef(Piece(Results[0], U, 1), 0);
|
---|
| 426 | CreatedDoc.ErrorText := Piece(Results[0], U, 2);
|
---|
| 427 | end;
|
---|
| 428 | if ( DCSummRec.Lines <> nil ) and ( CreatedDoc.IEN <> 0 ) then
|
---|
| 429 | begin
|
---|
| 430 | SetText(ErrMsg, DCSummRec.Lines, CreatedDoc.IEN, 1);
|
---|
| 431 | if ErrMsg <> '' then
|
---|
| 432 | begin
|
---|
| 433 | CreatedDoc.IEN := 0;
|
---|
| 434 | CreatedDoc.ErrorText := ErrMsg;
|
---|
| 435 | end;
|
---|
| 436 | end;
|
---|
| 437 | end;
|
---|
| 438 |
|
---|
| 439 | procedure PutDCAddendum(var CreatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; AddendumTo:
|
---|
| 440 | Integer);
|
---|
| 441 | { create a new addendum for note identified in AddendumTo, returns IEN of new document
|
---|
| 442 | load broker directly since there isn't a good way to set up multiple subscript arrays }
|
---|
| 443 | (*var
|
---|
| 444 | i: Integer;*)
|
---|
| 445 | var
|
---|
| 446 | ErrMsg: string;
|
---|
| 447 | begin
|
---|
| 448 | with RPCBrokerV do
|
---|
| 449 | begin
|
---|
| 450 | ClearParameters := True;
|
---|
| 451 | RemoteProcedure := 'TIU CREATE ADDENDUM RECORD';
|
---|
| 452 | Param[0].PType := literal;
|
---|
| 453 | Param[0].Value := IntToStr(AddendumTo);
|
---|
| 454 | Param[1].PType := list;
|
---|
| 455 | with Param[1] do
|
---|
| 456 | begin
|
---|
| 457 | Mult['.09'] := DCSummRec.Urgency;
|
---|
| 458 | Mult['1202'] := IntToStr(DCSummRec.Dictator);
|
---|
| 459 | Mult['1301'] := FloatToStr(DCSummRec.DischargeDateTime);
|
---|
| 460 | Mult['1307'] := FloatToStr(DCSummRec.DictDateTime);
|
---|
| 461 | if DCSummRec.Cosigner > 0 then
|
---|
| 462 | begin
|
---|
| 463 | Mult['1208'] := IntToStr(DCSummRec.Cosigner);
|
---|
| 464 | Mult['1506'] := '1';
|
---|
| 465 | end
|
---|
| 466 | else
|
---|
| 467 | begin
|
---|
| 468 | Mult['1208'] := '';
|
---|
| 469 | Mult['1506'] := '0';
|
---|
| 470 | end ;
|
---|
| 471 | (* if DCSummRec.Lines <> nil then
|
---|
| 472 | for i := 0 to DCSummRec.Lines.Count - 1 do
|
---|
| 473 | Mult['"TEXT",' + IntToStr(i+1) + ',0'] := FilteredString(DCSummRec.Lines[i]);*)
|
---|
| 474 | end;
|
---|
| 475 | Param[2].PType := literal;
|
---|
| 476 | Param[2].Value := '1'; // suppress commit logic
|
---|
| 477 | CallBroker;
|
---|
| 478 | CreatedDoc.IEN := StrToIntDef(Piece(Results[0], U, 1), 0);
|
---|
| 479 | CreatedDoc.ErrorText := Piece(Results[0], U, 2);
|
---|
| 480 | end;
|
---|
| 481 | if ( DCSummRec.Lines <> nil ) and ( CreatedDoc.IEN <> 0 ) then
|
---|
| 482 | begin
|
---|
| 483 | SetText(ErrMsg, DCSummRec.Lines, CreatedDoc.IEN, 1);
|
---|
| 484 | if ErrMsg <> '' then
|
---|
| 485 | begin
|
---|
| 486 | CreatedDoc.IEN := 0;
|
---|
| 487 | CreatedDoc.ErrorText := ErrMsg;
|
---|
| 488 | end;
|
---|
| 489 | end;
|
---|
| 490 | end;
|
---|
| 491 |
|
---|
| 492 | procedure PutEditedDCSumm(var UpdatedDoc: TCreatedDoc; const DCSummRec: TDCSummRec; NoteIEN:
|
---|
| 493 | Integer);
|
---|
| 494 | { update the fields and content of the note identified in NoteIEN, returns 1 if successful
|
---|
| 495 | load broker directly since there isn't a good way to set up mutilple subscript arrays }
|
---|
| 496 | (*var
|
---|
| 497 | i: Integer;*)
|
---|
| 498 | var
|
---|
| 499 | ErrMsg: string;
|
---|
| 500 | begin
|
---|
| 501 | // First, file field data
|
---|
| 502 | with RPCBrokerV do
|
---|
| 503 | begin
|
---|
| 504 | ClearParameters := True;
|
---|
| 505 | RemoteProcedure := 'TIU UPDATE RECORD';
|
---|
| 506 | Param[0].PType := literal;
|
---|
| 507 | Param[0].Value := IntToStr(NoteIEN);
|
---|
| 508 | Param[1].PType := list;
|
---|
| 509 | with Param[1] do
|
---|
| 510 | begin
|
---|
| 511 | if DCSummRec.Addend = 0 then
|
---|
| 512 | begin
|
---|
| 513 | Mult['.01'] := IntToStr(DCSummRec.Title);
|
---|
| 514 | //Mult['.11'] := BOOLCHAR[DCSummRec.NeedCPT]; // **** removed in v19.1 {RV} ****
|
---|
| 515 | end;
|
---|
| 516 | if (DCSummRec.Status in [TIU_ST_UNREL(*, TIU_ST_UNVER*)]) then Mult['.05'] := IntToStr(DCSummRec.Status);
|
---|
| 517 | Mult['1202'] := IntToStr(DCSummRec.Dictator);
|
---|
| 518 | Mult['1209'] := IntToStr(DCSummRec.Attending);
|
---|
| 519 | Mult['1301'] := FloatToStr(DCSummRec.DischargeDateTime);
|
---|
| 520 | if DCSummRec.Cosigner > 0 then
|
---|
| 521 | begin
|
---|
| 522 | Mult['1208'] := IntToStr(DCSummRec.Cosigner);
|
---|
| 523 | Mult['1506'] := '1';
|
---|
| 524 | end
|
---|
| 525 | else
|
---|
| 526 | begin
|
---|
| 527 | Mult['1208'] := '';
|
---|
| 528 | Mult['1506'] := '0';
|
---|
| 529 | end ;
|
---|
| 530 | (* for i := 0 to DCSummRec.Lines.Count - 1 do
|
---|
| 531 | Mult['"TEXT",' + IntToStr(i+1) + ',0'] := FilteredString(DCSummRec.Lines[i]);*)
|
---|
| 532 | end;
|
---|
| 533 | CallBroker;
|
---|
| 534 | UpdatedDoc.IEN := StrToIntDef(Piece(Results[0], U, 1), 0);
|
---|
| 535 | UpdatedDoc.ErrorText := Piece(Results[0], U, 2);
|
---|
| 536 | end;
|
---|
| 537 |
|
---|
| 538 | if UpdatedDoc.IEN <= 0 then //v22.12 - RV
|
---|
| 539 | //if UpdatedDoc.ErrorText <> '' then //v22.5 - RV
|
---|
| 540 | begin
|
---|
| 541 | UpdatedDoc.ErrorText := UpdatedDoc.ErrorText + #13#10 + #13#10 + 'Document #: ' + IntToStr(NoteIEN);
|
---|
| 542 | exit;
|
---|
| 543 | end;
|
---|
| 544 |
|
---|
| 545 | // next, if no error, file document body
|
---|
| 546 | SetText(ErrMsg, DCSummRec.Lines, NoteIEN, 0);
|
---|
| 547 | if ErrMsg <> '' then
|
---|
| 548 | begin
|
---|
| 549 | UpdatedDoc.IEN := 0;
|
---|
| 550 | UpdatedDoc.ErrorText := ErrMsg;
|
---|
| 551 | end;
|
---|
| 552 | end;
|
---|
| 553 |
|
---|
| 554 | function GetAttending(const DFN: string): string; //*DFN*
|
---|
| 555 | begin
|
---|
| 556 | CallV('ORQPT ATTENDING/PRIMARY',[DFN]);
|
---|
| 557 | Result := Piece(RPCBrokerV.Results[0],';',1);
|
---|
| 558 | end;
|
---|
| 559 |
|
---|
| 560 | function GetDischargeDate(const DFN: string; AdmitDateTime: string): string; //*DFN*
|
---|
| 561 | begin
|
---|
| 562 | CallV('ORWPT DISCHARGE',[DFN, AdmitDateTime]);
|
---|
| 563 | Result := RPCBrokerV.Results[0];
|
---|
| 564 | end;
|
---|
| 565 |
|
---|
| 566 | function RequireRelease(ANote, AType: Integer): Boolean;
|
---|
| 567 | { returns true if a discharge summary must be released }
|
---|
| 568 | begin
|
---|
| 569 | if ANote > 0 then
|
---|
| 570 | Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 2) = '1'
|
---|
| 571 | else
|
---|
| 572 | Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [0, AType]), U, 2) = '1';
|
---|
| 573 | end;
|
---|
| 574 |
|
---|
| 575 | function RequireMASVerification(ANote, AType: Integer): Boolean;
|
---|
| 576 | { returns true if a discharge summary must be verified }
|
---|
| 577 | var
|
---|
| 578 | AValue: integer;
|
---|
| 579 | begin
|
---|
| 580 | Result := False;
|
---|
| 581 | if ANote > 0 then
|
---|
| 582 | AValue := StrToIntDef(Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 3), 0)
|
---|
| 583 | else
|
---|
| 584 | AValue := StrToIntDef(Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [0, AType]), U, 3), 0);
|
---|
| 585 | case AValue of
|
---|
| 586 | 0: Result := False; // NO
|
---|
| 587 | 1: Result := True; // ALWAYS
|
---|
| 588 | 2: Result := False; // UPLOAD ONLY
|
---|
| 589 | 3: Result := True; // DIRECT ENTRY ONLY
|
---|
| 590 | end;
|
---|
| 591 | end;
|
---|
| 592 |
|
---|
| 593 | function AllowMultipleSummsPerAdmission(ANote, AType: Integer): Boolean;
|
---|
| 594 | { returns true if a discharge summary must be released }
|
---|
| 595 | begin
|
---|
| 596 | if ANote > 0 then
|
---|
| 597 | Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [ANote]), U, 10) = '1'
|
---|
| 598 | else
|
---|
| 599 | Result := Piece(sCallV('TIU GET DOCUMENT PARAMETERS', [0, AType]), U, 10) = '1';
|
---|
| 600 | end;
|
---|
| 601 |
|
---|
| 602 | procedure ChangeAttending(IEN: integer; AnAttending: int64);
|
---|
| 603 | var
|
---|
| 604 | AttendingIsNotCurrentUser: boolean;
|
---|
| 605 | begin
|
---|
| 606 | AttendingIsNotCurrentUser := (AnAttending <> User.DUZ);
|
---|
| 607 | with RPCBrokerV do
|
---|
| 608 | begin
|
---|
| 609 | ClearParameters := True;
|
---|
| 610 | RemoteProcedure := 'TIU UPDATE RECORD';
|
---|
| 611 | Param[0].PType := literal;
|
---|
| 612 | Param[0].Value := IntToStr(IEN);
|
---|
| 613 | Param[1].PType := list;
|
---|
| 614 | with Param[1] do
|
---|
| 615 | begin
|
---|
| 616 | Mult['1209'] := IntToStr(AnAttending);
|
---|
| 617 | if AttendingIsNotCurrentUser then
|
---|
| 618 | begin
|
---|
| 619 | Mult['1208'] := IntToStr(AnAttending);
|
---|
| 620 | Mult['1506'] := '1';
|
---|
| 621 | end
|
---|
| 622 | else
|
---|
| 623 | begin
|
---|
| 624 | Mult['1208'] := '';
|
---|
| 625 | Mult['1506'] := '0';
|
---|
| 626 | end ;
|
---|
| 627 | end;
|
---|
| 628 | CallBroker;
|
---|
| 629 | end;
|
---|
| 630 | end;
|
---|
| 631 |
|
---|
| 632 | function GetCurrentDCSummContext: TTIUContext;
|
---|
| 633 | var
|
---|
| 634 | x: string;
|
---|
| 635 | AContext: TTIUContext;
|
---|
| 636 | begin
|
---|
| 637 | x := sCallV('ORWTIU GET DCSUMM CONTEXT', [User.DUZ]) ;
|
---|
| 638 | with AContext do
|
---|
| 639 | begin
|
---|
| 640 | Changed := True;
|
---|
| 641 | BeginDate := Piece(x, ';', 1);
|
---|
| 642 | EndDate := Piece(x, ';', 2);
|
---|
| 643 | Status := Piece(x, ';', 3);
|
---|
| 644 | if (StrToIntDef(Status, 0) < 1) or (StrToIntDef(Status, 0) > 5) then Status := '1';
|
---|
| 645 | Author := StrToInt64Def(Piece(x, ';', 4), 0);
|
---|
| 646 | MaxDocs := StrToIntDef(Piece(x, ';', 5), 0);
|
---|
| 647 | ShowSubject := StrToIntDef(Piece(x, ';', 6), 0) > 0; //TIU PREFERENCE??
|
---|
| 648 | SortBy := Piece(x, ';', 7); //TIU PREFERENCE??
|
---|
| 649 | ListAscending := StrToIntDef(Piece(x, ';', 8), 0) > 0;
|
---|
| 650 | TreeAscending := StrToIntDef(Piece(x, ';', 9), 0) > 0; //TIU PREFERENCE??
|
---|
| 651 | GroupBy := Piece(x, ';', 10);
|
---|
| 652 | SearchField := Piece(x, ';', 11);
|
---|
| 653 | KeyWord := Piece(x, ';', 12);
|
---|
| 654 | Filtered := (Keyword <> '');
|
---|
| 655 | end;
|
---|
| 656 | Result := AContext;
|
---|
| 657 | end;
|
---|
| 658 |
|
---|
| 659 | procedure SaveCurrentDCSummContext(AContext: TTIUContext) ;
|
---|
| 660 | var
|
---|
| 661 | x: string;
|
---|
| 662 | begin
|
---|
| 663 | with AContext do
|
---|
| 664 | begin
|
---|
| 665 | SetPiece(x, ';', 1, BeginDate);
|
---|
| 666 | SetPiece(x, ';', 2, EndDate);
|
---|
| 667 | SetPiece(x, ';', 3, Status);
|
---|
| 668 | if Author > 0 then
|
---|
| 669 | SetPiece(x, ';', 4, IntToStr(Author))
|
---|
| 670 | else
|
---|
| 671 | SetPiece(x, ';', 4, '');
|
---|
| 672 | SetPiece(x, ';', 5, IntToStr(MaxDocs));
|
---|
| 673 | SetPiece(x, ';', 6, BOOLCHAR[ShowSubject]); //TIU PREFERENCE??
|
---|
| 674 | SetPiece(x, ';', 7, SortBy); //TIU PREFERENCE??
|
---|
| 675 | SetPiece(x, ';', 8, BOOLCHAR[ListAscending]);
|
---|
| 676 | SetPiece(x, ';', 9, BOOLCHAR[TreeAscending]); //TIU PREFERENCE??
|
---|
| 677 | SetPiece(x, ';', 10, GroupBy);
|
---|
| 678 | SetPiece(x, ';', 11, SearchField);
|
---|
| 679 | SetPiece(x, ';', 12, KeyWord);
|
---|
| 680 | end;
|
---|
| 681 | CallV('ORWTIU SAVE DCSUMM CONTEXT', [x]);
|
---|
| 682 | end;
|
---|
| 683 |
|
---|
| 684 | initialization
|
---|
| 685 | // nothing for now
|
---|
| 686 |
|
---|
| 687 | finalization
|
---|
| 688 | if uDCSummTitles <> nil then uDCSummTitles.Free;
|
---|
| 689 | if uDCSummPrefs <> nil then uDCSummPrefs.Free;
|
---|
| 690 |
|
---|
| 691 | end.
|
---|