| [459] | 1 | unit fEditConsult;
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | interface
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | uses
 | 
|---|
 | 6 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
 | 7 |   StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
 | 
|---|
 | 8 |   Menus ;
 | 
|---|
 | 9 | 
 | 
|---|
 | 10 | type
 | 
|---|
 | 11 |   TfrmEditCslt = class(TForm)
 | 
|---|
 | 12 |     cboService: TORComboBox;
 | 
|---|
 | 13 |     cboUrgency: TORComboBox;
 | 
|---|
 | 14 |     radInpatient: TRadioButton;
 | 
|---|
 | 15 |     radOutpatient: TRadioButton;
 | 
|---|
 | 16 |     cboPlace: TORComboBox;
 | 
|---|
 | 17 |     txtProvDiag: TCaptionEdit;
 | 
|---|
 | 18 |     txtAttn: TORComboBox;
 | 
|---|
 | 19 |     lblReason: TLabel;
 | 
|---|
 | 20 |     lblService: TLabel;
 | 
|---|
 | 21 |     lblUrgency: TStaticText;
 | 
|---|
 | 22 |     lblPlace: TStaticText;
 | 
|---|
 | 23 |     lblAttn: TStaticText;
 | 
|---|
 | 24 |     lblProvDiag: TStaticText;
 | 
|---|
 | 25 |     cboCategory: TORComboBox;
 | 
|---|
 | 26 |     pnlMessage: TPanel;
 | 
|---|
 | 27 |     imgMessage: TImage;
 | 
|---|
 | 28 |     memMessage: TRichEdit;
 | 
|---|
 | 29 |     cmdAccept: TButton;
 | 
|---|
 | 30 |     cmdQuit: TButton;
 | 
|---|
 | 31 |     memComment: TRichEdit;
 | 
|---|
 | 32 |     lblComment: TLabel;
 | 
|---|
 | 33 |     lblComments: TLabel;
 | 
|---|
 | 34 |     btnCmtCancel: TButton;
 | 
|---|
 | 35 |     btnCmtOther: TButton;
 | 
|---|
 | 36 |     mnuPopProvDx: TPopupMenu;
 | 
|---|
 | 37 |     mnuPopProvDxDelete: TMenuItem;
 | 
|---|
 | 38 |     cmdLexSearch: TButton;
 | 
|---|
 | 39 |     lblInpOutp: TStaticText;
 | 
|---|
 | 40 |     memReason: TRichEdit;
 | 
|---|
 | 41 |     popReason: TPopupMenu;
 | 
|---|
 | 42 |     popReasonCut: TMenuItem;
 | 
|---|
 | 43 |     popReasonCopy: TMenuItem;
 | 
|---|
 | 44 |     popReasonPaste: TMenuItem;
 | 
|---|
 | 45 |     popReasonPaste2: TMenuItem;
 | 
|---|
 | 46 |     popReasonReformat: TMenuItem;
 | 
|---|
 | 47 |     procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
 | 
|---|
 | 48 |       Direction, InsertAt: Integer);
 | 
|---|
 | 49 |     procedure radInpatientClick(Sender: TObject);
 | 
|---|
 | 50 |     procedure radOutpatientClick(Sender: TObject);
 | 
|---|
 | 51 |     procedure ControlChange(Sender: TObject);
 | 
|---|
 | 52 |     procedure FormClose(Sender: TObject; var Action: TCloseAction);
 | 
|---|
 | 53 |     procedure cmdQuitClick(Sender: TObject);
 | 
|---|
 | 54 |     procedure cmdAcceptClick(Sender: TObject);
 | 
|---|
 | 55 |     procedure memReasonExit(Sender: TObject);
 | 
|---|
 | 56 |     procedure OrderMessage(const AMessage: string);
 | 
|---|
 | 57 |     procedure btnCmtCancelClick(Sender: TObject);
 | 
|---|
 | 58 |     procedure btnCmtOtherClick(Sender: TObject);
 | 
|---|
 | 59 |     procedure cmdLexSearchClick(Sender: TObject);
 | 
|---|
 | 60 |     procedure mnuPopProvDxDeleteClick(Sender: TObject);
 | 
|---|
 | 61 |     procedure popReasonCutClick(Sender: TObject);
 | 
|---|
 | 62 |     procedure popReasonCopyClick(Sender: TObject);
 | 
|---|
 | 63 |     procedure popReasonPasteClick(Sender: TObject);
 | 
|---|
 | 64 |     procedure popReasonPopup(Sender: TObject);
 | 
|---|
 | 65 |     procedure popReasonReformatClick(Sender: TObject);
 | 
|---|
 | 66 |     procedure memCommentKeyUp(Sender: TObject; var Key: Word;
 | 
|---|
 | 67 |       Shift: TShiftState);
 | 
|---|
 | 68 |     procedure memCommentKeyDown(Sender: TObject; var Key: Word;
 | 
|---|
 | 69 |       Shift: TShiftState);
 | 
|---|
 | 70 |     procedure memCommentKeyPress(Sender: TObject; var Key: Char);
 | 
|---|
 | 71 |   private
 | 
|---|
 | 72 |     FLastServiceID: string;
 | 
|---|
 | 73 |     FChanged: boolean;
 | 
|---|
 | 74 |     FChanging: boolean;
 | 
|---|
 | 75 |     FEditCtrl: TCustomEdit;
 | 
|---|
 | 76 |     FNavigatingTab: boolean;
 | 
|---|
 | 77 |     procedure SetProvDiagPromptingMode;
 | 
|---|
 | 78 |   protected
 | 
|---|
 | 79 |     procedure InitDialog;
 | 
|---|
 | 80 |     procedure Validate(var AnErrMsg: string);
 | 
