| 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. | 
|---|