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