|---|
 | 81 |     function  ValidSave: Boolean;
 | 
|---|
 | 82 |   end;
 | 
|---|
 | 83 | 
 | 
|---|
 | 84 | function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean;
 | 
|---|
 | 85 | 
 | 
|---|
 | 86 | var
 | 
|---|
 | 87 |   frmEditCslt: TfrmEditCslt;
 | 
|---|
 | 88 | 
 | 
|---|
 | 89 | implementation
 | 
|---|
 | 90 | 
 | 
|---|
 | 91 | {$R *.DFM}
 | 
|---|
 | 92 | 
 | 
|---|
 | 93 | uses
 | 
|---|
 | 94 |     rODBase, rConsults, uCore, rCore, fConsults, fRptBox, fPCELex, rPCE,
 | 
|---|
 | 95 |     ORClasses, clipbrd, UBAGlobals, rOrders ;
 | 
|---|
 | 96 | 
 | 
|---|
 | 97 | var
 | 
|---|
 | 98 |   SvcList: TStrings ;
 | 
|---|
 | 99 |   OldRec, NewRec: TEditResubmitRec;
 | 
|---|
 | 100 |   Defaults: TStringList;
 | 
|---|
 | 101 |   uMessageVisible: DWORD;
 | 
|---|
 | 102 |   ProvDx: TProvisionalDiagnosis;
 | 
|---|
 | 103 | {Begin BillingAware}
 | 
|---|
 | 104 |   BADxUpdated: boolean;
 | 
|---|
 | 105 | {End BillingAware}
 | 
|---|
 | 106 | 
 | 
|---|
 | 107 | const
 | 
|---|
 | 108 |   TX_NOTTHISSVC_TEXT = 'Consults cannot be ordered from this service' ;
 | 
|---|
 | 109 |   TX_NO_SVC          = 'A service must be specified.'    ;
 | 
|---|
 | 110 |   TX_NO_REASON       = 'A reason for this consult must be entered.'  ;
 | 
|---|
 | 111 |   TX_SVC_ERROR       = 'This service has not been defined in your Orderable Items file.' +
 | 
|---|
 | 112 |                        #13#10'Contact IRM for assistance.' ;
 | 
|---|
 | 113 |   TX_NO_URGENCY      = 'An urgency must be specified.';
 | 
|---|
 | 114 |   TX_NO_PLACE        = 'A place of consultation must be specified';
 | 
|---|
 | 115 |   TX_NO_DIAG         = 'A provisional diagnosis must be entered for consults to this service.';
 | 
|---|
 | 116 |   TX_SELECT_DIAG     = 'You must use the "Lexicon" button to select a diagnosis for consults to this service.';
 | 
|---|
 | 117 |   TX_INACTIVE_CODE   = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 +
 | 
|---|
 | 118 |                        'Another code must be selected';
 | 
|---|
 | 119 |   TC_INACTIVE_CODE   = 'Inactive ICD Code';
 | 
|---|
 | 120 | 
 | 
|---|
 | 121 | function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean;
 | 
|---|
 | 122 | begin
 | 
|---|
 | 123 |   Result := False;
 | 
|---|
 | 124 |   if ConsultIEN = 0 then exit;
 | 
|---|
 | 125 |   FillChar(OldRec, SizeOf(OldRec), 0);
 | 
|---|
 | 126 |   FillChar(NewRec, SizeOf(NewRec), 0);
 | 
|---|
 | 127 |   FillChar(ProvDx, SizeOf(ProvDx), 0);
 | 
|---|
 | 128 |   OldRec := LoadConsultForEdit(ConsultIEN);
 | 
|---|
 | 129 |   NewRec.IEN := OldRec.IEN;
 | 
|---|
 | 130 |   NewRec.RequestType := OldRec.RequestType;
 | 
|---|
 | 131 |   with NewRec do
 | 
|---|
 | 132 |     begin
 | 
|---|
 | 133 |       RequestReason:= TStringList.Create ;
 | 
|---|
 | 134 |       DenyComments:= TStringList.Create ;
 | 
|---|
 | 135 |       OtherComments:= TStringList.Create ;
 | 
|---|
 | 136 |       NewComments:= TStringList.Create ;
 | 
|---|
 | 137 |     end;
 | 
|---|
 | 138 |   StatusText('Loading Consult for Edit');
 | 
|---|
 | 139 |   frmEditCslt := TfrmEditCslt.Create(Application);
 | 
|---|
 | 140 |   SvcList     := TStringList.Create ;
 | 
|---|
 | 141 |   Defaults    := TStringList.Create;
 | 
|---|
 | 142 |   try
 | 
|---|
 | 143 |     with frmEditCslt do
 | 
|---|
 | 144 |       begin
 | 
|---|
 | 145 |         ResizeAnchoredFormToFont(frmEditCslt);
 | 
|---|
 | 146 |         FChanged     := False;
 | 
|---|
 | 147 |         InitDialog;
 | 
|---|
 | 148 |         ShowModal ;
 | 
|---|
 | 149 |         Result := FChanged ;
 | 
|---|
 | 150 |       end ;
 | 
|---|
 | 151 |   finally
 | 
|---|
 | 152 |     OldRec.RequestReason.Free;
 | 
|---|
 | 153 |     OldRec.DenyComments.Free;
 | 
|---|
 | 154 |     OldRec.OtherComments.Free;
 | 
|---|
 | 155 |     OldRec.NewComments.Free;
 | 
|---|
 | 156 |     NewRec.RequestReason.Free;
 | 
|---|
 | 157 |     NewRec.DenyComments.Free;
 | 
|---|
 | 158 |     NewRec.OtherComments.Free;
 | 
|---|
 | 159 |     NewRec.NewComments.Free;
 | 
