| [453] | 1 | //kt -- Modified with SourceScanner on 8/7/2007 | 
|---|
|  | 2 | unit rTIU.pas.kil; | 
|---|
|  | 3 |  | 
|---|
|  | 4 | interface | 
|---|
|  | 5 |  | 
|---|
|  | 6 | uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, TRPCB, dialogs, uSurgery; | 
|---|
|  | 7 |  | 
|---|
|  | 8 | type | 
|---|
|  | 9 | TSurgCaseContext = record | 
|---|
|  | 10 | Changed: Boolean; | 
|---|
|  | 11 | OpProc:  string; | 
|---|
|  | 12 | BeginDate: string; | 
|---|
|  | 13 | FMBeginDate: TFMDateTime; | 
|---|
|  | 14 | EndDate: string; | 
|---|
|  | 15 | FMEndDate: TFMDateTime; | 
|---|
|  | 16 | MaxDocs: integer; | 
|---|
|  | 17 | Status: string; | 
|---|
|  | 18 | GroupBy: string; | 
|---|
|  | 19 | TreeAscending: Boolean; | 
|---|
|  | 20 | end ; | 
|---|
|  | 21 |  | 
|---|
|  | 22 | TShowSurgeryTab = record | 
|---|
|  | 23 | Evaluated: boolean; | 
|---|
|  | 24 | ShowIt:     boolean; | 
|---|
|  | 25 | end; | 
|---|
|  | 26 |  | 
|---|
|  | 27 | TShowOpTop = record | 
|---|
|  | 28 | Evaluated: boolean; | 
|---|
|  | 29 | ShowIt:    integer; | 
|---|
|  | 30 | end; | 
|---|
|  | 31 |  | 
|---|
|  | 32 | {Surgery Titles } | 
|---|
|  | 33 | function  DfltSurgeryTitle(AClassName: string): integer; | 
|---|
|  | 34 | function  DfltSurgeryTitleName(AClassName: string): string; | 
|---|
|  | 35 | procedure ListSurgeryTitlesShort(Dest: TStrings; AClassName: string); | 
|---|
|  | 36 | function SubSetOfSurgeryTitles(const StartFrom: string; Direction: Integer; AClassName: string): TStrings; | 
|---|
|  | 37 | function IsSurgeryTitle(TitleIEN: Integer): Boolean; | 
|---|
|  | 38 | procedure ResetSurgeryTitles; | 
|---|
|  | 39 |  | 
|---|
|  | 40 | { Data Retrieval } | 
|---|
|  | 41 | procedure GetSurgCaseList(Dest: TStrings; Early, Late: double; Context, Max: integer); | 
|---|
|  | 42 | procedure ListSurgeryCases(Dest: TStrings); | 
|---|
|  | 43 | procedure GetSingleCaseListItemWithDocs(Dest: TStrings; NoteIEN: integer); | 
|---|
|  | 44 | function GetSingleCaseListItemWithoutDocs(NoteIEN: integer): string; | 
|---|
|  | 45 | //procedure LoadOpTop(Dest: TStrings; ACaseIEN: integer; IsNonORProc, ShowReport: boolean) ; | 
|---|
|  | 46 | procedure LoadSurgReportText(Dest: TStrings; IEN: integer) ; | 
|---|
|  | 47 | procedure LoadSurgReportDetail(Dest: TStrings; IEN: integer) ; | 
|---|
|  | 48 | function  GetCurrentSurgCaseContext: TSurgCaseContext; | 
|---|
|  | 49 | procedure SaveCurrentSurgCaseContext(AContext: TSurgCaseContext) ; | 
|---|
|  | 50 | function  GetSurgCaseRefForNote(NoteIEN: integer): string; | 
|---|
|  | 51 | //function  ShowOpTopOnSignature(ACaseIEN: integer): integer; | 
|---|
|  | 52 | function ShowSurgeryTab: boolean; | 
|---|
|  | 53 | function IsNonORProcedure(ACaseIEN: integer): boolean; | 
|---|
|  | 54 |  | 
|---|
|  | 55 | implementation | 
|---|
|  | 56 |  | 
|---|
|  | 57 | var | 
|---|
|  | 58 | uSurgeryTitles: TSurgeryTitles; | 
|---|
|  | 59 | uShowSurgeryTab: TShowSurgeryTab; | 
|---|
|  | 60 | //uShowOpTop: TShowOpTop; | 
|---|
|  | 61 |  | 
|---|
|  | 62 | function ShowSurgeryTab: boolean; | 
|---|
|  | 63 | begin | 
|---|
|  | 64 | with uShowSurgeryTab do | 
|---|
|  | 65 | begin | 
|---|
|  | 66 | if not Evaluated then | 
|---|
|  | 67 | begin | 
|---|
|  | 68 | ShowIt := sCallV('ORWSR SHOW SURG TAB', [nil]) = '1'; | 
|---|
|  | 69 | Evaluated := True; | 
|---|
|  | 70 | end; | 
|---|
|  | 71 | Result := ShowIt; | 
|---|
|  | 72 | end; | 
|---|
|  | 73 | end; | 
|---|
|  | 74 | { -------------------------- Surgery Titles --------------------------------- } | 
|---|
|  | 75 |  | 
|---|
|  | 76 | procedure LoadSurgeryTitles(AClassName: string); | 
|---|
|  | 77 | { private - called to set up the uSurgeryTitles object } | 
|---|
|  | 78 | var | 
|---|
|  | 79 | SurgeryClass: integer; | 
|---|
|  | 80 | x: string; | 
|---|
|  | 81 | begin | 
|---|
|  | 82 | if uSurgeryTitles <> nil then | 
|---|
|  | 83 | begin | 
|---|
|  | 84 | if uSurgeryTitles.Classname = AClassName then exit; | 
|---|
|  | 85 | uSurgeryTitles.Free; | 
|---|
|  | 86 | uSurgeryTitles := nil; | 
|---|
|  | 87 | end; | 
|---|
|  | 88 | // pass in class name to return OR/non-OR class, depending on selected case | 
|---|
|  | 89 | SurgeryClass := StrToInt(sCallV('TIU IDENTIFY SURGERY CLASS',[AClassName]))  ; | 
|---|
|  | 90 | CallV('TIU PERSONAL TITLE LIST', [User.DUZ, SurgeryClass]); | 
|---|
|  | 91 | RPCBrokerV.Results.Insert(0, '~SHORT LIST');  // insert so can call ExtractItems | 
|---|
|  | 92 | uSurgeryTitles := TSurgeryTitles.Create; | 
|---|
|  | 93 | ExtractItems(uSurgeryTitles.ShortList, RPCBrokerV.Results, 'SHORT LIST'); | 
|---|
|  | 94 | x := ExtractDefault(RPCBrokerV.Results, 'SHORT LIST'); | 
|---|
|  | 95 | uSurgeryTitles.ClassName := AClassName; | 
|---|
|  | 96 | uSurgeryTitles.DfltTitle := StrToIntDef(Piece(x, U, 1), 0); | 
|---|
|  | 97 | uSurgeryTitles.DfltTitleName := Piece(x, U, 2); | 
|---|
|  | 98 | end; | 
|---|
|  | 99 |  | 
|---|
|  | 100 | procedure ResetSurgeryTitles; | 
|---|
|  | 101 | begin | 
|---|
|  | 102 | if uSurgeryTitles <> nil then | 
|---|
|  | 103 | begin | 
|---|
|  | 104 | uSurgeryTitles.Free; | 
|---|
|  | 105 | uSurgeryTitles := nil; | 
|---|
|  | 106 | end; | 
|---|
|  | 107 | end; | 
|---|
|  | 108 |  | 
|---|
|  | 109 | function DfltSurgeryTitle(AClassName: string): integer; | 
|---|
|  | 110 | { returns the user defined default Surgery title (if any) } | 
|---|
|  | 111 | begin | 
|---|
|  | 112 | if AClassName <> uSurgeryTitles.ClassName then LoadSurgeryTitles(AClassName); | 
|---|
|  | 113 | Result := uSurgeryTitles.DfltTitle; | 
|---|
|  | 114 | end; | 
|---|
|  | 115 |  | 
|---|
|  | 116 | function DfltSurgeryTitleName(AClassName: string): string; | 
|---|
|  | 117 | { returns the name of the user defined default progress note title (if any) } | 
|---|
|  | 118 | begin | 
|---|
|  | 119 | if AClassName <> uSurgeryTitles.ClassName then LoadSurgeryTitles(AClassName); | 
|---|
|  | 120 | Result := uSurgeryTitles.DfltTitleName; | 
|---|
|  | 121 | end; | 
|---|
|  | 122 |  | 
|---|
|  | 123 | procedure ListSurgeryTitlesShort(Dest: TStrings; AClassName: string); | 
|---|
|  | 124 | { returns the user defined list (short list) of Surgery titles } | 
|---|
|  | 125 | begin | 
|---|
|  | 126 | if (uSurgeryTitles = nil) or (AClassName <> uSurgeryTitles.ClassName) then LoadSurgeryTitles(AClassName); | 
|---|
|  | 127 | Dest.AddStrings(uSurgeryTitles.ShortList); | 
|---|
|  | 128 | if uSurgeryTitles.ShortList.Count > 0 then | 
|---|
|  | 129 | begin | 
|---|
|  | 130 | Dest.Add('0^________________________________________________________________________'); | 
|---|
|  | 131 | Dest.Add('0^ '); | 
|---|
|  | 132 | end; | 
|---|
|  | 133 | end; | 
|---|
|  | 134 |  | 
|---|
|  | 135 | function SubSetOfSurgeryTitles(const StartFrom: string; Direction: Integer; AClassName: string): TStrings; | 
|---|
|  | 136 | { returns a pointer to a list of Surgery progress note titles (for use in a long list box) - | 
|---|
|  | 137 | The return value is a pointer to RPCBrokerV.Results, so the data must be used BEFORE | 
|---|
|  | 138 | the next broker call! } | 
|---|
|  | 139 | begin | 
|---|
|  | 140 | // pass in class name based on OR/non-OR | 
|---|
|  | 141 | CallV('TIU LONG LIST SURGERY TITLES', [StartFrom, Direction, AClassName]); | 
|---|
|  | 142 | //MixedCaseList(RPCBrokerV.Results); | 
|---|
|  | 143 | Result := RPCBrokerV.Results; | 
|---|
|  | 144 | end; | 
|---|
|  | 145 |  | 
|---|
|  | 146 | function IsSurgeryTitle(TitleIEN: Integer): Boolean; | 
|---|
|  | 147 | begin | 
|---|
|  | 148 | Result := False; | 
|---|
|  | 149 | if not ShowSurgeryTab then exit; | 
|---|
|  | 150 | if TitleIEN <= 0 then Exit; | 
|---|
|  | 151 | Result := sCallV('TIU IS THIS A SURGERY?', [TitleIEN]) = '1'; | 
|---|
|  | 152 | end; | 
|---|
|  | 153 |  | 
|---|
|  | 154 | {--------------- data retrieval ------------------------------------------} | 
|---|
|  | 155 |  | 
|---|
|  | 156 | procedure GetSurgCaseList(Dest: TStrings; Early, Late: double; Context, Max: integer); | 
|---|
|  | 157 | { returns a list of surgery cases for a patient, based on selected dates, service, status, or ALL} | 
|---|
|  | 158 | (* | 
|---|
|  | 159 | CASE #^Operative Procedure^Date/Time of Operation^Surgeon;Surgeon name^^^^^^^^^+^Context*) | 
|---|
|  | 160 | var | 
|---|
|  | 161 | date1, date2: string; | 
|---|
|  | 162 | begin | 
|---|
|  | 163 | if Early <= 0 then date1 := '' else date1 := FloatToStr(Early) ; | 
|---|
|  | 164 | if Late  <= 0 then date2 := '' else date2 := FloatToStr(Late)  ; | 
|---|
|  | 165 | CallV('ORWSR LIST', [Patient.DFN, date1, date2, Context, Max]); | 
|---|
|  | 166 | with RPCBrokerV do | 
|---|
|  | 167 | begin | 
|---|
|  | 168 | if Results.Count > 0 then | 
|---|
|  | 169 | begin | 
|---|
|  | 170 | SortByPiece(TStringList(Results), U, 2); | 
|---|
|  | 171 | InvertStringList(TStringList(Results)); | 
|---|
|  | 172 | Dest.Assign(Results); | 
|---|
|  | 173 | end | 
|---|
|  | 174 | else | 
|---|
|  | 175 | begin | 
|---|
|  | 176 | Dest.Clear ; | 
|---|
|  | 177 | Dest.Add('-1^No Matches') ; | 
|---|
|  | 178 | end ; | 
|---|
|  | 179 | end; | 
|---|
|  | 180 | end; | 
|---|
|  | 181 |  | 
|---|
|  | 182 | procedure ListSurgeryCases(Dest: TStrings); | 
|---|
|  | 183 | { returns a list of surgery cases for a patient, without documents, for fNoteProps case selection} | 
|---|
|  | 184 | //CASE #^Operative Procedure^Date/Time of Operation^Surgeon;Surgeon name) | 
|---|
|  | 185 | begin | 
|---|
|  | 186 | CallV('ORWSR CASELIST', [Patient.DFN]); | 
|---|
|  | 187 | with RPCBrokerV do | 
|---|
|  | 188 | begin | 
|---|
|  | 189 | if Results.Count > 0 then | 
|---|
|  | 190 | begin | 
|---|
|  | 191 | SortByPiece(TStringList(Results), U, 3); | 
|---|
|  | 192 | InvertStringList(TStringList(Results)); | 
|---|
|  | 193 | SetListFMDateTime('mmm dd,yy hh:nn', TStringList(Results), U, 3); | 
|---|
|  | 194 | Dest.Assign(Results); | 
|---|
|  | 195 | end | 
|---|
|  | 196 | else | 
|---|
|  | 197 | begin | 
|---|
|  | 198 | Dest.Clear ; | 
|---|
|  | 199 | Dest.Add('-1^No Cases Found') ; | 
|---|
|  | 200 | end ; | 
|---|
|  | 201 | end; | 
|---|
|  | 202 | end; | 
|---|
|  | 203 |  | 
|---|
|  | 204 |  | 
|---|
|  | 205 | procedure LoadSurgReportText(Dest: TStrings; IEN: integer) ; | 
|---|
|  | 206 | { returns the text of a surgery report } | 
|---|
|  | 207 | begin | 
|---|
|  | 208 | CallV('TIU GET RECORD TEXT', [IEN]); | 
|---|
|  | 209 | Dest.Assign(RPCBrokerV.Results); | 
|---|
|  | 210 | end; | 
|---|
|  | 211 |  | 
|---|
|  | 212 | procedure LoadSurgReportDetail(Dest: TStrings; IEN: integer) ; | 
|---|
|  | 213 | { returns the detail of a surgery report } | 
|---|
|  | 214 | begin | 
|---|
|  | 215 | CallV('TIU DETAILED DISPLAY', [IEN]); | 
|---|
|  | 216 | Dest.Assign(RPCBrokerV.Results); | 
|---|
|  | 217 | end; | 
|---|
|  | 218 |  | 
|---|
|  | 219 | (*procedure LoadOpTop(Dest: TStrings; ACaseIEN: integer; IsNonORProc, ShowReport: boolean) ; | 
|---|
|  | 220 | { returns the OpTop for a surgical case } | 
|---|
|  | 221 | begin | 
|---|
|  | 222 | if IsNonORProc then | 
|---|
|  | 223 | CallV('ORWSR OPTOP NON-OR', [ACaseIEN, ShowReport]) | 
|---|
|  | 224 | else | 
|---|
|  | 225 | CallV('ORWSR OPTOP', [ACaseIEN, ShowReport]); | 
|---|
|  | 226 | with RPCBrokerV do | 
|---|
|  | 227 | begin | 
|---|
|  | 228 | //if Results.Count > 0 then Results.Delete(0);   //This is the value of the ShowOpTopOnSignature site parameter. | 
|---|
|  | 229 | Dest.Assign(Results); | 
|---|
|  | 230 | end; | 
|---|
|  | 231 | end;*) | 
|---|
|  | 232 |  | 
|---|
|  | 233 | function GetCurrentSurgCaseContext: TSurgCaseContext; | 
|---|
|  | 234 | var | 
|---|
|  | 235 | x: string; | 
|---|
|  | 236 | AContext: TSurgCaseContext; | 
|---|
|  | 237 | begin | 
|---|
|  | 238 | x := sCallV('ORWSR GET SURG CONTEXT', [User.DUZ]) ; | 
|---|
|  | 239 | with AContext do | 
|---|
|  | 240 | begin | 
|---|
|  | 241 | Changed       := True; | 
|---|
|  | 242 | BeginDate     := Piece(x, ';', 1); | 
|---|
|  | 243 | FMBeginDate   := StrToFMDateTime(BeginDate); | 
|---|
|  | 244 | EndDate       := Piece(x, ';', 2); | 
|---|
|  | 245 | FMEndDate     := StrToFMDateTime(EndDate); | 
|---|
|  | 246 | Status        := Piece(x, ';', 3); | 
|---|
|  | 247 | GroupBy       := Piece(x, ';', 4); | 
|---|
|  | 248 | MaxDocs       := StrToIntDef(Piece(x, ';', 5), 0); | 
|---|
|  | 249 | TreeAscending     := (Piece(x, ';', 6) = '1'); | 
|---|
|  | 250 | end; | 
|---|
|  | 251 | Result := AContext; | 
|---|
|  | 252 | end ; | 
|---|
|  | 253 |  | 
|---|
|  | 254 | procedure SaveCurrentSurgCaseContext(AContext: TSurgCaseContext) ; | 
|---|
|  | 255 | var | 
|---|
|  | 256 | x: string; | 
|---|
|  | 257 | begin | 
|---|
|  | 258 | with AContext do | 
|---|
|  | 259 | begin | 
|---|
|  | 260 | SetPiece(x, ';', 1, BeginDate); | 
|---|
|  | 261 | SetPiece(x, ';', 2, EndDate); | 
|---|
|  | 262 | SetPiece(x, ';', 3, Status); | 
|---|
|  | 263 | SetPiece(x, ';', 4, GroupBy); | 
|---|
|  | 264 | SetPiece(x, ';', 5, IntToStr(MaxDocs)); | 
|---|
|  | 265 | SetPiece(x, ';', 6, BOOLCHAR[TreeAscending]); | 
|---|
|  | 266 | end; | 
|---|
|  | 267 | CallV('ORWSR SAVE SURG CONTEXT', [x]); | 
|---|
|  | 268 | end; | 
|---|
|  | 269 |  | 
|---|
|  | 270 | function GetSurgCaseRefForNote(NoteIEN: integer): string; | 
|---|
|  | 271 | var | 
|---|
|  | 272 | x: string; | 
|---|
|  | 273 | begin | 
|---|
|  | 274 | x := sCallV('TIU GET REQUEST', [NoteIEN]); | 
|---|
|  | 275 | if Piece(x, ';', 2) <> 'SRF(' then | 
|---|
|  | 276 | Result := '-1' | 
|---|
|  | 277 | else | 
|---|
|  | 278 | Result := x | 
|---|
|  | 279 | end; | 
|---|
|  | 280 |  | 
|---|
|  | 281 | procedure GetSingleCaseListItemWithDocs(Dest: TStrings; NoteIEN: integer); | 
|---|
|  | 282 | begin | 
|---|
|  | 283 | CallV('ORWSR ONECASE', [NoteIEN]); | 
|---|
|  | 284 | Dest.Assign(RPCBrokerV.Results); | 
|---|
|  | 285 | end; | 
|---|
|  | 286 |  | 
|---|
|  | 287 | function GetSingleCaseListItemWithoutDocs(NoteIEN: integer): string; | 
|---|
|  | 288 | begin | 
|---|
|  | 289 | CallV('ORWSR ONECASE', [NoteIEN]); | 
|---|
|  | 290 | if RPCBrokerV.Results.Count > 0 then Result := RPCBrokerV.Results[0]; | 
|---|
|  | 291 | end; | 
|---|
|  | 292 |  | 
|---|
|  | 293 | (*function  ShowOpTopOnSignature(ACaseIEN: integer): integer; | 
|---|
|  | 294 | begin | 
|---|
|  | 295 | with uShowOpTop do | 
|---|
|  | 296 | begin | 
|---|
|  | 297 | if not Evaluated then | 
|---|
|  | 298 | begin | 
|---|
|  | 299 | ShowIt := StrToIntDef(sCallV('ORWSR SHOW OPTOP WHEN SIGNING', [ACaseIEN]), 0); | 
|---|
|  | 300 | Evaluated := True; | 
|---|
|  | 301 | end; | 
|---|
|  | 302 | Result := ShowIt; | 
|---|
|  | 303 | end; | 
|---|
|  | 304 | end;*) | 
|---|
|  | 305 |  | 
|---|
|  | 306 | function IsNonORProcedure(ACaseIEN: integer): boolean; | 
|---|
|  | 307 | begin | 
|---|
|  | 308 | Result := sCallV('ORWSR IS NON-OR PROCEDURE', [ACaseIEN]) = '1'; | 
|---|
|  | 309 | end; | 
|---|
|  | 310 |  | 
|---|
|  | 311 | initialization | 
|---|
|  | 312 |  | 
|---|
|  | 313 | finalization | 
|---|
|  | 314 | if uSurgeryTitles <> nil then uSurgeryTitles.Free; | 
|---|
|  | 315 |  | 
|---|
|  | 316 | end. | 
|---|