Module

fPatientFlagMulti

Path

C:\CPRS\CPRS30\fPatientFlagMulti.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
rMisc -

Units Used in Implementation

Name Comments
fRptBox -
rCover -
uConst -
uCore -
uOrPtf -

Classes

Name Comments
TfrmFlags -
TPRFNotes This object holds a List of Notes Linked to a PRF as Returned VIA the RPCBroker

Procedures

Name Owner Declaration Scope Comments
ActivateSpecificFlag TfrmFlags procedure ActivateSpecificFlag; Private -
FormClose TfrmFlags procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmFlags procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmFlags procedure FormDestroy(Sender: TObject); Public/Published -
FormKeyDown TfrmFlags procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
FormShow TfrmFlags procedure FormShow(Sender: TObject); Public/Published -
GetNotes TfrmFlags procedure GetNotes(SelectedList : TORListBox); Private -
Load TPRFNotes procedure Load(TitleIEN : Int64; DFN : String); Public Procedure to load the notes, this will call the RPC
LoadSelectedFlagData TfrmFlags procedure LoadSelectedFlagData(SelectedList : TORListBox); Private -
lstFlagsCat1Click TfrmFlags procedure lstFlagsCat1Click(Sender: TObject); Public/Published -
lstFlagsCat2Click TfrmFlags procedure lstFlagsCat2Click(Sender: TObject); Public/Published -
lvPRFClick TfrmFlags procedure lvPRFClick(Sender: TObject); Public/Published -
lvPRFKeyDown TfrmFlags procedure lvPRFKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
MakeCat1FlagsStandOut TfrmFlags procedure MakeCat1FlagsStandOut; Private -
PutFlagsOnLists TfrmFlags procedure PutFlagsOnLists(flags, Cat1List, Cat2List: TStrings); Private -
ShowActionsOnList TPRFNotes procedure ShowActionsOnList(DisplayList : TCaptionListView); Public Procedure to show the Notes in a ListView, requires a listview parameter
ShowFlags - procedure ShowFlags(FlagId: integer = 0); Interfaced -
TimerTextFlashTimer TfrmFlags procedure TimerTextFlashTimer(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
GetListToActivate TfrmFlags function GetListToActivate : TORListBox; Private -
getNoteIEN TPRFNotes function getNoteIEN(index: integer): String; Public -

Constants

Name Declaration Scope Comments
ACTION_POS 2 Interfaced -
AUTHOR_POS 4 Interfaced -
HIDDEN_COL 'Press enter or space bar to view this note:' Interfaced -
NOTE_DATE_POS 3 Interfaced -
NOTE_IEN_POS 1 Interfaced TIU GET LINKED PRF NOTES, return position constants
NOTE_TITLE 2 Interfaced -
NOTE_TITLE_IEN 1 Interfaced TIU GET PRF TITLE, return position constants


Module Source

1     unit fPatientFlagMulti;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7       Dialogs, StdCtrls, fAutoSz, ORCtrls, ExtCtrls, ComCtrls, rMisc, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      {This object holds a List of Notes Linked to a PRF as Returned VIA the RPCBroker}
12      TPRFNotes = class(TObject)
13      private
14        FPRFNoteList : TStringList;
15      public
16        //procedure to show the Notes in a ListView, requires a listview parameter
17        procedure ShowActionsOnList(DisplayList : TCaptionListView);
18        //procedure to load the notes, this will call the RPC
19        procedure Load(TitleIEN : Int64; DFN : String);
20        function getNoteIEN(index: integer): String;
21        constructor create;
22        destructor Destroy(); override;
23      end;
24    
25      TfrmFlags = class(TfrmBase508Form)
26        Panel1: TPanel;
27        Splitter3: TSplitter;
28        Splitter1: TSplitter;
29        lblFlags: TLabel;
30        lstFlagsCat2: TORListBox;
31        memFlags: TRichEdit;
32        pnlNotes: TPanel;
33        lvPRF: TCaptionListView;
34        lblNoteTitle: TLabel;
35        Splitter2: TSplitter;
36        pnlBottom: TORAutoPanel;
37        btnClose: TButton;
38        lstFlagsCat1: TORListBox;
39        lblCat1: TLabel;
40        TimerTextFlash: TTimer;
41        procedure lstFlagsCat1Click(Sender: TObject);
42        procedure FormKeyDown(Sender: TObject; var Key: Word;
43          Shift: TShiftState);
44        procedure FormShow(Sender: TObject);
45        procedure FormCreate(Sender: TObject);
46        procedure FormClose(Sender: TObject; var Action: TCloseAction);
47        procedure FormDestroy(Sender: TObject);
48        procedure lvPRFClick(Sender: TObject);
49        procedure lvPRFKeyDown(Sender: TObject; var Key: Word;
50          Shift: TShiftState);
51        procedure TimerTextFlashTimer(Sender: TObject);
52        procedure lstFlagsCat2Click(Sender: TObject);
53      private
54        FFlagID: integer;
55        FPRFNotes : TPRFNotes;
56        FNoteTitle: String;
57        procedure GetNotes(SelectedList : TORListBox);
58        procedure MakeCat1FlagsStandOut;
59        procedure LoadSelectedFlagData(SelectedList : TORListBox);
60        procedure ActivateSpecificFlag;
61        procedure PutFlagsOnLists(flags, Cat1List,  Cat2List: TStrings);
62        function GetListToActivate : TORListBox;
63      public
64        { Public declarations }
65      end;
66    const
67      HIDDEN_COL = 'Press enter or space bar to view this note:';
68      //TIU GET LINKED PRF NOTES, return position constants
69      NOTE_IEN_POS = 1;
70      ACTION_POS = 2;
71      NOTE_DATE_POS = 3;
72      AUTHOR_POS = 4;
73      //TIU GET PRF TITLE, return position constants
74      NOTE_TITLE_IEN = 1;
75      NOTE_TITLE = 2;
76    
77    
78    procedure ShowFlags(FlagId: integer = 0);
79    
80    implementation
81    
82    uses uCore,uOrPtf,ORFn, ORNet, uConst, fRptBox, rCover;
83    {$R *.dfm}
84    
85    procedure ShowFlags(FlagId: integer);
86    var
87      frmFlags: TfrmFlags;
88    begin
89      frmFlags := TfrmFlags.Create(Nil);
90      try
91        SetFormPosition(frmFlags);
92        if HasFlag then
93        begin
94          with frmFlags do begin
95            FFlagID := FlagId;
96            PutFlagsOnLists(FlagList, lstFlagsCat1.Items, lstFlagsCat2.Items);
97          end;
98          frmFlags.memFlags.SelStart := 0;
99          ResizeFormToFont(TForm(frmFlags));
100         frmFlags.ShowModal;
101       end
102     finally
103       frmFlags.Release;
104     end;
105   end;
106   
107   procedure TfrmFlags.lstFlagsCat1Click(Sender: TObject);
108   begin
109     if lstFlagsCat1.ItemIndex >= 0 then
110     begin
111       with lstFlagsCat2 do
112         Selected[ItemIndex] := False;
113       LoadSelectedFlagData(lstFlagsCat1);
114     end;
115   end;
116   
117   procedure TfrmFlags.FormKeyDown(Sender: TObject; var Key: Word;
118     Shift: TShiftState);
119   begin
120     if Key = VK_ESCAPE then
121       Close;
122   end;
123   
124   
125   procedure TfrmFlags.FormShow(Sender: TObject);
126   begin
127     inherited;
128     SetFormPosition(Self);
129     if lstFlagsCat1.Count > 0 then
130       MakeCat1FlagsStandOut;
131   
132     ActivateSpecificFlag;
133   end;
134   
135   procedure TfrmFlags.FormCreate(Sender: TObject);
136   begin
137     inherited;
138     FFlagID := 0;
139   end;
140   
141   procedure TfrmFlags.FormClose(Sender: TObject; var Action: TCloseAction);
142   begin
143     inherited;
144     SaveUserBounds(Self);
145   end;
146   
147   procedure TfrmFlags.GetNotes(SelectedList : TORListBox);
148   var
149     NoteTitleIEN, FlagID : Int64;
150   begin
151       if FPRFNotes = nil then
152         FPRFNotes := TPRFNotes.create;
153       FlagID := SelectedList.ItemID;
154       CallV('TIU GET PRF TITLE', [Patient.DFN,FlagID]);
155       FNoteTitle := Piece(RPCBrokerV.Results[0],U,NOTE_TITLE);
156       lblNoteTitle.Caption := 'Signed, Linked Notes of Title: '+ FNoteTitle;
157       NoteTitleIEN := StrToInt(Piece(RPCBrokerV.Results[0],U,NOTE_TITLE_IEN));
158       FPRFNotes.Load(NoteTitleIEN,Patient.DFN);
159       FPRFNotes.ShowActionsOnList(lvPRF);
160       with lvPRF do begin
161   
162         Columns.BeginUpdate;
163         Columns.EndUpdate;
164       end;
165   end;
166   
167   { TPRFNotes }
168   
169   constructor TPRFNotes.create;
170   begin
171     inherited;
172     FPRFNoteList := TStringList.create;
173   end;
174   
175   destructor TPRFNotes.Destroy;
176   begin
177     FPRFNoteList.Free;
178     inherited;
179   end;
180   
181   function TPRFNotes.getNoteIEN(index: integer): String;
182   begin
183    Result := Piece(FPRFNoteList[index],U,NOTE_IEN_POS);
184   end;
185   
186   procedure TPRFNotes.Load(TitleIEN: Int64; DFN: String);
187   const
188     REVERSE_CHRONO = 1;
189   begin
190     CallV('TIU GET LINKED PRF NOTES', [DFN,TitleIEN,REVERSE_CHRONO]);
191     FastAssign(RPCBrokerV.Results, FPRFNoteList);
192   end;
193   
194   procedure TPRFNotes.ShowActionsOnList(DisplayList: TCaptionListView);
195   var
196     i : integer;
197     ListItem: TListItem;
198   begin
199     DisplayList.Clear;
200     for i := 0 to FPRFNoteList.Count-1 do
201     begin
202       //Caption="Text for Screen Reader" SubItem1=Flag SubItem2=Date SubItem3=Action SubItem4=Note
203       ListItem := DisplayList.Items.Add;
204       ListItem.Caption := HIDDEN_COL; //Screen readers don't read the first column title on a listview.
205       ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,NOTE_DATE_POS));
206       ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,ACTION_POS));
207       ListItem.SubItems.Add(Piece(FPRFNoteList[i],U,AUTHOR_POS));
208     end;
209   end;
210   
211   procedure TfrmFlags.FormDestroy(Sender: TObject);
212   begin
213     FPRFNotes.Free;
214   end;
215   
216   procedure TfrmFlags.lvPRFClick(Sender: TObject);
217   begin
218     if lvPRF.ItemIndex > -1 then
219     begin
220       NotifyOtherApps(NAE_REPORT, 'TIU^' + FPRFNotes.getNoteIEN(lvPRF.ItemIndex));
221       ReportBox(DetailPosting(FPRFNotes.getNoteIEN(lvPRF.ItemIndex)), FNoteTitle, True);
222     end;
223   end;
224   
225   procedure TfrmFlags.lvPRFKeyDown(Sender: TObject; var Key: Word;
226     Shift: TShiftState);
227   begin
228     if (Key = VK_SPACE) or (Key = VK_RETURN) then
229       lvPRFClick(Sender);
230   end;
231   
232   
233   procedure TfrmFlags.MakeCat1FlagsStandOut;
234   Const
235     FONT_INC = 4;
236     clBrightOrange = TColor($3ABEF3);  //Blue 58 Green 190 Red 243
237   begin
238     lblCat1.Font.Size := lblCat1.Font.Size + FONT_INC;
239     lstFlagsCat1.Font.Size := lstFlagsCat1.Font.Size + FONT_INC;
240     lblCat1.Color := Get508CompliantColor(clBrightOrange);
241     lstFlagsCat1.Color := Get508CompliantColor(clBrightOrange);
242     lblCat1.Font.Color := Get508CompliantColor(clWhite);
243     lstFlagsCat1.Font.Color := Get508CompliantColor(clWhite);
244     TimerTextFlash.Enabled := true;
245   end;
246   
247   procedure TfrmFlags.TimerTextFlashTimer(Sender: TObject);
248   begin
249     if lblCat1.Font.Color = Get508CompliantColor(clWhite) then
250       lblCat1.Font.Color := Get508CompliantColor(clBlack)
251     else
252       lblCat1.Font.Color := Get508CompliantColor(clWhite);
253   end;
254   
255   procedure TfrmFlags.LoadSelectedFlagData(SelectedList: TORListBox);
256   var
257     FlagArray: TStringList;
258   begin
259       FlagArray := TStringList.Create;
260       GetActiveFlg(FlagArray, Patient.DFN, SelectedList.ItemID);
261       if FlagArray.Count > 0 then
262         QuickCopy(FlagArray, memFlags);
263       memFlags.SelStart := 0;
264       GetNotes(SelectedList);
265   end;
266   
267   procedure TfrmFlags.lstFlagsCat2Click(Sender: TObject);
268   begin
269     if lstFlagsCat2.ItemIndex >= 0 then
270     begin
271       with lstFlagsCat1 do
272         Selected[ItemIndex] := False;
273       LoadSelectedFlagData(lstFlagsCat2);
274     end;
275   end;
276   
277   procedure TfrmFlags.ActivateSpecificFlag;
278   var
279     idx: integer;
280     SelectedList : TORListBox;
281   begin
282     idx := 0;
283     SelectedList := GetListToActivate;
284     if FFlagID > 0 then
285       idx := SelectedList.SelectByIEN(FFlagId);
286     SelectedList.ItemIndex := idx;
287     SelectedList.OnClick(Self);
288     ActiveControl := memFlags;
289     GetNotes(SelectedList);
290   end;
291   
292   function TfrmFlags.GetListToActivate: TORListBox;
293   begin
294     Result := nil;
295     if FFlagID > 0 then begin
296       if lstFlagsCat1.SelectByIEN(FFlagId) > -1 then
297         Result := lstFlagsCat1
298       else if lstFlagsCat2.SelectByIEN(FFlagId) > -1 then
299         Result := lstFlagsCat2
300     end;
301     if Result = nil then
302       if lstFlagsCat1.Items.Count > 0 then
303         Result := lstFlagsCat1
304       else
305         Result := lstFlagsCat2;
306   
307   end;
308   
309   procedure TfrmFlags.PutFlagsOnLists(flags, Cat1List, Cat2List: TStrings);
310   Const
311     FLAG_TYPE_POS = 3;
312     TRUE_STRING = '1';
313   var
314     i, TypeOneCount, TypeTwoCount : integer;
315   begin
316     TypeOneCount := 0;
317     TypeTwoCount := 0;
318     for i := 0 to flags.Count-1 do begin
319       if Piece(flags[i],U,FLAG_TYPE_POS) = TRUE_STRING then begin
320         Cat1List.Add(flags[i]);
321         Inc(TypeOneCount);
322       end else begin
323         Cat2List.Add(flags[i]);
324         Inc(TypeTwoCount);
325       end;
326     end;
327     If TypeOneCount > 0 then
328      lblCat1.Caption := 'Category I Flags: ' + IntToStr(TypeOneCount) + ' Item(s)'
329     else
330      lblCat1.Caption := 'Category I Flags';
331   
332     If TypeTwoCount > 0 then
333      lblFlags.Caption := 'Category II Flags: ' + IntToStr(TypeTwoCount) + ' Item(s)'
334     else
335      lblFlags.Caption := 'Category II Flags';
336   end;
337   
338   
339   end.