|---|
 | 160 |     SvcList.Free;
 | 
|---|
 | 161 |     Defaults.Free;
 | 
|---|
 | 162 |     frmEditCslt.Release;
 | 
|---|
 | 163 |   end;
 | 
|---|
 | 164 | end;
 | 
|---|
 | 165 | 
 | 
|---|
 | 166 | procedure TfrmEditCslt.InitDialog;
 | 
|---|
 | 167 | var
 | 
|---|
 | 168 |  i:integer;
 | 
|---|
 | 169 | begin
 | 
|---|
 | 170 |   FChanging := True;
 | 
|---|
 | 171 |   Defaults.Assign(ODForConsults);
 | 
|---|
 | 172 |   FLastServiceID := '';
 | 
|---|
 | 173 |   cboService.Items.Clear;
 | 
|---|
 | 174 |   if OldRec.InpOutp <> '' then
 | 
|---|
 | 175 |     case OldRec.InpOutp[1] of
 | 
|---|
 | 176 |       'I': radInpatient.Checked  := True;                 //INPATIENT CONSULT
 | 
|---|
 | 177 |       'O': radOutpatient.Checked := True;                 //OUTPATIENT CONSULT
 | 
|---|
 | 178 |     end
 | 
|---|
 | 179 |   else
 | 
|---|
 | 180 |     begin
 | 
|---|
 | 181 |       if Patient.Inpatient then
 | 
|---|
 | 182 |         radInpatient.Checked  := True
 | 
|---|
 | 183 |       else
 | 
|---|
 | 184 |         radOutpatient.Checked := True;  
 | 
|---|
 | 185 |     end;
 | 
|---|
 | 186 |   StatusText('Initializing Long List');
 | 
|---|
 | 187 |   SvcList.Assign(LoadServiceList(CN_SVC_LIST_ORD))   ;
 | 
|---|
 | 188 |   with cboService do
 | 
|---|
 | 189 |     begin
 | 
|---|
 | 190 |       for i := 0 to SvcList.Count - 1 do
 | 
|---|
 | 191 |         if SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
 | 
|---|
 | 192 |           Items.Add(SvcList.Strings[i]);
 | 
|---|
 | 193 |       SelectByID(IntToStr(OldRec.ToService));
 | 
|---|
 | 194 |     end;
 | 
|---|
 | 195 |   cboPlace.SelectByID(OldRec.Place);
 | 
|---|
 | 196 |   with cboUrgency do for i := 0 to Items.Count-1 do
 | 
|---|
 | 197 |     if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
 | 
|---|
 | 198 |   txtProvDiag.Text := OldRec.ProvDiagnosis;
 | 
|---|
 | 199 |   ProvDx.Code := OldRec.ProvDxCode;
 | 
|---|
 | 200 |   if OldRec.ProvDxCodeInactive then
 | 
|---|
 | 201 |    begin
 | 
|---|
 | 202 |     InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
 | 
|---|
 | 203 |     ProvDx.CodeInactive := True;
 | 
|---|
 | 204 |    end;
 | 
|---|
 | 205 |   memReason.Lines.Assign(OldRec.RequestReason);
 | 
|---|
 | 206 |   memComment.Clear ;
 | 
|---|
 | 207 |   btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
 | 
|---|
 | 208 |   btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
 | 
|---|
 | 209 |   txtAttn.InitLongList(OldRec.AttnName) ;
 | 
|---|
 | 210 |   if OldRec.Attention > 0 then
 | 
|---|
 | 211 |     txtAttn.SelectByIEN(OldRec.Attention)
 | 
|---|
 | 212 |   else
 | 
|---|
 | 213 |     txtAttn.ItemIndex := -1;
 | 
|---|
 | 214 |   SetProvDiagPromptingMode;
 | 
|---|
 | 215 |   FChanging := False;
 | 
|---|
 | 216 |   StatusText('');
 | 
|---|
 | 217 | end;
 | 
|---|
 | 218 | 
 | 
|---|
 | 219 | procedure TfrmEditCslt.Validate(var AnErrMsg: string);
 | 
|---|
 | 220 | 
 | 
|---|
 | 221 |   procedure SetError(const x: string);
 | 
|---|
 | 222 |   begin
 | 
|---|
 | 223 |     if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
 | 
|---|
 | 224 |     AnErrMsg := AnErrMsg + x;
 | 
|---|
 | 225 |   end;
 | 
|---|
 | 226 | 
 | 
|---|
 | 227 | begin
 | 
|---|
 | 228 |   inherited;
 | 
|---|
 | 229 |   if cboService.ItemIEN = 0               then SetError(TX_NO_SVC);
 | 
|---|
 | 230 |   if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
 | 
|---|
 | 231 |   if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
 | 
|---|
 | 232 |   if memReason.Lines.Count = 0            then SetError(TX_NO_REASON);
 | 
|---|
 | 233 |   with cboService do
 | 
|---|
 | 234 |     begin
 | 
|---|
 | 235 |       if Piece(Items[ItemIndex], U, 5) = '1' then SetError(TX_NOTTHISSVC_TEXT);
 | 
|---|
 | 236 |       if (Piece(Items[ItemIndex],U,5) <> '1')
 | 
|---|
 | 237 |          and (Piece(Items[ItemIndex], U, 6) = '')
 | 
|---|
 | 238 |                                               then SetError(TX_SVC_ERROR) ;
 | 
|---|
 | 239 |     end;
 | 
|---|
 | 240 |   if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
 | 
|---|
 | 241 |     begin
 | 
|---|
 | 242 |       if ProvDx.PromptMode = 'F' then
 | 
|---|
 | 243 |         SetError(TX_NO_DIAG)
 | 
