unit fCover; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fPage, StdCtrls, ORCtrls, ExtCtrls, rOrders, ORClasses, Menus, rCover, fAllgyBox, VA508AccessibilityManager, fBase508Form; {REV} type TfrmCover = class(TfrmPage) pnlBase: TPanel; pnlTop: TPanel; pnlNotTheBottom: TPanel; pnlMiddle: TPanel; pnlBottom: TPanel; sptTop: TSplitter; sptBottom: TSplitter; pnl_Not3: TPanel; pnl_Not8: TPanel; pnl_4: TPanel; pnl_5: TPanel; pnl_6: TPanel; pnl_7: TPanel; pnl_8: TPanel; spt_3: TSplitter; spt_4: TSplitter; spt_5: TSplitter; pnl_1: TPanel; pnl_2: TPanel; pnl_3: TPanel; spt_1: TSplitter; spt_2: TSplitter; lbl_1: TOROffsetLabel; lbl_2: TOROffsetLabel; lbl_4: TOROffsetLabel; lbl_5: TOROffsetLabel; lbl_6: TOROffsetLabel; lbl_7: TOROffsetLabel; lbl_8: TOROffsetLabel; lst_1: TORListBox; lst_2: TORListBox; lst_4: TORListBox; lst_5: TORListBox; lst_6: TORListBox; lst_7: TORListBox; lst_8: TORListBox; timPoll: TTimer; popMenuAllergies: TPopupMenu; popNewAllergy: TMenuItem; popNKA: TMenuItem; popEditAllergy: TMenuItem; popEnteredInError: TMenuItem; pnlFlag: TPanel; lstFlag: TORListBox; lblFlag: TOROffsetLabel; lbl_3: TOROffsetLabel; lst_3: TORListBox; sptFlag: TSplitter; VA508ComponentAccessibility1: TVA508ComponentAccessibility; procedure CoverItemClick(Sender: TObject); procedure timPollTimer(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure RemContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure sptBottomCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure sptTopCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure spt_1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure spt_2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure spt_3CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure spt_4CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure spt_5CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure popMenuAllergiesPopup(Sender: TObject); procedure popNewAllergyClick(Sender: TObject); procedure popNKAClick(Sender: TObject); procedure popEditAllergyClick(Sender: TObject); procedure popEnteredInErrorClick(Sender: TObject); procedure CoverItemExit(Sender: TObject); procedure lstFlagClick(Sender: TObject); procedure lstFlagKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private FCoverList: TCoverSheetList; popReminders: TORPopupMenu; FLoadingForDFN: string; //*DFN* procedure RemindersChange(Sender: TObject); procedure GetPatientFlag; procedure LoadList(const StsTxt: string; ListCtrl: TObject; ARpc: String; ACase, AInvert: Boolean; ADatePiece: integer; ADateFormat, AParam1, AID, ADetail: String; Reminders: boolean = FALSE); public procedure ClearPtData; override; procedure DisplayPage; override; procedure SetFontSize(NewFontSize: Integer); override; procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override; {REV} procedure UpdateAllergiesList; procedure UpdateVAAButton; end; var frmCover: TfrmCover; VAAFlag: TStringList; MHVFlag: TStringList; VAA_DFN: string; PtIsVAA: boolean; PtIsMHV: boolean; const CoverSplitters1 = 'frmCoverSplitters1'; CoverSplitters2 = 'frmCoverSplitters2'; implementation {$R *.DFM} uses ORNet, ORFn, fRptBox, fVitals, fvit, fFrame, uCore, TRPCB, uConst, uInit, uReminders, rReminders, fARTAllgy, uOrPtf, fPatientFlagMulti, rODAllergy, rMisc, VA508AccessibilityRouter; const TAG_PROB = 10; TAG_ALLG = 20; TAG_POST = 30; TAG_MEDS = 40; TAG_RMND = 50; TAG_LABS = 60; TAG_VITL = 70; TAG_VSIT = 80; RemID = '50'; TX_INACTIVE_ICODE = 'This problem references an ICD-9-CM code that is not currently active.' + #13#10 + 'Please correct this code using the ''Problems'' tab.'; TC_INACTIVE_ICODE = 'Inactive ICD-9-CM code'; TX_INACTIVE_SCODE = 'This problem references an SNOMED CT code that is not currently active.' + #13#10 + 'Please correct this code using the ''Problems'' tab.'; TC_INACTIVE_SCODE = 'Inactive SNOMED CT code'; var uIPAddress: string; uARTCoverSheetParams: string; procedure TfrmCover.ClearPtData; { clears all lists displayed on the cover sheet } begin timPoll.Enabled := False; if Length(FLoadingForDFN) > 0 then StopCoverSheet(FLoadingForDFN, uIPAddress, frmFrame.Handle); //*DFN* FLoadingForDFN := ''; //*DFN* inherited ClearPtData; lst_1.Clear; lst_2.Clear; lst_3.Clear; lst_4.Clear; lst_5.Clear; lst_6.Clear; lst_7.Clear; lst_8.Clear; pnl_1.Visible := false; pnl_2.Visible := false; pnl_3.Visible := false; pnl_4.Visible := false; pnl_5.Visible := false; pnl_6.Visible := false; pnl_7.Visible := false; pnl_8.Visible := false; end; procedure TfrmCover.LoadList(const StsTxt: string; ListCtrl: TObject; ARpc: String; ACase, AInvert: Boolean; ADatePiece: integer; ADateFormat, AParam1, AID, ADetail: String; Reminders: boolean = FALSE); begin StatusText(StsTxt); if(ListCtrl is TORListBox) then begin ListGeneric((ListCtrl as TORListBox).Items, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID); if((ListCtrl as TORListBox).Items.Count = 0) then (ListCtrl as TORListBox).Items.Add(NoDataText(Reminders)); end else begin ListGeneric(ListCtrl as TStrings, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID); if((ListCtrl as TStrings).Count = 0) then (ListCtrl as TStrings).Add(NoDataText(Reminders)); end; StatusText(''); end; procedure TfrmCover.DisplayPage; { loads the cover sheet lists if the patient has just been selected } var DontDo, ForeGround: string; WaitCount: Integer; RemSL: TStringList; uCoverSheetList: TStringList; i, iRem: Integer; aIFN, aRPC, aCase, aInvert, aDatePiece, aDateFormat, aTextColor, aStatus, aParam1, aID, aQualifier, aTabPos, aName, aPiece, aDetail, x: string; bCase, bInvert: Boolean; iDatePiece: Integer; (* procedure LoadList(const StsTxt: string; ListCtrl: TObject; ARpc: String; ACase, AInvert: Boolean; ADatePiece: integer; ADateFormat, AParam1, AID, ADetail: String; Reminders: boolean = FALSE); begin StatusText(StsTxt); if(ListCtrl is TORListBox) then begin ListGeneric((ListCtrl as TORListBox).Items, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID); if((ListCtrl as TORListBox).Items.Count = 0) then (ListCtrl as TORListBox).Items.Add(NoDataText(Reminders)); end else begin ListGeneric(ListCtrl as TStrings, ARpc, ACase, AInvert, ADatePiece, ADateFormat, AParam1, ADetail, AID); if((ListCtrl as TStrings).Count = 0) then (ListCtrl as TStrings).Add(NoDataText(Reminders)); end; StatusText(''); end;*) procedure WaitList(ListCtrl: TORListBox); begin ListCtrl.Clear; Inc(WaitCount); ListCtrl.Items.Add('0^Retrieving in background...'); ListCtrl.Repaint; end; begin inherited DisplayPage; iRem := -1; frmFrame.mnuFilePrintSetup.Enabled := True; if InitPage then uIPAddress := DottedIPStr; if InitPatient then begin WaitCount := 0; if InteractiveRemindersActive then begin if(InitialRemindersLoaded) then begin DontDo := RemID+';'; NotifyWhenRemindersChange(RemindersChange); end else begin DontDo := ''; RemoveNotifyRemindersChange(RemindersChange); end; end; ForeGround := StartCoverSheet(uIPAddress, frmFrame.Handle, DontDo, InteractiveRemindersActive); uCoverSheetList := TStringList.Create; LoadCoverSheetList(uCoverSheetList); for i := 0 to uCoverSheetList.Count - 1 do begin x := uCoverSheetList[i]; aName := Piece(x,'^',2); aRPC := Piece(x,'^',6); aCase := Piece(x,'^',7); aInvert := Piece(x,'^',8); aDatePiece := Piece(x,'^',11); aDateFormat := Piece(x,'^',10); aTextColor := Piece(x,'^',9); aStatus := 'Searching for ' + Piece(x,'^',2) + '...'; aParam1 := Piece(x,'^',12); aID := Piece(x,'^',1); //TAG_PROB, TAG_RMND, ETC. aQualifier := Piece(x,'^',13); aTabPos := Piece(x,'^',14); aPiece := Piece(x,'^',15); aDetail := Piece(x,'^',16); aIFN := Piece(x,'^',17); bCase := FALSE; bInvert := FALSE; iDatePiece := 0; if aCase = '1' then bCase := TRUE; if aInvert = '1' then bInvert := TRUE; if Length(aDatePiece) > 0 then iDatePiece := StrToInt(aDatePiece); if Length(aTextColor) > 0 then aTextColor := 'cl' + aTextColor; // Assign properties to components FCoverList.CVlbl(i).Caption := aName; FCoverList.CVlst(i).Caption := aName; if Length(aTabPos) > 0 then FCoverList.CVlst(i).TabPositions := aTabPos; if Length(aTextColor) > 0 then FCoverList.CVlst(i).Font.Color := Get508CompliantColor(StringToColor(aTextColor)); if Length(aPiece) > 0 then FCoverList.CVlst(i).Pieces := aPiece; FCoverList.CVlst(i).Tag := StrToInt(aID); if(aID <> RemID) then begin if((aID = '20') or (Pos(aID + ';', ForeGround) > 0)) then LoadList(aStatus, FCoverList.CVlst(i), aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail) else Waitlist(FCoverList.CVlst(i)); if (aID = '20') and ARTPatchInstalled then with FCoverList.CVlst(i) do begin uARTCoverSheetParams := x; PopupMenu := popMenuAllergies; RightClickSelect := True; popMenuAllergies.PopupComponent := FCoverList.CVlst(i); end; end; FCoverList.CVpln(i).Visible := true; if aID = RemID then begin FCoverList.CVLst(i).OnContextPopup := RemContextPopup; FCoverList.CVlst(i).RightClickSelect := True; iRem := FCoverList.CVlst(i).ComponentIndex; if InteractiveRemindersActive then begin if(InitialRemindersLoaded) then CoverSheetRemindersInBackground := FALSE else begin InitialRemindersLoaded := TRUE; CoverSheetRemindersInBackground := (Pos(aID + ';', ForeGround) = 0); if(not CoverSheetRemindersInBackground) then begin //InitialRemindersLoaded := TRUE; RemSL := TStringList.Create; try LoadList(aStatus, RemSL, aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail); RemindersEvaluated(RemSL); finally; RemSL.Free; end; NotifyWhenRemindersChange(RemindersChange); end else Waitlist(FCoverList.CVlst(i)); end; end else if Pos(aID + ';', ForeGround) > 0 then LoadList(aStatus, FCoverList.CVlst(i), aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail, TRUE) else Waitlist(FCoverList.CVlst(i)); if WaitCount > 0 then begin FLoadingForDFN := Patient.DFN; timPoll.Enabled := True; end else FLoadingForDFN := ''; //*DFN* if InteractiveRemindersActive then begin RemindersStarted := TRUE; LoadReminderData(CoverSheetRemindersInBackground); end; end; if WaitCount > 0 then begin FLoadingForDFN := Patient.DFN; timPoll.Enabled := True; end else FLoadingForDFN := ''; //*DFN* end; FocusFirstControl; spt_2.Left := pnl_Not3.Left + pnl_Not3.Width; spt_5.Left := pnl_Not8.Left + pnl_Not8.Width; GetPatientFlag; end; if InitPage then begin popReminders := TORPopupMenu.Create(Self); if InteractiveRemindersActive then begin SetReminderPopupCoverRoutine(popReminders); if iRem > -1 then (frmCover.Components[iRem] as TORListBox).PopupMenu := popReminders; end else begin if iRem > -1 then begin (frmCover.Components[iRem] as TORListBox).RightClickSelect := FALSE; (frmCover.Components[iRem] as TORListBox).OnMouseUp := nil; end; end; end; end; procedure TfrmCover.SetFontSize(NewFontSize: Integer); var i: integer; begin inherited; with frmCover do for i := ComponentCount - 1 downto 0 do begin if Components[i] is TORListBox then begin case Components[i].Tag of 30: (Components[i] as TORListBox).Font.Size := NewFontSize; end; end; end; end; procedure TfrmCover.CoverItemClick(Sender: TObject); { displays details for an item that has been clicked on the cover sheet } var i: integer; aDetail: string; begin inherited; with TORListBox(Sender) do begin aDetail := Uppercase(Piece(TORListBox(Sender).Items[TORListBox(Sender).ItemIndex],'^',12)); case Tag of TAG_PROB: if ItemIEN > 0 then begin i := ItemIndex; if Piece(Items[ItemIndex], U, 13) = '#' then InfoBox(TX_INACTIVE_ICODE, TC_INACTIVE_ICODE, MB_ICONWARNING or MB_OK) else if Piece(Items[ItemIndex], U, 13) = '$' then InfoBox(TX_INACTIVE_SCODE, TC_INACTIVE_SCODE, MB_ICONWARNING or MB_OK); ItemIndex := i; ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True); lst_1.SetFocus; end; TAG_ALLG: { TODO -oRich V. -cART/Allergy : What to do about NKA only via right-click menu? Add here? } if ItemIEN > 0 then begin if ARTPatchInstalled then begin AllergyBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True, ItemIEN); lst_2.SetFocus; //TDP - Fixed allergy form focus problem if (frmARTAllergy <> nil) and frmARTAllergy.Showing then frmARTAllergy.SetFocus; end else begin ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True); lst_2.SetFocus; end; end; TAG_POST: if DisplayText[ItemIndex] = 'Allergies' then begin ReportBox(DetailPosting('A'), DisplayText[ItemIndex], True); lst_3.SetFocus; end else if ItemID <> '' then begin NotifyOtherApps(NAE_REPORT, 'TIU^' + ItemID); ReportBox(DetailPosting(ItemID), DisplayText[ItemIndex], True); lst_3.SetFocus; end; TAG_MEDS: if (ItemID <> '') and (ItemID <> '0') then begin ReportBox(DetailMed(ItemID), DisplayText[ItemIndex], True); lst_4.SetFocus; end; TAG_RMND: if ItemIEN > 0 then begin ReportBox(DetailReminder(ItemIEN), ClinMaintText + ': ' + DisplayText[ItemIndex], True); lst_5.SetFocus; end; TAG_LABS: if (ItemID <> '') and (Piece(ItemID,';',1) <> '0') and (not ContainsAlpha(Piece(ItemID,';',1))) then begin ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True); lst_6.SetFocus; end; TAG_VITL: if ItemID <> '' then begin //agp prevent double clicking on Vitals which can cause CPRS to shut down when exiting vitals TORListBox(Sender).Enabled := false; SelectVitals(Piece(DisplayText[ItemIndex],Char(9),1)); //Char(9) = Tab Character ClearPtData; //agp set InitialRemindersLoaded to False only if reminders are still evaluating. This prevent //a problem with reminders not finishing the evaluation if the Vital DLL is launch and it prevent //an automatic re-evaluation of reminders if reminders are done evaluating. if RemindersEvaluatingInBackground = true then InitialRemindersLoaded := False; DisplayPage; TORListBox(Sender).Enabled := True; lst_7.SetFocus; end; TAG_VSIT: if (ItemID <> '') and (ItemID <> '0') then begin ReportBox(DetailGeneric(ItemIEN, ItemID, aDetail), DisplayText[ItemIndex], True); lst_8.SetFocus; end else //don't try to display a detail report end; if uInit.TimedOut then // Fix for CQ: 8011 Abort else ItemIndex := -1; end; end; procedure TfrmCover.FormClose(Sender: TObject; var Action: TCloseAction); begin inherited; timPoll.Enabled := False; if Length(FLoadingForDFN) > 0 then StopCoverSheet(FLoadingForDFN, uIPAddress, frmFrame.Handle); //*DFN* FLoadingForDFN := ''; //*DFN* end; procedure TfrmCover.timPollTimer(Sender: TObject); const RemUnchanged = '[{^Reminders @ @ @ Unchanged^]}'; var Done: Boolean; ReminderSL: TStringList; ProbSL, PostSL, MedsSL, RemSL, LabsSL, VitSL, VisitSL: TStringList; i, iProb, iPost, iMeds, iRem, iLabs, iVit, iVisit: integer; begin inherited; iProb := -1; iPost := -1; iMeds := -1; iRem := -1; iLabs := -1; iVit := -1; iVisit := -1; with frmCover do for i := ComponentCount - 1 downto 0 do begin if Components[i] is TORListBox then begin case Components[i].Tag of TAG_PROB: iProb := i; TAG_POST: iPost := i; TAG_MEDS: iMeds := i; TAG_RMND: iRem := i; TAG_LABS: iLabs := i; TAG_VITL: iVit := i; TAG_VSIT: iVisit := i; end; end; end; ProbSL := TStringList.Create; PostSL := TStringList.Create; MedsSL := TStringList.Create; RemSL := TStringList.Create; LabsSL := TStringList.Create; VitSL := TStringList.Create; VisitSL := TStringList.Create; if InteractiveRemindersActive then begin ReminderSL := TStringList.Create; try ReminderSL.Add(RemUnchanged); ListAllBackGround(Done, ProbSL, PostSL, MedsSL, ReminderSL, LabsSL, VitSL, VisitSL, uIPAddress, frmFrame.Handle); if (iProb > -1) and (ProbSL.Count > 0) then FastAssign(ProbSL, (Components[iProb] as TORListBox).Items); if (iPost > -1) and (PostSL.Count > 0) then FastAssign(PostSL, (Components[iPost] as TORListBox).Items); if (iMeds > -1) and (MedsSL.Count > 0) then FastAssign(MedsSL, (Components[iMeds] as TORListBox).Items); if (iLabs > -1) and (LabsSL.Count > 0) then FastAssign(LabsSL, (Components[iLabs] as TORListBox).Items); if (iVit > -1) and (VitSL.Count > 0) then FastAssign(VitSL, (Components[iVit] as TORListBox).Items); if (iVisit > -1) and (VisitSL.Count > 0) then FastAssign(VisitSL, (Components[iVisit] as TORListBox).Items); // since this RPC is connected to a timer, clear the results each time to make sure that // the results aren't passed to another RPC in the case that there is an error RPCBrokerV.ClearResults := True; if Done then begin timPoll.Enabled := False; FLoadingForDFN := ''; //*DFN* end; if(not InitialRemindersLoaded) and (ReminderSL.Count <> 1) or (ReminderSL[0] <> RemUnchanged) then begin CoverSheetRemindersInBackground := FALSE; // InitialRemindersLoaded := TRUE; RemindersEvaluated(ReminderSL); NotifyWhenRemindersChange(RemindersChange); end; finally ReminderSL.Free; end; end else begin ListAllBackGround(Done, ProbSL, PostSL, MedsSL, RemSL, LabsSL, VitSL, VisitSL, uIPAddress, frmFrame.Handle); if (iProb > -1) and (ProbSL.Count > 0) then FastAssign(ProbSL, (Components[iProb] as TORListBox).Items); if (iPost > -1) and (PostSL.Count > 0) then FastAssign(PostSL, (Components[iPost] as TORListBox).Items); if (iMeds > -1) and (MedsSL.Count > 0) then FastAssign(MedsSL, (Components[iMeds] as TORListBox).Items); if (iRem > -1) and (RemSL.Count > 0) then FastAssign(RemSL, (Components[iRem] as TORListBox).Items); if (iLabs > -1) and (LabsSL.Count > 0) then FastAssign(LabsSL, (Components[iLabs] as TORListBox).Items); if (iVit > -1) and (VitSL.Count > 0) then FastAssign(VitSL, (Components[iVit] as TORListBox).Items); if (iVisit > -1) and (VisitSL.Count > 0) then FastAssign(VisitSL, (Components[iVisit] as TORListBox).Items); // since this RPC is connected to a timer, clear the results each time to make sure that // the results aren't passed to another RPC in the case that there is an error RPCBrokerV.ClearResults := True; if Done then begin timPoll.Enabled := False; FLoadingForDFN := ''; //*DFN* end; end; ProbSL.Free; PostSL.Free; MedsSL.Free; RemSL.Free; LabsSL.Free; VitSL.Free; VisitSL.Free; end; procedure TfrmCover.NotifyOrder(OrderAction: Integer; AnOrder: TOrder); {REV} var i: integer; begin case OrderAction of ORDER_SIGN: begin with frmCover do for i := ComponentCount - 1 downto 0 do begin if Components[i] is TORListBox then begin case Components[i].Tag of 20: UpdateAllergiesList; 30: ListPostings((Components[i] as TORListBox).Items); end; end; end; end; end; end; procedure TfrmCover.RemindersChange(Sender: TObject); var i: integer; tmp: string; lb: TORListBox; begin lb := nil; with frmCover do for i := ComponentCount - 1 downto 0 do begin if (Components[i] is TORListBox) and (Components[i].Tag = TAG_RMND) then begin lb := (Components[i] as TORListBox); break; end; end; if assigned(lb) then begin lb.Clear; //i := -1; //AGP Change 26.8 this changes allowed Reminders to display on the coversheet //even if they had an error on evaluation for i := 0 to ActiveReminders.Count-1 do begin if Piece(ActiveReminders.Strings[i],U,6)='1' then begin tmp := ActiveReminders[i]; SetPiece(tmp, U, 3, FormatFMDateTimeStr('mmm dd,yy', Piece(tmp, U, 3))); lb.Items.Add(tmp); end; if Piece(ActiveReminders.Strings[i],U,6)='3' then begin tmp := ActiveReminders[i]; SetPiece(tmp, U, 3, 'Error'); lb.Items.Add(tmp); end; if Piece(ActiveReminders.Strings[i],U,6)='4' then begin tmp := ActiveReminders[i]; SetPiece(tmp, U, 3, 'CNBD'); lb.Items.Add(tmp); end; end; //AGP End Change for 26.8 if(RemindersEvaluatingInBackground) then lb.Items.Insert(0,'0^Evaluating Reminders...') //AGP added code below to change the reminder panel picture if the clock has not stop by this point. CQ else if(lb.Items.Count = 0) and (RemindersStarted) then begin lb.Items.Add(NoDataText(TRUE)); if frmFrame.anmtRemSearch.Visible = true then begin frmFrame.anmtRemSearch.Visible := FALSE; frmFrame.imgReminder.Visible := TRUE; frmFrame.imgReminder.Picture.Bitmap.LoadFromResourceName(hInstance, 'BMP_REMINDERS_APPLICABLE'); frmFrame.anmtRemSearch.Active := FALSE; end; end else if (lb.Items.Count > 0) and (RemindersStarted) and (frmFrame.anmtRemSearch.Visible = true) then begin frmFrame.anmtRemSearch.Visible := FALSE; frmFrame.imgReminder.Visible := TRUE; frmFrame.imgReminder.Picture.Bitmap.LoadFromResourceName(hInstance, 'BMP_REMINDERS_DUE'); frmFrame.anmtRemSearch.Active := FALSE; end; end; end; Procedure TfrmCover.RemContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); var idx: integer; i, iRem: integer; begin inherited; Handled := TRUE; iRem := -1; with frmCover do for i := ComponentCount - 1 downto 0 do begin if Components[i] is TORListBox then begin case Components[i].Tag of TAG_RMND: iRem := i; end; end; end; if iRem > -1 then if ((frmCover.Components[iRem] as TORListBox).ItemIndex >= 0) then begin idx := StrToIntDef(Piece((frmCover.Components[iRem] as TORListBox).Items[(frmCover.Components[iRem] as TORListBox).ItemIndex],U,1),0); if(idx <> 0) then begin popReminders.Data := RemCode + (frmCover.Components[iRem] as TORListBox).Items[(frmCover.Components[iRem] as TORListBox).ItemIndex]; Handled := FALSE; end; end; end; procedure TfrmCover.FormCreate(Sender: TObject); begin inherited; PageID := CT_COVER; FCoverList := TCoverSheetList.Create; FCoverList.Add(pnl_1, lbl_1, lst_1); FCoverList.Add(pnl_2, lbl_2, lst_2); FCoverList.Add(pnl_3, lbl_3, lst_3); FCoverList.Add(pnl_4, lbl_4, lst_4); FCoverList.Add(pnl_5, lbl_5, lst_5); FCoverList.Add(pnl_6, lbl_6, lst_6); FCoverList.Add(pnl_7, lbl_7, lst_7); FCoverList.Add(pnl_8, lbl_8, lst_8); end; procedure TfrmCover.FormDestroy(Sender: TObject); begin inherited; FCoverList.Free; end; procedure TfrmCover.sptBottomCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmCover.sptTopCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmCover.spt_1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmCover.spt_2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmCover.spt_3CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmCover.spt_4CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmCover.spt_5CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 50 then Newsize := 50; end; procedure TfrmCover.popMenuAllergiesPopup(Sender: TObject); const NO_ASSESSMENT = 'No Allergy Assessment'; var AListBox: TORListBox; x: string; begin inherited; AListBox := (popMenuAllergies.PopupComponent as TORListBox); popEditAllergy.Enabled := (AListBox.ItemIEN > 0) and IsARTClinicalUser(x); popEnteredInError.Enabled := (AListBox.ItemIEN > 0) and IsARTClinicalUser(x); popNKA.Enabled := (AListBox.Items.Count = 1) and (Piece(AListBox.Items[0], U, 2) = NO_ASSESSMENT); //and IsARTClinicalUser(x); v26.12 popNewAllergy.Enabled := True; //IsARTClinicalUser(x); v26.12 end; procedure TfrmCover.popNewAllergyClick(Sender: TObject); const NEW_ALLERGY = True; ENTERED_IN_ERROR = True; begin inherited; EnterEditAllergy(0, NEW_ALLERGY, not ENTERED_IN_ERROR); end; procedure TfrmCover.popNKAClick(Sender: TObject); var Changed: boolean; begin inherited; Changed := EnterNKAForPatient; if Changed then UpdateAllergiesList; end; procedure TfrmCover.popEditAllergyClick(Sender: TObject); const NEW_ALLERGY = True; ENTERED_IN_ERROR = True; begin inherited; EnterEditAllergy((popMenuAllergies.PopupComponent as TORListBox).ItemIEN, not NEW_ALLERGY, not ENTERED_IN_ERROR); end; procedure TfrmCover.popEnteredInErrorClick(Sender: TObject); begin inherited; MarkEnteredInError((popMenuAllergies.PopupComponent as TORListBox).ItemIEN); end; procedure TfrmCover.UpdateAllergiesList; var bCase, bInvert: boolean; iDatePiece: integer ; x, aRPC, aDateFormat, aParam1, aID, aDetail, aStatus, aName, aCase, aInvert, aDatePiece, aTextColor, aQualifier, aTabPos, aPiece, aIFN: string; begin x := uARTCoverSheetParams; if x = '' then exit; aName := Piece(x,'^',2); aRPC := Piece(x,'^',6); aCase := Piece(x,'^',7); aInvert := Piece(x,'^',8); aDatePiece := Piece(x,'^',11); aDateFormat := Piece(x,'^',10); aTextColor := Piece(x,'^',9); aStatus := 'Searching for ' + Piece(x,'^',2) + '...'; aParam1 := Piece(x,'^',12); aID := Piece(x,'^',1); //TAG_PROB, TAG_RMND, ETC. aQualifier := Piece(x,'^',13); aTabPos := Piece(x,'^',14); aPiece := Piece(x,'^',15); aDetail := Piece(x,'^',16); aIFN := Piece(x,'^',17); bCase := FALSE; bInvert := FALSE; iDatePiece := 0; if aCase = '1' then bCase := TRUE; if aInvert = '1' then bInvert := TRUE; if Length(aDatePiece) > 0 then iDatePiece := StrToInt(aDatePiece); if Length(aTextColor) > 0 then aTextColor := 'cl' + aTextColor; // Assign properties to components if Length(aTabPos) > 0 then (popMenuAllergies.PopupComponent as TORListBox).TabPositions := aTabPos; if Length(aTextColor) > 0 then (popMenuAllergies.PopupComponent as TORListBox).Font.Color := Get508CompliantColor(StringToColor(aTextColor)); if Length(aPiece) > 0 then (popMenuAllergies.PopupComponent as TORListBox).Pieces := aPiece; (popMenuAllergies.PopupComponent as TORListBox).Tag := StrToInt(aID); LoadList(aStatus, (popMenuAllergies.PopupComponent as TORListBox), aRpc, bCase, bInvert, iDatePiece, aDateFormat, aParam1, aID, aDetail); with frmFrame do begin lblPtCWAD.Caption := GetCWADInfo(Patient.DFN); if Length(lblPtCWAD.Caption) > 0 then lblPtPostings.Caption := 'Postings' else lblPtPostings.Caption := 'No Postings'; pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption; end; end; procedure TfrmCover.CoverItemExit(Sender: TObject); begin with Sender as TORListBox do Selected[ItemIndex] := False; inherited; end; procedure TfrmCover.GetPatientFlag; begin pnlFlag.Visible := HasFlag; sptFlag.Visible := HasFlag; FastAssign(FlagList, lstFlag.Items); end; procedure TfrmCover.lstFlagClick(Sender: TObject); begin if lstFlag.ItemIndex >= 0 then ShowFlags(lstFlag.ItemID); lstFlag.ItemIndex := -1; end; procedure TfrmCover.lstFlagKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if Key = VK_RETURN then lstFlagClick(Self); end; procedure TfrmCover.UpdateVAAButton; const MHVLabelOrigTop = 3; PtInsLabelOrigTop = 27; //var // PtIsVAA: boolean; // PtIsMHV: boolean; begin //VAA & MHV PtIsVAA := false; PtIsMHV := false; VAAFlag := TStringList.Create; MHVFlag := TStringList.Create; VAA_DFN := Patient.DFN; tCallV(VAAFlag, 'ORVAA VAA', [VAA_DFN]); tCallV(MHVFlag, 'ORWMHV MHV', [VAA_DFN]); if VAAFlag[0] <> '0' then begin PtIsVAA := true; with frmFrame do begin laVAA2.Caption := Piece(VAAFlag[0], '^', 1); laVAA2.Hint := Piece(VAAFlag[0], '^', 2); //CQ7626 was piece '6' end; end else begin with frmFrame do begin laVAA2.Caption := #0; laVAA2.Hint := 'No active insurance'; //CQ7626 added this line end; end; //MHV flag if MHVFlag[0] <> '0' then begin PtIsMHV := true; with frmFrame do begin laMHV.Caption := Piece(MHVFlag[0], '^', 1); laMHV.Hint := Piece(MHVFlag[0], '^', 2); if VAAFlag[0] = '0' then laMHV.Caption := 'MHV'; end; end else begin with frmFrame do begin laMHV.Caption := #0; laMHV.Hint := 'No MyHealthyVet data'; //CQ7626 added this line end; end; with frmFrame do begin //Modified this 'with' section for CQ7783 paVAA.Hide; //Start by hiding it. Show it only if one of the conditions below is true, else it stays invisible. paVAA.Height := pnlPrimaryCare.Height; if ((PtIsVAA and PtIsMHV)) then //CQ7411 - this line begin laMHV.Top := paVAA.Top; laMHV.Width := paVAA.Width - 1; laMHV.Height := (paVAA.ClientHeight div 2) - 1; laMHV.Visible := true; laVAA2.Top := laMHV.Top + laMHV.Height + 1; laVAA2.Width := paVAA.Width - 1; laVAA2.Height := (paVAA.ClientHeight div 2); laVAA2.Visible := true; paVAA.Show; end else if ((PtIsMHV and (not PtIsVAA))) then begin laMHV.Top := paVAA.Top; paVAA.Height := pnlPrimaryCare.Height; laMHV.Height := paVAA.ClientHeight - 1; laMHV.Visible := true; laVAA2.Visible := false; paVAA.Show; end else if ((PtIsVAA and (not PtIsMHV))) then begin laVAA2.Top := paVAA.Top; paVAA.Height := pnlPrimaryCare.Height-2; laVAA2.Height := paVAA.ClientHeight - 1; laVAA2.Width := paVAA.Width - 1; laVAA2.Visible := true; laMHV.Visible := false; paVAA.Show; end; end; //with //end VAA & MHV end; initialization SpecifyFormIsNotADialog(TfrmCover); finalization if Assigned(fCover.VAAFlag) then fCover.VAAFlag.Free; //VAA end.