Module Calls (2 levels)


fPatientFlagMulti
 ├rMisc
 │ └fOrders
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├uOrPtf
 ├uConst
 ├fRptBox
 │ ├fFrame
 │ ├fBase508Form...
 │ ├uReports
 │ └rReports
 └rCover
   ├uConst
   ├fFrame...
   ├uCore...
   ├rMeds
   └uReminders

Module Called-By (2 levels)


          fPatientFlagMulti
                   fFrame┤ 
              CPRSChart┤ │ 
                  fPage┤ │ 
                uOrders┤ │ 
                fODBase┤ │ 
                UBACore┤ │ 
                fOrders┤ │ 
                   uPCE┤ │ 
      fBALocalDiagnoses┤ │ 
             fEncVitals┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fPtSelMsg┤ │ 
                 fPtSel┤ │ 
            fOrdersSign┤ │ 
         fPrintLocation┤ │ 
                  fMeds┤ │ 
                fRptBox┤ │ 
                 fNotes┤ │ 
               fReports┤ │ 
                 fEncnt┤ │ 
                 fProbs┤ │ 
          fReportsPrint┤ │ 
                fGraphs┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
              fLabPrint┤ │ 
                fReview┤ │ 
            fIconLegend┤ │ 
           fOrdersPrint┤ │ 
               fSurgery┤ │ 
uVA508CPRSCompatibility┤ │ 
           fOrdersRenew┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                 fOMSet┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
             fOCSession┤ │ 
              fODActive┤ │ 
               fPCEEdit┘ │ 
                fCover...┘