|---|
 | 244 |       else
 | 
|---|
 | 245 |         SetError(TX_SELECT_DIAG);
 | 
|---|
 | 246 |     end;
 | 
|---|
 | 247 |   if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
 | 
|---|
 | 248 |     SetError(TX_INACTIVE_CODE);
 | 
|---|
 | 249 | end;
 | 
|---|
 | 250 | 
 | 
|---|
 | 251 | procedure TfrmEditCslt.txtAttnNeedData(Sender: TObject;
 | 
|---|
 | 252 |   const StartFrom: string; Direction, InsertAt: Integer);
 | 
|---|
 | 253 | begin
 | 
|---|
 | 254 |   inherited;
 | 
|---|
 | 255 |   txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
 | 
|---|
 | 256 | end;
 | 
|---|
 | 257 | 
 | 
|---|
 | 258 | procedure TfrmEditCslt.radInpatientClick(Sender: TObject);
 | 
|---|
 | 259 | begin
 | 
|---|
 | 260 |   inherited;
 | 
|---|
 | 261 |   cboUrgency.Items.Clear;
 | 
|---|
 | 262 |   cboPlace.Items.Clear;
 | 
|---|
 | 263 |   cboCategory.Items.Clear;
 | 
|---|
 | 264 |   cboCategory.Items.Add('I^Inpatient');
 | 
|---|
 | 265 |   cboCategory.SelectById('I');
 | 
|---|
 | 266 |   ExtractItems(cboPlace.Items, Defaults, 'Inpt Place');
 | 
|---|
 | 267 |   ExtractItems(cboUrgency.Items, Defaults, 'Inpt Cslt Urgencies');      //S.GMRCR
 | 
|---|
 | 268 |   ControlChange(Self);
 | 
|---|
 | 269 | end;
 | 
|---|
 | 270 | 
 | 
|---|
 | 271 | procedure TfrmEditCslt.radOutpatientClick(Sender: TObject);
 | 
|---|
 | 272 | begin
 | 
|---|
 | 273 |   inherited;
 | 
|---|
 | 274 |   cboUrgency.Items.Clear;
 | 
|---|
 | 275 |   cboPlace.Items.Clear;
 | 
|---|
 | 276 |   cboCategory.Items.Clear;
 | 
|---|
 | 277 |   cboCategory.Items.Add('O^Outpatient');
 | 
|---|
 | 278 |   cboCategory.SelectById('O');
 | 
|---|
 | 279 |   ExtractItems(cboPlace.Items, Defaults, 'Outpt Place');
 | 
|---|
 | 280 |   ExtractItems(cboUrgency.Items, Defaults, 'Outpt Urgencies');     //S.GMRCO
 | 
|---|
 | 281 |   ControlChange(Self);
 | 
|---|
 | 282 | end;
 | 
|---|
 | 283 | 
 | 
|---|
 | 284 | 
 | 
|---|
 | 285 | procedure TfrmEditCslt.ControlChange(Sender: TObject);
 | 
|---|
 | 286 | begin
 | 
|---|
 | 287 |   if FChanging then exit;
 | 
|---|
 | 288 |   with NewRec do
 | 
|---|
 | 289 |     begin
 | 
|---|
 | 290 |       with cboService do if ItemIEN > 0 then
 | 
|---|
 | 291 |         if ItemIEN <> OldRec.ToService then
 | 
|---|
 | 292 |           begin
 | 
|---|
 | 293 |             ToService     := ItemIEN;
 | 
|---|
 | 294 |             ToServiceName := Text;
 | 
|---|
 | 295 |           end
 | 
|---|
 | 296 |         else
 | 
|---|
 | 297 |           begin
 | 
|---|
 | 298 |             ToService     := 0;
 | 
|---|
 | 299 |             ToServiceName := '';
 | 
|---|
 | 300 |           end;
 | 
|---|
 | 301 | 
 | 
|---|
 | 302 |      with cboCategory do if Length(ItemID) > 0 then
 | 
|---|
 | 303 |        if ItemID <> OldRec.InpOutP then
 | 
|---|
 | 304 |          InpOutP := ItemID
 | 
|---|
 | 305 |        else
 | 
|---|
 | 306 |          InpOutP := '';
 | 
|---|
 | 307 | 
 | 
|---|
 | 308 |      with cboUrgency do if ItemIEN > 0 then
 | 
|---|
 | 309 |        if StrToIntDef(Piece(Items[ItemIndex], U, 3), 0) <> OldRec.Urgency then
 | 
|---|
 | 310 |          begin
 | 
|---|
 | 311 |            Urgency     := StrToIntDef(Piece(Items[ItemIndex], U, 3), 0);
 | 
|---|
 | 312 |            UrgencyName := Text;
 | 
|---|
 | 313 |          end
 | 
|---|
 | 314 |        else
 | 
|---|
 | 315 |          begin
 | 
|---|
 | 316 |            Urgency     := 0;
 | 
|---|
 | 317 |            UrgencyName := '';
 | 
|---|
 | 318 |          end;
 | 
|---|
 | 319 | 
 | 
|---|
 | 320 |      with cboPlace do if Length(ItemID) > 0 then
 | 
|---|
 | 321 |        if ItemID <> OldRec.Place then
 | 
|---|
 | 322 |          begin
 | 
|---|
 | 323 |            Place     := ItemID;
 | 
|---|
 | 324 |            PlaceName := Text;
 | 
|---|
 | 325 |          end
 | 
|---|
 | 326 |        else
 | 
|---|
 | 327 |          begin
 | 
|---|
 | 328 |            Place     := '';
 | 
|---|
 | 329 |            PlaceName := '';
 | 
|---|
 | 330 |          end;
 | 
|---|
 | 331 | 
 | 
