[456] | 1 | unit fProbEdt;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | SysUtils, windows, Messages, Classes, Graphics, Controls,
|
---|
| 7 | Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Grids,
|
---|
[830] | 8 | ORCtrls, Vawrgrid, uCore, Menus, uConst, fBase508Form,
|
---|
| 9 | VA508AccessibilityManager;
|
---|
[456] | 10 |
|
---|
| 11 | const
|
---|
| 12 | SOC_QUIT = 1; { close single dialog }
|
---|
| 13 |
|
---|
| 14 | type
|
---|
[830] | 15 | TfrmdlgProb = class(TfrmBase508Form)
|
---|
[456] | 16 | Label1: TLabel;
|
---|
| 17 | Label5: TLabel;
|
---|
| 18 | edResDate: TCaptionEdit;
|
---|
| 19 | Label7: TLabel;
|
---|
| 20 | edUpdate: TCaptionEdit;
|
---|
| 21 | pnlBottom: TPanel;
|
---|
| 22 | bbQuit: TBitBtn;
|
---|
| 23 | bbFile: TBitBtn;
|
---|
| 24 | pnlComments: TPanel;
|
---|
| 25 | Bevel1: TBevel;
|
---|
| 26 | lblCmtDate: TOROffsetLabel;
|
---|
| 27 | lblComment: TOROffsetLabel;
|
---|
| 28 | lblCom: TStaticText;
|
---|
| 29 | bbAdd: TBitBtn;
|
---|
| 30 | bbRemove: TBitBtn;
|
---|
| 31 | lstComments: TORListBox;
|
---|
| 32 | bbEdit: TBitBtn;
|
---|
| 33 | pnlTop: TPanel;
|
---|
| 34 | lblAct: TLabel;
|
---|
| 35 | rgStatus: TKeyClickRadioGroup;
|
---|
| 36 | rgStage: TKeyClickRadioGroup;
|
---|
| 37 | bbChangeProb: TBitBtn;
|
---|
| 38 | edProb: TCaptionEdit;
|
---|
| 39 | gbTreatment: TGroupBox;
|
---|
| 40 | ckSC: TCheckBox;
|
---|
| 41 | ckRad: TCheckBox;
|
---|
| 42 | ckAO: TCheckBox;
|
---|
| 43 | ckENV: TCheckBox;
|
---|
| 44 | ckHNC: TCheckBox;
|
---|
| 45 | ckMST: TCheckBox;
|
---|
[830] | 46 | ckSHAD: TCheckBox;
|
---|
[456] | 47 | ckVerify: TCheckBox;
|
---|
| 48 | edRecDate: TCaptionEdit;
|
---|
| 49 | cbServ: TORComboBox;
|
---|
| 50 | cbLoc: TORComboBox;
|
---|
| 51 | lblLoc: TLabel;
|
---|
| 52 | cbProv: TORComboBox;
|
---|
| 53 | Label3: TLabel;
|
---|
| 54 | edOnsetdate: TCaptionEdit;
|
---|
| 55 | Label6: TLabel;
|
---|
| 56 | procedure bbQuitClick(Sender: TObject);
|
---|
| 57 | procedure bbAddComClick(Sender: TObject);
|
---|
| 58 | procedure FormShow(Sender: TObject);
|
---|
| 59 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 60 | procedure bbFileClick(Sender: TObject);
|
---|
| 61 | procedure bbRemoveClick(Sender: TObject);
|
---|
| 62 | procedure cbProvKeyPress(Sender: TObject; var Key: Char);
|
---|
| 63 | procedure rgStatusClick(Sender: TObject);
|
---|
| 64 | procedure cbProvClick(Sender: TObject);
|
---|
| 65 | procedure cbLocClick(Sender: TObject);
|
---|
| 66 | procedure cbLocKeyPress(Sender: TObject; var Key: Char);
|
---|
| 67 | procedure SetDefaultProb(Alist:TstringList;prob:string);
|
---|
| 68 | procedure ControlChange(Sender: TObject);
|
---|
| 69 | function BadDates:Boolean;
|
---|
| 70 | procedure cbProvDropDown(Sender: TObject);
|
---|
| 71 | procedure cbLocDropDown(Sender: TObject);
|
---|
| 72 | procedure FormCreate(Sender: TObject);
|
---|
| 73 | procedure bbChangeProbClick(Sender: TObject);
|
---|
| 74 | procedure cbLocNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 75 | Direction, InsertAt: Integer);
|
---|
| 76 | procedure cbProvNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 77 | Direction, InsertAt: Integer);
|
---|
| 78 | procedure cbServNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 79 | Direction, InsertAt: Integer);
|
---|
| 80 | procedure bbEditClick(Sender: TObject);
|
---|
| 81 | private
|
---|
| 82 | { Private declarations }
|
---|
| 83 | FEditing: Boolean;
|
---|
| 84 | FInitialShow: Boolean;
|
---|
| 85 | FModified: Boolean;
|
---|
| 86 | FProviderID: Int64;
|
---|
| 87 | FLocationID: Longint;
|
---|
| 88 | FDisplayGroupID: Integer;
|
---|
| 89 | FInitialFocus: TWinControl;
|
---|
| 90 | FCtrlMap: TStringList;
|
---|
| 91 | FSourceOfClose: Integer;
|
---|
| 92 | FOnInitiate: TNotifyEvent;
|
---|
| 93 | fChanged:boolean;
|
---|
| 94 | FSilent: boolean;
|
---|
| 95 | FCanQuit: boolean;
|
---|
| 96 |
|
---|
| 97 | procedure UMTakeFocus(var Message: TMessage); message UM_TAKEFOCUS;
|
---|
| 98 | procedure ShowComments;
|
---|
| 99 | procedure GetEditedComments;
|
---|
| 100 | procedure GetNewComments(Reason:char);
|
---|
| 101 | function OkToQuit:boolean;
|
---|
| 102 | protected
|
---|
| 103 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
| 104 | procedure DoShow; override;
|
---|
| 105 | procedure Loaded; override;
|
---|
| 106 | procedure ClearDialogControls; virtual;
|
---|
| 107 | function LackRequired: Boolean; virtual;
|
---|
| 108 | procedure LoadDefaults; virtual;
|
---|
| 109 | property InitialFocus: TWinControl read FInitialFocus write FInitialFocus;
|
---|
| 110 | public
|
---|
| 111 | { Public declarations }
|
---|
| 112 | Reason:Char;
|
---|
| 113 | problemIFN:String;
|
---|
| 114 | subjProb:string; {parameters for problem being added}
|
---|
| 115 | constructor Create(AOwner: TComponent); override ;
|
---|
| 116 | destructor Destroy; override;
|
---|
| 117 | property DisplayGroupID: Integer read FDisplayGroupID write FDisplayGroupID;
|
---|
| 118 | property Editing: Boolean read FEditing write FEditing;
|
---|
| 119 | property Silent: Boolean read FSilent write FSilent;
|
---|
| 120 | property ProviderID: Int64 read FProviderID write FProviderID;
|
---|
| 121 | property LocationID: Longint read FLocationID write FLocationID;
|
---|
| 122 | property SourceOfClose: Integer read FSourceOfClose write FSourceOfClose;
|
---|
| 123 | property OnInitiate: TNotifyEvent read FOnInitiate write FOnInitiate;
|
---|
| 124 | procedure SetFontSize( NewFontSize: integer);
|
---|
| 125 | property CanQuit: boolean read FCanQuit write FCanQuit;
|
---|
| 126 | end ;
|
---|
| 127 |
|
---|
| 128 | implementation
|
---|
| 129 |
|
---|
| 130 | {$R *.DFM}
|
---|
| 131 |
|
---|
[830] | 132 | uses ORFn, uProbs, fProbs, rProbs, fCover, rCover, rCore, fProbCmt, fProbLex, rPCE, uInit ,
|
---|
| 133 | VA508AccessibilityRouter;
|
---|
[456] | 134 |
|
---|
| 135 | type
|
---|
| 136 | TDialogItem = class { for loading edits & quick orders }
|
---|
| 137 | ControlName: string;
|
---|
| 138 | DialogPtr: Integer;
|
---|
| 139 | Instance: Integer;
|
---|
| 140 | end;
|
---|
| 141 |
|
---|
| 142 | function TfrmdlgProb.OkToQuit:boolean;
|
---|
| 143 | begin
|
---|
| 144 | Result := not fChanged;
|
---|
| 145 | end;
|
---|
| 146 |
|
---|
| 147 | procedure TfrmdlgProb.bbQuitClick(Sender: TObject);
|
---|
| 148 | begin
|
---|
| 149 | if OkToQuit then
|
---|
| 150 | begin
|
---|
| 151 | frmProblems.lblProbList.caption := frmProblems.pnlRight.Caption ;
|
---|
| 152 | close;
|
---|
| 153 | end
|
---|
| 154 | else
|
---|
| 155 | begin
|
---|
| 156 | if (not FSilent) and
|
---|
| 157 | (InfoBox('Discard changes?', 'Add/Edit a Problem', MB_YESNO or MB_ICONQUESTION) <> IDYES) then
|
---|
| 158 | begin
|
---|
| 159 | FCanQuit := False;
|
---|
| 160 | exit;
|
---|
| 161 | end
|
---|
| 162 | else
|
---|
| 163 | begin
|
---|
| 164 | frmProblems.lblProbList.caption := frmProblems.pnlRight.Caption ;
|
---|
| 165 | FCanQuit := True;
|
---|
| 166 | close;
|
---|
| 167 | end;
|
---|
| 168 | end;
|
---|
| 169 | end;
|
---|
| 170 |
|
---|
| 171 | procedure TfrmdlgProb.bbAddComClick(Sender: TObject);
|
---|
| 172 | var
|
---|
| 173 | cmt: string ;
|
---|
| 174 | begin
|
---|
| 175 | cmt := NewComment ;
|
---|
| 176 | if StrToInt(Piece(cmt, U, 1)) > 0 then
|
---|
| 177 | begin
|
---|
| 178 | lstComments.Items.Add(Pieces(cmt, U, 2, 3)) ;
|
---|
| 179 | fChanged := true;
|
---|
| 180 | end ;
|
---|
| 181 | end;
|
---|
| 182 |
|
---|
| 183 | procedure TfrmdlgProb.bbEditClick(Sender: TObject);
|
---|
| 184 | var
|
---|
| 185 | cmt: string ;
|
---|
| 186 | begin
|
---|
| 187 | if lstComments.ItemIndex < 0 then Exit;
|
---|
| 188 | cmt := EditComment(lstComments.Items[lstComments.ItemIndex]) ;
|
---|
| 189 | if StrToInt(Piece(cmt, U, 1)) > 0 then
|
---|
| 190 | begin
|
---|
| 191 | lstComments.Items[lstComments.ItemIndex] := Pieces(cmt, U, 2, 3) ;
|
---|
| 192 | fChanged := true;
|
---|
| 193 | end ;
|
---|
| 194 | end;
|
---|
| 195 |
|
---|
| 196 | procedure TfrmdlgProb.FormShow(Sender: TObject);
|
---|
| 197 | var
|
---|
| 198 | alist: TstringList;
|
---|
| 199 | Anchorses: Array of TAnchors;
|
---|
| 200 | i: integer;
|
---|
| 201 | begin
|
---|
| 202 | if ProbRec <> nil then exit;
|
---|
| 203 | if (ResizeWidth(Font,MainFont,Width) >= Parent.ClientWidth) and
|
---|
| 204 | (ResizeHeight(Font,MainFont,Height) >= Parent.ClientHeight) then
|
---|
| 205 | begin //This form won't fit when it resizes, so we have to take Drastic Measures
|
---|
| 206 | SetLength(Anchorses, dlgProbs.ControlCount);
|
---|
| 207 | for i := 0 to ControlCount - 1 do
|
---|
| 208 | begin
|
---|
| 209 | Anchorses[i] := Controls[i].Anchors;
|
---|
| 210 | Controls[i].Anchors := [akLeft, akTop];
|
---|
| 211 | end;
|
---|
| 212 | SetFontSize(MainFontSize);
|
---|
| 213 | RequestAlign;
|
---|
| 214 | for i := 0 to ControlCount - 1 do
|
---|
| 215 | Controls[i].Anchors := Anchorses[i];
|
---|
| 216 | end
|
---|
| 217 | else
|
---|
| 218 | begin
|
---|
| 219 | SetFontSize(MainFontSize);
|
---|
| 220 | RequestAlign;
|
---|
| 221 | end;
|
---|
| 222 | frmProblems.mnuView.Enabled := False;
|
---|
| 223 | frmProblems.mnuAct.Enabled := False ;
|
---|
| 224 | frmProblems.lstView.Enabled := False;
|
---|
| 225 | frmProblems.bbNewProb.Enabled := False ;
|
---|
| 226 | Alist := TstringList.create;
|
---|
| 227 | try
|
---|
| 228 | if Reason = 'E' then
|
---|
| 229 | lblact.caption := 'Editing:'
|
---|
| 230 | else if Reason = 'A' then
|
---|
| 231 | lblact.caption := 'Adding'
|
---|
| 232 | else {display, comment edit or remove problem}
|
---|
| 233 | begin
|
---|
| 234 | case reason of 'C','c': lblact.caption := 'Comment Edit';
|
---|
| 235 | 'R','r': lblact.caption := 'Remove Problem:';
|
---|
| 236 | end; {case}
|
---|
| 237 | {ckVerify.Enabled:=false;}
|
---|
| 238 | cbProv.Enabled := false;
|
---|
| 239 | cbLoc.Enabled := false;
|
---|
| 240 | bbRemove.enabled := false;
|
---|
| 241 | rgStatus.Enabled := false;
|
---|
| 242 | rgStage.Enabled := false;
|
---|
| 243 | edRecdate.enabled := false;
|
---|
| 244 | edResdate.enabled := false;
|
---|
| 245 | edOnsetDate.enabled := false;
|
---|
| 246 | ckSC.enabled := false;
|
---|
| 247 | ckRAD.enabled := false;
|
---|
| 248 | ckAO.enabled := false;
|
---|
| 249 | ckENV.enabled := false;
|
---|
| 250 | ckHNC.enabled := false;
|
---|
| 251 | ckMST.enabled := false;
|
---|
[830] | 252 | ckSHAD.enabled := false;
|
---|
[456] | 253 | if Reason = 'R' then bbFile.caption := 'Remove';
|
---|
| 254 | end;
|
---|
| 255 | edProb.Caption := lblact.Caption;
|
---|
| 256 | if Piece(subjProb,U,3) <> '' then
|
---|
| 257 | edProb.Text := Piece(subjProb, u, 2) + ' (' + Piece(subjProb, u, 3) + ')'
|
---|
| 258 | else
|
---|
| 259 | edProb.Text := Piece(subjProb, u, 2);
|
---|
| 260 | {line up problem action and title}
|
---|
| 261 | {edProb.Left:=lblAct.left+lblAct.width+2;}
|
---|
| 262 | {get problem}
|
---|
| 263 | if Reason <> 'A' then
|
---|
| 264 | begin {edit,remove or display existing problem}
|
---|
| 265 | problemIFN := Piece(subjProb, u, 1);
|
---|
[830] | 266 | FastAssign(EditLoad(ProblemIFN, User.DUZ, PLPt.ptVAMC), AList) ; //V17.5 RV
|
---|
[456] | 267 | end
|
---|
| 268 | else {new problem}
|
---|
| 269 | SetDefaultProb(Alist, subjProb);
|
---|
| 270 | if Alist.count = 0 then
|
---|
| 271 | begin
|
---|
| 272 | InfoBox('No Data on Host for problem ' + ProblemIFN, 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
| 273 | close;
|
---|
| 274 | exit;
|
---|
| 275 | end;
|
---|
| 276 | ProbRec := TProbRec.Create(Alist); {create a problem object}
|
---|
| 277 | ProbRec.PIFN := ProblemIFN;
|
---|
| 278 | ProbRec.EnteredBy.DHCPtoKeyVal(inttostr(User.DUZ) + u + User.Name);
|
---|
| 279 | ProbRec.RecordedBy.DHCPtoKeyVal(inttostr(Encounter.Provider) + u + Encounter.ProviderName);
|
---|
| 280 | {fill in defaults}
|
---|
| 281 | edOnsetdate.text := ProbRec.DateOnsetStr;
|
---|
| 282 | if Probrec.status <> 'A' then
|
---|
| 283 | begin
|
---|
| 284 | rgStatus.itemindex := 1;
|
---|
| 285 | rgStage.Visible := False ;
|
---|
| 286 | end;
|
---|
| 287 | if Probrec.Priority = 'A' then
|
---|
| 288 | rgStage.itemindex := 0
|
---|
| 289 | else if Probrec.Priority = 'C' then
|
---|
| 290 | rgStage.itemindex := 1
|
---|
| 291 | else
|
---|
| 292 | rgStage.itemindex := 2;
|
---|
| 293 | rgStatus.TabStop := (rgStatus.ItemIndex = -1);
|
---|
| 294 | rgStage.TabStop := (rgStage.ItemIndex = -1);
|
---|
| 295 | edRecDate.text := Probrec.DateRecStr;
|
---|
| 296 | edUpdate.text := Probrec.DateModStr;
|
---|
| 297 | edResDate.text := ProbRec.DateResStr;
|
---|
| 298 | edUpdate.enabled := false;
|
---|
| 299 | if pos(Reason,'CR') = 0 then
|
---|
| 300 | with PLPt do
|
---|
| 301 | begin
|
---|
| 302 | if UpperCase(Reason) = 'E' then
|
---|
| 303 | begin
|
---|
| 304 | ckSC.Enabled := ProbRec.SCProblem or PtServiceConnected;
|
---|
| 305 | ckSC.checked := ProbRec.SCProblem;
|
---|
| 306 | end
|
---|
| 307 | else
|
---|
| 308 | begin
|
---|
| 309 | ckSC.enabled := PtServiceConnected ;
|
---|
| 310 | ckSC.checked := ProbRec.SCProblem and PtServiceConnected ;
|
---|
| 311 | end;
|
---|
| 312 | ckAO.enabled := PtAgentOrange ;
|
---|
| 313 | ckRAD.enabled := PtRadiation ;
|
---|
| 314 | ckENV.enabled := PtEnvironmental ;
|
---|
| 315 | ckHNC.enabled := PtHNC ;
|
---|
| 316 | ckMST.enabled := PtMST ;
|
---|
[830] | 317 | ckSHAD.Enabled := PtSHAD;
|
---|
[456] | 318 | ckAO.checked := Probrec.AOProblem and PtAgentOrange;
|
---|
| 319 | ckRAD.checked := Probrec.RADProblem and PtRadiation;
|
---|
| 320 | ckENV.checked := Probrec.ENVProblem and PtEnvironmental;
|
---|
| 321 | ckHNC.checked := Probrec.HNCProblem and PtHNC;
|
---|
| 322 | ckMST.checked := Probrec.MSTProblem and PtMST;
|
---|
[830] | 323 | ckSHAD.Checked := Probrec.SHADProlem and PtSHAD;
|
---|
[456] | 324 | end ;
|
---|
| 325 | cbProv.InitLongList(ProbRec.RespProvider.extern) ;
|
---|
| 326 | if (ProbRec.RespProvider.intern <> '') and (StrToInt64Def(ProbRec.RespProvider.intern, 0) > 0) then
|
---|
| 327 | cbProv.SelectByIEN(StrToInt64(ProbRec.RespProvider.intern)) ;
|
---|
| 328 |
|
---|
| 329 | if UpperCase(Reason) = 'A' then
|
---|
| 330 | begin
|
---|
| 331 | if Encounter.Inpatient then
|
---|
| 332 | begin
|
---|
| 333 | cbLoc.visible:=false;
|
---|
| 334 | cbServ.Visible:=true;
|
---|
| 335 | lblLoc.caption:='Service:';
|
---|
| 336 | cbServ.InitLongList('');
|
---|
| 337 | end
|
---|
| 338 | else
|
---|
| 339 | begin
|
---|
| 340 | cbLoc.visible:=true;
|
---|
| 341 | cbServ.Visible:=false;
|
---|
| 342 | lblLoc.caption:='Clinic:';
|
---|
| 343 | cbLoc.InitLongList(Encounter.LocationName) ;
|
---|
| 344 | cbLoc.SelectByIEN(Encounter.Location);
|
---|
| 345 | end;
|
---|
| 346 | end
|
---|
| 347 | else
|
---|
| 348 | begin
|
---|
| 349 | if (ProbRec.Service.DHCPField = '^') and (ProbRec.Clinic.DHCPField <> '^') then
|
---|
| 350 | begin
|
---|
| 351 | cbLoc.visible:=true;
|
---|
| 352 | cbServ.Visible:=false;
|
---|
| 353 | lblLoc.caption:='Clinic:';
|
---|
| 354 | cbLoc.InitLongList(ProbRec.Clinic.Extern) ;
|
---|
| 355 | cbLoc.SelectByID(ProbRec.Clinic.Intern) ;
|
---|
| 356 | end
|
---|
| 357 | else if (ProbRec.Clinic.DHCPField = '^') and (ProbRec.Service.DHCPField <> '^') then
|
---|
| 358 | begin
|
---|
| 359 | cbLoc.visible:=false;
|
---|
| 360 | cbServ.Visible:=true;
|
---|
| 361 | lblLoc.caption:='Service:';
|
---|
| 362 | cbServ.InitLongList(ProbRec.Service.Extern) ;
|
---|
| 363 | cbServ.SelectByID(ProbRec.Service.Intern) ;
|
---|
| 364 | end
|
---|
| 365 | else
|
---|
| 366 | begin
|
---|
| 367 | if Encounter.Inpatient then
|
---|
| 368 | begin
|
---|
| 369 | cbLoc.visible:=false;
|
---|
| 370 | cbServ.Visible:=true;
|
---|
| 371 | lblLoc.caption:='Service:';
|
---|
| 372 | cbServ.InitLongList('');
|
---|
| 373 | end
|
---|
| 374 | else
|
---|
| 375 | begin
|
---|
| 376 | cbLoc.visible:=true;
|
---|
| 377 | cbServ.Visible:=false;
|
---|
| 378 | lblLoc.caption:='Clinic:';
|
---|
| 379 | cbLoc.InitLongList('') ;
|
---|
| 380 | end;
|
---|
| 381 | end;
|
---|
| 382 | end;
|
---|
| 383 | cbLoc.Caption := lblLoc.Caption;
|
---|
| 384 |
|
---|
| 385 | if Pos(Reason,'E,C') > 0 then ShowComments ;
|
---|
| 386 | if ProbRec.CmtIsXHTML then
|
---|
| 387 | begin
|
---|
| 388 | bbAdd.Enabled := FALSE;
|
---|
| 389 | bbEdit.Enabled := FALSE;
|
---|
| 390 | bbRemove.Enabled := FALSE;
|
---|
| 391 | pnlComments.Hint := ProbRec.CmtNoEditReason;
|
---|
| 392 | end
|
---|
| 393 | else
|
---|
| 394 | begin
|
---|
| 395 | bbAdd.Enabled := TRUE;
|
---|
| 396 | bbEdit.Enabled := TRUE;
|
---|
| 397 | bbRemove.Enabled := TRUE;
|
---|
| 398 | pnlComments.Hint := '';
|
---|
| 399 | end ;
|
---|
| 400 | // =================== changed code - REV 7/30/98 =========================
|
---|
| 401 | // PlUser.usVerifyTranscribed is a SITE requirement, not a user ability
|
---|
| 402 | if Reason = 'A' then
|
---|
| 403 | begin
|
---|
| 404 | if PlUser.usVerifyTranscribed and not PlUser.usPrimeUser then
|
---|
| 405 | ckVerify.Checked := False
|
---|
| 406 | else
|
---|
| 407 | ckVerify.Checked := True;
|
---|
| 408 | end
|
---|
| 409 | else ckVerify.checked := (Probrec.condition = 'P');
|
---|
| 410 | //===========================================================================
|
---|
| 411 | (* if (PlUSer.usVerifyTranscribed) and (Reason='A') then
|
---|
| 412 | begin {some users can add and verify}
|
---|
| 413 | {ckVerify.visible:=true;}
|
---|
| 414 | ckVerify.checked:=true; {assume it will be entered verified}
|
---|
| 415 | end {others can add and edit verified status}
|
---|
| 416 | else if (PlUSer.usVerifyTranscribed) and (PlUser.usPrimeUser) then
|
---|
| 417 | begin
|
---|
| 418 | {ckVerify.visible:=true; }
|
---|
| 419 | ckVerify.checked:=(Probrec.condition='P');
|
---|
| 420 | end; *)
|
---|
| 421 | if Reason <> 'A' then fChanged := False else fChanged := True; {initialize form for changes}
|
---|
| 422 | finally
|
---|
| 423 | alist.free;
|
---|
| 424 | end;
|
---|
| 425 | end;
|
---|
| 426 |
|
---|
| 427 | procedure TfrmdlgProb.ShowComments;
|
---|
| 428 | var
|
---|
| 429 | i:integer;
|
---|
| 430 | begin
|
---|
| 431 | with ProbRec do
|
---|
| 432 | for i:=0 to Pred(fComments.count) do
|
---|
| 433 | lstComments.Items.Add(TComment(fComments[i]).ExtDateAdd + '^' + TComment(fComments[i]).Narrative);
|
---|
| 434 | end;
|
---|
| 435 |
|
---|
| 436 |
|
---|
| 437 | procedure TfrmdlgProb.FormClose(Sender: TObject; var Action: TCloseAction);
|
---|
| 438 | var
|
---|
| 439 | Alist: TStringList;
|
---|
| 440 | begin
|
---|
| 441 | AList := TStringList.Create;
|
---|
| 442 | try
|
---|
| 443 | //frmProblems.lblProbList.caption := frmProblems.pnlRight.Caption ; {moved to bbQuit - only on CANCEL}
|
---|
| 444 | TWinControl(parent).visible := false;
|
---|
| 445 | with frmProblems do
|
---|
| 446 | begin
|
---|
| 447 | pnlProbList.Visible := False ;
|
---|
| 448 | edProbEnt.text := '';
|
---|
| 449 | pnlView.BringToFront ;
|
---|
| 450 | pnlView.Show ;
|
---|
| 451 | mnuView.Enabled := True;
|
---|
| 452 | mnuAct.Enabled := True ;
|
---|
| 453 | lstView.Enabled := True ;
|
---|
| 454 | bbNewProb.Enabled := true ;
|
---|
| 455 | if fChanged then LoadPatientProblems(AList,PLUser.usViewAct[1],false);
|
---|
| 456 | end ;
|
---|
| 457 | Action := caFree;
|
---|
| 458 | finally
|
---|
| 459 | AList.Free;
|
---|
| 460 | end;
|
---|
| 461 | end;
|
---|
| 462 |
|
---|
| 463 | {--------------------------------- file ---------------------------------}
|
---|
| 464 |
|
---|
| 465 | procedure TfrmdlgProb.bbFileClick(Sender: TObject);
|
---|
| 466 | const
|
---|
| 467 | TX_INACTIVE_CODE = 'This problem references an inactive ICD code.' + #13#10 +
|
---|
| 468 | 'The code must be updated using the ''Change''' + #13#10 +
|
---|
| 469 | 'button before it can be saved';
|
---|
| 470 | TC_INACTIVE_CODE = 'Inactive Code';
|
---|
| 471 | var
|
---|
| 472 | AList: TstringList;
|
---|
| 473 | remcom, vu, ut: string;
|
---|
| 474 | i: integer;
|
---|
| 475 | begin
|
---|
| 476 | if (Reason <> 'R') and (Reason <> 'r') then
|
---|
| 477 | if (rgStatus.itemindex=-1) or (cbProv.itemindex=-1) then
|
---|
| 478 | begin
|
---|
| 479 | InfoBox('Status and Responsible Provider are required.', 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
| 480 | exit;
|
---|
| 481 | end;
|
---|
| 482 | if Reason in ['C','c','E','e'] then
|
---|
| 483 | if not IsActiveICDCode(ProbRec.Diagnosis.extern) then
|
---|
| 484 | begin
|
---|
| 485 | InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
|
---|
| 486 | exit;
|
---|
| 487 | end;
|
---|
| 488 | if BadDates then exit;
|
---|
| 489 | Alist:=TStringList.create;
|
---|
| 490 | try
|
---|
| 491 | screen.cursor := crHourGlass;
|
---|
| 492 | {if (ckVerify.visible) then }
|
---|
| 493 | if (ckVerify.Checked) then
|
---|
| 494 | ProbRec.Condition := 'P'
|
---|
| 495 | else
|
---|
| 496 | Probrec.Condition := 'T';
|
---|
| 497 | if rgStatus.itemindex = 0 then
|
---|
| 498 | Probrec.status := 'A'
|
---|
| 499 | else if rgstatus.itemindex = 1 then
|
---|
| 500 | Probrec.status := 'I';
|
---|
| 501 | if rgStage.itemindex = 0 then
|
---|
| 502 | Probrec.Priority := 'A'
|
---|
| 503 | else if rgStage.itemindex = 1 then
|
---|
| 504 | Probrec.Priority := 'C';
|
---|
| 505 | ProbRec.DateOnsetStr := edOnsetDate.text;
|
---|
| 506 | ProbRec.DateResStr := edResDate.text;{aka inactivation date}
|
---|
| 507 | ProbRec.DateRecStr := edRecDate.text;{recorded anywhere}
|
---|
| 508 | if edUpdate.text = '' then
|
---|
| 509 | ProbRec.DateModStr := DatetoStr(trunc(FMNow))
|
---|
| 510 | else
|
---|
| 511 | ProbRec.DateModStr := edUpdate.text; {last update}
|
---|
| 512 | (*if ckSC.enabled then *)Probrec.SCProblem := ckSC.checked;
|
---|
| 513 | if ckRAD.enabled then Probrec.RadProblem := ckrad.Checked;
|
---|
| 514 | if ckAO.enabled then ProbRec.AOProblem := ckAO.checked;
|
---|
| 515 | if ckENV.enabled then ProbRec.ENVProblem := ckENV.Checked;
|
---|
| 516 | if ckHNC.enabled then ProbRec.HNCProblem := ckHNC.Checked;
|
---|
| 517 | if ckMST.enabled then ProbRec.MSTProblem := ckMST.Checked;
|
---|
[830] | 518 | if ckSHAD.Enabled then ProbRec.SHADProlem := ckSHAD.Checked;
|
---|
[456] | 519 | if cbProv.itemindex = -1 then {Get provider}
|
---|
| 520 | begin
|
---|
| 521 | Probrec.respProvider.intern := '0';
|
---|
| 522 | Probrec.RespProvider.extern := '';
|
---|
| 523 | end
|
---|
| 524 | else
|
---|
| 525 | ProbRec.RespProvider.DHCPtoKeyVal(cbProv.Items[cbProv.itemindex]);
|
---|
| 526 | if cbLoc.itemindex = -1 then {Get Clinic}
|
---|
| 527 | begin
|
---|
| 528 | Probrec.Clinic.intern := '';
|
---|
| 529 | Probrec.Clinic.extern := '';
|
---|
| 530 | end
|
---|
| 531 | else
|
---|
| 532 | ProbRec.Clinic.DHCPtoKeyVal(cbLoc.Items[cbLoc.itemindex]);
|
---|
| 533 | if cbServ.itemindex = -1 then {Get Service}
|
---|
| 534 | begin
|
---|
| 535 | Probrec.Service.intern := '';
|
---|
| 536 | Probrec.Service.extern := '';
|
---|
| 537 | end
|
---|
| 538 | else
|
---|
| 539 | Probrec.Service.DHCPtoKeyVal(cbServ.Items[cbServ.itemindex]);
|
---|
| 540 | if ProbRec.Commentcount > 0 then GetEditedComments;
|
---|
| 541 | GetNewComments(Reason);
|
---|
| 542 | case Reason of
|
---|
| 543 | 'E','e','C','c': {edits or comments}
|
---|
| 544 | begin
|
---|
| 545 | ut := '';
|
---|
| 546 | if PLUser.usPrimeUser then ut := '1';
|
---|
[830] | 547 | FastAssign(EditSave(ProblemIFN, User.DUZ, PLPt.ptVAMC, ut, ProbRec.FilerObject), AList) ; //V17.5 RV
|
---|
[456] | 548 | end;
|
---|
| 549 | 'A','a': {new problem}
|
---|
[830] | 550 | FastAssign(AddSave(PLPt.GetGMPDFN(Patient.DFN, Patient.Name),
|
---|
| 551 | pProviderID, PLPt.ptVAMC, ProbRec.FilerObject), AList) ; //*DFN*
|
---|
[456] | 552 | 'R','r': {remove problem}
|
---|
| 553 | begin
|
---|
| 554 | remcom := '';
|
---|
| 555 | if Probrec.commentcount > 0 then
|
---|
| 556 | if TComment(Probrec.comments[pred(probrec.commentcount)]).IsNew then
|
---|
| 557 | remcom := TComment(Probrec.comments[pred(probrec.commentcount)]).Narrative;
|
---|
[830] | 558 | FastAssign(ProblemDelete(ProbRec.PIFN, User.DUZ, PLPt.ptVAMC, remcom), AList) ; //changed in v14
|
---|
[456] | 559 | end
|
---|
| 560 | else exit;
|
---|
| 561 | end; {case}
|
---|
| 562 | screen.cursor := crDefault;
|
---|
| 563 | if Alist.count < 1 then
|
---|
| 564 | InfoBox('Broker time out filing on Host. Try again in a moment or cancel', 'Information', MB_OK or MB_ICONINFORMATION)
|
---|
| 565 | else if Alist[0] = '1' then
|
---|
| 566 | begin
|
---|
| 567 | Alist.clear;
|
---|
| 568 | vu:=PLUser.usViewAct;
|
---|
| 569 | fChanged := True; {ensure update of problem list on close}
|
---|
| 570 | //frmProblems.LoadPatientProblems(AList,vu[1],false);
|
---|
| 571 | { update cover sheet problem list }
|
---|
| 572 | with frmCover do
|
---|
| 573 | for i := ComponentCount - 1 downto 0 do
|
---|
| 574 | begin
|
---|
| 575 | if Components[i] is TORListBox then
|
---|
| 576 | begin
|
---|
| 577 | case Components[i].Tag of
|
---|
| 578 | 10: ListActiveProblems((Components[i] as TORListBox).Items);
|
---|
| 579 | end;
|
---|
| 580 | end;
|
---|
| 581 | end;
|
---|
| 582 | Close;
|
---|
| 583 | end
|
---|
| 584 | else
|
---|
| 585 | InfoBox('Unable to lock record for filing on Host. Try again in a moment or cancel',
|
---|
| 586 | 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
| 587 | finally
|
---|
| 588 | Alist.free
|
---|
| 589 | end;
|
---|
| 590 | end;
|
---|
| 591 |
|
---|
| 592 | procedure TfrmdlgProb.GetEditedComments;
|
---|
| 593 | var
|
---|
| 594 | i: integer;
|
---|
| 595 | begin
|
---|
| 596 | for i := 0 to pred(ProbRec.CommentCount) do
|
---|
| 597 | if i < lstComments.Items.Count then with lstComments do
|
---|
| 598 | begin
|
---|
| 599 | if Items[i] = 'DELETED' then
|
---|
| 600 | TComment(ProbRec.fComments[i]).Narrative := '' {this deletes the comment}
|
---|
| 601 | else
|
---|
| 602 | begin
|
---|
| 603 | TComment(ProbRec.fComments[i]).DateAdd := Piece(lstComments.Items[i], U, 1) ;
|
---|
| 604 | TComment(ProbRec.fComments[i]).Narrative := Piece(lstComments.Items[i], U, 2) ;
|
---|
| 605 | end;
|
---|
| 606 | end;
|
---|
| 607 | end;
|
---|
| 608 |
|
---|
| 609 | procedure TfrmdlgProb.GetNewComments(Reason: char);
|
---|
| 610 | var
|
---|
| 611 | i, start: integer;
|
---|
| 612 | begin
|
---|
| 613 | {don't display previous comments for add comment or remove problem functions}
|
---|
| 614 | if (Reason <> 'R') then
|
---|
| 615 | start := ProbRec.CommentCount
|
---|
| 616 | else
|
---|
| 617 | start := 0;
|
---|
| 618 | for i := start to Pred(lstComments.Items.Count) do
|
---|
| 619 | begin
|
---|
| 620 | with lstComments do
|
---|
| 621 | begin
|
---|
| 622 | if (lstComments.Items[i] <> 'DELETED') and (Piece(lstComments.Items[i], u, 2) <> '') then
|
---|
| 623 | ProbRec.AddNewComment(Piece(lstComments.Items[i],u,2));
|
---|
| 624 | end;
|
---|
| 625 | end;
|
---|
| 626 | end;
|
---|
| 627 |
|
---|
| 628 | procedure TfrmdlgProb.bbRemoveClick(Sender: TObject);
|
---|
| 629 | begin
|
---|
| 630 | if (lstComments.Items.Count = 0) or (lstComments.ItemIndex < 0) then exit ;
|
---|
| 631 | lstComments.Items[lstComments.ItemIndex] := 'DELETED' ;
|
---|
| 632 | fChanged := true;
|
---|
| 633 | end;
|
---|
| 634 |
|
---|
| 635 | procedure TfrmdlgProb.cbProvKeyPress(Sender: TObject; var Key: Char);
|
---|
| 636 | begin
|
---|
| 637 | if key = #13 then
|
---|
| 638 | SendMessage(cbProv.Handle, CB_SHOWDROPDOWN, 1, 0) {Opens list}
|
---|
| 639 | else
|
---|
| 640 | SendMessage(cbProv.Handle, CB_SHOWDROPDOWN, 0, 0) {Closes list}
|
---|
| 641 | end;
|
---|
| 642 |
|
---|
| 643 | procedure TfrmdlgProb.rgStatusClick(Sender: TObject);
|
---|
| 644 | begin
|
---|
| 645 | if rgStatus.Itemindex = 1 then
|
---|
| 646 | begin
|
---|
| 647 | edResDate.text := DateToStr(Date) ;
|
---|
| 648 | rgStage.Visible := False ;
|
---|
| 649 | end
|
---|
| 650 | else
|
---|
| 651 | begin
|
---|
| 652 | edResDate.text := '';
|
---|
| 653 | rgStage.Visible := True ;
|
---|
| 654 | end ;
|
---|
| 655 | FChanged := True;
|
---|
| 656 | end;
|
---|
| 657 |
|
---|
| 658 | procedure TfrmdlgProb.cbProvClick(Sender: TObject);
|
---|
| 659 | begin
|
---|
| 660 | SendMessage(cbProv.Handle, CB_SHOWDROPDOWN, 0, 0); {Closes list}
|
---|
| 661 | end;
|
---|
| 662 |
|
---|
| 663 | procedure TfrmdlgProb.cbLocClick(Sender: TObject);
|
---|
| 664 | begin
|
---|
| 665 | SendMessage(cbLoc.Handle, CB_SHOWDROPDOWN, 0, 0); {Closes list}
|
---|
| 666 | end;
|
---|
| 667 |
|
---|
| 668 | procedure TfrmdlgProb.cbLocKeyPress(Sender: TObject; var Key: Char);
|
---|
| 669 | begin
|
---|
| 670 | if key = #13 then
|
---|
| 671 | SendMessage(cbLoc.Handle, CB_SHOWDROPDOWN, 1, 0) {Opens list}
|
---|
| 672 | else
|
---|
| 673 | SendMessage(cbLoc.Handle, CB_SHOWDROPDOWN, 0, 0) {Closes list}
|
---|
| 674 | end;
|
---|
| 675 |
|
---|
| 676 |
|
---|
| 677 | procedure TfrmdlgProb.SetDefaultProb(Alist: TStringList; prob: string);
|
---|
| 678 | var
|
---|
| 679 | Today: string;
|
---|
| 680 |
|
---|
| 681 | function Permanent: char;
|
---|
| 682 | begin
|
---|
| 683 | // =================== changed code - REV 7/30/98 =========================
|
---|
| 684 | // PlUser.usVerifyTranscribed is a SITE requirement, not a USER ability
|
---|
| 685 | if PlUser.usVerifyTranscribed and not PlUser.usPrimeUser then
|
---|
| 686 | result:='T'
|
---|
| 687 | else
|
---|
| 688 | result:='P';
|
---|
| 689 | //===========================================================================
|
---|
| 690 | { if PLUser.usPrimeUser or (PlUser.usVerifyTranscribed) then
|
---|
| 691 | result:='P'
|
---|
| 692 | else
|
---|
| 693 | result:='T';}
|
---|
| 694 | end;
|
---|
| 695 |
|
---|
| 696 | begin {BODY }
|
---|
| 697 | Today := PLPt.Today;
|
---|
| 698 | if Piece(prob, u, 4) <> '' then
|
---|
| 699 | alist.add('NEW' + v + '.01' + v +Piece(prob, u, 4) + u + Piece(prob, u, 3))
|
---|
| 700 | else
|
---|
| 701 | alist.add('NEW' + v + '.01' + v + u); {no icd code}
|
---|
| 702 | {Leave ien of .05 undefined - let host save routine compute it}
|
---|
| 703 | alist.add('NEW' + v + '.05' + v + u + Piece(prob,u,2));{actual text}
|
---|
| 704 | alist.add('NEW' + v + '.06' + v + PLPt.PtVAMC);
|
---|
| 705 | alist.add('NEW' + v + '.08' + v + Today);
|
---|
| 706 | alist.add('NEW' + v + '.12' + v + 'A' + u + 'ACTIVE');
|
---|
| 707 | alist.add('NEW' + v + '.13' + v + '');
|
---|
| 708 | alist.add('NEW' + v + '1.01' + v + Piece(prob,u,1) + u + Piece(prob,u,2));{standardized text}
|
---|
| 709 | alist.add('NEW' + v + '1.02' + v + Permanent); {Permanent or Transcribed status}
|
---|
| 710 | alist.add('NEW' + v + '1.03' + v + inttostr(Encounter.Provider) + u + Encounter.Providername); {ent by}
|
---|
| 711 | alist.add('NEW' + v + '1.04' + v + inttostr(Encounter.Provider) + u + Encounter.Providername); {recording prov}
|
---|
| 712 | alist.add('NEW' + v + '1.05' + v + inttostr(Encounter.Provider) + u + Encounter.Providername); {resp prov}
|
---|
| 713 | alist.add('NEW' + v + '1.06' + v + PLUser.usService); {user's service/section}
|
---|
| 714 | alist.add('NEW' + v + '1.07' + v + '');
|
---|
| 715 | alist.add('NEW' + v + '1.08' + v + '') ;{IntToStr(Encounter.Location));}
|
---|
| 716 | alist.add('NEW' + v + '1.09' + v + Today);
|
---|
| 717 | alist.add('NEW' + v + '1.1' + v + '0' + u + 'NO'); {SC}
|
---|
| 718 | alist.add('NEW' + v + '1.11' + v + '0' + u + 'NO'); {AO}
|
---|
| 719 | alist.add('NEW' + v + '1.12' + v + '0' + u + 'NO'); {RAD}
|
---|
| 720 | alist.add('NEW' + v + '1.13' + v + '0' + u + 'NO'); {ENV}
|
---|
[830] | 721 | alist.add('NEW' + v + '1.14' + v + '0' + u + 'NO'); {SHD}
|
---|
| 722 | alist.add('NEW' + v + '1.15' + v + '');
|
---|
[456] | 723 | end;
|
---|
| 724 |
|
---|
| 725 |
|
---|
| 726 | function TfrmdlgProb.BadDates:Boolean;
|
---|
| 727 | var
|
---|
| 728 | ds:string;
|
---|
| 729 | i:integer;
|
---|
| 730 |
|
---|
| 731 | procedure Msg(msg: string);
|
---|
| 732 | begin
|
---|
| 733 | InfoBox('Dates must be in format m/d/y or m/d or y, or T+d or T-d' +
|
---|
| 734 | #13#10 + msg + ' is formatted improperly.' +
|
---|
| 735 | #13#10 + ' Please check the other dates as well.',
|
---|
| 736 | 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
| 737 | end;
|
---|
| 738 | begin
|
---|
| 739 | result:=True; {initialize for error condition}
|
---|
| 740 | if edRecDate.text <>'' then
|
---|
| 741 | begin
|
---|
| 742 | ds:=DateStringOk(edRecDate.text);
|
---|
| 743 | if ds = 'ERROR' then
|
---|
| 744 | begin
|
---|
| 745 | msg('Recorded');
|
---|
| 746 | exit;
|
---|
| 747 | end;
|
---|
| 748 | end ;
|
---|
| 749 | if edResDate.text <>'' then
|
---|
| 750 | begin
|
---|
| 751 | ds:=DateStringOk(edResDate.text);
|
---|
| 752 | if ds = 'ERROR' then
|
---|
| 753 | begin
|
---|
| 754 | msg('Resolved');
|
---|
| 755 | exit;
|
---|
| 756 | end;
|
---|
| 757 | end ;
|
---|
| 758 | if edOnsetDate.text <>'' then
|
---|
| 759 | begin
|
---|
| 760 | ds:=DateStringOk(edOnsetDate.text);
|
---|
| 761 | if ds = 'ERROR' then
|
---|
| 762 | begin
|
---|
| 763 | msg('Onset');
|
---|
| 764 | exit;
|
---|
| 765 | end;
|
---|
| 766 | if StrToFMDateTime(edOnsetDate.Text) > FMNow then
|
---|
| 767 | begin
|
---|
| 768 | InfoBox('Onset dates in the future are not allowed.', 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
| 769 | Exit;
|
---|
| 770 | end;
|
---|
| 771 | end ;
|
---|
| 772 | for i:=0 to pred(lstComments.Items.Count) do
|
---|
| 773 | begin
|
---|
| 774 | if Piece(lstComments.Items[i],u,2)<>'' then {may have blank lines at bottom}
|
---|
| 775 | begin
|
---|
| 776 | ds:=DateStringOk(Piece(lstComments.Items[i],u,1));
|
---|
| 777 | if ds='ERROR' then
|
---|
| 778 | begin
|
---|
| 779 | msg('Comment #' + inttostr(i));
|
---|
| 780 | exit;
|
---|
| 781 | end;
|
---|
| 782 | end;
|
---|
| 783 | end;
|
---|
| 784 | result:=False; {made it through, so no bad dates}
|
---|
| 785 | end;
|
---|
| 786 |
|
---|
| 787 | procedure TfrmdlgProb.ControlChange(Sender: TObject);
|
---|
| 788 | begin
|
---|
| 789 | fChanged:=true;
|
---|
| 790 | end;
|
---|
| 791 |
|
---|
| 792 | destructor TfrmdlgProb.Destroy;
|
---|
| 793 | begin
|
---|
| 794 | ProbRec.free;
|
---|
| 795 | ProbRec := nil;
|
---|
| 796 | FCtrlMap.Free;
|
---|
| 797 | if fprobs.dlgProbs <> nil then fprobs.dlgProbs := nil;
|
---|
| 798 | if (not Application.Terminated) and (not uInit.TimedOut) then {prevents GPF if system close box is clicked
|
---|
| 799 | while frmDlgProbs is visible}
|
---|
| 800 | if Assigned(frmProblems) then PostMessage(frmProblems.Handle, UM_CLOSEPROBLEM, 0, 0);
|
---|
| 801 | inherited Destroy ;
|
---|
| 802 | end;
|
---|
| 803 |
|
---|
| 804 | procedure TfrmdlgProb.cbProvDropDown(Sender: TObject);
|
---|
| 805 | var
|
---|
| 806 | alist:TstringList;
|
---|
| 807 | i:integer;
|
---|
| 808 | v:string;
|
---|
| 809 | begin
|
---|
| 810 | v := uppercase(cbProv.text);
|
---|
| 811 | if (v <> '') then
|
---|
| 812 | begin
|
---|
| 813 | alist := TstringList.create;
|
---|
| 814 | try
|
---|
[830] | 815 | FastAssign(ProviderList('', 25, V, V), AList) ;
|
---|
[456] | 816 | if alist.count > 0 then
|
---|
| 817 | begin
|
---|
| 818 | if cbProv.items.count + 25 > 100 then
|
---|
| 819 | for i := 0 to 75 do {don't allow more than 100 to build up}
|
---|
| 820 | cbProv.Items.delete(i);
|
---|
| 821 | for i := 0 to pred(alist.count) do
|
---|
| 822 | cbProv.Items.add(Alist[i]); {add new ones to list}
|
---|
| 823 | end;
|
---|
| 824 | finally
|
---|
| 825 | alist.free;
|
---|
| 826 | end;
|
---|
| 827 | end;
|
---|
| 828 | end;
|
---|
| 829 |
|
---|
| 830 | procedure TfrmdlgProb.cbLocDropDown(Sender: TObject);
|
---|
| 831 | var
|
---|
| 832 | alist: TstringList;
|
---|
| 833 | v: string;
|
---|
| 834 | begin
|
---|
| 835 | v := uppercase(cbLoc.text);
|
---|
| 836 | alist := TstringList.create;
|
---|
| 837 | try
|
---|
[830] | 838 | FastAssign(ClinicSearch(' '), AList) ;
|
---|
| 839 | if alist.count > 0 then FastAssign(Alist, cbLoc.Items);
|
---|
[456] | 840 | finally
|
---|
| 841 | alist.free;
|
---|
| 842 | end;
|
---|
| 843 | end;
|
---|
| 844 |
|
---|
| 845 | procedure TfrmdlgProb.FormCreate(Sender: TObject);
|
---|
| 846 | begin
|
---|
| 847 | FSilent := False;
|
---|
| 848 | if rgStatus.ItemIndex = -1
|
---|
| 849 | then
|
---|
| 850 | InitialFocus := rgStatus
|
---|
| 851 | else
|
---|
| 852 | InitialFocus := rgStatus.Controls[rgStatus.ItemIndex] as TWinControl;
|
---|
| 853 | end;
|
---|
| 854 |
|
---|
| 855 | { old TPLDlgForm Methods }
|
---|
| 856 |
|
---|
| 857 | constructor TfrmdlgProb.Create(AOwner: TComponent);
|
---|
| 858 | { It is unusual to not call the inherited Create first, but necessary in this case; some
|
---|
| 859 | of the TMStruct objects need to be created before the form gets its OnCreate event. }
|
---|
| 860 | begin
|
---|
| 861 | FCtrlMap := TStringList.Create; { FCtrlMap[n]='CtrlName=PtrID' }
|
---|
| 862 | inherited Create(AOwner);
|
---|
| 863 | FInitialShow := True;
|
---|
| 864 | FModified := False;
|
---|
| 865 | FEditing := False;
|
---|
| 866 | end;
|
---|
| 867 |
|
---|
| 868 | procedure TfrmdlgProb.CreateParams(var Params: TCreateParams);
|
---|
| 869 | begin
|
---|
| 870 | inherited CreateParams(Params);
|
---|
| 871 | { to make the form a child window }
|
---|
| 872 | with Params do
|
---|
| 873 | begin
|
---|
| 874 | if Owner is TPanel then
|
---|
| 875 | WndParent := (Owner as TPanel).Handle
|
---|
| 876 | else {pdr}
|
---|
| 877 | WndParent := Application.MainForm.Handle;
|
---|
| 878 | Style := ws_Child or ws_ClipSiblings;
|
---|
| 879 | X := 0;
|
---|
| 880 | Y := 0;
|
---|
| 881 | end;
|
---|
| 882 | end;
|
---|
| 883 |
|
---|
| 884 | procedure TfrmdlgProb.Loaded;
|
---|
| 885 | begin
|
---|
| 886 | inherited Loaded;
|
---|
| 887 | { allow the form to be treated as a child form }
|
---|
| 888 | Visible := False;
|
---|
| 889 | Position := poDefault;
|
---|
| 890 | BorderIcons := [];
|
---|
| 891 | BorderStyle := bsNone;
|
---|
| 892 | HandleNeeded;
|
---|
| 893 | end;
|
---|
| 894 |
|
---|
| 895 | procedure TfrmdlgProb.DoShow;
|
---|
| 896 | begin
|
---|
| 897 | FInitialShow := False;
|
---|
| 898 | inherited DoShow;
|
---|
| 899 | end;
|
---|
| 900 |
|
---|
| 901 | procedure TfrmdlgProb.SetFontSize( NewFontSize: integer);
|
---|
| 902 | begin
|
---|
| 903 | ResizeAnchoredFormToFont( self );
|
---|
| 904 | end;
|
---|
| 905 |
|
---|
| 906 | { base form procedures (shared by all ordering dialogs) }
|
---|
| 907 |
|
---|
| 908 |
|
---|
| 909 | procedure TfrmdlgProb.ClearDialogControls; { Reset all the controls in the dialog }
|
---|
| 910 | var
|
---|
| 911 | i: Integer;
|
---|
| 912 | begin
|
---|
| 913 | for i := 0 to ControlCount - 1 do
|
---|
| 914 | begin
|
---|
| 915 | if Controls[i] is TLabel then Continue;
|
---|
| 916 | if Controls[i] is TButton then Continue;
|
---|
| 917 | end;
|
---|
| 918 | LoadDefaults; { added for lab to reset cleared lists }
|
---|
| 919 | end;
|
---|
| 920 |
|
---|
| 921 | procedure TfrmdlgProb.LoadDefaults;
|
---|
| 922 | begin
|
---|
| 923 | { by default nothing - should override in specific dialog }
|
---|
| 924 | end;
|
---|
| 925 |
|
---|
| 926 |
|
---|
| 927 |
|
---|
| 928 | function TfrmdlgProb.LackRequired: Boolean;
|
---|
| 929 | begin
|
---|
| 930 | Result := False; { should override to check for additional required fields }
|
---|
| 931 | end;
|
---|
| 932 |
|
---|
| 933 |
|
---|
| 934 | procedure TfrmdlgProb.UMTakeFocus(var Message: TMessage);
|
---|
| 935 | begin
|
---|
| 936 | if FInitialFocus = nil then exit; {PDR}
|
---|
| 937 | if (FInitialFocus.visible) and (FInitialFocus.enabled) then FInitialFocus.SetFocus;
|
---|
| 938 | end;
|
---|
| 939 |
|
---|
| 940 | procedure TfrmdlgProb.bbChangeProbClick(Sender: TObject);
|
---|
| 941 | const
|
---|
| 942 | TX799 = '799.9';
|
---|
| 943 | var
|
---|
| 944 | newprob: string ;
|
---|
| 945 | frmPLLex: TfrmPLLex;
|
---|
| 946 | begin
|
---|
| 947 | if PLUser.usUseLexicon then
|
---|
| 948 | begin
|
---|
| 949 | frmPLLex:=TfrmPLLex.create(Application);
|
---|
| 950 | try
|
---|
| 951 | frmPLLex.showmodal;
|
---|
| 952 | finally
|
---|
| 953 | frmPLLex.Free;
|
---|
| 954 | end;
|
---|
| 955 | end
|
---|
| 956 | else
|
---|
| 957 | begin
|
---|
| 958 | PLProblem := InputBox('Change problem','Enter new problem name: ','') ;
|
---|
| 959 | if PLProblem<>'' then
|
---|
| 960 | PLProblem := u + PLProblem + u + TX799 + u
|
---|
| 961 | else
|
---|
| 962 | exit ;
|
---|
| 963 | end ;
|
---|
| 964 |
|
---|
| 965 | {problems are in the form of: ien^.01^icd^icdifn , although only the .01 is required}
|
---|
| 966 | if PLProblem='' then exit ;
|
---|
| 967 | newprob := PLProblem ;
|
---|
| 968 | if frmProblems.HighlightDuplicate(NewProb, Piece(newprob, U, 2) + #13#10#13#10 +
|
---|
| 969 | 'This problem would be a duplicate.'+#13#10 +
|
---|
| 970 | 'Return to the list and see the highlighted problem.',
|
---|
| 971 | mtInformation, 'CHANGE') then
|
---|
| 972 | exit {bail out - don't want dups}
|
---|
| 973 | else
|
---|
| 974 | begin
|
---|
| 975 | {ien^.01^icd^icdifn - see SetDefaultProblem}
|
---|
| 976 | {Set new problem properties}
|
---|
| 977 | ProbRec.Problem.DHCPtoKeyVal(Piece(NewProb,u,1) + u + Piece(NewProb,u,2)) ; {1.01}
|
---|
| 978 | ProbRec.Diagnosis.DHCPtoKeyVal(Piece(NewProb,u,4) + u + Piece(NewProb,u,3)) ; {.01}
|
---|
| 979 | ProbRec.Narrative.DHCPtoKeyVal(u + Piece(NewProb,u,2)); {.05}
|
---|
| 980 |
|
---|
| 981 | {mark it as changed}
|
---|
| 982 | fchanged := true ;
|
---|
| 983 |
|
---|
| 984 | {Redraw heading}
|
---|
| 985 | if Piece(NewProb,u,3)<>'' then
|
---|
| 986 | edProb.Text:=Piece(NewProb,u,2) + ' (' + Piece(NewProb,u,3) + ')'
|
---|
| 987 | else
|
---|
| 988 | edProb.Text:=Piece(NewProb,u,2) + ' (799.9)'; {code not found, or free-text entry}
|
---|
| 989 | end ;
|
---|
| 990 | end ;
|
---|
| 991 |
|
---|
| 992 | procedure TfrmdlgProb.cbLocNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 993 | Direction, InsertAt: Integer);
|
---|
| 994 | begin
|
---|
| 995 | cbLoc.ForDataUse(SubSetOfClinics(StartFrom, Direction));
|
---|
| 996 | end;
|
---|
| 997 |
|
---|
| 998 | procedure TfrmdlgProb.cbProvNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 999 | Direction, InsertAt: Integer);
|
---|
| 1000 | begin
|
---|
| 1001 | cbProv.ForDataUse(SubSetOfProviders(StartFrom, Direction));
|
---|
| 1002 | end;
|
---|
| 1003 |
|
---|
| 1004 | procedure TfrmdlgProb.cbServNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 1005 | Direction, InsertAt: Integer);
|
---|
| 1006 | begin
|
---|
| 1007 | cbServ.ForDataUse(ServiceSearch(StartFrom, Direction));
|
---|
| 1008 | end;
|
---|
| 1009 |
|
---|
[830] | 1010 | initialization
|
---|
| 1011 | SpecifyFormIsNotADialog(TfrmdlgProb);
|
---|
| 1012 |
|
---|
[456] | 1013 | end.
|
---|