Changeset 460 for cprs/branches/foia-cprs/CPRS-Chart/fNoteProps.pas
- Timestamp:
- Jul 6, 2008, 8:20:14 PM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
cprs/branches/foia-cprs/CPRS-Chart/fNoteProps.pas
r459 r460 1 unit fNoteProps; 1 unit fNoteProps; 2 2 3 3 interface … … 5 5 uses 6 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ORDtTm, ORCtrls, ExtCtrls, rTIU, uConst, uTIU, ORFn, ORNet; 7 StdCtrls, ORDtTm, ORCtrls, ExtCtrls, rTIU, uConst, uTIU, ORFn, ORNet, 8 ComCtrls, Buttons; 8 9 9 10 type 11 {This object holds a List of Actions as Returned VIA the RPCBroker} 12 TPRFActions = class(TObject) 13 private 14 FPRFActionList : TStringList; 15 public 16 //procedure to show the Action in a ListView, requires a listview parameter 17 procedure ShowActionsOnList(DisplayList : TCaptionListView); 18 //procedure to load the actions, this will call the RPC 19 procedure Load(TitleIEN : Int64; DFN : String); 20 //returns true if the Action at the Index passed is associated with a note 21 function SelActionHasNote(lstIndex : integer) : boolean; 22 //return the Action IEN at the Index passed 23 function GetActionIEN(lstIndex : integer) : String; 24 //return the PRF IEN at the Index passed 25 function GetPRF_IEN(lstIndex : integer) : integer; 26 constructor Create(); 27 destructor Destroy(); override; 28 end; 29 10 30 TfrmNoteProperties = class(TForm) 11 31 lblNewTitle: TLabel; … … 42 62 lblProcDateTime: TOROffsetLabel; 43 63 btnShowList: TButton; 64 pnlPRF: TORAutoPanel; 65 lblPRF: TLabel; 66 Bevel1: TBevel; 67 lvPRF: TCaptionListView; 68 btnDetails: TButton; 44 69 procedure FormShow(Sender: TObject); 45 70 procedure cboNewTitleNeedData(Sender: TObject; const StartFrom: String; … … 63 88 procedure FormResize(Sender: TObject); 64 89 procedure calNoteEnter(Sender: TObject); 90 procedure FormDestroy(Sender: TObject); 91 procedure btnDetailsClick(Sender: TObject); 92 procedure lstRequestsChange(Sender: TObject); 65 93 private 66 94 FCosignIEN: Int64; // store cosigner that was passed in … … 81 109 FProcDateTime: TFMDateTime; 82 110 FCPStatusFlag: integer; 111 FPRFActions : TPRFActions; 112 FStarting: boolean; 83 113 procedure SetCosignerRequired(DoSetup: boolean); 84 114 procedure FormatRequestList; 85 115 procedure ShowRequestList(ShouldShow: Boolean); 86 116 procedure ShowSurgCaseList(ShouldShow: Boolean); 117 procedure ShowPRFList(ShouldShow: Boolean); 87 118 procedure ShowClinProcFields(YesNo: boolean); 119 procedure SetGenericFormSize; 88 120 procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT; 89 121 public 90 122 { Public declarations } 123 91 124 end; 125 92 126 93 127 function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly, … … 101 135 TC_INACTIVE_USER = 'Inactive User Alert'; 102 136 137 PIXEL_SPACE = 6; 138 103 139 implementation 104 140 105 141 {$R *.DFM} 106 142 107 uses uCore, rCore, rConsults, uConsults, rSurgery, uAccessibleListBox ;143 uses uCore, rCore, rConsults, uConsults, rSurgery, uAccessibleListBox, fRptBox; 108 144 109 145 { Initial values in ANote … … 133 169 TX_REQ_REQUEST = CRLF + 'This title requires the selection of an associated consult request.'; 134 170 TX_REQ_SURGCASE = CRLF + 'This title requires the selection of an associated surgery case.'; 171 TX_REQ_PRF_ACTION = CRLF + 'Notes of this title require the selection of a patient record flag action.'; 172 TX_REQ_PRF_NOTE = CRLF + 'This action has already been assigned to another note.'; 135 173 TX_NO_FUTURE = CRLF + 'A reference date/time in the future is not allowed.'; 136 174 TX_COS_SELF = CRLF + 'You cannot make yourself a cosigner.'; … … 153 191 ACTIVE_STATUS = 'ACTIVE,PENDING,SCHEDULED'; 154 192 193 PRF_LABEL = 'Which Patient Record Flag Action should this Note be linked to?'; 194 195 FLAG_NAME = 1; 196 PRF_IEN = 2; 197 ACTION_NAME = 3; 198 ACTION_IEN = 4; 199 ACTION_DATE_I = 5; 200 ACTION_DATE = 6; 201 NOTE_IEN = 7; 202 155 203 156 204 var … … 176 224 FIsClinProcNote := (AClassName = DCL_CLINPROC); 177 225 FCPStatusFlag := CPStatusFlag; 178 uShowUnresolvedOnly := False; 226 //uShowUnresolvedOnly := False; //v26.5 (RV) 227 uShowUnresolvedOnly := True; //v26.5 (RV) 179 228 if ANote.DocType <> TYP_ADDENDUM then 180 229 begin … … 210 259 CT_NOTES: begin 211 260 Caption := 'Progress Note Properties'; 212 if ANote.IsNewNote and UnresolvedConsultsExist then 213 uShowUnresolvedOnly := InfoBox(TX_UNRESOLVED_CONSULTS, 'Unresolved Consults Exist', 214 MB_YESNO or MB_ICONQUESTION) = IDYES; 261 if ANote.IsNewNote then 262 begin 263 GetUnresolvedConsultsInfo; // v26.5 (RV) removed nag screen 264 end; 215 265 cboNewTitle.InitLongList(''); 216 266 cboAuthor.InitLongList(ANote.AuthorName); … … 235 285 end; 236 286 ShowClinProcFields(FIsClinProcNote); 287 FStarting := True; 237 288 if ANote.Title > 0 then cboNewTitle.SelectByIEN(ANote.Title); 238 289 if (ANote.Title > 0) and (cboNewTitle.ItemIndex < 0) 239 290 then cboNewTitle.SetExactByIEN(ANote.Title, ANote.TitleName); 291 FStarting := False; 240 292 calNote.FMDateTime := ANote.DateTime; 241 293 // setup cosigner fields … … 248 300 SetCosignerRequired(True); 249 301 // setup package fields 302 SetGenericFormSize; 250 303 case FCallingTab of 251 304 CT_CONSULTS: begin 252 305 ShowRequestList(False); 253 306 ShowSurgCaseList(False); 307 ShowPRFList(False); 254 308 end; 255 309 CT_SURGERY : begin 256 310 ShowRequestList(False); 257 311 ShowSurgCaseList(False); 312 ShowPRFList(False); 258 313 end; 259 314 CT_NOTES : begin 260 if IsConsultTitle(ANote.Title) then 261 begin 262 ShowRequestList(True); 263 ShowSurgCaseList(False); 264 end 265 else if IsSurgeryTitle(ANote.Title) then 266 begin 267 ShowSurgCaseList(True); 268 ShowRequestList(False); 269 end 270 else 271 begin 272 ShowRequestList(False); 273 ShowSurgCaseList(False); 274 end; 315 with uUnresolvedConsults do // v26.5 (RV) 316 ShowRequestList(IsConsultTitle(ANote.Title) or 317 (UnresolvedConsultsExist and ShowNagScreen)); // v26.5 (RV) 318 ShowSurgCaseList(IsSurgeryTitle(ANote.Title)); 319 ShowPRFList(IsPRFTitle(ANote.Title)); 275 320 end; 276 321 end; … … 283 328 end; 284 329 cboNewTitle.Caption := lblNewTitle.Caption; 330 FStarting := True; 285 331 cboNewTitleExit(frmNoteProperties); // force display of request/case list 332 FStarting := False; 286 333 if uShowUnresolvedOnly then // override previous display if SHOW ME clicked on entrance 287 334 begin 288 cboNewTitle.ItemIndex := -1;335 //cboNewTitle.ItemIndex := -1; CQ#7587, v26.25 - RV 289 336 uShowUnresolvedOnly := not uShowUnresolvedOnly; 290 337 FormatRequestList; … … 351 398 PkgPtr := PKG_SURGERY; 352 399 PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr; 400 end 401 else if pnlPRF.Visible then //PRF 402 begin 403 PRF_IEN := FPRFActions.GetPRF_IEN(lvPRF.ItemIndex); 404 ActionIEN := FPRFActions.GetActionIEN(lvPRF.ItemIndex); 353 405 end; 354 406 end; … … 392 444 begin 393 445 if cboNewTitle.ItemIEN = 0 394 then lblCosigner.Visible := AskCosignerForTitle(FDocType, cboAuthor.ItemIEN )395 else lblCosigner.Visible := AskCosignerForTitle(cboNewTitle.ItemIEN, cboAuthor.ItemIEN );446 then lblCosigner.Visible := AskCosignerForTitle(FDocType, cboAuthor.ItemIEN, calNote.FMDateTime) 447 else lblCosigner.Visible := AskCosignerForTitle(cboNewTitle.ItemIEN, cboAuthor.ItemIEN, calNote.FMDateTime); 396 448 end; 397 449 cboCosigner.Visible := lblCosigner.Visible; … … 427 479 SavedIEN: integer; 428 480 begin 481 ShouldShow := ShouldShow and (FCallingTab = CT_NOTES); 429 482 if FDocType = TYP_ADDENDUM then ShouldShow := False; 483 pnlConsults.Visible := ShouldShow; 430 484 if ShouldShow then 431 485 begin 432 486 SavedIEN := lstRequests.ItemIEN; 433 for i := 0 to Pred(ControlCount) do 434 if Controls[i].Tag = 1 then Controls[i].Visible := True; 435 pnlConsults.Align := alBottom; 436 ClientHeight := cboCosigner.Top + cboCosigner.Height + 6 + pnlConsults.Height; 487 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlConsults.Height; 437 488 lstRequests.Items.Clear; 438 489 if uConsultsList.Count = 0 then ListConsultRequests(uConsultsList); … … 451 502 lblConsult1.Visible := (cboNewTitle.ItemIndex > -1); 452 503 lstRequests.SelectByIEN(SavedIEN); 453 end else 454 begin 455 for i := 0 to Pred(ControlCount) do 456 if Controls[i].Tag = 1 then Controls[i].Visible := False; 457 ClientHeight := cboCosigner.Top + cboCosigner.Height + 6; 458 end; 504 btnDetails.Enabled := (lstRequests.ItemIndex > -1); 505 end 459 506 end; 460 507 461 508 procedure TfrmNoteProperties.ShowSurgCaseList(ShouldShow: Boolean); 462 509 { called initially & whenever title changes } 463 var 464 i: Integer; 465 begin 510 begin 511 pnlSurgery.Visible := ShouldShow; 466 512 if FDocType = TYP_ADDENDUM then ShouldShow := False; 467 513 if ShouldShow then 468 514 begin 469 for i := 0 to Pred(ControlCount) do 470 if Controls[i].Tag = 2 then Controls[i].Visible := True; 471 pnlSurgery.Align := alBottom; 472 ClientHeight := cboCosigner.Top + cboCosigner.Height + 6 + pnlSurgery.Height; 515 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlSurgery.Height; 473 516 if lstSurgery.Items.Count = 0 then ListSurgeryCases(lstSurgery.Items); 474 end else 475 begin 476 for i := 0 to Pred(ControlCount) do 477 if Controls[i].Tag = 2 then Controls[i].Visible := False; 478 ClientHeight := cboCosigner.Top + cboCosigner.Height + 6; 479 end; 517 end 480 518 end; 481 519 … … 503 541 504 542 procedure TfrmNoteProperties.cboNewTitleMouseClick(Sender: TObject); 543 const 544 TX_NEED_CONSULT_TITLE = 'You currently have unresolved consults awaiting completion.' + CRLF + 545 'The selected title cannot be used to complete consults.' + CRLF + 546 'You must select a Consults title to complete a consult.' + CRLF + CRLF + 547 'Answer "YES" to continue with this title and not complete a consult.' + CRLF + 548 'Answer "NO" to select a different title.' + CRLF + CRLF + 549 'Do you want to use this title and continue?'; 550 TC_NOT_CONSULT_TITLE = 'Not a consult title'; 551 var 552 WantsToCompleteConsult: boolean; 553 ConsultTitle: boolean; 505 554 begin 506 555 with cboNewTitle do … … 515 564 CT_CONSULTS: ; // no action 516 565 CT_SURGERY : ; // no action 517 CT_NOTES : if IsConsultTitle(cboNewTitle.ItemIEN) then 518 begin 519 ShowSurgCaseList(False); 520 ShowRequestList(True); 521 end 522 else if IsSurgeryTitle(cboNewTitle.ItemIEN) then 523 begin 524 ShowRequestList(False); 525 ShowSurgCaseList(True); 526 end 527 else 528 begin 529 ShowRequestList(False); 530 ShowSurgCaseList(False); 531 end; 566 CT_NOTES : begin // v26.5 (RV) main changes here 567 WantsToCompleteConsult := False; 568 ConsultTitle := IsConsultTitle(cboNewTitle.ItemIEN); 569 if (pnlConsults.Visible) and 570 (lstRequests.Items.Count > 0) and 571 (not FStarting) and 572 (*(lstRequests.ItemID <> '') and*) 573 (not ConsultTitle) then 574 WantsToCompleteConsult := (InfoBox(TX_NEED_CONSULT_TITLE, 575 TC_NOT_CONSULT_TITLE, 576 MB_ICONWARNING or MB_YESNO or MB_DEFBUTTON2) = IDNO); 577 if WantsToCompleteConsult and (not ConsultTitle) then cboNewTitle.ItemIndex := -1; 578 SetGenericFormSize; 579 ShowRequestList(WantsToCompleteConsult or ConsultTitle); 580 ShowSurgCaseList(IsSurgeryTitle(cboNewTitle.ItemIEN)); 581 ShowPRFList(IsPRFTitle(cboNewTitle.ItemIEN)); 582 end; 532 583 end; 533 584 SetCosignerRequired(True); … … 573 624 //var x: string; 574 625 begin 575 with cboCosigner do if Text = '' then ItemIndex := -1; 626 with cboCosigner do if ((Text = '') or (ItemIEN = 0)) then 627 begin 628 ItemIndex := -1; 629 FCosignIEN := 0; 630 FCosignName := ''; 631 exit; 632 end; 576 633 FCosignIEN := cboCosigner.ItemIEN; 577 634 FCosignName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2); … … 602 659 ShowRequestList(False); 603 660 ShowSurgCaseList(False); 661 ShowPRFList(False); 604 662 end; 605 663 end;*) 606 664 SetCosignerRequired(False); 607 665 ErrMsg := ''; 608 if cboNewTitle.ItemIEN = 0 then 609 ErrMsg := ErrMsg + TX_REQ_TITLE 610 //code added 12/2002 check note parm - one per visit GRE 611 else if OneNotePerVisit(CboNewTitle.ItemIEN, Patient.DFN, Encounter.VisitStr)then 612 ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1 613 + Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2) 614 + TX_ONE_NOTE_PER_VISIT2 615 else 666 if cboNewTitle.ItemIEN = 0 then 667 ErrMsg := ErrMsg + TX_REQ_TITLE ; 668 if ErrMsg = '' then 669 begin 670 if FDocType = TYP_ADDENDUM then 671 begin 672 if OneNotePerVisit(TYP_ADDENDUM, Patient.DFN, Encounter.VisitStr)then 673 ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1 674 + 'Addendum to ' + Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2) 675 + TX_ONE_NOTE_PER_VISIT2; 676 end 677 //code added 12/2002 check note parm - one per visit GRE 678 else if OneNotePerVisit(CboNewTitle.ItemIEN, Patient.DFN, Encounter.VisitStr)then 679 ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1 680 + Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2) 681 + TX_ONE_NOTE_PER_VISIT2; 682 end; 683 if ErrMsg = '' then 616 684 begin 617 685 if FIDNoteTitlesOnly then … … 626 694 else if ((pnlSurgery.Visible) and (lstSurgery.ItemIndex < 0)) then 627 695 ErrMsg := ErrMsg + TX_REQ_SURGCASE 696 else if (pnlPRF.Visible) then 697 begin 698 if (lvPRF.ItemIndex < 0) then 699 ErrMsg := ErrMsg + TX_REQ_PRF_ACTION 700 else if FPRFActions.SelActionHasNote(lvPRF.ItemIndex) then 701 ErrMsg := ErrMsg + TX_REQ_PRF_NOTE; 702 end; 628 703 end; 629 704 end; … … 635 710 if (cboCosigner.ItemIEN = 0) then ErrMsg := ErrMsg + TX_REQ_COSIGNER; 636 711 //if (cboCosigner.ItemIEN = User.DUZ) then ErrMsg := TX_COS_SELF; // (CanCosign will do this check) 637 if (cboCosigner.ItemIEN > 0) and not CanCosign(cboNewTitle.ItemIEN, FDocType, cboCosigner.ItemIEN )712 if (cboCosigner.ItemIEN > 0) and not CanCosign(cboNewTitle.ItemIEN, FDocType, cboCosigner.ItemIEN, calNote.FMDateTime) 638 713 then ErrMsg := cboCosigner.Text + TX_COS_AUTH; 639 714 //code added 02/2003 check if User is Inactive GRE … … 719 794 else 720 795 Caption := SHOW_UNRESOLVED; 721 ShowRequestList(True); 796 with uUnresolvedConsults do if (UnresolvedConsultsExist and ShowNagScreen) then pnlConsults.Visible := TRUE; //v26.27 (RV) 797 ShowRequestList(pnlConsults.Visible); //v26.5 (RV) 798 //ShowRequestList(True); //v26.5 (RV) 722 799 end; 723 800 … … 739 816 end; 740 817 818 procedure TfrmNoteProperties.ShowPRFList(ShouldShow: Boolean); 819 begin 820 pnlPRF.Visible := ShouldShow and not (FDocType = TYP_ADDENDUM); 821 if pnlPRF.Visible then 822 begin 823 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlPRF.Height; 824 if FPRFActions = nil then 825 FPRFActions := TPRFActions.Create; 826 FPRFActions.Load(cboNewTitle.ItemIEN,Patient.DFN); 827 if RPCBrokerV.Results.Count <> 0 then 828 lblPRF.Caption := PRF_LABEL 829 else 830 lblPRF.Caption := 'No Linkable Actions for this Patient and/or Title.'; 831 FPRFActions.ShowActionsOnList(lvPRF); 832 //Fix for CQ: 6926 833 lvPRF.Columns.BeginUpdate; 834 lvPRF.Columns.EndUpdate; 835 //End Fix for CQ: 6926 836 end 837 end; 838 839 procedure TfrmNoteProperties.SetGenericFormSize; 840 begin 841 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE; 842 end; 843 844 { TPRFActions } 845 846 constructor TPRFActions.Create; 847 begin 848 inherited; 849 FPRFActionList := TStringList.Create; 850 end; 851 852 destructor TPRFActions.Destroy; 853 begin 854 FPRFActionList.Free; 855 inherited; 856 end; 857 858 function TPRFActions.GetActionIEN(lstIndex: integer): String; 859 begin 860 Result := Piece(FPRFActionList[lstIndex],U,ACTION_IEN); 861 end; 862 863 function TPRFActions.GetPRF_IEN(lstIndex: integer): integer; 864 begin 865 Result := StrToInt(Piece(FPRFActionList[lstIndex],U,PRF_IEN)); 866 end; 867 868 procedure TPRFActions.Load(TitleIEN : Int64; DFN : String); 869 begin 870 CallV('TIU GET PRF ACTIONS', [TitleIEN,DFN]); 871 FPRFActionList.Assign(RPCBrokerV.Results); 872 end; 873 874 function TPRFActions.SelActionHasNote(lstIndex: integer): boolean; 875 begin 876 Result := false; 877 if Piece(FPRFActionList[lstIndex],U,NOTE_IEN) <> '' then 878 Result := true; 879 end; 880 881 procedure TPRFActions.ShowActionsOnList(DisplayList: TCaptionListView); 882 var 883 i : integer; 884 ListItem: TListItem; 885 begin 886 DisplayList.Clear; 887 for i := 0 to FPRFActionList.Count-1 do 888 begin 889 //Caption="Text for Screen Reader" SubItem1=Flag SubItem2=Date SubItem3=Action SubItem4=Note 890 ListItem := DisplayList.Items.Add; 891 ListItem.Caption := PRF_LABEL; //Screen readers don't read the first column title on a listview. 892 ListItem.SubItems.Add(Piece(FPRFActionList[i],U,FLAG_NAME)); 893 ListItem.SubItems.Add(Piece(FPRFActionList[i],U,ACTION_DATE)); 894 ListItem.SubItems.Add(Piece(FPRFActionList[i],U,ACTION_NAME)); 895 if SelActionHasNote(i) then 896 ListItem.SubItems.Add('Yes') 897 else 898 ListItem.SubItems.Add('No'); 899 end; 900 end; 901 902 procedure TfrmNoteProperties.FormDestroy(Sender: TObject); 903 begin 904 FPRFActions.Free; 905 end; 906 907 procedure TfrmNoteProperties.btnDetailsClick(Sender: TObject); 908 var 909 ConsultDetail: TStringList; 910 begin 911 if lstRequests.ItemIEN <= 0 then exit; 912 ConsultDetail := TStringList.Create; 913 try 914 LoadConsultDetail(ConsultDetail, lstRequests.ItemIEN) ; 915 ReportBox(ConsultDetail, 'Consult Details: #' + lstRequests.ItemID + ' - ' + 916 Piece(lstRequests.Items[lstRequests.ItemIndex], U, 3), TRUE); 917 finally 918 ConsultDetail.Free; 919 end; 920 end; 921 922 procedure TfrmNoteProperties.lstRequestsChange(Sender: TObject); 923 begin 924 btnDetails.Enabled := (lstRequests.ItemIEN > 0); 925 end; 926 741 927 end.
Note:
See TracChangeset
for help on using the changeset viewer.