|---|
 | 332 |      with txtAttn do
 | 
|---|
 | 333 |        if ItemIEN > 0 then
 | 
|---|
 | 334 |          begin
 | 
|---|
 | 335 |            if ItemIEN <> OldRec.Attention then
 | 
|---|
 | 336 |              begin
 | 
|---|
 | 337 |                Attention := ItemIEN;
 | 
|---|
 | 338 |                AttnName  := Text;
 | 
|---|
 | 339 |              end
 | 
|---|
 | 340 |            else
 | 
|---|
 | 341 |              begin
 | 
|---|
 | 342 |                Attention := 0;
 | 
|---|
 | 343 |                AttnName  := '';
 | 
|---|
 | 344 |              end;
 | 
|---|
 | 345 |          end
 | 
|---|
 | 346 |        else  // blank
 | 
|---|
 | 347 |          begin
 | 
|---|
 | 348 |            if OldRec.Attention > 0 then
 | 
|---|
 | 349 |              begin
 | 
|---|
 | 350 |                Attention := -1;
 | 
|---|
 | 351 |                AttnName  := '';
 | 
|---|
 | 352 |              end
 | 
|---|
 | 353 |            else
 | 
|---|
 | 354 |              begin
 | 
|---|
 | 355 |                Attention := 0;
 | 
|---|
 | 356 |                AttnName  := '';
 | 
|---|
 | 357 |              end;
 | 
|---|
 | 358 |          end;
 | 
|---|
 | 359 | 
 | 
|---|
 | 360 |      with txtProvDiag do
 | 
|---|
 | 361 |        if Length(Text) > 0 then
 | 
|---|
 | 362 |          begin
 | 
|---|
 | 363 |            if Text <> OldRec.ProvDiagnosis then
 | 
|---|
 | 364 |              ProvDiagnosis := Text
 | 
|---|
 | 365 |            else
 | 
|---|
 | 366 |              ProvDiagnosis := '';
 | 
|---|
 | 367 | 
 | 
|---|
 | 368 |            if ProvDx.Code <> OldRec.ProvDxCode then
 | 
|---|
 | 369 |              ProvDxCode := ProvDx.Code
 | 
|---|
 | 370 |            else
 | 
|---|
 | 371 |              ProvDxCode := '';
 | 
|---|
 | 372 | 
 | 
|---|
 | 373 |            if OldRec.ProvDxCodeInactive then
 | 
|---|
 | 374 |              ProvDx.CodeInactive := (ProvDx.Code = OldRec.ProvDxCode);
 | 
|---|
 | 375 |          end
 | 
|---|
 | 376 |        else  //blank
 | 
|---|
 | 377 |          begin
 | 
|---|
 | 378 |            ProvDx.Code := '';
 | 
|---|
 | 379 |            ProvDx.CodeInactive := False;
 | 
|---|
 | 380 |            if OldRec.ProvDiagnosis <> '' then
 | 
|---|
 | 381 |              ProvDiagnosis := '@'
 | 
|---|
 | 382 |            else
 | 
|---|
 | 383 |              ProvDiagnosis := '';
 | 
|---|
 | 384 |          end;
 | 
|---|
 | 385 | 
 | 
|---|
 | 386 |      with memReason do if Lines.Count > 0 then
 | 
|---|
 | 387 |         if Lines.Equals(OldRec.RequestReason) then
 | 
|---|
 | 388 |           RequestReason.Clear
 | 
|---|
 | 389 |         else
 | 
|---|
 | 390 |           RequestReason.Assign(Lines);
 | 
|---|
 | 391 | 
 | 
|---|
 | 392 |       with memComment do
 | 
|---|
 | 393 |         if GetTextLen > 0 then
 | 
|---|
 | 394 |           NewComments.Assign(Lines)
 | 
|---|
 | 395 |         else
 | 
|---|
 | 396 |           NewComments.Clear;
 | 
|---|
 | 397 |     end;
 | 
|---|
 | 398 | end;
 | 
|---|
 | 399 | 
 | 
|---|
 | 400 | procedure TfrmEditCslt.FormClose(Sender: TObject; var Action: TCloseAction);
 | 
|---|
 | 401 | const
 | 
|---|
 | 402 |   TX_ACCEPT = 'Resubmit this request?' + CRLF + CRLF;
 | 
|---|
 | 403 |   TX_ACCEPT_CAP = 'Unsaved Changes';
 | 
|---|
 | 404 | begin
 | 
|---|
 | 405 |   if FChanged then
 | 
|---|
 | 406 |     if InfoBox(TX_ACCEPT, TX_ACCEPT_CAP, MB_YESNO) = ID_YES then
 | 
|---|
 | 407 |       if not ValidSave then Action := caNone;
 | 
|---|
 | 408 | end;
 | 
|---|
 | 409 | 
 | 
|---|
 | 410 | procedure TfrmEditCslt.cmdAcceptClick(Sender: TObject);
 | 
|---|
 | 411 | {Begin BillingAware}
 | 
|---|
 | 412 | var
 | 
|---|
 | 413 |   BADiagnosis: string;
 | 
|---|
 | 414 |   //newDxRec: TBADxRecord;
 | 
|---|
 | 415 |   //AnOrder: TOrder;
 | 
|---|
 | 416 | {End BillingAware}
 | 
|---|
 | 417 | begin
 | 
|---|
 | 418 | 
 | 
|---|
 | 419 | {Begin BillingAware}
 | 
|---|
 | 420 |   if  BILLING_AWARE then
 | 
|---|
 | 421 |   begin
 | 
|---|
 | 422 |      if BADxUpdated then
 | 
|---|
 | 423 |      begin
 | 
|---|
 | 424 |         BADiagnosis := ProvDx.Text + '^' + ProvDx.Code;
 | 
|---|
 | 425 |         UBAGlobals.Dx1 := BADiagnosis;  //  add selected dx to BA Dx List.
 | 
|---|
 | 426 |         UBAGlobals.SimpleAddTempDxList(UBAGlobals.BAOrderID);
 | 
|---|
 | 427 |      end;
 | 
|---|
 | 428 |   end;
 | 
|---|
 | 429 | {End BillingAware}
 | 
|---|
 | 430 | 
 | 
|---|
 | 431 |   if ValidSave then
 | 
|---|
 | 432 |     begin
 | 
|---|
 | 433 |       FChanged := (ResubmitConsult(NewRec) = '0');
 | 
|---|
 | 434 |       Close;
 | 
|---|
 | 435 |     end;
 | 
|---|
 | 436 | end;
 | 
|---|
 | 437 | 
 | 
|---|
 | 438 | procedure TfrmEditCslt.memReasonExit(Sender: TObject);
 | 
|---|
 | 439 | var
 | 
|---|
 | 440 |   AStringList: TStringList;
 | 
|---|
 | 441 | begin
 | 
|---|
 | 442 |   inherited;
 | 
|---|
 | 443 |   AStringList := TStringList.Create;
 | 
|---|
 | 444 |   try
 | 
|---|
 | 445 |     AStringList.Assign(memReason.Lines);
 | 
|---|
 | 446 |     LimitStringLength(AStringList, 74);
 | 
|---|
 | 447 |     memReason.Lines.Assign(AstringList);
 | 
|---|
 | 448 |     ControlChange(Self);
 | 
|---|
 | 449 |   finally
 | 
|---|
 | 450 |     AStringList.Free;
 | 
|---|
 | 451 |   end;
 | 
|---|
 | 452 | end;
 | 
|---|
 | 453 | 
 | 
|---|
 | 454 | procedure TfrmEditCslt.cmdQuitClick(Sender: TObject);
 | 
|---|
 | 455 | begin
 | 
|---|
 | 456 |   inherited;
 | 
|---|
 | 457 |   FChanged := False;
 | 
|---|
 | 458 |   Close;
 | 
|---|
 | 459 | end;
 | 
|---|
 | 460 | 
 | 
|---|
 | 461 | function TfrmEditCslt.ValidSave: Boolean;
 | 
|---|
 | 462 | const
 | 
|---|
 | 463 |   TX_NO_SAVE     = 'This request cannot be saved for the following reason(s):' + CRLF + CRLF;
 | 
|---|
 | 464 |   TX_NO_SAVE_CAP = 'Unable to Save Request';
 | 
|---|
 | 465 |   TX_SAVE_ERR    = 'Unexpected error - it was not possible to save this request.';
 | 
|---|
 | 466 | var
 | 
|---|
 | 467 |   ErrMsg: string;
 | 
|---|
 | 468 | begin
 | 
|---|
 | 469 |   Result := True;
 | 
|---|
 | 470 |   Validate(ErrMsg);
 | 
|---|
 | 471 |   if Length(ErrMsg) > 0 then
 | 
|---|
 | 472 |   begin
 | 
|---|
 | 473 |     InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
 | 
|---|
 | 474 |     Result := False;
 | 
|---|
 | 475 |   end;
 | 
|---|
 | 476 |   if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) and (ProvDx.PromptMode = 'L') then
 | 
|---|
 | 477 |     cmdLexSearchClick(Self);
 | 
|---|
 | 478 | end;
 | 
|---|
 | 479 | 
 | 
|---|
 | 480 | 
 | 
|---|
 | 481 | procedure TfrmEditCslt.OrderMessage(const AMessage: string);
 | 
|---|
 | 482 | begin
 | 
|---|
 | 483 |   memMessage.Lines.SetText(PChar(AMessage));
 | 
|---|
 | 484 |   if ContainsVisibleChar(AMessage) then
 | 
|---|
 | 485 |   begin
 | 
|---|
 | 486 |     pnlMessage.Visible := True;
 | 
|---|
 | 487 |     pnlMessage.BringToFront;
 | 
|---|
 | 488 |     uMessageVisible := GetTickCount;
 | 
|---|
 | 489 |   end
 | 
|---|
 | 490 |   else pnlMessage.Visible := False;
 | 
|---|
 | 491 | end;
 | 
|---|
 | 492 | 
 | 
|---|
 | 493 | procedure TfrmEditCslt.btnCmtCancelClick(Sender: TObject);
 | 
|---|
 | 494 | begin
 | 
|---|
 | 495 |   ReportBox(OldRec.DenyComments, 'Cancellation Comments', False);
 | 
|---|
 | 496 | end;
 | 
|---|
 | 497 | 
 | 
|---|
 | 498 | procedure TfrmEditCslt.btnCmtOtherClick(Sender: TObject);
 | 
|---|
 | 499 | begin
 | 
|---|
 | 500 |   ReportBox(OldRec.OtherComments, 'Added Comments', False);
 | 
|---|
 | 501 | end;
 | 
|---|
 | 502 | 
 | 
|---|
 | 503 | procedure TfrmEditCslt.cmdLexSearchClick(Sender: TObject);
 | 
|---|
 | 504 | var
 | 
|---|
 | 505 |   Match: string;
 | 
|---|
 | 506 |   i: integer;
 | 
|---|
 | 507 | begin
 | 
|---|
 | 508 |   inherited;
 | 
|---|
 | 509 | {Begin BillingAware}
 | 
|---|
 | 510 |   if  BILLING_AWARE then BADxUpdated := FALSE;
 | 
|---|
 | 511 | {End BillingAware}
 | 
|---|
 | 512 |   LexiconLookup(Match, LX_ICD);
 | 
|---|
 | 513 |   if Match = '' then Exit;
 | 
|---|
 | 514 |   ProvDx.Code := Piece(Match, U, 1);
 | 
|---|
 | 515 |   ProvDx.Text := Piece(Match, U, 2);
 | 
|---|
 | 516 |   i := Pos(' (ICD', ProvDx.Text);
 | 
|---|
 | 517 |   if i = 0 then i := Length(ProvDx.Text) + 1;
 | 
|---|
 | 518 |   if ProvDx.Text[i-1] = '*' then i := i - 2;
 | 
|---|
 | 519 |   ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
 | 
|---|
 | 520 |   txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
 | 
|---|
 | 521 | {Begin BillingAware}
 | 
|---|
 | 522 |   if  BILLING_AWARE then BADxUpdated := TRUE;
 | 
|---|
 | 523 | {End BillingAware}
 | 
|---|
 | 524 |   ProvDx.CodeInactive := False;
 | 
|---|
 | 525 | end;
 | 
|---|
 | 526 | 
 | 
|---|
 | 527 | procedure TfrmEditCslt.SetProvDiagPromptingMode;
 | 
|---|
 | 528 | const
 | 
|---|
 | 529 |   TX_USE_LEXICON = 'You must use the "Lexicon" button to select a provisional diagnosis for this service.';
 | 
|---|
 | 530 |   TX_PROVDX_OPT  = 'Provisional Diagnosis';
 | 
|---|
 | 531 |   TX_PROVDX_REQD = 'Provisional Dx (REQUIRED)';
 | 
|---|
 | 532 | begin
 | 
|---|
 | 533 |   cmdLexSearch.Enabled   := False;
 | 
|---|
 | 534 |   txtProvDiag.Enabled    := False;
 | 
|---|
 | 535 |   txtProvDiag.ReadOnly   := True;
 | 
|---|
 | 536 |   txtProvDiag.Color      := clBtnFace;
 | 
|---|
 | 537 |   txtProvDiag.Font.Color := clBtnText;
 | 
|---|
 | 538 |   lblProvDiag.Enabled    := False;
 | 
|---|
 | 539 |   txtProvDiag.Hint       := '';
 | 
|---|
 | 540 |   if cboService.ItemIEN = 0 then Exit;
 | 
|---|
 | 541 |   GetProvDxMode(ProvDx, cboService.ItemID + CSLT_PTR);
 | 
|---|
 | 542 |   //  Returns:  string  A^B
 | 
|---|
 | 543 |   //     A = O (optional), R (required) or S (suppress)
 | 
|---|
 | 544 |   //     B = F (free-text) or L (lexicon)
 | 
|---|
 | 545 |   with ProvDx do if (Reqd = '') or (PromptMode = '') then Exit;
 | 
|---|
 | 546 |   if ProvDx.Reqd = 'R' then
 | 
|---|
 | 547 |     lblProvDiag.Caption := TX_PROVDX_REQD
 | 
|---|
 | 548 |   else
 | 
|---|
 | 549 |     lblProvDiag.Caption := TX_PROVDX_OPT;
 | 
|---|
 | 550 |   if ProvDx.Reqd = 'S' then
 | 
|---|
 | 551 |     begin
 | 
|---|
 | 552 |       cmdLexSearch.Enabled   := False;
 | 
|---|
 | 553 |       txtProvDiag.Enabled    := False;
 | 
|---|
 | 554 |       txtProvDiag.ReadOnly   := True;
 | 
|---|
 | 555 |       txtProvDiag.Color      := clBtnFace;
 | 
|---|
 | 556 |       txtProvDiag.Font.Color := clBtnText;
 | 
|---|
 | 557 |       lblProvDiag.Enabled    := False;
 | 
|---|
 | 558 |     end
 | 
|---|
 | 559 |   else
 | 
|---|
 | 560 |     case ProvDx.PromptMode[1] of
 | 
|---|
 | 561 |       'F':  begin
 | 
|---|
 | 562 |               cmdLexSearch.Enabled   := False;
 | 
|---|
 | 563 |               txtProvDiag.Enabled    := True;
 | 
|---|
 | 564 |               txtProvDiag.ReadOnly   := False;
 | 
|---|
 | 565 |               txtProvDiag.Color      := clWindow;
 | 
|---|
 | 566 |               txtProvDiag.Font.Color := clWindowText;
 | 
|---|
 | 567 |               lblProvDiag.Enabled    := True;
 | 
|---|
 | 568 |             end;
 | 
|---|
 | 569 |       'L':  begin
 | 
|---|
 | 570 |               cmdLexSearch.Enabled   := True;
 | 
|---|
 | 571 |               txtProvDiag.Enabled    := True;
 | 
|---|
 | 572 |               txtProvDiag.ReadOnly   := True;
 | 
|---|
 | 573 |               txtProvDiag.Color      := clInfoBk;
 | 
|---|
 | 574 |               txtProvDiag.Font.Color := clInfoText;
 | 
|---|
 | 575 |               lblProvDiag.Enabled    := True;
 | 
|---|
 | 576 |               txtProvDiag.Hint       := TX_USE_LEXICON;
 | 
|---|
 | 577 |             end;
 | 
|---|
 | 578 |     end;
 | 
|---|
 | 579 | end;
 | 
|---|
 | 580 | 
 | 
|---|
 | 581 | procedure TfrmEditCslt.mnuPopProvDxDeleteClick(Sender: TObject);
 | 
|---|
 | 582 | begin
 | 
|---|
 | 583 |   inherited;
 | 
|---|
 | 584 |   ProvDx.Text := '';
 | 
|---|
 | 585 |   ProvDx.Code := '';
 | 
|---|
 | 586 |   ProvDx.CodeInactive := False;
 | 
|---|
 | 587 |   txtProvDiag.Text := '';
 | 
|---|
 | 588 |   ControlChange(Self);
 | 
|---|
 | 589 | end;
 | 
|---|
 | 590 | 
 | 
|---|
 | 591 | procedure TfrmEditCslt.popReasonPopup(Sender: TObject);
 | 
|---|
 | 592 | begin
 | 
|---|
 | 593 |   inherited;
 | 
|---|
 | 594 |   if PopupComponent(Sender, popReason) is TCustomEdit
 | 
|---|
 | 595 |     then FEditCtrl := TCustomEdit(PopupComponent(Sender, popReason))
 | 
|---|
 | 596 |     else FEditCtrl := nil;
 | 
|---|
 | 597 |   if FEditCtrl <> nil then
 | 
|---|
 | 598 |   begin
 | 
|---|
 | 599 |     popReasonCut.Enabled      := FEditCtrl.SelLength > 0;
 | 
|---|
 | 600 |     popReasonCopy.Enabled     := popReasonCut.Enabled;
 | 
|---|
 | 601 |     popReasonPaste.Enabled    := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
 | 
|---|
 | 602 |                                    Clipboard.HasFormat(CF_TEXT);
 | 
|---|
 | 603 |   end else
 | 
|---|
 | 604 |   begin
 | 
|---|
 | 605 |     popReasonCut.Enabled      := False;
 | 
|---|
 | 606 |     popReasonCopy.Enabled     := False;
 | 
|---|
 | 607 |     popReasonPaste.Enabled    := False;
 | 
|---|
 | 608 |   end;
 | 
|---|
 | 609 |   popReasonReformat.Enabled := True;
 | 
|---|
 | 610 | end;
 | 
|---|
 | 611 | 
 | 
|---|
 | 612 | procedure TfrmEditCslt.popReasonCutClick(Sender: TObject);
 | 
|---|
 | 613 | begin
 | 
|---|
 | 614 |   inherited;
 | 
|---|
 | 615 |   FEditCtrl.CutToClipboard;
 | 
|---|
 | 616 | end;
 | 
|---|
 | 617 | 
 | 
|---|
 | 618 | procedure TfrmEditCslt.popReasonCopyClick(Sender: TObject);
 | 
|---|
 | 619 | begin
 | 
|---|
 | 620 |   inherited;
 | 
|---|
 | 621 |   FEditCtrl.CopyToClipboard;
 | 
|---|
 | 622 | end;
 | 
|---|
 | 623 | 
 | 
|---|
 | 624 | procedure TfrmEditCslt.popReasonPasteClick(Sender: TObject);
 | 
|---|
 | 625 | begin
 | 
|---|
 | 626 |   inherited;
 | 
|---|
 | 627 |   FEditCtrl.SelText := Clipboard.AsText;
 | 
|---|
 | 628 | end;
 | 
|---|
 | 629 | 
 | 
|---|
 | 630 | procedure TfrmEditCslt.popReasonReformatClick(Sender: TObject);
 | 
|---|
 | 631 | begin
 | 
|---|
 | 632 |   inherited;
 | 
|---|
 | 633 |   if (Screen.ActiveControl <> memReason) and
 | 
|---|
 | 634 |      (Screen.ActiveControl <> memComment)then Exit;
 | 
|---|
 | 635 |   ReformatMemoParagraph(TCustomMemo(FEditCtrl));
 | 
|---|
 | 636 | end;
 | 
|---|
 | 637 | 
 | 
|---|
 | 638 | procedure TfrmEditCslt.memCommentKeyUp(Sender: TObject; var Key: Word;
 | 
|---|
 | 639 |   Shift: TShiftState);
 | 
|---|
 | 640 | begin
 | 
|---|
 | 641 |   if FNavigatingTab then
 | 
|---|
 | 642 |   begin
 | 
|---|
 | 643 |     if ssShift in Shift then
 | 
|---|
 | 644 |       FindNextControl(Sender as TWinControl, False, True, False).SetFocus //previous control
 | 
|---|
 | 645 |     else if ssCtrl      in Shift then
 | 
|---|
 | 646 |       FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
 | 
|---|
 | 647 |     FNavigatingTab := False;
 | 
|---|
 | 648 |   end;
 | 
|---|
 | 649 |   if (key = VK_ESCAPE) then begin
 | 
|---|
 | 650 |     FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
 | 
|---|
 | 651 |     key := 0;
 | 
|---|
 | 652 |   end;
 | 
|---|
 | 653 | end;
 | 
|---|
 | 654 | 
 | 
|---|
 | 655 | procedure TfrmEditCslt.memCommentKeyDown(Sender: TObject; var Key: Word;
 | 
|---|
 | 656 |   Shift: TShiftState);
 | 
|---|
 | 657 | begin
 | 
|---|
 | 658 |   //The navigating tab controls were inadvertantently adding tab characters
 | 
|---|
 | 659 |   //This should fix it
 | 
|---|
 | 660 |   FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
 | 
|---|
 | 661 |   if FNavigatingTab then
 | 
|---|
 | 662 |     Key := 0;
 | 
|---|
 | 663 | end;
 | 
|---|
 | 664 | 
 | 
|---|
 | 665 | procedure TfrmEditCslt.memCommentKeyPress(Sender: TObject; var Key: Char);
 | 
|---|
 | 666 | begin
 | 
|---|
 | 667 |   if FNavigatingTab then
 | 
|---|
 | 668 |     Key := #0;  //Disable shift-tab processin
 | 
|---|
 | 669 | end;
 | 
|---|
 | 670 | 
 | 
|---|
 | 671 | end.
 | 
|---|